quotient.ML
changeset 321 f46dc0ca08c3
parent 320 7d3d86beacd6
child 329 5d06e1dba69a
--- a/quotient.ML	Fri Nov 20 13:03:01 2009 +0100
+++ b/quotient.ML	Sat Nov 21 02:49:39 2009 +0100
@@ -1,5 +1,7 @@
 signature QUOTIENT =
 sig
+  exception LIFT_MATCH of string 
+
   val quotient_type: ((binding * mixfix) * (typ * term)) list -> Proof.context -> Proof.state
   val quotient_type_cmd: (((bstring * mixfix) * string) * string) list -> Proof.context -> Proof.state
 
@@ -9,6 +11,9 @@
 structure Quotient: QUOTIENT =
 struct
 
+(* exception for when quotient and lifted things do not match *)
+exception LIFT_MATCH of string 
+
 (* wrappers for define, note and theorem_i *)
 fun define (name, mx, rhs) lthy =
 let
@@ -150,15 +155,17 @@
   val _ = tracing ("storing under: " ^ qty_str)
   val lthy3 = quotdata_update qty_str (Logic.varifyT abs_ty, Logic.varifyT rty, rel, equiv_thm) lthy2  
   (* FIXME: varifyT should not be used *)
+  (* storing of the equiv_thm under a name *)
+  val (_, lthy4) = note (Binding.suffix_name "_equiv" qty_name, equiv_thm) lthy3
 
   (* interpretation *)
   val bindd = ((Binding.make ("", Position.none)), ([]: Attrib.src list))
-  val ((_, [eqn1pre]), lthy4) = Variable.import true [ABS_def] lthy3;
+  val ((_, [eqn1pre]), lthy5) = Variable.import true [ABS_def] lthy4;
   val eqn1i = Thm.prop_of (symmetric eqn1pre)
-  val ((_, [eqn2pre]), lthy5) = Variable.import true [REP_def] lthy4;
+  val ((_, [eqn2pre]), lthy6) = Variable.import true [REP_def] lthy5;
   val eqn2i = Thm.prop_of (symmetric eqn2pre)
 
-  val exp_morphism = ProofContext.export_morphism lthy5 (ProofContext.init (ProofContext.theory_of lthy5));
+  val exp_morphism = ProofContext.export_morphism lthy6 (ProofContext.init (ProofContext.theory_of lthy6));
   val exp_term = Morphism.term exp_morphism;
   val exp = Morphism.thm exp_morphism;
 
@@ -169,14 +176,14 @@
   val exp_i = [(@{const_name QUOT_TYPE}, ((("QUOT_TYPE_I_" ^ (Binding.name_of qty_name)), true),
     Expression.Named [("R", rel), ("Abs", abs), ("Rep", rep) ]))]
 in
-  lthy5
+  lthy6
   |> note (quot_thm_name, quot_thm)
   ||>> note (quotient_thm_name, quotient_thm)
   ||> Local_Theory.theory (fn thy =>
       let
         val global_eqns = map exp_term [eqn2i, eqn1i];
         (* Not sure if the following context should not be used *)
-        val (global_eqns2, lthy6) = Variable.import_terms true global_eqns lthy5;
+        val (global_eqns2, lthy7) = Variable.import_terms true global_eqns lthy6;
         val global_eqns3 = map (fn t => (bindd, t)) global_eqns2;
       in ProofContext.theory_of (bymt (Expression.interpretation (exp_i, []) global_eqns3 thy)) end)
 end