# HG changeset patch # User wenzelm # Date 1139255988 -3600 # Node ID b6b19cc8454fa401da81a2558516bb77676abeca # Parent de38ee3654d4ca6bc26b6f82b4f438302019833a LocalDefs.cert_def; tuned; diff -r de38ee3654d4 -r b6b19cc8454f src/Pure/Isar/constdefs.ML --- a/src/Pure/Isar/constdefs.ML Mon Feb 06 20:59:47 2006 +0100 +++ b/src/Pure/Isar/constdefs.ML Mon Feb 06 20:59:48 2006 +0100 @@ -25,24 +25,19 @@ fun gen_constdef prep_vars prep_term prep_att structs (raw_decl, ((raw_name, raw_atts), raw_prop)) thy = let - fun err msg ts = - error (cat_lines (msg :: map (Sign.string_of_term thy) ts)); + fun err msg ts = error (cat_lines (msg :: map (Sign.string_of_term thy) ts)); - val (_, ctxt) = thy |> ProofContext.init |> ProofContext.add_fixes_i structs; - val ((d, mx), ctxt') = + val thy_ctxt = ProofContext.init thy; + val struct_ctxt = #2 (ProofContext.add_fixes_i structs thy_ctxt); + val ((d, mx), var_ctxt) = (case raw_decl of - NONE => ((NONE, NoSyn), ctxt) + NONE => ((NONE, NoSyn), struct_ctxt) | SOME raw_var => - ctxt |> prep_vars [raw_var] |-> (fn [(x, T, mx)] => + struct_ctxt |> prep_vars [raw_var] |-> (fn [(x, T, mx)] => ProofContext.add_fixes_legacy [(x, T, mx)] #> snd #> pair (SOME x, mx))); - val prop = prep_term ctxt' raw_prop; - val concl = Logic.strip_imp_concl prop; - val (lhs, _) = Logic.dest_equals concl handle TERM _ => - err "Not a meta-equality (==):" [concl]; - val head = Term.head_of lhs; - val (c, T) = Term.dest_Free head handle TERM _ => - err "Locally fixed variable required as head of definition:" [head]; + val prop = prep_term var_ctxt raw_prop; + val (c, T) = #1 (LocalDefs.cert_def thy_ctxt (Logic.strip_imp_concl prop)); val _ = (case d of NONE => () | SOME c' => if c <> c' then err ("Head of definition " ^ quote c ^ " differs from declaration " ^ quote c') []