fixed two stupid bugs of SML to do with the value restriction and missing type
authorurbanc
Tue, 06 Feb 2007 15:12:18 +0100
changeset 22250 0d7ea7d2bc28
parent 22249 5460a5e4caa2
child 22251 b4e26fba2a1a
fixed two stupid bugs of SML to do with the value restriction and missing type information in records
src/HOL/Nominal/nominal_thmdecls.ML
--- a/src/HOL/Nominal/nominal_thmdecls.ML	Tue Feb 06 12:54:55 2007 +0100
+++ b/src/HOL/Nominal/nominal_thmdecls.ML	Tue Feb 06 15:12:18 2007 +0100
@@ -12,7 +12,7 @@
 
 signature NOMINAL_THMDECLS =
 sig
-  val print_eqvtset: Proof.context -> unit
+  val print_data: Proof.context -> unit
   val eqvt_add: attribute
   val eqvt_del: attribute
   val setup: theory -> theory
@@ -27,14 +27,22 @@
 (
   val name = "HOL/Nominal/eqvt";
   type T = {eqvt:thm list, fresh:thm list, bij:thm list};
-  val empty = {eqvt=[], fresh=[], bij=[]};
+  val empty = ({eqvt=[], fresh=[], bij=[]}:T);
   val extend = I;
-  fun merge _ (r1,r2) = {eqvt  = Drule.merge_rules (#eqvt r1, #eqvt r2), 
-                         fresh = Drule.merge_rules (#fresh r1, #fresh r2), 
-                         bij   = Drule.merge_rules (#bij r1, #bij r2)}
-  fun print context rules =
-    Pretty.writeln (Pretty.big_list "Equivariance lemmas:"
-      (map (ProofContext.pretty_thm (Context.proof_of context)) (#eqvt rules)));
+  fun merge _ (r1:T,r2:T) = {eqvt  = Drule.merge_rules (#eqvt r1, #eqvt r2), 
+                             fresh = Drule.merge_rules (#fresh r1, #fresh r2), 
+                             bij   = Drule.merge_rules (#bij r1, #bij r2)}
+  fun print context (data:T) =
+    let 
+       fun print_aux msg thms =
+         Pretty.writeln (Pretty.big_list msg
+           (map (ProofContext.pretty_thm (Context.proof_of context)) thms))
+    in
+      (print_aux "Equivariance lemmas: " (#eqvt data);
+       print_aux "Freshness lemmas: " (#fresh data);
+       print_aux "Bijection lemmas: " (#bij data))
+    end;
+ 
 );
 
 (* Exception for when a theorem does not conform with form of an equivariance lemma. *)
@@ -48,7 +56,7 @@
 (* eqality-lemma can be derived. *)
 exception EQVT_FORM;
 
-val print_eqvtset = Data.print o Context.Proof;
+val print_data = Data.print o Context.Proof;
 
 (* FIXME: should be a function in a library *)
 fun mk_permT T = HOLogic.listT (HOLogic.mk_prodT (T, T));
@@ -176,21 +184,12 @@
      Context.mapping (snd o PureThy.add_thmss [((name,(record_access (Data.get context'))),[])]) I context' 
    end
 
-(*
-fun simple_add_del_aux record_access name flag th context = 
-  let 
-     val context' = Data.map th context 
-  in 
-     Context.mapping (snd o PureThy.add_thmss [((name,(record_access (Data.get context'))),[])]) I context'
-  end
-*)
+fun bij_add_del_aux f   = simple_add_del_aux #bij "bij" f
+fun fresh_add_del_aux f = simple_add_del_aux #fresh "fresh" f
 
-val bij_add_del_aux   = simple_add_del_aux #bij "bij"
-val fresh_add_del_aux = simple_add_del_aux #fresh "fresh"
-
-fun eqvt_map f th r  = {eqvt = (f th (#eqvt r)), fresh = #fresh r, bij = #bij r};
-fun fresh_map f th r = {eqvt = #eqvt r, fresh = (f th (#fresh r)), bij = #bij r};
-fun bij_map f th r   = {eqvt = #eqvt r, fresh = #fresh r, bij = (f th (#bij r))};
+fun eqvt_map f th (r:Data.T)  = {eqvt = (f th (#eqvt r)), fresh = #fresh r, bij = #bij r};
+fun fresh_map f th (r:Data.T) = {eqvt = #eqvt r, fresh = (f th (#fresh r)), bij = #bij r};
+fun bij_map f th (r:Data.T)   = {eqvt = #eqvt r, fresh = #fresh r, bij = (f th (#bij r))};
 
 val eqvt_add  = Thm.declaration_attribute (eqvt_add_del_aux (eqvt_map Drule.add_rule)); 
 val eqvt_del  = Thm.declaration_attribute (eqvt_add_del_aux (eqvt_map Drule.del_rule));