src/HOLCF/fixrec_package.ML
changeset 17985 d5d576b72371
parent 17959 8db36a108213
child 18358 0a733e11021a
--- a/src/HOLCF/fixrec_package.ML	Sat Oct 22 01:22:10 2005 +0200
+++ b/src/HOLCF/fixrec_package.ML	Tue Oct 25 18:18:49 2005 +0200
@@ -105,11 +105,10 @@
       PureThy.add_defs_i false (map Thm.no_attributes fixdefs) thy;
     val ctuple_fixdef_thm = foldr1 (fn (x,y) => cpair_equalI OF [x,y]) fixdef_thms;
     
-    fun mk_cterm t = cterm_of thy' (infer thy' t);
-    val ctuple_unfold_ct = mk_cterm (mk_trp (mk_ctuple lhss === mk_ctuple rhss));
-    val ctuple_unfold_thm = OldGoals.prove_goalw_cterm [] ctuple_unfold_ct
-          (fn _ => [rtac (ctuple_fixdef_thm RS fix_eq2 RS trans) 1,
-                    simp_tac (simpset_of thy') 1]);
+    val ctuple_unfold = infer thy' (mk_trp (mk_ctuple lhss === mk_ctuple rhss));
+    val ctuple_unfold_thm = standard (Goal.prove thy' [] [] ctuple_unfold
+          (fn _ => EVERY [rtac (ctuple_fixdef_thm RS fix_eq2 RS trans) 1,
+                    simp_tac (simpset_of thy') 1]));
     val ctuple_induct_thm =
           (space_implode "_" names ^ "_induct", ctuple_fixdef_thm RS def_fix_ind);
     
@@ -216,9 +215,8 @@
 (* proves a block of pattern matching equations as theorems, using unfold *)
 fun make_simps thy (unfold_thm, eqns) =
   let
-    fun tacsf prems =
-      [rtac (unfold_thm RS ssubst_lhs) 1, simp_tac (simpset_of thy addsimps prems) 1];
-    fun prove_term t = OldGoals.prove_goalw_cterm [] (cterm_of thy t) tacsf;
+    val tacs = [rtac (unfold_thm RS ssubst_lhs) 1, asm_simp_tac (simpset_of thy) 1];
+    fun prove_term t = standard (Goal.prove thy [] [] t (K (EVERY tacs)));
     fun prove_eqn ((name, eqn_t), atts) = ((name, prove_term eqn_t), atts);
   in
     map prove_eqn eqns
@@ -275,8 +273,8 @@
     val cname = case chead_of t of Const(c,_) => c | _ =>
               fixrec_err "function is not declared as constant in theory";
     val unfold_thm = PureThy.get_thm thy (Name (cname^"_unfold"));
-    val simp = OldGoals.prove_goalw_cterm [] (cterm_of thy eq)
-          (fn _ => [stac unfold_thm 1, simp_tac (simpset_of thy) 1]);
+    val simp = standard (Goal.prove thy [] [] eq
+          (fn _ => EVERY [stac unfold_thm 1, simp_tac (simpset_of thy) 1]));
   in simp end;
 
 fun gen_add_fixpat prep_term prep_attrib ((name, srcs), strings) thy =