src/Pure/Isar/constdefs.ML
changeset 18948 b6b19cc8454f
parent 18873 11c92ec2c29c
child 20885 e0223c1bd7e8
equal deleted inserted replaced
18947:de38ee3654d4 18948:b6b19cc8454f
    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