provide explicit variant initializers for regular named target vs. almost-named target
--- a/src/Doc/Implementation/Local_Theory.thy Fri Aug 04 08:12:37 2017 +0200
+++ b/src/Doc/Implementation/Local_Theory.thy Fri Aug 04 08:12:37 2017 +0200
@@ -91,8 +91,7 @@
text %mlref \<open>
\begin{mldecls}
@{index_ML_type local_theory: Proof.context} \\
- @{index_ML Named_Target.init: "(local_theory -> local_theory) option ->
- string -> theory -> local_theory"} \\[1ex]
+ @{index_ML Named_Target.init: "string -> theory -> local_theory"} \\[1ex]
@{index_ML Local_Theory.define: "(binding * mixfix) * (Attrib.binding * term) ->
local_theory -> (term * (string * thm)) * local_theory"} \\
@{index_ML Local_Theory.note: "Attrib.binding * thm list ->
--- a/src/HOL/Statespace/state_space.ML Fri Aug 04 08:12:37 2017 +0200
+++ b/src/HOL/Statespace/state_space.ML Fri Aug 04 08:12:37 2017 +0200
@@ -298,7 +298,7 @@
fun add_declaration name decl thy =
thy
- |> Named_Target.init NONE name
+ |> Named_Target.init name
|> (fn lthy => Local_Theory.declaration {syntax = false, pervasive = false} (decl lthy) lthy)
|> Local_Theory.exit_global;
--- a/src/Pure/Isar/class_declaration.ML Fri Aug 04 08:12:37 2017 +0200
+++ b/src/Pure/Isar/class_declaration.ML Fri Aug 04 08:12:37 2017 +0200
@@ -327,7 +327,7 @@
#> Class.register class sups params base_sort base_morph export_morph some_axiom some_assm_intro of_class
#> Global_Theory.store_thm (prefix (Binding.qualified_name (class ^ ".of_class.intro")), of_class)))
|> snd
- |> Named_Target.init NONE class
+ |> Named_Target.init class
|> pair class
end;
--- a/src/Pure/Isar/expression.ML Fri Aug 04 08:12:37 2017 +0200
+++ b/src/Pure/Isar/expression.ML Fri Aug 04 08:12:37 2017 +0200
@@ -825,7 +825,7 @@
val loc_ctxt = thy'
|> Locale.register_locale binding (extraTs, params)
(asm, rev defs) (a_intro, b_intro) axioms hyp_spec [] (rev notes) (rev deps')
- |> Named_Target.init NONE name
+ |> Named_Target.init name
|> fold (fn (kind, facts) => Local_Theory.notes_kind kind facts #> snd) notes';
in (name, loc_ctxt) end;
--- a/src/Pure/Isar/interpretation.ML Fri Aug 04 08:12:37 2017 +0200
+++ b/src/Pure/Isar/interpretation.ML Fri Aug 04 08:12:37 2017 +0200
@@ -220,7 +220,7 @@
fun gen_global_sublocale prep_loc prep_interpretation
raw_locale expression raw_defs raw_eqns thy =
let
- val lthy = Named_Target.init NONE (prep_loc thy raw_locale) thy;
+ val lthy = Named_Target.init (prep_loc thy raw_locale) thy;
fun setup_proof after_qed =
Element.witness_proof_eqs
(fn wits => fn eqs => after_qed wits eqs #> Local_Theory.exit);
--- a/src/Pure/Isar/named_target.ML Fri Aug 04 08:12:37 2017 +0200
+++ b/src/Pure/Isar/named_target.ML Fri Aug 04 08:12:37 2017 +0200
@@ -11,7 +11,9 @@
val locale_of: local_theory -> string option
val bottom_locale_of: local_theory -> string option
val class_of: local_theory -> string option
- val init: (local_theory -> local_theory) option -> string -> theory -> local_theory
+ val init: string -> theory -> local_theory
+ val init': {setup: local_theory -> local_theory, conclude: local_theory -> local_theory} ->
+ string -> theory -> local_theory
val theory_init: theory -> local_theory
val theory_map: (local_theory -> local_theory) -> theory -> theory
val begin: xstring * Position.T -> theory -> local_theory
@@ -123,7 +125,7 @@
| init_context (Locale locale) = Locale.init locale
| init_context (Class class) = Class.init class;
-fun init before_exit ident thy =
+fun init' {setup, conclude} ident thy =
let
val target = make_target thy ident;
val background_naming =
@@ -132,7 +134,7 @@
thy
|> Sign.change_begin
|> init_context target
- |> is_none before_exit ? Data.put (SOME target)
+ |> setup
|> Local_Theory.init background_naming
{define = Generic_Target.define (foundation target),
notes = Generic_Target.notes (notes target),
@@ -141,11 +143,13 @@
theory_registration = theory_registration target,
locale_dependency = locale_dependency target,
pretty = pretty target,
- exit = the_default I before_exit
- #> Local_Theory.target_of #> Sign.change_end_local}
+ exit = conclude #> Local_Theory.target_of #> Sign.change_end_local}
end;
-val theory_init = init NONE "";
+fun init ident thy =
+ init' {setup = Data.put (SOME (make_target thy ident)), conclude = I} ident thy;
+
+val theory_init = init "";
fun theory_map f = theory_init #> f #> Local_Theory.exit_global;
@@ -153,7 +157,7 @@
(* toplevel interaction *)
fun begin ("-", _) thy = theory_init thy
- | begin target thy = init NONE (Locale.check thy target) thy;
+ | begin target thy = init (Locale.check thy target) thy;
val exit = Local_Theory.assert_bottom #> Local_Theory.exit_global;
@@ -164,7 +168,7 @@
| switch NONE (Context.Proof lthy) =
(Context.Proof o Local_Theory.reset, lthy)
| switch (SOME name) (Context.Proof lthy) =
- (Context.Proof o init NONE (ident_of lthy) o exit,
+ (Context.Proof o init (ident_of lthy) o exit,
(begin name o exit o Local_Theory.assert_nonbrittle) lthy);
end;