# HG changeset patch # User wenzelm # Date 1163105067 -3600 # Node ID c605503bb4ef705381905a4707edd4d292aa3896 # Parent 7a6299a17386aa0e7b5eb3d605c10de5e419c174 abbrevs: return result; diff -r 7a6299a17386 -r c605503bb4ef src/Pure/Isar/isar_syn.ML --- a/src/Pure/Isar/isar_syn.ML Thu Nov 09 18:58:52 2006 +0100 +++ b/src/Pure/Isar/isar_syn.ML Thu Nov 09 21:44:27 2006 +0100 @@ -221,7 +221,7 @@ (P.opt_locale_target -- opt_mode -- Scan.repeat1 (Scan.option constdecl -- P.prop) >> (fn ((loc, mode), args) => - Toplevel.local_theory loc (Specification.abbreviation mode args))); + Toplevel.local_theory loc (snd o Specification.abbreviation mode args))); val notationP = OuterSyntax.command "notation" "variable/constant syntax" K.thy_decl diff -r 7a6299a17386 -r c605503bb4ef src/Pure/Isar/proof_context.ML --- a/src/Pure/Isar/proof_context.ML Thu Nov 09 18:58:52 2006 +0100 +++ b/src/Pure/Isar/proof_context.ML Thu Nov 09 21:44:27 2006 +0100 @@ -140,8 +140,8 @@ val expand_abbrevs: bool -> Proof.context -> Proof.context val add_notation: Syntax.mode -> (term * mixfix) list -> Proof.context -> Proof.context - val add_abbrevs: Syntax.mode -> ((bstring * mixfix) * term) list -> - Proof.context -> Proof.context + val add_abbrevs: Syntax.mode -> ((bstring * mixfix) * term) list -> Proof.context -> + (term * term) list * Proof.context val verbose: bool ref val setmp_verbose: ('a -> 'b) -> 'a -> 'b val print_syntax: Proof.context -> unit @@ -867,10 +867,11 @@ val expand_abbrevs = map_consts o apsnd o Consts.expand_abbrevs; -fun add_abbrevs prmode = fold (fn ((raw_c, raw_mx), raw_t) => fn ctxt => +fun add_abbrevs prmode = fold_map (fn ((raw_c, raw_mx), raw_t) => fn ctxt => let val ([(c, _, mx)], _) = cert_vars [(raw_c, NONE, raw_mx)] ctxt; - val c' = Syntax.constN ^ full_name ctxt c; + val full_c = full_name ctxt c; + val c' = Syntax.constN ^ full_c; val t0 = cert_term (ctxt |> expand_abbrevs false) raw_t; val [t] = Variable.exportT_terms (Variable.declare_term t0 ctxt) ctxt [t0]; val T = Term.fastype_of t; @@ -883,6 +884,7 @@ |> map_consts (apsnd (Consts.abbreviate (pp ctxt) (tsig_of ctxt) (naming_of ctxt) (#1 prmode) ((c, t), true))) |> map_syntax (LocalSyntax.add_modesyntax (theory_of ctxt) prmode [(false, (c', T, mx))]) + |> pair (Const (full_c, T), t) end); diff -r 7a6299a17386 -r c605503bb4ef src/Pure/sign.ML --- a/src/Pure/sign.ML Thu Nov 09 18:58:52 2006 +0100 +++ b/src/Pure/sign.ML Thu Nov 09 21:44:27 2006 +0100 @@ -192,7 +192,8 @@ val read_prop: theory -> string -> term val add_consts_authentic: (bstring * typ * mixfix) list -> theory -> theory val add_notation: Syntax.mode -> (term * mixfix) list -> theory -> theory - val add_abbrevs: Syntax.mode -> ((bstring * mixfix) * term) list -> theory -> theory + val add_abbrevs: Syntax.mode -> ((bstring * mixfix) * term) list -> theory -> + (term * term) list * theory include SIGN_THEORY end @@ -752,20 +753,23 @@ (* add abbreviations *) -fun add_abbrevs (mode, inout) = fold (fn ((raw_c, raw_mx), raw_t) => fn thy => +fun add_abbrevs prmode = fold_map (fn ((raw_c, raw_mx), raw_t) => fn thy => let val prep_tm = Compress.term thy o Logic.varify o no_vars (pp thy) o Term.no_dummy_patterns o cert_term_abbrev thy; val (c, mx) = Syntax.const_mixfix raw_c raw_mx; - val c' = Syntax.constN ^ full_name thy c; + val full_c = full_name thy c; + val c' = Syntax.constN ^ full_c; val t = (prep_tm raw_t handle TYPE (msg, _, _) => error msg | TERM (msg, _) => error msg) handle ERROR msg => cat_error msg ("in constant abbreviation " ^ quote c); val T = Term.fastype_of t; in thy - |> map_consts (Consts.abbreviate (pp thy) (tsig_of thy) (naming_of thy) mode ((c, t), true)) - |> add_modesyntax_i (mode, inout) [(c', T, mx)] + |> map_consts + (Consts.abbreviate (pp thy) (tsig_of thy) (naming_of thy) (#1 prmode) ((c, t), true)) + |> add_modesyntax_i prmode [(c', T, mx)] + |> pair (Const (full_c, T), t) end);