added restore;
authorwenzelm
Sat, 11 Feb 2006 17:17:52 +0100
changeset 19017 5f06c37043e4
parent 19016 f26377a4605a
child 19018 88b4979193d8
added restore; consts: provide abbreviations;
src/Pure/Isar/local_theory.ML
--- a/src/Pure/Isar/local_theory.ML	Sat Feb 11 17:17:51 2006 +0100
+++ b/src/Pure/Isar/local_theory.ML	Sat Feb 11 17:17:52 2006 +0100
@@ -19,6 +19,7 @@
   val theory_result: (theory -> 'a * theory) -> local_theory -> 'a * local_theory
   val init: xstring option -> theory -> local_theory
   val init_i: string option -> theory -> local_theory
+  val restore: local_theory -> local_theory
   val exit: local_theory -> local_theory * theory
   val consts: ((bstring * typ) * mixfix) list -> local_theory -> term list * local_theory
   val consts_restricted: (string * typ -> bool) ->
@@ -55,7 +56,6 @@
   fun init thy = {locale = NONE, params = [], hyps = [], exit = I};
   fun print _ _ = ();
 );
-
 val _ = Context.add_setup Data.init;
 
 fun map_locale f = Data.map (fn {locale, params, hyps, exit} =>
@@ -112,14 +112,18 @@
 fun locale_result f ctxt =
   (case locale_of ctxt of
     NONE => error "Local theory: no locale context"
-  | SOME (loc, (view, loc_ctxt)) =>
+  | SOME (_, view_ctxt) =>
       let
-        val (res, loc_ctxt') = f loc_ctxt;
+        val (res, loc_ctxt') = f view_ctxt;
         val thy' = ProofContext.theory_of loc_ctxt';
       in (res, ctxt |> map_locale (K loc_ctxt') |> transfer thy') end);
 
+fun locale f ctxt =
+  if is_none (locale_of ctxt) then ctxt
+  else #2 (locale_result (f #> pair ()) ctxt);
 
-(* init -- exit *)
+
+(* init -- restore -- exit *)
 
 fun init_i NONE thy = ProofContext.init thy
   | init_i (SOME loc) thy =
@@ -135,6 +139,11 @@
 
 fun init loc thy = init_i (Option.map (Locale.intern thy) loc) thy;
 
+fun restore ctxt =
+  (case locale_of ctxt of
+    NONE => ctxt
+  | SOME (_, (_, loc_ctxt)) => loc_ctxt |> Data.put (Data.get ctxt));
+
 fun exit ctxt = (ctxt, #exit (Data.get ctxt) (ProofContext.theory_of ctxt));
 
 
@@ -149,11 +158,18 @@
     val params = filter pred (params_of ctxt);
     val ps = map Free params;
     val Ps = map #2 params;
+    val abbrevs = decls |> map (fn ((c, T), mx) =>
+      let val t = Term.list_comb (Const (Sign.full_name thy c, Ps ---> T), ps)
+      in (c, t, mx) end);
   in
-    ctxt
-    |> theory (Sign.add_consts_i (decls |> map (fn ((c, T), mx) => (c, Ps ---> T, mx))))
-    |> pair (decls |> map (fn ((c, T), _) =>
-      Term.list_comb (Const (Sign.full_name thy c, Ps ---> T), ps)))
+    ctxt |>
+    (case locale_of ctxt of
+      NONE => theory (Sign.add_consts_i (map (fn ((c, T), mx) => (c, T, mx)) decls))
+    | SOME (loc, _) =>
+        theory (Sign.add_consts_i (map (fn ((c, T), _) => (c, Ps ---> T, NoSyn)) decls)) #>
+        locale (Locale.add_abbrevs loc true abbrevs) #>
+        ProofContext.add_abbrevs_i true abbrevs)
+    |> pair (map #2 abbrevs)
   end;
 
 val consts = consts_restricted (K true);
@@ -169,8 +185,8 @@
     ctxt |>
     (case locale_of ctxt of
       NONE => theory_result (PureThy.note_thmss_i kind (Attrib.map_facts attrib facts'))
-    | SOME (loc, view_ctxt) =>
-        locale_result (K (apfst #1 (Locale.add_thmss kind loc facts' view_ctxt))))
+    | SOME (loc, _) =>
+        locale_result (apfst #1 o Locale.add_thmss kind loc facts'))
     ||> (#2 o ProofContext.note_thmss_i (Attrib.map_facts attrib facts))
   end;