clarified Named_Target.target_declaration: propagate through other levels as well;
tuned signature;
--- a/src/Pure/Isar/generic_target.ML Sun Apr 01 14:29:22 2012 +0200
+++ b/src/Pure/Isar/generic_target.ML Sun Apr 01 15:23:43 2012 +0200
@@ -22,6 +22,7 @@
val background_declaration: declaration -> local_theory -> local_theory
val standard_declaration: declaration -> local_theory -> local_theory
+ val locale_declaration: string -> bool -> declaration -> local_theory -> local_theory
val theory_foundation: ((binding * typ) * mixfix) * (binding * term) ->
term list * term list -> local_theory -> (term * thm) * local_theory
@@ -194,6 +195,11 @@
(fn lthy => Local_Theory.map_contexts (fn _ => fn ctxt =>
Context.proof_map (Local_Theory.standard_form lthy ctxt decl) ctxt) lthy);
+fun locale_declaration locale syntax decl lthy = lthy
+ |> Local_Theory.target (fn ctxt => ctxt |>
+ Locale.add_declaration locale syntax
+ (Morphism.transform (Local_Theory.standard_morphism lthy ctxt) decl));
+
(** primitive theory operations **)
--- a/src/Pure/Isar/locale.ML Sun Apr 01 14:29:22 2012 +0200
+++ b/src/Pure/Isar/locale.ML Sun Apr 01 15:23:43 2012 +0200
@@ -49,8 +49,7 @@
(* Storing results *)
val add_thmss: string -> string -> (Attrib.binding * (thm list * Attrib.src list) list) list ->
Proof.context -> Proof.context
- val add_declaration: string -> declaration -> Proof.context -> Proof.context
- val add_syntax_declaration: string -> declaration -> Proof.context -> Proof.context
+ val add_declaration: string -> bool -> declaration -> Proof.context -> Proof.context
(* Activation *)
val activate_declarations: string * morphism -> Proof.context -> Proof.context
@@ -553,15 +552,22 @@
(* Declarations *)
-fun add_declaration loc decl =
+local
+
+fun add_decl loc decl =
add_thmss loc ""
[((Binding.conceal Binding.empty,
[Attrib.internal (fn phi => Thm.declaration_attribute (K (decl phi)))]),
[([Drule.dummy_thm], [])])];
-fun add_syntax_declaration loc decl =
- Proof_Context.background_theory ((change_locale loc o apfst o apfst) (cons (decl, serial ())))
- #> add_declaration loc decl;
+in
+
+fun add_declaration loc syntax decl =
+ syntax ?
+ Proof_Context.background_theory ((change_locale loc o apfst o apfst) (cons (decl, serial ())))
+ #> add_decl loc decl;
+
+end;
(*** Reasoning about locales ***)
--- a/src/Pure/Isar/named_target.ML Sun Apr 01 14:29:22 2012 +0200
+++ b/src/Pure/Isar/named_target.ML Sun Apr 01 15:23:43 2012 +0200
@@ -49,30 +49,10 @@
else error "Not in a named target (global theory, locale, class)";
-(* generic declarations *)
-
-fun locale_declaration locale syntax decl lthy =
- let
- val add = if syntax then Locale.add_syntax_declaration else Locale.add_declaration;
- val locale_decl = Morphism.transform (Local_Theory.target_morphism lthy) decl;
- in
- lthy
- |> Local_Theory.target (add locale locale_decl)
- end;
+(* consts in locale *)
-fun target_declaration (Target {target, ...}) {syntax, pervasive} decl lthy =
- if target = "" then Generic_Target.standard_declaration decl lthy
- else
- lthy
- |> pervasive ? Generic_Target.background_declaration decl
- |> locale_declaration target syntax decl
- |> Context.proof_map (Morphism.form decl);
-
-
-(* consts in locales *)
-
-fun locale_const (ta as Target {target, is_class, ...}) (prmode as (mode, _)) ((b, mx), rhs) =
- locale_declaration target true (fn phi =>
+fun locale_const (Target {target, is_class, ...}) (prmode as (mode, _)) ((b, mx), rhs) =
+ Generic_Target.locale_declaration target true (fn phi =>
let
val b' = Morphism.binding phi b;
val rhs' = Morphism.term phi rhs;
@@ -157,6 +137,18 @@
|> Generic_Target.theory_abbrev prmode ((b, mx), global_rhs);
+(* declaration *)
+
+fun target_declaration (Target {target, ...}) {syntax, pervasive} decl lthy =
+ if target = "" then Generic_Target.standard_declaration decl lthy
+ else
+ lthy
+ |> pervasive ? Generic_Target.background_declaration decl
+ |> Generic_Target.locale_declaration target syntax decl
+ |> (fn lthy' => lthy' |> Local_Theory.map_contexts (fn level => fn ctxt => ctxt |>
+ level > 0 ? Context.proof_map (Local_Theory.standard_form lthy' ctxt decl)));
+
+
(* pretty *)
fun pretty (Target {target, is_locale, is_class, ...}) ctxt =