abbrevs: return result;
authorwenzelm
Thu, 09 Nov 2006 21:44:27 +0100
changeset 21269 c605503bb4ef
parent 21268 7a6299a17386
child 21270 b82f4c16355e
abbrevs: return result;
src/Pure/Isar/isar_syn.ML
src/Pure/Isar/proof_context.ML
src/Pure/sign.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
--- 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);
 
 
--- 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);