# HG changeset patch # User wenzelm # Date 1236721796 -3600 # Node ID 692279df7cc299bc916f11ffbfa70060e3fb7a31 # Parent 6baef860dfa6dccf1e35651c9bd9f2fe894ecdda Consts.eq_const is back again (cf. 907da436f8a9) -- required in ProofContext.transfer_syntax to prevent expensive merges of local_consts/global_consts; diff -r 6baef860dfa6 -r 692279df7cc2 src/Pure/Isar/proof_context.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; diff -r 6baef860dfa6 -r 692279df7cc2 src/Pure/consts.ML --- 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};