1 (* Title: Pure/Isar/constdefs.ML
3 Author: Makarius, Hagia Maria Sion Abbey (Jerusalem)
5 Standard constant definitions, with type-inference and optional
6 structure context; specifications need to observe strictly sequential
7 dependencies; no support for overloading.
12 val add_constdefs: (string * string option) list *
13 ((bstring * string option * mixfix) option * ((bstring * Attrib.src list) * string)) list ->
15 val add_constdefs_i: (string * typ option) list *
16 ((bstring * typ option * mixfix) option * ((bstring * attribute list) * term)) list ->
20 structure Constdefs: CONSTDEFS =
23 (** add_constdefs(_i) **)
25 fun gen_constdef prep_vars prep_term prep_att
26 structs (raw_decl, ((raw_name, raw_atts), raw_prop)) thy =
29 error (cat_lines (msg :: map (Sign.string_of_term thy) ts));
31 val (_, ctxt) = thy |> ProofContext.init |> ProofContext.add_fixes_i structs;
32 val ((d, mx), ctxt') =
34 NONE => ((NONE, NoSyn), ctxt)
36 ctxt |> prep_vars [raw_var] |-> (fn [(x, T, mx)] =>
37 ProofContext.add_fixes_legacy [(x, T, mx)] #> snd #> pair (SOME x, mx)));
39 val prop = prep_term ctxt' raw_prop;
40 val concl = Logic.strip_imp_concl prop;
41 val (lhs, _) = Logic.dest_equals concl handle TERM _ =>
42 err "Not a meta-equality (==):" [concl];
43 val head = Term.head_of lhs;
44 val (c, T) = Term.dest_Free head handle TERM _ =>
45 err "Locally fixed variable required as head of definition:" [head];
46 val _ = (case d of NONE => () | SOME c' =>
48 err ("Head of definition " ^ quote c ^ " differs from declaration " ^ quote c') []
51 val def = Term.subst_atomic [(Free (c, T), Const (Sign.full_name thy c, T))] prop;
52 val name = if raw_name = "" then Thm.def_name c else raw_name;
53 val atts = map (prep_att thy) raw_atts;
57 |> Theory.add_consts_i [(c, T, mx)]
58 |> PureThy.add_defs_i false [((name, def), atts)] |> snd;
59 in ((c, T), thy') end;
61 fun gen_constdefs prep_vars prep_term prep_att (raw_structs, specs) thy =
63 val ctxt = ProofContext.init thy;
64 val (structs, _) = prep_vars (map (fn (x, T) => (x, T, Structure)) raw_structs) ctxt;
65 val (decls, thy') = fold_map (gen_constdef prep_vars prep_term prep_att structs) specs thy;
66 in Pretty.writeln (LocalTheory.pretty_consts ctxt decls); thy' end;
68 val add_constdefs = gen_constdefs ProofContext.read_vars_legacy
69 ProofContext.read_term_legacy Attrib.attribute;
70 val add_constdefs_i = gen_constdefs ProofContext.cert_vars_legacy ProofContext.cert_term (K I);