Quot/quotient_tacs.ML
changeset 1077 44461d5615eb
parent 1075 b2f32114e8a6
child 1078 f4da25147389
--- a/Quot/quotient_tacs.ML	Fri Feb 05 15:17:21 2010 +0100
+++ b/Quot/quotient_tacs.ML	Sat Feb 06 10:04:56 2010 +0100
@@ -15,7 +15,7 @@
   val lift_tac: Proof.context -> thm list -> int -> tactic
   val quotient_tac: Proof.context -> int -> tactic
   val quot_true_tac: Proof.context -> (term -> term) -> int -> tactic
-  val lifted_attr: attribute
+  val lifted_attrib: attribute
 end;
 
 structure Quotient_Tacs: QUOTIENT_TACS =
@@ -648,15 +648,19 @@
   THEN' RANGE (map mk_tac rthms)
 end
 
-(* The attribute *)
-fun lifted_attr_pre ctxt thm =
+(* An Attribute *)
+(* FIXME: Logic.unvarify needs to be replaced by propper Isar constructions *)
+fun lifted_attrib_pre context thm =
 let
-  val gl = (quotient_lift_all ctxt o Logic.unvarify o prop_of) thm
-  val glc = Syntax.check_term ctxt gl
+  val ctxt = Context.proof_of context
+  val goal = (quotient_lift_all ctxt o Logic.unvarify o prop_of) thm
+  val goal_chk = Syntax.check_term ctxt goal
+  val frees = Term.add_free_names goal_chk []
 in
-  (Goal.prove ctxt (Term.add_free_names glc []) [] glc (fn x => lift_tac (#context x) [thm] 1))
+  Goal.prove ctxt frees [] goal_chk 
+   (fn x => lift_tac (#context x) [thm] 1)
 end;
 
-val lifted_attr = Thm.rule_attribute (fn ctxt => fn t => lifted_attr_pre (Context.proof_of ctxt) t)
+val lifted_attrib = Thm.rule_attribute lifted_attrib_pre
 
 end; (* structure *)