Proof method 'reify' is now reentrant.
--- a/src/HOL/Library/reflection.ML Sun Feb 08 11:59:26 2009 +0100
+++ b/src/HOL/Library/reflection.ML Mon Feb 09 11:19:44 2009 +0100
@@ -86,6 +86,23 @@
exception REIF of string;
+fun dest_listT (Type ("List.list", [T])) = T;
+
+fun partition P [] = ([],[])
+ | partition P (x::xs) =
+ let val (yes,no) = partition P xs
+ in if P x then (x::yes,no) else (yes, x::no) end
+
+fun rearrange congs =
+let
+ fun P (_, th) =
+ let val @{term "Trueprop"}$(Const ("op =",_) $l$_) = concl_of th
+ in can dest_Var l end
+ val (yes,no) = partition P congs
+ in no @ yes end
+
+fun genreif ctxt raw_eqs t =
+ let
val bds = ref ([]: (typ * ((term list) * (term list))) list);
fun index_of t =
@@ -106,8 +123,6 @@
end)
end;
-fun dest_listT (Type ("List.list", [T])) = T;
-
fun decomp_genreif da cgns (t,ctxt) =
let
val thy = ProofContext.theory_of ctxt
@@ -151,8 +166,6 @@
end;
(* looks for the atoms equation and instantiates it with the right number *)
-
-
fun mk_decompatom eqs (t,ctxt) =
let
val tT = fastype_of t
@@ -229,8 +242,8 @@
(* Generic reification procedure: *)
(* creates all needed cong rules and then just uses the theorem synthesis *)
- fun mk_congs ctxt raw_eqs =
- let
+fun mk_congs ctxt raw_eqs =
+let
val fs = fold_rev (fn eq =>
insert (op =) (eq |> prop_of |> HOLogic.dest_Trueprop
|> HOLogic.dest_eq |> fst |> strip_comb
@@ -257,23 +270,6 @@
in ps ~~ (Variable.export ctxt' ctxt congs)
end
-fun partition P [] = ([],[])
- | partition P (x::xs) =
- let val (yes,no) = partition P xs
- in if P x then (x::yes,no) else (yes, x::no) end
-
-fun rearrange congs =
-let
- fun P (_, th) =
- let val @{term "Trueprop"}$(Const ("op =",_) $l$_) = concl_of th
- in can dest_Var l end
- val (yes,no) = partition P congs
- in no @ yes end
-
-
-
-fun genreif ctxt raw_eqs t =
- let
val congs = rearrange (mk_congs ctxt raw_eqs)
val th = divide_and_conquer (decomp_genreif (mk_decompatom raw_eqs) congs) (t,ctxt)
fun is_listVar (Var (_,t)) = can dest_listT t