23 (** add_constdefs(_i) **) |
23 (** add_constdefs(_i) **) |
24 |
24 |
25 fun gen_constdef prep_vars prep_term prep_att |
25 fun gen_constdef prep_vars prep_term prep_att |
26 structs (raw_decl, ((raw_name, raw_atts), raw_prop)) thy = |
26 structs (raw_decl, ((raw_name, raw_atts), raw_prop)) thy = |
27 let |
27 let |
28 fun err msg ts = |
28 fun err msg ts = error (cat_lines (msg :: map (Sign.string_of_term thy) ts)); |
29 error (cat_lines (msg :: map (Sign.string_of_term thy) ts)); |
|
30 |
29 |
31 val (_, ctxt) = thy |> ProofContext.init |> ProofContext.add_fixes_i structs; |
30 val thy_ctxt = ProofContext.init thy; |
32 val ((d, mx), ctxt') = |
31 val struct_ctxt = #2 (ProofContext.add_fixes_i structs thy_ctxt); |
|
32 val ((d, mx), var_ctxt) = |
33 (case raw_decl of |
33 (case raw_decl of |
34 NONE => ((NONE, NoSyn), ctxt) |
34 NONE => ((NONE, NoSyn), struct_ctxt) |
35 | SOME raw_var => |
35 | SOME raw_var => |
36 ctxt |> prep_vars [raw_var] |-> (fn [(x, T, mx)] => |
36 struct_ctxt |> prep_vars [raw_var] |-> (fn [(x, T, mx)] => |
37 ProofContext.add_fixes_legacy [(x, T, mx)] #> snd #> pair (SOME x, mx))); |
37 ProofContext.add_fixes_legacy [(x, T, mx)] #> snd #> pair (SOME x, mx))); |
38 |
38 |
39 val prop = prep_term ctxt' raw_prop; |
39 val prop = prep_term var_ctxt raw_prop; |
40 val concl = Logic.strip_imp_concl prop; |
40 val (c, T) = #1 (LocalDefs.cert_def thy_ctxt (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' => |
41 val _ = (case d of NONE => () | SOME c' => |
47 if c <> c' then |
42 if c <> c' then |
48 err ("Head of definition " ^ quote c ^ " differs from declaration " ^ quote c') [] |
43 err ("Head of definition " ^ quote c ^ " differs from declaration " ^ quote c') [] |
49 else ()); |
44 else ()); |
50 |
45 |