named target is optional; explicit Name_Target.reinit
authorhaftmann
Thu, 12 Aug 2010 13:42:13 +0200
changeset 38391 ba1cc1815ce1
parent 38390 cb72d89bb444
child 38392 8a3ca8b96b23
named target is optional; explicit Name_Target.reinit
src/Pure/Isar/named_target.ML
src/Pure/Isar/toplevel.ML
--- a/src/Pure/Isar/named_target.ML	Thu Aug 12 13:42:12 2010 +0200
+++ b/src/Pure/Isar/named_target.ML	Thu Aug 12 13:42:13 2010 +0200
@@ -7,10 +7,11 @@
 
 signature NAMED_TARGET =
 sig
-  val peek: local_theory -> {target: string, is_locale: bool, is_class: bool}
   val init: string -> theory -> local_theory
   val theory_init: theory -> local_theory
+  val reinit: local_theory -> local_theory -> local_theory
   val context_cmd: xstring -> theory -> local_theory
+  val peek: local_theory -> {target: string, is_locale: bool, is_class: bool} option
 end;
 
 structure Named_Target: NAMED_TARGET =
@@ -33,11 +34,11 @@
 
 structure Data = Proof_Data
 (
-  type T = target;
-  fun init _ = global_target;
+  type T = target option;
+  fun init _ = NONE;
 );
 
-val peek = (fn Target args => args) o Data.get;
+val peek = Option.map (fn Target args => args) o Data.get;
 
 
 (* generic declarations *)
@@ -187,7 +188,7 @@
 fun init_target (ta as Target {target, ...}) thy =
   thy
   |> init_context ta
-  |> Data.put ta
+  |> Data.put (SOME ta)
   |> Local_Theory.init NONE (Long_Name.base_name target)
      {define = Generic_Target.define (target_foundation ta),
       notes = Generic_Target.notes (target_notes ta),
@@ -203,6 +204,10 @@
 
 fun init target thy = init_target (named_target thy target) thy;
 
+fun reinit lthy = case peek lthy
+ of SOME {target, ...} => init target o Local_Theory.exit_global
+  | NONE => error "Not in a named target";
+
 val theory_init = init_target global_target;
 
 fun context_cmd "-" thy = init "" thy
--- a/src/Pure/Isar/toplevel.ML	Thu Aug 12 13:42:12 2010 +0200
+++ b/src/Pure/Isar/toplevel.ML	Thu Aug 12 13:42:13 2010 +0200
@@ -107,13 +107,11 @@
 
 fun loc_begin loc (Context.Theory thy) = loc_init (the_default "-" loc) thy
   | loc_begin NONE (Context.Proof lthy) = lthy
-  | loc_begin (SOME loc) (Context.Proof lthy) = loc_init loc (loc_exit lthy);
+  | loc_begin (SOME loc) (Context.Proof lthy) = (loc_init loc o loc_exit) lthy;
 
 fun loc_finish _ (Context.Theory _) = Context.Theory o loc_exit
   | loc_finish NONE (Context.Proof _) = Context.Proof o Local_Theory.restore
-  | loc_finish (SOME _) (Context.Proof lthy) = fn lthy' => let
-        val target = #target (Named_Target.peek lthy);
-      in Context.Proof (Named_Target.init target (loc_exit lthy')) end;
+  | loc_finish (SOME _) (Context.Proof lthy) = Context.Proof o Named_Target.reinit lthy;
 
 
 (* datatype node *)