29 val rep_ctyp: ctyp -> {T: typ, sign: Sign.sg} |
29 val rep_ctyp: ctyp -> {T: typ, sign: Sign.sg} |
30 val term_of: cterm -> term |
30 val term_of: cterm -> term |
31 val typ_of: ctyp -> typ |
31 val typ_of: ctyp -> typ |
32 val cterm_fun: (term -> term) -> (cterm -> cterm) |
32 val cterm_fun: (term -> term) -> (cterm -> cterm) |
33 (*end of cterm/ctyp functions*) |
33 (*end of cterm/ctyp functions*) |
34 |
34 local open Sign.Syntax in |
35 (* FIXME *) |
35 val add_classes: (class * class list) list -> theory -> theory |
36 local open Sign.Syntax Sign.Syntax.Mixfix in (* FIXME remove ...Mixfix *) |
|
37 val add_classes: (class list * class * class list) list -> theory -> theory |
|
38 val add_classrel: (class * class) list -> theory -> theory |
36 val add_classrel: (class * class) list -> theory -> theory |
39 val add_defsort: sort -> theory -> theory |
37 val add_defsort: sort -> theory -> theory |
40 val add_types: (string * int * mixfix) list -> theory -> theory |
38 val add_types: (string * int * mixfix) list -> theory -> theory |
41 val add_tyabbrs: (string * string list * string * mixfix) list |
39 val add_tyabbrs: (string * string list * string * mixfix) list |
42 -> theory -> theory |
40 -> theory -> theory |
57 val add_axioms_i: (string * term) list -> theory -> theory |
55 val add_axioms_i: (string * term) list -> theory -> theory |
58 val add_thyname: string -> theory -> theory |
56 val add_thyname: string -> theory -> theory |
59 end |
57 end |
60 val cert_axm: Sign.sg -> string * term -> string * term |
58 val cert_axm: Sign.sg -> string * term -> string * term |
61 val read_axm: Sign.sg -> string * string -> string * term |
59 val read_axm: Sign.sg -> string * string -> string * term |
|
60 val inferT_axm: Sign.sg -> string * term -> string * term |
62 val abstract_rule: string -> cterm -> thm -> thm |
61 val abstract_rule: string -> cterm -> thm -> thm |
63 val add_congs: meta_simpset * thm list -> meta_simpset |
62 val add_congs: meta_simpset * thm list -> meta_simpset |
64 val add_prems: meta_simpset * thm list -> meta_simpset |
63 val add_prems: meta_simpset * thm list -> meta_simpset |
65 val add_simps: meta_simpset * thm list -> meta_simpset |
64 val add_simps: meta_simpset * thm list -> meta_simpset |
66 val assume: cterm -> thm |
65 val assume: cterm -> thm |
77 val dest_state: thm * int -> (term*term)list * term list * term * term |
76 val dest_state: thm * int -> (term*term)list * term list * term * term |
78 val empty_mss: meta_simpset |
77 val empty_mss: meta_simpset |
79 val eq_assumption: int -> thm -> thm |
78 val eq_assumption: int -> thm -> thm |
80 val equal_intr: thm -> thm -> thm |
79 val equal_intr: thm -> thm -> thm |
81 val equal_elim: thm -> thm -> thm |
80 val equal_elim: thm -> thm -> thm |
82 val extend_theory: theory -> string |
|
83 -> (class * class list) list * sort |
|
84 * (string list * int)list |
|
85 * (string * string list * string) list |
|
86 * (string list * (sort list * class))list |
|
87 * (string list * string)list * Sign.Syntax.sext option |
|
88 -> (string*string)list -> theory |
|
89 val extensional: thm -> thm |
81 val extensional: thm -> thm |
90 val flexflex_rule: thm -> thm Sequence.seq |
82 val flexflex_rule: thm -> thm Sequence.seq |
91 val flexpair_def: thm |
83 val flexpair_def: thm |
92 val forall_elim: cterm -> thm -> thm |
84 val forall_elim: cterm -> thm -> thm |
93 val forall_intr: cterm -> thm -> thm |
85 val forall_intr: cterm -> thm -> thm |
191 Cterm{sign=sign, T=T, maxidx=maxidx, t=B}) |
183 Cterm{sign=sign, T=T, maxidx=maxidx, t=B}) |
192 | dest_cimplies ct = raise TERM ("dest_cimplies", [term_of ct]); |
184 | dest_cimplies ct = raise TERM ("dest_cimplies", [term_of ct]); |
193 |
185 |
194 |
186 |
195 |
187 |
196 (** read cterms **) |
188 (** read cterms **) (*exception ERROR*) (* FIXME check *) |
197 |
189 |
198 (*read term, infer types, certify term*) |
190 (*read term, infer types, certify term*) |
199 |
|
200 fun read_def_cterm (sign, types, sorts) (a, T) = |
191 fun read_def_cterm (sign, types, sorts) (a, T) = |
201 let |
192 let |
202 val {tsig, const_tab, syn, ...} = Sign.rep_sg sign; |
193 val t = Syntax.read (#syn (Sign.rep_sg sign)) T a; |
203 val showtyp = Sign.string_of_typ sign; |
194 val (t', tye) = Sign.infer_types sign types sorts (t, T); |
204 val showterm = Sign.string_of_term sign; |
|
205 |
|
206 fun termerr [] = "" |
|
207 | termerr [t] = "\nInvolving this term:\n" ^ showterm t |
|
208 | termerr ts = "\nInvolving these terms:\n" ^ cat_lines (map showterm ts); |
|
209 |
|
210 val T' = Sign.certify_typ sign T |
|
211 handle TYPE (msg, _, _) => error msg; |
|
212 val t = Syntax.read syn T' a; |
|
213 val (t', tye) = Type.infer_types (tsig, const_tab, types, sorts, T', t) |
|
214 handle TYPE (msg, Ts, ts) => error ("Type checking error: " ^ msg ^ "\n" |
|
215 ^ cat_lines (map showtyp Ts) ^ termerr ts); |
|
216 val ct = cterm_of sign t' handle TERM (msg, _) => error msg; |
195 val ct = cterm_of sign t' handle TERM (msg, _) => error msg; |
217 in (ct, tye) end; |
196 in (ct, tye) end; |
218 |
197 |
219 fun read_cterm sign = #1 o read_def_cterm (sign, K None, K None); |
198 fun read_cterm sign = #1 o read_def_cterm (sign, K None, K None); |
220 |
199 |
373 |
352 |
374 fun read_axm sg (name, str) = |
353 fun read_axm sg (name, str) = |
375 (name, no_vars (term_of (read_cterm sg (str, propT)))) |
354 (name, no_vars (term_of (read_cterm sg (str, propT)))) |
376 handle ERROR => err_in_axm name; |
355 handle ERROR => err_in_axm name; |
377 |
356 |
|
357 fun inferT_axm sg (name, pre_tm) = |
|
358 (name, no_vars (#1 (Sign.infer_types sg (K None) (K None) (pre_tm, propT)))) |
|
359 handle ERROR => err_in_axm name; |
|
360 |
378 |
361 |
379 (* extend axioms of a theory *) |
362 (* extend axioms of a theory *) |
380 |
363 |
381 fun ext_axms prep_axm axms (thy as Theory {sign, ...}) = |
364 fun ext_axms prep_axm axms (thy as Theory {sign, ...}) = |
382 let |
365 let |
386 ext_thy thy sign1 axioms |
369 ext_thy thy sign1 axioms |
387 end; |
370 end; |
388 |
371 |
389 val add_axioms = ext_axms read_axm; |
372 val add_axioms = ext_axms read_axm; |
390 val add_axioms_i = ext_axms cert_axm; |
373 val add_axioms_i = ext_axms cert_axm; |
391 |
|
392 |
|
393 (* extend theory (old) *) (* FIXME remove *) |
|
394 |
|
395 (*converts Frees to Vars: axioms can be written without question marks*) |
|
396 fun prepare_axiom sign sP = |
|
397 Logic.varify (term_of (read_cterm sign (sP, propT))); |
|
398 |
|
399 (*read an axiom for a new theory*) |
|
400 fun read_ax sign (a, sP) = |
|
401 (a, prepare_axiom sign sP) handle ERROR => err_in_axm a; |
|
402 |
|
403 (*extension of a theory with given classes, types, constants and syntax; |
|
404 reads the axioms from strings: axpairs have the form (axname, axiom)*) |
|
405 fun extend_theory thy thyname ext axpairs = |
|
406 let |
|
407 val Theory {sign, ...} = thy; |
|
408 |
|
409 val sign1 = Sign.extend sign thyname ext; |
|
410 val axioms = map (read_ax sign1) axpairs; |
|
411 in |
|
412 writeln "WARNING: called obsolete function \"extend_theory\""; |
|
413 ext_thy thy sign1 axioms |
|
414 end; |
|
415 |
374 |
416 |
375 |
417 |
376 |
418 (** merge theories **) |
377 (** merge theories **) |
419 |
378 |