# HG changeset patch # User haftmann # Date 1281613333 -7200 # Node ID ba1cc1815ce1b7f8e77a8c977000a2226835a015 # Parent cb72d89bb444d2e49cac6e078a555bccd56fe6c5 named target is optional; explicit Name_Target.reinit diff -r cb72d89bb444 -r ba1cc1815ce1 src/Pure/Isar/named_target.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 diff -r cb72d89bb444 -r ba1cc1815ce1 src/Pure/Isar/toplevel.ML --- 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 *)