clarified semantics of merge
authorhaftmann
Thu, 26 Apr 2007 13:33:16 +0200
changeset 22806 45ac82e7b887
parent 22805 1166a966e7b4
child 22807 715d01b34abb
clarified semantics of merge
src/Pure/Tools/codegen_data.ML
--- a/src/Pure/Tools/codegen_data.ML	Thu Apr 26 13:33:15 2007 +0200
+++ b/src/Pure/Tools/codegen_data.ML	Thu Apr 26 13:33:16 2007 +0200
@@ -126,7 +126,7 @@
     fun drop thm' = not (matches args (args_of thm'))
       orelse (warning ("Dropping redundant defining equation\n" ^ string_of_thm thm'); false);
     val (keeps, drops) = List.partition drop sels;
-  in (thm :: keeps, dels |> fold (insert Thm.eq_thm_prop) drops |> remove Thm.eq_thm_prop thm) end;
+  in (thm :: keeps, dels |> remove Thm.eq_thm_prop thm |> fold (insert Thm.eq_thm_prop) drops) end;
 
 fun add_thm thm (sels, dels) =
   apfst Susp.value (add_drop_redundant thm (Susp.force sels, dels));
@@ -148,11 +148,13 @@
     val (dels_t, dels) = merge_thms (dels1, dels2);
   in if dels_t
     then let
-      val (_, sels) = merge_thms (Susp.force sels1, subtract Thm.eq_thm_prop dels1 (Susp.force sels2))
-      val (_, dels) = merge_thms (dels1, subtract Thm.eq_thm_prop (Susp.force sels1) dels2)
+      val (_, sels) = merge_thms
+        (subtract Thm.eq_thm_prop dels2 (Susp.force sels1), Susp.force sels2);
+      val (_, dels) = merge_thms
+        (subtract Thm.eq_thm_prop (Susp.force sels2) dels1, dels2);
     in (true, ((lazy_thms o K) sels, dels)) end
     else let
-      val (sels_t, sels) = merge_lthms (sels1, sels2)
+      val (sels_t, sels) = merge_lthms (sels1, sels2);
     in (sels_t, (sels, dels)) end
   end;
 
@@ -191,9 +193,9 @@
       (if touched then cs''' := cons c (!cs''') else (); thms') end;
   in (cs'' @ !cs''', Consttab.join merge tabs) end;
 fun merge_funcs (thms1, thms2) =
-    let
-      val (consts, thms) = join_func_thms (thms1, thms2);
-    in (SOME consts, thms) end;
+  let
+    val (consts, thms) = join_func_thms (thms1, thms2);
+  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));
@@ -209,7 +211,9 @@
     val diff_types = not (gen_eq_set (eq_pair (op =) eq_dtyp)
       (AList.make (the o Symtab.lookup tab1) tycos',
        AList.make (the o Symtab.lookup tab2) tycos'));
-  in ((new_types, diff_types), Symtab.merge (K true) tabs) end;
+    fun join _ (cos as (_, cos2)) = if eq_dtyp cos
+      then raise Symtab.SAME else cos2;
+  in ((new_types, diff_types), Symtab.join join tabs) end;
 
 datatype spec = Spec of {
   funcs: sdthms Consttab.table,