9 sig |
9 sig |
10 val read_props: string list -> (binding * string option * mixfix) list -> Proof.context -> |
10 val read_props: string list -> (binding * string option * mixfix) list -> Proof.context -> |
11 term list * Proof.context |
11 term list * Proof.context |
12 val read_prop: string -> (binding * string option * mixfix) list -> Proof.context -> |
12 val read_prop: string -> (binding * string option * mixfix) list -> Proof.context -> |
13 term * Proof.context |
13 term * Proof.context |
14 val check_free_spec: |
14 val check_spec: (binding * typ option * mixfix) list -> |
15 (binding * typ option * mixfix) list -> (Attrib.binding * term) list -> Proof.context -> |
15 term list -> Attrib.binding * term -> Proof.context -> |
16 ((((binding * typ) * mixfix) list * (Attrib.binding * term) list) * (string -> Position.T)) |
16 ((((binding * typ) * mixfix) list * (Attrib.binding * term)) * (string -> Position.T)) |
17 * Proof.context |
17 * Proof.context |
18 val read_free_spec: |
18 val read_spec: (binding * string option * mixfix) list -> |
19 (binding * string option * mixfix) list -> (Attrib.binding * string) list -> Proof.context -> |
19 string list -> Attrib.binding * string -> Proof.context -> |
20 ((((binding * typ) * mixfix) list * (Attrib.binding * term) list) * (string -> Position.T)) |
20 ((((binding * typ) * mixfix) list * (Attrib.binding * term)) * (string -> Position.T)) |
21 * Proof.context |
21 * Proof.context |
22 val check_spec: |
22 type multi_specs = ((Attrib.binding * term) * term list) list |
23 (binding * typ option * mixfix) list -> (Attrib.binding * term) list -> Proof.context -> |
23 type multi_specs_cmd = ((Attrib.binding * string) * string list) list |
|
24 val check_multi_specs: (binding * typ option * mixfix) list -> multi_specs -> Proof.context -> |
24 (((binding * typ) * mixfix) list * (Attrib.binding * term) list) * Proof.context |
25 (((binding * typ) * mixfix) list * (Attrib.binding * term) list) * Proof.context |
25 val read_spec: |
26 val read_multi_specs: (binding * string option * mixfix) list -> multi_specs_cmd -> Proof.context -> |
26 (binding * string option * mixfix) list -> (Attrib.binding * string) list -> Proof.context -> |
|
27 (((binding * typ) * mixfix) list * (Attrib.binding * term) list) * Proof.context |
27 (((binding * typ) * mixfix) list * (Attrib.binding * term) list) * Proof.context |
28 val check_specification: (binding * typ option * mixfix) list -> |
28 val check_specification: (binding * typ option * mixfix) list -> term list -> |
29 (Attrib.binding * term list) list -> Proof.context -> |
29 (Attrib.binding * term list) list -> Proof.context -> |
30 (((binding * typ) * mixfix) list * (Attrib.binding * term list) list) * Proof.context |
30 (((binding * typ) * mixfix) list * (Attrib.binding * term list) list) * Proof.context |
31 val read_specification: (binding * string option * mixfix) list -> |
31 val read_specification: (binding * string option * mixfix) list -> string list -> |
32 (Attrib.binding * string list) list -> Proof.context -> |
32 (Attrib.binding * string list) list -> Proof.context -> |
33 (((binding * typ) * mixfix) list * (Attrib.binding * term list) list) * Proof.context |
33 (((binding * typ) * mixfix) list * (Attrib.binding * term list) list) * Proof.context |
34 val axiomatization: (binding * typ option * mixfix) list -> |
34 val axiomatization: (binding * typ option * mixfix) list -> term list -> |
35 (Attrib.binding * term list) list -> theory -> |
35 (Attrib.binding * term list) list -> theory -> (term list * thm list list) * theory |
36 (term list * thm list list) * theory |
36 val axiomatization_cmd: (binding * string option * mixfix) list -> string list -> |
37 val axiomatization_cmd: (binding * string option * mixfix) list -> |
37 (Attrib.binding * string list) list -> theory -> (term list * thm list list) * theory |
38 (Attrib.binding * string list) list -> theory -> |
|
39 (term list * thm list list) * theory |
|
40 val axiom: Attrib.binding * term -> theory -> thm * theory |
38 val axiom: Attrib.binding * term -> theory -> thm * theory |
41 val definition: |
39 val definition: (binding * typ option * mixfix) option -> term list -> |
42 (binding * typ option * mixfix) option * (Attrib.binding * term) -> |
40 Attrib.binding * term -> local_theory -> (term * (string * thm)) * local_theory |
43 local_theory -> (term * (string * thm)) * local_theory |
41 val definition': (binding * typ option * mixfix) option -> term list -> |
44 val definition': |
42 Attrib.binding * term -> bool -> local_theory -> (term * (string * thm)) * local_theory |
45 (binding * typ option * mixfix) option * (Attrib.binding * term) -> |
43 val definition_cmd: (binding * string option * mixfix) option -> string list -> |
46 bool -> local_theory -> (term * (string * thm)) * local_theory |
44 Attrib.binding * string -> bool -> local_theory -> (term * (string * thm)) * local_theory |
47 val definition_cmd: |
45 val abbreviation: Syntax.mode -> (binding * typ option * mixfix) option -> term -> |
48 (binding * string option * mixfix) option * (Attrib.binding * string) -> |
|
49 bool -> local_theory -> (term * (string * thm)) * local_theory |
|
50 val abbreviation: Syntax.mode -> (binding * typ option * mixfix) option * term -> |
|
51 bool -> local_theory -> local_theory |
46 bool -> local_theory -> local_theory |
52 val abbreviation_cmd: Syntax.mode -> (binding * string option * mixfix) option * string -> |
47 val abbreviation_cmd: Syntax.mode -> (binding * string option * mixfix) option -> string -> |
53 bool -> local_theory -> local_theory |
48 bool -> local_theory -> local_theory |
54 val type_notation: bool -> Syntax.mode -> (typ * mixfix) list -> local_theory -> local_theory |
49 val type_notation: bool -> Syntax.mode -> (typ * mixfix) list -> local_theory -> local_theory |
55 val type_notation_cmd: bool -> Syntax.mode -> (string * mixfix) list -> |
50 val type_notation_cmd: bool -> Syntax.mode -> (string * mixfix) list -> |
56 local_theory -> local_theory |
51 local_theory -> local_theory |
57 val notation: bool -> Syntax.mode -> (term * mixfix) list -> local_theory -> local_theory |
52 val notation: bool -> Syntax.mode -> (term * mixfix) list -> local_theory -> local_theory |
139 Context_Position.reports params_ctxt |
134 Context_Position.reports params_ctxt |
140 (map (Binding.pos_of o #1) vars ~~ |
135 (map (Binding.pos_of o #1) vars ~~ |
141 map (Variable.markup_entity_def params_ctxt ##> Properties.remove Markup.kindN) xs); |
136 map (Variable.markup_entity_def params_ctxt ##> Properties.remove Markup.kindN) xs); |
142 |
137 |
143 val Asss0 = |
138 val Asss0 = |
144 (map o map) snd raw_specss |
139 map (fn (raw_concls, raw_prems) => raw_prems :: map snd raw_concls) raw_specss |
145 |> (burrow o burrow) (grouped 10 Par_List.map_independent (parse_prop params_ctxt)); |
140 |> (burrow o burrow) (grouped 10 Par_List.map_independent (parse_prop params_ctxt)); |
146 val names = |
141 val names = |
147 Variable.names_of (params_ctxt |> (fold o fold o fold) Variable.declare_term Asss0) |
142 Variable.names_of (params_ctxt |> (fold o fold o fold) Variable.declare_term Asss0) |
148 |> fold Name.declare xs; |
143 |> fold Name.declare xs; |
149 |
144 |
150 val (Asss1, _) = (fold_map o fold_map o fold_map) Term.free_dummy_patterns Asss0 names; |
145 val (Asss1, _) = (fold_map o fold_map o fold_map) Term.free_dummy_patterns Asss0 names; |
151 val idx = (fold o fold o fold) Term.maxidx_term Asss1 ~1 + 1; |
146 val idx = (fold o fold o fold) Term.maxidx_term Asss1 ~1 + 1; |
152 |
147 |
153 val (Asss2, _) = |
148 val (Asss2, _) = |
154 fold_map (fn Ass => fn i => (burrow (close_forms params_ctxt auto_close i []) Ass, i + 1)) |
149 fold_map (fn prems :: conclss => fn i => |
155 Asss1 idx; |
150 (burrow (close_forms params_ctxt auto_close i prems) conclss, i + 1)) Asss1 idx; |
156 |
151 |
157 val specs = burrow (Syntax.check_props params_ctxt) (flat Asss2); |
152 val specs = burrow (Syntax.check_props params_ctxt) (flat Asss2); |
158 val specs_ctxt = params_ctxt |> (fold o fold) Variable.declare_term specs; |
153 val specs_ctxt = params_ctxt |> (fold o fold) Variable.declare_term specs; |
159 |
154 |
160 val ps = specs_ctxt |> fold_map Proof_Context.inferred_param xs |> fst; |
155 val ps = specs_ctxt |> fold_map Proof_Context.inferred_param xs |> fst; |
161 val params = map2 (fn (b, _, mx) => fn (_, T) => ((b, T), mx)) vars ps; |
156 val params = map2 (fn (b, _, mx) => fn (_, T) => ((b, T), mx)) vars ps; |
162 val name_atts: Attrib.binding list = |
157 val name_atts: Attrib.binding list = |
163 map (fn ((name, atts), _) => (name, map (prep_att ctxt) atts)) (flat raw_specss); |
158 map (fn ((name, atts), _) => (name, map (prep_att ctxt) atts)) (maps #1 raw_specss); |
164 |
159 |
165 fun get_pos x = |
160 fun get_pos x = |
166 (case (maps o maps o maps) (get_positions specs_ctxt x) Asss2 of |
161 (case (maps o maps o maps) (get_positions specs_ctxt x) Asss2 of |
167 [] => Position.none |
162 [] => Position.none |
168 | pos :: _ => pos); |
163 | pos :: _ => pos); |
169 in (((params, name_atts ~~ specs), get_pos), specs_ctxt) end; |
164 in (((params, name_atts ~~ specs), get_pos), specs_ctxt) end; |
170 |
165 |
171 |
166 |
172 fun single_spec (a, prop) = [(a, [prop])]; |
167 fun single_spec ((a, B), As) = ([(a, [B])], As); |
173 fun the_spec (a, [prop]) = (a, prop); |
168 fun the_spec (a, [prop]) = (a, prop); |
174 |
169 |
175 fun prep_spec prep_var parse_prop prep_att auto_close vars specs = |
170 fun prep_specs prep_var parse_prop prep_att auto_close vars specs = |
176 prepare prep_var parse_prop prep_att auto_close |
171 prepare prep_var parse_prop prep_att auto_close |
177 vars (map single_spec specs) #>> (apfst o apsnd) (map the_spec); |
172 vars (map single_spec specs) #>> (apfst o apsnd) (map the_spec); |
178 |
173 |
179 in |
174 in |
180 |
175 |
181 fun check_free_spec vars specs = |
176 fun check_spec xs As B = |
182 prep_spec Proof_Context.cert_var (K I) (K I) false vars specs; |
177 prep_specs Proof_Context.cert_var (K I) (K I) false xs [(B, As)] #> |
183 |
178 (apfst o apfst o apsnd) the_single; |
184 fun read_free_spec vars specs = |
179 |
185 prep_spec Proof_Context.read_var Syntax.parse_prop Attrib.check_src false vars specs; |
180 fun read_spec xs As B = |
186 |
181 prep_specs Proof_Context.read_var Syntax.parse_prop Attrib.check_src false xs [(B, As)] #> |
187 fun check_spec vars specs = |
182 (apfst o apfst o apsnd) the_single; |
188 prep_spec Proof_Context.cert_var (K I) (K I) true vars specs #> apfst fst; |
183 |
189 |
184 type multi_specs = ((Attrib.binding * term) * term list) list; |
190 fun read_spec vars specs = |
185 type multi_specs_cmd = ((Attrib.binding * string) * string list) list; |
191 prep_spec Proof_Context.read_var Syntax.parse_prop Attrib.check_src true vars specs #> apfst fst; |
186 |
192 |
187 fun check_multi_specs xs specs = |
193 fun check_specification vars specs = |
188 prep_specs Proof_Context.cert_var (K I) (K I) true xs specs #>> #1; |
194 prepare Proof_Context.cert_var (K I) (K I) true vars [specs] #> apfst fst |
189 |
195 |
190 fun read_multi_specs xs specs = |
196 fun read_specification vars specs = |
191 prep_specs Proof_Context.read_var Syntax.parse_prop Attrib.check_src true xs specs #>> #1; |
197 prepare Proof_Context.read_var Syntax.parse_prop Attrib.check_src true vars [specs] #> apfst fst; |
192 |
|
193 fun check_specification xs As Bs = |
|
194 prepare Proof_Context.cert_var (K I) (K I) true xs [(Bs, As)] #>> #1; |
|
195 |
|
196 fun read_specification xs As Bs = |
|
197 prepare Proof_Context.read_var Syntax.parse_prop Attrib.check_src true xs [(Bs, As)] #>> #1; |
198 |
198 |
199 end; |
199 end; |
200 |
200 |
201 |
201 |
202 (* axiomatization -- within global theory *) |
202 (* axiomatization -- within global theory *) |
203 |
203 |
204 fun gen_axioms prep raw_vars raw_specs thy = |
204 fun gen_axioms prep raw_decls raw_prems raw_concls thy = |
205 let |
205 let |
206 val ((vars, specs), _) = prep raw_vars raw_specs (Proof_Context.init_global thy); |
206 val ((decls, specs), _) = prep raw_decls raw_prems raw_concls (Proof_Context.init_global thy); |
207 val xs = map (fn ((b, T), _) => (Variable.check_name b, T)) vars; |
207 val xs = map (fn ((b, T), _) => (Variable.check_name b, T)) decls; |
208 |
208 |
209 (*consts*) |
209 (*consts*) |
210 val (consts, consts_thy) = thy |> fold_map Theory.specify_const vars; |
210 val (consts, consts_thy) = thy |> fold_map Theory.specify_const decls; |
211 val subst = Term.subst_atomic (map Free xs ~~ consts); |
211 val subst = Term.subst_atomic (map Free xs ~~ consts); |
212 |
212 |
213 (*axioms*) |
213 (*axioms*) |
214 val (axioms, axioms_thy) = (specs, consts_thy) |-> fold_map (fn ((b, atts), props) => |
214 val (axioms, axioms_thy) = (specs, consts_thy) |-> fold_map (fn ((b, atts), props) => |
215 fold_map Thm.add_axiom_global |
215 fold_map Thm.add_axiom_global |
226 in ((consts, map #2 facts), Local_Theory.exit_global facts_lthy) end; |
226 in ((consts, map #2 facts), Local_Theory.exit_global facts_lthy) end; |
227 |
227 |
228 val axiomatization = gen_axioms check_specification; |
228 val axiomatization = gen_axioms check_specification; |
229 val axiomatization_cmd = gen_axioms read_specification; |
229 val axiomatization_cmd = gen_axioms read_specification; |
230 |
230 |
231 fun axiom (b, ax) = axiomatization [] [(b, [ax])] #>> (hd o hd o snd); |
231 fun axiom (b, ax) = axiomatization [] [] [(b, [ax])] #>> (hd o hd o snd); |
232 |
232 |
233 |
233 |
234 (* definition *) |
234 (* definition *) |
235 |
235 |
236 fun gen_def prep (raw_var, raw_spec) int lthy = |
236 fun gen_def prep raw_var raw_prems raw_spec int lthy = |
237 let |
237 let |
238 val ((vars, [((raw_name, atts), prop)]), get_pos) = |
238 val ((vars, ((raw_name, atts), prop)), get_pos) = |
239 fst (prep (the_list raw_var) [raw_spec] lthy); |
239 fst (prep (the_list raw_var) raw_prems raw_spec lthy); |
240 val (((x, T), rhs), prove) = Local_Defs.derived_def lthy {conditional = true} prop; |
240 val (((x, T), rhs), prove) = Local_Defs.derived_def lthy {conditional = true} prop; |
241 val _ = Name.reject_internal (x, []); |
241 val _ = Name.reject_internal (x, []); |
242 val (b, mx) = |
242 val (b, mx) = |
243 (case vars of |
243 (case vars of |
244 [] => (Binding.make (x, get_pos x), NoSyn) |
244 [] => (Binding.make (x, get_pos x), NoSyn) |
264 val _ = |
264 val _ = |
265 Proof_Display.print_consts int (Position.thread_data ()) lthy4 |
265 Proof_Display.print_consts int (Position.thread_data ()) lthy4 |
266 (member (op =) (Term.add_frees lhs' [])) [(x, T)]; |
266 (member (op =) (Term.add_frees lhs' [])) [(x, T)]; |
267 in ((lhs, (def_name, th')), lthy4) end; |
267 in ((lhs, (def_name, th')), lthy4) end; |
268 |
268 |
269 val definition' = gen_def check_free_spec; |
269 val definition' = gen_def check_spec; |
270 fun definition spec = definition' spec false; |
270 fun definition xs As B = definition' xs As B false; |
271 val definition_cmd = gen_def read_free_spec; |
271 val definition_cmd = gen_def read_spec; |
272 |
272 |
273 |
273 |
274 (* abbreviation *) |
274 (* abbreviation *) |
275 |
275 |
276 fun gen_abbrev prep mode (raw_var, raw_prop) int lthy = |
276 fun gen_abbrev prep mode raw_var raw_prop int lthy = |
277 let |
277 let |
278 val lthy1 = lthy |
278 val lthy1 = lthy |
279 |> Proof_Context.set_syntax_mode mode; |
279 |> Proof_Context.set_syntax_mode mode; |
280 val (((vars, [(_, prop)]), get_pos), _) = |
280 val (((vars, (_, prop)), get_pos), _) = |
281 prep (the_list raw_var) [(Attrib.empty_binding, raw_prop)] |
281 prep (the_list raw_var) [] (Attrib.empty_binding, raw_prop) |
282 (lthy1 |> Proof_Context.set_mode Proof_Context.mode_abbrev); |
282 (lthy1 |> Proof_Context.set_mode Proof_Context.mode_abbrev); |
283 val ((x, T), rhs) = Local_Defs.abs_def (#2 (Local_Defs.cert_def lthy1 prop)); |
283 val ((x, T), rhs) = Local_Defs.abs_def (#2 (Local_Defs.cert_def lthy1 prop)); |
284 val _ = Name.reject_internal (x, []); |
284 val _ = Name.reject_internal (x, []); |
285 val (b, mx) = |
285 val (b, mx) = |
286 (case vars of |
286 (case vars of |