# HG changeset patch # User haftmann # Date 1197910672 -3600 # Node ID d0e8cb55ee7b03ced50dc6928b103e08883bca79 # Parent a9ebfc170fbc5b1c21db32ef2bc6db63df62982e explicit closing of derived witnesses diff -r a9ebfc170fbc -r d0e8cb55ee7b src/Pure/Isar/locale.ML --- a/src/Pure/Isar/locale.ML Mon Dec 17 17:57:51 2007 +0100 +++ b/src/Pure/Isar/locale.ML Mon Dec 17 17:57:52 2007 +0100 @@ -330,25 +330,26 @@ | _ => (regs, [])) end; - fun gen_add f ts thm regs = + fun gen_add f ts regs = let val t = termify ts; in - Termtab.update (t, f thm (the (Termtab.lookup regs t))) regs + Termtab.update (t, f (the (Termtab.lookup regs t))) regs end; (* add witness theorem to registration, only if instantiation is exact, otherwise exception Option raised *) - fun add_witness ts thm regs = - gen_add (fn thm => fn (x, m, thms, eqns) => (x, m, thm::thms, eqns)) ts thm regs; + fun add_witness ts wit regs = + gen_add (fn (x, m, wits, eqns) => (x, m, Element.close_witness wit :: wits, eqns)) + ts regs; (* add equation to registration, replaces previous equation with same lhs; only if instantiation is exact, otherwise exception Option raised; exception TERM raised if not a meta equality *) fun add_equation ts thm regs = - gen_add (fn thm => fn (x, m, thms, eqns) => - (x, m, thms, Termtab.update (thm |> prop_of |> Logic.dest_equals |> fst, thm) eqns)) - ts thm regs; + gen_add (fn (x, m, thms, eqns) => + (x, m, thms, Termtab.update (thm |> prop_of |> Logic.dest_equals |> fst, Goal.close_result thm) eqns)) + ts regs; end; @@ -856,7 +857,8 @@ (Element.morph_witness (Element.instT_morphism thy env $> Element.rename_morphism ren $> - Element.satisfy_morphism wits))); + Element.satisfy_morphism wits) + #> Element.close_witness)); val new_ids' = map (fn (id, wits) => (id, ([], Derived wits))) (new_ids ~~ new_wits); val new_idTs' = map (fn ((n, pTs), (_, ([], mode))) => @@ -1017,7 +1019,8 @@ Assumed axs => fold (add_local_witness (name, ps') o Element.assume_witness thy o Element.witness_prop) axs ctxt'' - | Derived ths => fold (add_local_witness (name, ps')) ths ctxt'' + | Derived ths => + fold (add_local_witness (name, ps')) ths ctxt'' end end in (ProofContext.restore_naming ctxt ctxt'', res) end; @@ -1557,7 +1560,7 @@ fun init loc = ProofContext.init - #> (#2 o cert_context_statement (SOME loc) [] []); + #> #2 o cert_context_statement (SOME loc) [] []; (* print locale *)