Consts.eq_const is back again (cf. 907da436f8a9) -- required in ProofContext.transfer_syntax to prevent expensive merges of local_consts/global_consts;
authorwenzelm
Tue, 10 Mar 2009 22:49:56 +0100
changeset 30424 692279df7cc2
parent 30423 6baef860dfa6
child 30426 699afca33527
Consts.eq_const is back again (cf. 907da436f8a9) -- required in ProofContext.transfer_syntax to prevent expensive merges of local_consts/global_consts;
src/Pure/Isar/proof_context.ML
src/Pure/consts.ML
--- a/src/Pure/Isar/proof_context.ML	Tue Mar 10 22:27:32 2009 +0100
+++ b/src/Pure/Isar/proof_context.ML	Tue Mar 10 22:49:56 2009 +0100
@@ -262,9 +262,11 @@
 
 fun transfer_syntax thy =
   map_syntax (LocalSyntax.rebuild thy) #>
-  map_consts (fn (local_consts, _) =>
-    let val thy_consts = Sign.consts_of thy
-    in (Consts.merge (local_consts, thy_consts), thy_consts) end);
+  map_consts (fn consts as (local_consts, global_consts) =>
+    let val thy_consts = Sign.consts_of thy in
+      if Consts.eq_consts (thy_consts, global_consts) then consts
+      else (Consts.merge (local_consts, thy_consts), thy_consts)
+    end);
 
 fun transfer thy = Context.transfer_proof thy #> transfer_syntax thy;
 
--- a/src/Pure/consts.ML	Tue Mar 10 22:27:32 2009 +0100
+++ b/src/Pure/consts.ML	Tue Mar 10 22:49:56 2009 +0100
@@ -8,6 +8,7 @@
 signature CONSTS =
 sig
   type T
+  val eq_consts: T * T -> bool
   val abbrevs_of: T -> string list -> (term * term) list
   val dest: T ->
    {constants: (typ * term option) NameSpace.table,
@@ -53,6 +54,13 @@
   constraints: typ Symtab.table,
   rev_abbrevs: (term * term) list Symtab.table};
 
+fun eq_consts
+   (Consts {decls = decls1, constraints = constraints1, rev_abbrevs = rev_abbrevs1},
+    Consts {decls = decls2, constraints = constraints2, rev_abbrevs = rev_abbrevs2}) =
+  pointer_eq (decls1, decls2) andalso
+  pointer_eq (constraints1, constraints2) andalso
+  pointer_eq (rev_abbrevs1, rev_abbrevs2);
+
 fun make_consts (decls, constraints, rev_abbrevs) =
   Consts {decls = decls, constraints = constraints, rev_abbrevs = rev_abbrevs};