monomorphic equality: let ML work out the details;
authorwenzelm
Sun, 03 Jun 2007 23:16:57 +0200
changeset 23229 492e2fd12767
parent 23228 05fb9b2b16d7
child 23230 b70c8c2283c2
monomorphic equality: let ML work out the details;
src/Pure/Tools/codegen_data.ML
src/Pure/Tools/codegen_names.ML
--- a/src/Pure/Tools/codegen_data.ML	Sun Jun 03 23:16:56 2007 +0200
+++ b/src/Pure/Tools/codegen_data.ML	Sun Jun 03 23:16:57 2007 +0200
@@ -211,7 +211,7 @@
   in (SOME consts, thms) end;
 
 val eq_string = op = : string * string -> bool;
-val eq_co = eq_pair eq_string (eq_list (is_equal o Term.typ_ord));
+val eq_co = op = : (string * typ list) * (string * typ list) -> bool;
 fun eq_dtyp ((vs1, cs1), (vs2, cs2)) = 
   gen_eq_set (eq_pair eq_string (gen_eq_set eq_string)) (vs1, vs2)
     andalso gen_eq_set eq_co (cs1, cs2);
--- a/src/Pure/Tools/codegen_names.ML	Sun Jun 03 23:16:56 2007 +0200
+++ b/src/Pure/Tools/codegen_names.ML	Sun Jun 03 23:16:57 2007 +0200
@@ -232,14 +232,12 @@
 
 type tyco = string;
 type const = string;
-val string_pair_ord = prod_ord fast_string_ord fast_string_ord;
-val eq_string_pair = is_equal o string_pair_ord;
 structure Consttab = CodegenConsts.Consttab;
 
 structure StringPairTab =
   TableFun(
     type key = string * string;
-    val ord = string_pair_ord;
+    val ord = prod_ord fast_string_ord fast_string_ord;
   );
 
 datatype names = Names of {
@@ -256,8 +254,6 @@
   instance = (StringPairTab.empty, Symtab.empty)
 };
 
-val eq_string = op = : string * string -> bool;
-
 local
   fun mk_names (class, classrel, tyco, instance) =
     Names { class = class, classrel = classrel, tyco = tyco, instance = instance };
@@ -270,10 +266,10 @@
     Names { class = (class2, classrev2),
       classrel = (classrel2, classrelrev2), tyco = (tyco2, tycorev2),
       instance = (instance2, instancerev2) }) =
-    mk_names ((Symtab.merge eq_string (class1, class2), Symtab.merge eq_string (classrev1, classrev2)),
-      (StringPairTab.merge eq_string (classrel1, classrel2), Symtab.merge eq_string_pair (classrelrev1, classrelrev2)),
-      (Symtab.merge eq_string (tyco1, tyco2), Symtab.merge eq_string (tycorev1, tycorev2)),
-      (StringPairTab.merge eq_string (instance1, instance2), Symtab.merge eq_string_pair (instancerev1, instancerev2)));
+    mk_names ((Symtab.merge (op =) (class1, class2), Symtab.merge (op =) (classrev1, classrev2)),
+      (StringPairTab.merge (op =) (classrel1, classrel2), Symtab.merge (op =) (classrelrev1, classrelrev2)),
+      (Symtab.merge (op =) (tyco1, tyco2), Symtab.merge (op =) (tycorev1, tycorev2)),
+      (StringPairTab.merge (op =) (instance1, instance2), Symtab.merge (op =) (instancerev1, instancerev2)));
   fun map_class f = map_names
     (fn (class, classrel, tyco, inst) => (f class, classrel, tyco, inst));
   fun map_classrel f = map_names
@@ -297,8 +293,8 @@
 (
   type T = const Consttab.table * (string * string option) Symtab.table;
   val empty = (Consttab.empty, Symtab.empty);
-  fun merge _ ((const1, constrev1), (const2, constrev2)) =
-    (Consttab.merge eq_string (const1, const2),
+  fun merge _ ((const1, constrev1), (const2, constrev2)) : T =
+    (Consttab.merge (op =) (const1, const2),
       Symtab.merge CodegenConsts.eq_const (constrev1, constrev2));
   fun purge _ NONE _ = empty
     | purge _ (SOME cs) (const, constrev) = (fold Consttab.delete_safe cs const,