equal
deleted
inserted
replaced
7 |
7 |
8 signature FIXREC_PACKAGE = |
8 signature FIXREC_PACKAGE = |
9 sig |
9 sig |
10 val legacy_infer_term: theory -> term -> term |
10 val legacy_infer_term: theory -> term -> term |
11 val legacy_infer_prop: theory -> term -> term |
11 val legacy_infer_prop: theory -> term -> term |
12 val add_fixrec: bool -> ((string * Attrib.src list) * string) list list -> theory -> theory |
12 val add_fixrec: bool -> ((Name.binding * Attrib.src list) * string) list list -> theory -> theory |
13 val add_fixrec_i: bool -> ((string * attribute list) * term) list list -> theory -> theory |
13 val add_fixrec_i: bool -> ((Name.binding * attribute list) * term) list list -> theory -> theory |
14 val add_fixpat: (string * Attrib.src list) * string list -> theory -> theory |
14 val add_fixpat: (Name.binding * Attrib.src list) * string list -> theory -> theory |
15 val add_fixpat_i: (string * attribute list) * term list -> theory -> theory |
15 val add_fixpat_i: (Name.binding * attribute list) * term list -> theory -> theory |
16 end; |
16 end; |
17 |
17 |
18 structure FixrecPackage: FIXREC_PACKAGE = |
18 structure FixrecPackage: FIXREC_PACKAGE = |
19 struct |
19 struct |
20 |
20 |
224 fun gen_add_fixrec prep_prop prep_attrib strict blocks thy = |
224 fun gen_add_fixrec prep_prop prep_attrib strict blocks thy = |
225 let |
225 let |
226 val eqns = List.concat blocks; |
226 val eqns = List.concat blocks; |
227 val lengths = map length blocks; |
227 val lengths = map length blocks; |
228 |
228 |
229 val ((names, srcss), strings) = apfst split_list (split_list eqns); |
229 val ((bindings, srcss), strings) = apfst split_list (split_list eqns); |
|
230 val names = map Name.name_of bindings; |
230 val atts = map (map (prep_attrib thy)) srcss; |
231 val atts = map (map (prep_attrib thy)) srcss; |
231 val eqn_ts = map (prep_prop thy) strings; |
232 val eqn_ts = map (prep_prop thy) strings; |
232 val rec_ts = map (fn eq => chead_of (fst (dest_eqs (Logic.strip_imp_concl eq))) |
233 val rec_ts = map (fn eq => chead_of (fst (dest_eqs (Logic.strip_imp_concl eq))) |
233 handle TERM _ => fixrec_eq_err thy "not a proper equation" eq) eqn_ts; |
234 handle TERM _ => fixrec_eq_err thy "not a proper equation" eq) eqn_ts; |
234 val (_, eqn_ts') = OldPrimrecPackage.unify_consts thy rec_ts eqn_ts; |
235 val (_, eqn_ts') = OldPrimrecPackage.unify_consts thy rec_ts eqn_ts; |
276 let |
277 let |
277 val atts = map (prep_attrib thy) srcs; |
278 val atts = map (prep_attrib thy) srcs; |
278 val ts = map (prep_term thy) strings; |
279 val ts = map (prep_term thy) strings; |
279 val simps = map (fix_pat thy) ts; |
280 val simps = map (fix_pat thy) ts; |
280 in |
281 in |
281 (snd o PureThy.add_thmss [((name, simps), atts)]) thy |
282 (snd o PureThy.add_thmss [((Name.name_of name, simps), atts)]) thy |
282 end; |
283 end; |
283 |
284 |
284 val add_fixpat = gen_add_fixpat Syntax.read_term_global Attrib.attribute; |
285 val add_fixpat = gen_add_fixpat Syntax.read_term_global Attrib.attribute; |
285 val add_fixpat_i = gen_add_fixpat Sign.cert_term (K I); |
286 val add_fixpat_i = gen_add_fixpat Sign.cert_term (K I); |
286 |
287 |