27 - current finish_global adds unwanted lemmas to theory/locale |
27 - current finish_global adds unwanted lemmas to theory/locale |
28 *) |
28 *) |
29 |
29 |
30 signature LOCALE = |
30 signature LOCALE = |
31 sig |
31 sig |
32 type context |
32 type context = Proof.context |
33 datatype ('typ, 'term, 'fact) elem = |
33 datatype ('typ, 'term, 'fact) elem = |
34 Fixes of (string * 'typ option * mixfix option) list | |
34 Fixes of (string * 'typ option * mixfix option) list | |
35 Constrains of (string * 'typ) list | |
35 Constrains of (string * 'typ) list | |
36 Assumes of ((string * Attrib.src list) * ('term * ('term list * 'term list)) list) list | |
36 Assumes of ((string * Attrib.src list) * ('term * ('term list * 'term list)) list) list | |
37 Defines of ((string * Attrib.src list) * ('term * 'term list)) list | |
37 Defines of ((string * Attrib.src list) * ('term * 'term list)) list | |
38 Notes of ((string * Attrib.src list) * ('fact * Attrib.src list) list) list |
38 Notes of ((string * Attrib.src list) * ('fact * Attrib.src list) list) list |
|
39 type element = (string, string, thmref) elem |
|
40 type element_i = (typ, term, thm list) elem |
39 datatype expr = |
41 datatype expr = |
40 Locale of string | |
42 Locale of string | |
41 Rename of expr * (string * mixfix option) option list | |
43 Rename of expr * (string * mixfix option) option list | |
42 Merge of expr list |
44 Merge of expr list |
43 val empty: expr |
45 val empty: expr |
44 datatype 'a elem_expr = Elem of 'a | Expr of expr |
46 datatype 'a elem_expr = Elem of 'a | Expr of expr |
45 |
47 |
46 (* Abstract interface to locales *) |
48 (* Abstract interface to locales *) |
47 type element |
|
48 type element_i |
|
49 type locale |
49 type locale |
50 val intern: theory -> xstring -> string |
50 val intern: theory -> xstring -> string |
51 val extern: theory -> string -> xstring |
51 val extern: theory -> string -> xstring |
52 val the_locale: theory -> string -> locale |
52 val the_locale: theory -> string -> locale |
53 val intern_attrib_elem: theory -> |
53 val intern_attrib_elem: theory -> |
86 ((bstring * Attrib.src list) * (thmref * Attrib.src list) list) list -> |
86 ((bstring * Attrib.src list) * (thmref * Attrib.src list) list) list -> |
87 theory -> (theory * ProofContext.context) * (bstring * thm list) list |
87 theory -> (theory * ProofContext.context) * (bstring * thm list) list |
88 val note_thmss_i: string -> string -> |
88 val note_thmss_i: string -> string -> |
89 ((bstring * Attrib.src list) * (thm list * Attrib.src list) list) list -> |
89 ((bstring * Attrib.src list) * (thm list * Attrib.src list) list) list -> |
90 theory -> (theory * ProofContext.context) * (bstring * thm list) list |
90 theory -> (theory * ProofContext.context) * (bstring * thm list) list |
91 val add_thmss: string -> string -> ((string * thm list) * Attrib.src list) list -> |
91 val theorem: string -> (context * thm list -> thm list list -> theory -> theory) -> |
92 theory * context -> (theory * context) * (string * thm list) list |
92 string * Attrib.src list -> element elem_expr list -> |
93 |
93 ((string * Attrib.src list) * (string * (string list * string list)) list) list -> |
94 (* Locale interpretation *) |
94 theory -> Proof.state |
95 val prep_global_registration: |
95 val theorem_i: string -> (context * thm list -> thm list list -> theory -> theory) -> |
96 string * Attrib.src list -> expr -> string option list -> theory -> |
96 string * theory attribute list -> element_i elem_expr list -> |
97 ((string * term list) * term list) list * (thm list -> theory -> theory) |
97 ((string * theory attribute list) * (term * (term list * term list)) list) list -> |
98 val prep_local_registration: |
98 theory -> Proof.state |
99 string * Attrib.src list -> expr -> string option list -> context -> |
99 val theorem_in_locale: string -> |
100 ((string * term list) * term list) list * (thm list -> context -> context) |
100 ((context * context) * thm list -> thm list list -> theory -> theory) -> |
101 val prep_registration_in_locale: |
101 xstring -> string * Attrib.src list -> element elem_expr list -> |
102 string -> expr -> theory -> |
102 ((string * Attrib.src list) * (string * (string list * string list)) list) list -> |
103 ((string * string list) * term list) list * (thm list -> theory -> theory) |
103 theory -> Proof.state |
|
104 val theorem_in_locale_i: string -> |
|
105 ((context * context) * thm list -> thm list list -> theory -> theory) -> |
|
106 string -> string * Attrib.src list -> element_i elem_expr list -> |
|
107 ((string * Attrib.src list) * (term * (term list * term list)) list) list -> |
|
108 theory -> Proof.state |
|
109 val smart_theorem: string -> xstring option -> |
|
110 string * Attrib.src list -> element elem_expr list -> |
|
111 ((string * Attrib.src list) * (string * (string list * string list)) list) list -> |
|
112 theory -> Proof.state |
|
113 val interpretation: string * Attrib.src list -> expr -> string option list -> |
|
114 theory -> Proof.state |
|
115 val interpretation_in_locale: xstring * expr -> theory -> Proof.state |
|
116 val interpret: string * Attrib.src list -> expr -> string option list -> |
|
117 bool -> Proof.state -> Proof.state |
104 end; |
118 end; |
105 |
119 |
106 structure Locale: LOCALE = |
120 structure Locale: LOCALE = |
107 struct |
121 struct |
108 |
122 |
115 Constrains of (string * 'typ) list | |
129 Constrains of (string * 'typ) list | |
116 Assumes of ((string * Attrib.src list) * ('term * ('term list * 'term list)) list) list | |
130 Assumes of ((string * Attrib.src list) * ('term * ('term list * 'term list)) list) list | |
117 Defines of ((string * Attrib.src list) * ('term * 'term list)) list | |
131 Defines of ((string * Attrib.src list) * ('term * 'term list)) list | |
118 Notes of ((string * Attrib.src list) * ('fact * Attrib.src list) list) list; |
132 Notes of ((string * Attrib.src list) * ('fact * Attrib.src list) list) list; |
119 |
133 |
|
134 type element = (string, string, thmref) elem; |
|
135 type element_i = (typ, term, thm list) elem; |
|
136 |
120 datatype expr = |
137 datatype expr = |
121 Locale of string | |
138 Locale of string | |
122 Rename of expr * (string * mixfix option) option list | |
139 Rename of expr * (string * mixfix option) option list | |
123 Merge of expr list; |
140 Merge of expr list; |
124 |
141 |
125 val empty = Merge []; |
142 val empty = Merge []; |
126 |
143 |
127 datatype 'a elem_expr = |
144 datatype 'a elem_expr = |
128 Elem of 'a | Expr of expr; |
145 Elem of 'a | Expr of expr; |
129 |
|
130 type element = (string, string, thmref) elem; |
|
131 type element_i = (typ, term, thm list) elem; |
|
132 |
146 |
133 type locale = |
147 type locale = |
134 {predicate: cterm list * thm list, |
148 {predicate: cterm list * thm list, |
135 (* CB: For locales with "(open)" this entry is ([], []). |
149 (* CB: For locales with "(open)" this entry is ([], []). |
136 For new-style locales, which declare predicates, if the locale declares |
150 For new-style locales, which declare predicates, if the locale declares |
546 val loc_int = intern thy loc; |
560 val loc_int = intern thy loc; |
547 val regs = get_regs thy_ctxt; |
561 val regs = get_regs thy_ctxt; |
548 val loc_regs = Symtab.curried_lookup regs loc_int; |
562 val loc_regs = Symtab.curried_lookup regs loc_int; |
549 in |
563 in |
550 (case loc_regs of |
564 (case loc_regs of |
551 NONE => Pretty.str ("No interpretations in " ^ msg ^ ".") |
565 NONE => Pretty.str ("no interpretations in " ^ msg) |
552 | SOME r => let |
566 | SOME r => let |
553 val r' = Registrations.dest r; |
567 val r' = Registrations.dest r; |
554 val r'' = Library.sort_wrt (fn (_, ((prfx, _), _)) => prfx) r'; |
568 val r'' = Library.sort_wrt (fn (_, ((prfx, _), _)) => prfx) r'; |
555 in Pretty.big_list ("Interpretations in " ^ msg ^ ":") |
569 in Pretty.big_list ("interpretations in " ^ msg ^ ":") |
556 (map prt_reg r'') |
570 (map prt_reg r'') |
557 end) |
571 end) |
558 |> Pretty.writeln |
572 |> Pretty.writeln |
559 end; |
573 end; |
560 |
574 |
1673 |
1687 |
1674 (** store results **) |
1688 (** store results **) |
1675 |
1689 |
1676 (* note_thmss_qualified *) |
1690 (* note_thmss_qualified *) |
1677 |
1691 |
|
1692 fun theory_qualified name = |
|
1693 Theory.add_path (Sign.base_name name) |
|
1694 #> Theory.no_base_names; |
|
1695 |
1678 fun note_thmss_qualified kind name args thy = |
1696 fun note_thmss_qualified kind name args thy = |
1679 thy |
1697 thy |
1680 |> Theory.add_path (Sign.base_name name) |
1698 |> theory_qualified name |
1681 |> Theory.no_base_names |
|
1682 |> PureThy.note_thmss_i (Drule.kind kind) args |
1699 |> PureThy.note_thmss_i (Drule.kind kind) args |
1683 |>> Theory.restore_naming thy; |
1700 |>> Theory.restore_naming thy; |
1684 |
1701 |
1685 |
1702 |
1686 (* accesses of interpreted theorems *) |
1703 (* accesses of interpreted theorems *) |
1796 fun gen_note_thmss prep_locale prep_facts kind raw_loc args thy = |
1813 fun gen_note_thmss prep_locale prep_facts kind raw_loc args thy = |
1797 let |
1814 let |
1798 val thy_ctxt = ProofContext.init thy; |
1815 val thy_ctxt = ProofContext.init thy; |
1799 val loc = prep_locale thy raw_loc; |
1816 val loc = prep_locale thy raw_loc; |
1800 val (_, (stmt, _), loc_ctxt, _, _) = cert_context_statement (SOME loc) [] [] thy_ctxt; |
1817 val (_, (stmt, _), loc_ctxt, _, _) = cert_context_statement (SOME loc) [] [] thy_ctxt; |
1801 val export = ProofContext.export_standard stmt loc_ctxt thy_ctxt; |
1818 val export = ProofContext.export_standard_view stmt loc_ctxt thy_ctxt; |
1802 |
1819 |
1803 val (ctxt', (args', facts)) = activate_note prep_facts (loc_ctxt, args); |
1820 val (ctxt', (args', facts)) = activate_note prep_facts (loc_ctxt, args); |
1804 val facts' = |
1821 val facts' = |
1805 map (rpair [] o #1 o #1) args' ~~ |
1822 map (rpair [] o #1 o #1) args' ~~ |
1806 map (single o Thm.no_attributes o map export o #2) facts; |
1823 map (single o Thm.no_attributes o map export o #2) facts; |
1815 in |
1832 in |
1816 |
1833 |
1817 val note_thmss = gen_note_thmss intern read_facts; |
1834 val note_thmss = gen_note_thmss intern read_facts; |
1818 val note_thmss_i = gen_note_thmss (K I) cert_facts; |
1835 val note_thmss_i = gen_note_thmss (K I) cert_facts; |
1819 |
1836 |
1820 fun add_thmss kind loc args (thy, ctxt) = |
1837 fun add_thmss kind loc args (ctxt, thy) = |
1821 let |
1838 let |
1822 val (ctxt', (args', facts)) = activate_note cert_facts |
1839 val (ctxt', (args', facts)) = activate_note cert_facts |
1823 (ctxt, args |> map (fn ((a, ths), atts) => ((a, atts), [(ths, [])]))); |
1840 (ctxt, map (apsnd Thm.simple_fact) args); |
1824 val thy' = |
1841 val thy' = |
1825 thy |
1842 thy |
1826 |> put_facts loc args' |
1843 |> put_facts loc args' |
1827 |> note_thmss_registrations kind loc args'; |
1844 |> note_thmss_registrations kind loc args'; |
1828 in ((thy', ctxt'), facts) end; |
1845 in (facts, (ctxt', thy')) end; |
1829 |
1846 |
1830 end; |
1847 end; |
1831 |
1848 |
1832 |
1849 |
1833 (* predicate text *) |
1850 (* predicate text *) |
1983 val import = prep_expr thy raw_import; |
2000 val import = prep_expr thy raw_import; |
1984 |
2001 |
1985 val extraTs = foldr Term.add_term_tfrees [] exts' \\ |
2002 val extraTs = foldr Term.add_term_tfrees [] exts' \\ |
1986 foldr Term.add_typ_tfrees [] (map #2 parms); |
2003 foldr Term.add_typ_tfrees [] (map #2 parms); |
1987 val _ = if null extraTs then () |
2004 val _ = if null extraTs then () |
1988 else warning ("Encountered type variables in specification text that don't occur in the\n" ^ "locale parameters."); |
2005 else warning ("Additional type variables in locale specification: " ^ quote bname); |
1989 |
2006 |
1990 val (pred_thy, (elemss', predicate as (predicate_statement, predicate_axioms))) = |
2007 val (pred_thy, (elemss', predicate as (predicate_statement, predicate_axioms))) = |
1991 if do_pred then thy |> define_preds bname text elemss |
2008 if do_pred then thy |> define_preds bname text elemss |
1992 else (thy, (elemss, ([], []))); |
2009 else (thy, (elemss, ([], []))); |
1993 val pred_ctxt = ProofContext.init pred_thy; |
2010 val pred_ctxt = ProofContext.init pred_thy; |
1999 val (axs1, axs2) = splitAt (length ts, axs); |
2016 val (axs1, axs2) = splitAt (length ts, axs); |
2000 in (axs2, ((id, Assumed axs1), elems)) end) |
2017 in (axs2, ((id, Assumed axs1), elems)) end) |
2001 |> snd; |
2018 |> snd; |
2002 val (ctxt, (_, facts)) = activate_facts (K I) |
2019 val (ctxt, (_, facts)) = activate_facts (K I) |
2003 (pred_ctxt, axiomify predicate_axioms elemss'); |
2020 (pred_ctxt, axiomify predicate_axioms elemss'); |
2004 val export = ProofContext.export_standard predicate_statement ctxt pred_ctxt; |
2021 val export = ProofContext.export_standard_view predicate_statement ctxt pred_ctxt; |
2005 val facts' = facts |> map (fn (a, ths) => ((a, []), [(map export ths, [])])); |
2022 val facts' = facts |> map (fn (a, ths) => ((a, []), [(map export ths, [])])); |
2006 val elems' = List.concat (map #2 (List.filter (equal "" o #1 o #1) elemss')) |
2023 val elems' = List.concat (map #2 (List.filter (equal "" o #1 o #1) elemss')) |
2007 in |
2024 in |
2008 pred_thy |
2025 pred_thy |
2009 |> note_thmss_qualified "" name facts' |> #1 |
2026 |> note_thmss_qualified "" name facts' |> #1 |
2027 |
2044 |
2028 val _ = Context.add_setup |
2045 val _ = Context.add_setup |
2029 [add_locale_i true "var" empty [Fixes [(Syntax.internal "x", NONE, SOME Syntax.NoSyn)]], |
2046 [add_locale_i true "var" empty [Fixes [(Syntax.internal "x", NONE, SOME Syntax.NoSyn)]], |
2030 add_locale_i true "struct" empty [Fixes [(Syntax.internal "S", NONE, NONE)]]]; |
2047 add_locale_i true "struct" empty [Fixes [(Syntax.internal "S", NONE, NONE)]]]; |
2031 |
2048 |
|
2049 |
|
2050 |
|
2051 (** locale goals **) |
|
2052 |
|
2053 local |
|
2054 |
|
2055 fun global_goal prep_att = |
|
2056 Proof.global_goal ProofDisplay.present_results prep_att ProofContext.bind_propp_schematic_i; |
|
2057 |
|
2058 fun gen_theorem prep_att prep_elem prep_stmt kind after_qed a raw_elems concl thy = |
|
2059 let |
|
2060 val thy_ctxt = ProofContext.init thy; |
|
2061 val elems = map (prep_elem thy) raw_elems; |
|
2062 val (_, (_, view), _, ctxt, propp) = prep_stmt NONE elems (map snd concl) thy_ctxt; |
|
2063 val ctxt' = ctxt |> ProofContext.add_view thy_ctxt view; |
|
2064 val stmt = map fst concl ~~ propp; |
|
2065 in global_goal prep_att kind after_qed NONE a stmt ctxt' end; |
|
2066 |
|
2067 fun gen_theorem_in_locale prep_locale prep_src prep_elem prep_stmt |
|
2068 kind after_qed raw_locale (name, atts) raw_elems concl thy = |
|
2069 let |
|
2070 val locale = prep_locale thy raw_locale; |
|
2071 val locale_atts = map (prep_src thy) atts; |
|
2072 val locale_attss = map (map (prep_src thy) o snd o fst) concl; |
|
2073 val target = SOME (extern thy locale); |
|
2074 val elems = map (prep_elem thy) raw_elems; |
|
2075 val names = map (fst o fst) concl; |
|
2076 |
|
2077 val thy_ctxt = thy |> theory_qualified locale |> ProofContext.init; |
|
2078 val (_, (locale_view, elems_view), locale_ctxt, elems_ctxt, propp) = |
|
2079 prep_stmt (SOME raw_locale) elems (map snd concl) thy_ctxt; |
|
2080 val elems_ctxt' = elems_ctxt |> ProofContext.add_view locale_ctxt elems_view; |
|
2081 val elems_ctxt'' = elems_ctxt' |> ProofContext.add_view thy_ctxt locale_view; |
|
2082 val locale_ctxt' = locale_ctxt |> ProofContext.add_view thy_ctxt locale_view; |
|
2083 |
|
2084 val stmt = map (apsnd (K []) o fst) concl ~~ propp; |
|
2085 |
|
2086 fun after_qed' (goal_ctxt, raw_results) results = |
|
2087 let val res = results |> (map o map) |
|
2088 (ProofContext.export_standard elems_ctxt' locale_ctxt) in |
|
2089 Sign.restore_naming thy |
|
2090 #> curry (add_thmss kind locale ((names ~~ locale_attss) ~~ res)) locale_ctxt |
|
2091 #-> (fn res' => |
|
2092 if name = "" andalso null locale_atts then I |
|
2093 else #2 o add_thmss kind locale [((name, locale_atts), List.concat (map #2 res'))]) |
|
2094 #> #2 |
|
2095 #> after_qed ((goal_ctxt, locale_ctxt'), raw_results) results |
|
2096 end; |
|
2097 in global_goal (K I) kind after_qed' target (name, []) stmt elems_ctxt'' end; |
|
2098 |
|
2099 in |
|
2100 |
|
2101 val theorem = gen_theorem Attrib.global_attribute intern_attrib_elem_expr read_context_statement; |
|
2102 val theorem_i = gen_theorem (K I) (K I) cert_context_statement; |
|
2103 val theorem_in_locale = |
|
2104 gen_theorem_in_locale intern Attrib.intern_src intern_attrib_elem_expr read_context_statement; |
|
2105 val theorem_in_locale_i = |
|
2106 gen_theorem_in_locale (K I) (K I) (K I) cert_context_statement; |
|
2107 |
|
2108 fun smart_theorem kind NONE a [] concl = (* FIXME tune *) |
|
2109 Proof.theorem kind (K (K I)) NONE a concl o ProofContext.init |
|
2110 | smart_theorem kind NONE a elems concl = |
|
2111 theorem kind (K (K I)) a elems concl |
|
2112 | smart_theorem kind (SOME loc) a elems concl = |
|
2113 theorem_in_locale kind (K (K I)) loc a elems concl; |
|
2114 |
|
2115 end; |
2032 |
2116 |
2033 |
2117 |
2034 (** Interpretation commands **) |
2118 (** Interpretation commands **) |
2035 |
2119 |
2036 local |
2120 local |
2103 thy_ctxt'' |
2187 thy_ctxt'' |
2104 (* add facts to theory or context *) |
2188 (* add facts to theory or context *) |
2105 |> fold (activate_elems disch') new_elemss |
2189 |> fold (activate_elems disch') new_elemss |
2106 end; |
2190 end; |
2107 |
2191 |
2108 val global_activate_facts_elemss = gen_activate_facts_elemss |
2192 fun global_activate_facts_elemss x = gen_activate_facts_elemss |
2109 (fn thy => fn (name, ps) => |
2193 (fn thy => fn (name, ps) => |
2110 get_global_registration thy (name, map Logic.varify ps)) |
2194 get_global_registration thy (name, map Logic.varify ps)) |
2111 (global_note_accesses_i (Drule.kind "")) |
2195 (global_note_accesses_i (Drule.kind "")) |
2112 Attrib.global_attribute_i Drule.standard |
2196 Attrib.global_attribute_i Drule.standard |
2113 (fn (name, ps) => put_global_registration (name, map Logic.varify ps)) |
2197 (fn (name, ps) => put_global_registration (name, map Logic.varify ps)) |
2114 (fn (n, ps) => fn thm => |
2198 (fn (n, ps) => fn thm => |
2115 add_global_witness (n, map Logic.varify ps) (Drule.freeze_all thm)); |
2199 add_global_witness (n, map Logic.varify ps) (Drule.freeze_all thm)) x; |
2116 |
2200 |
2117 val local_activate_facts_elemss = gen_activate_facts_elemss |
2201 fun local_activate_facts_elemss x = gen_activate_facts_elemss |
2118 get_local_registration |
2202 get_local_registration |
2119 local_note_accesses_i |
2203 local_note_accesses_i |
2120 Attrib.context_attribute_i I |
2204 Attrib.context_attribute_i I |
2121 put_local_registration |
2205 put_local_registration |
2122 add_local_witness; |
2206 add_local_witness x; |
2123 |
2207 |
2124 fun gen_prep_registration mk_ctxt is_local read_terms test_reg activate |
2208 fun gen_prep_registration mk_ctxt is_local read_terms test_reg activate |
2125 attn expr insts thy_ctxt = |
2209 attn expr insts thy_ctxt = |
2126 let |
2210 let |
2127 val ctxt = mk_ctxt thy_ctxt; |
2211 val ctxt = mk_ctxt thy_ctxt; |
2206 val bind_attrib = Attrib.crude_closure ctxt o Args.assignable; |
2290 val bind_attrib = Attrib.crude_closure ctxt o Args.assignable; |
2207 val attn' = apsnd (map (bind_attrib o Attrib.intern_src thy)) attn; |
2291 val attn' = apsnd (map (bind_attrib o Attrib.intern_src thy)) attn; |
2208 |
2292 |
2209 in (propss, activate attn' inst_elemss new_inst_elemss propss) end; |
2293 in (propss, activate attn' inst_elemss new_inst_elemss propss) end; |
2210 |
2294 |
2211 in |
|
2212 |
|
2213 val prep_global_registration = gen_prep_registration |
2295 val prep_global_registration = gen_prep_registration |
2214 ProofContext.init false |
2296 ProofContext.init false |
2215 (fn thy => fn sorts => fn used => |
2297 (fn thy => fn sorts => fn used => |
2216 Sign.read_def_terms (thy, K NONE, sorts) used true) |
2298 Sign.read_def_terms (thy, K NONE, sorts) used true) |
2217 (fn thy => fn (name, ps) => |
2299 (fn thy => fn (name, ps) => |
2325 |> fold activate_reg regs |
2407 |> fold activate_reg regs |
2326 end; |
2408 end; |
2327 |
2409 |
2328 in (propss, activate) end; |
2410 in (propss, activate) end; |
2329 |
2411 |
2330 end; (* local *) |
2412 fun prep_propp propss = propss |> map (fn ((name, _), props) => |
2331 |
2413 ((NameSpace.base name, []), map (rpair ([], [])) props)); |
|
2414 |
|
2415 in |
|
2416 |
|
2417 fun interpretation (prfx, atts) expr insts thy = |
|
2418 let |
|
2419 val thy_ctxt = ProofContext.init thy; |
|
2420 val (propss, activate) = prep_global_registration (prfx, atts) expr insts thy; |
|
2421 fun after_qed (goal_ctxt, raw_results) _ = |
|
2422 activate (map (ProofContext.export_plain goal_ctxt thy_ctxt) raw_results); |
|
2423 in Proof.theorem_i Drule.internalK after_qed NONE ("", []) (prep_propp propss) thy_ctxt end; |
|
2424 |
|
2425 fun interpretation_in_locale (raw_target, expr) thy = |
|
2426 let |
|
2427 val target = intern thy raw_target; |
|
2428 val (propss, activate) = prep_registration_in_locale target expr thy; |
|
2429 fun after_qed ((goal_ctxt, locale_ctxt), raw_results) _ = |
|
2430 activate (map (ProofContext.export_plain goal_ctxt locale_ctxt) raw_results); |
|
2431 in |
|
2432 theorem_in_locale_i Drule.internalK after_qed target ("", []) [] (prep_propp propss) thy |
|
2433 end; |
|
2434 |
|
2435 fun interpret (prfx, atts) expr insts int state = |
|
2436 let |
|
2437 val (propss, activate) = |
|
2438 prep_local_registration (prfx, atts) expr insts (Proof.context_of state); |
|
2439 fun after_qed (_, raw_results) _ = Seq.single o Proof.map_context (activate raw_results); |
|
2440 in Proof.have_i after_qed (prep_propp propss) int state end; |
2332 |
2441 |
2333 end; |
2442 end; |
|
2443 |
|
2444 end; |