# HG changeset patch # User wenzelm # Date 1686057160 -7200 # Node ID 0ea55458f867f4329ef56b18287eadafe0f4b469 # Parent 9ccb1ae28f0dc26c5216b08dc9b7942e152c4529 proper trim_context / transfer, e.g. for Specification.definition; diff -r 9ccb1ae28f0d -r 0ea55458f867 src/Pure/assumption.ML --- a/src/Pure/assumption.ML Tue Jun 06 14:19:53 2023 +0200 +++ b/src/Pure/assumption.ML Tue Jun 06 15:12:40 2023 +0200 @@ -82,14 +82,19 @@ ); fun map_data f = Data.map (fn Data {rev_assms, rev_prems} => make_data (f (rev_assms, rev_prems))); -fun rep_data ctxt = Data.get ctxt |> (fn Data rep => rep); (* all assumptions *) -val all_assumptions_of = rev o #rev_assms o rep_data; +fun all_assumptions_of ctxt = + let val Data {rev_assms, ...} = Data.get ctxt + in fold (cons o (apsnd o map) (Thm.transfer_cterm' ctxt)) rev_assms [] end; + +fun all_prems_of ctxt = + let val Data {rev_prems, ...} = Data.get ctxt + in fold (cons o Thm.transfer' ctxt) rev_prems [] end; + val all_assms_of = maps #2 o all_assumptions_of; -val all_prems_of = rev o #rev_prems o rep_data; (* local assumptions *) @@ -129,7 +134,8 @@ let val (new_prems, ctxt') = fold_map assume_hyps new_asms ctxt in ctxt' |> map_data (fn (rev_assms, rev_prems) => - ((export, new_asms) :: rev_assms, fold cons new_prems rev_prems)) + ((export, map Thm.trim_context_cterm new_asms) :: rev_assms, + fold (cons o Thm.trim_context) new_prems rev_prems)) |> pair new_prems end; @@ -154,11 +160,12 @@ fun export_morphism inner outer = let - val export0 = export_thm false inner outer; + val assms0 = local_assumptions_of inner outer + |> (map o apsnd o map) Thm.trim_context_cterm; fun thm thy = let val norm = norm_hhf_protect (Proof_Context.init_global thy) - in norm #> export0 #> norm end; - val term = export_term inner outer; + in norm #> thm_export false assms0 #> norm end; + val term = term_export assms0; val typ = Logic.type_map term; in Morphism.morphism "Assumption.export"