first-class support for "unbundle no foobar_syntax" -- avoid redundant "bundle no_foobar_syntax" definitions;
authorwenzelm
Sat, 05 Oct 2024 14:58:36 +0200
changeset 81116 0fb1e2dd4122
parent 81115 7b3b27576f45
child 81117 0c898f7d9b15
first-class support for "unbundle no foobar_syntax" -- avoid redundant "bundle no_foobar_syntax" definitions;
NEWS
src/Doc/Datatypes/Datatypes.thy
src/Doc/Implementation/Local_Theory.thy
src/Doc/Isar_Ref/Spec.thy
src/HOL/Analysis/Cross3.thy
src/HOL/Analysis/Finite_Cartesian_Product.thy
src/HOL/Analysis/Inner_Product.thy
src/HOL/Analysis/Lipschitz.thy
src/HOL/Combinatorics/Perm.thy
src/HOL/Decision_Procs/Approximation.thy
src/HOL/Library/Option_ord.thy
src/HOL/List.thy
src/HOL/Main.thy
src/HOL/Product_Type.thy
src/HOL/Set.thy
src/HOL/Tools/Lifting/lifting_def_code_dt.ML
src/HOL/Tools/Lifting/lifting_setup.ML
src/HOL/Transitive_Closure.thy
src/Pure/Isar/bundle.ML
src/Pure/Isar/class_declaration.ML
src/Pure/Isar/expression.ML
src/Pure/Isar/parse_spec.ML
src/Pure/Isar/proof_context.ML
src/Pure/Isar/specification.ML
src/Pure/Isar/target_context.ML
src/Pure/Syntax/syntax.ML
src/Pure/sign.ML
--- a/NEWS	Fri Oct 04 23:38:04 2024 +0200
+++ b/NEWS	Sat Oct 05 14:58:36 2024 +0200
@@ -9,12 +9,18 @@
 
 *** General ***
 
+* Command "unbundle b" and its variants like "context includes b" allow
+an optional name prefix with the reserved word "no": "unbundle no b"
+etc. This inverts the polarity of bundled declarations like 'notation'
+vs. 'no_notation', and thus avoids redundant bundle definitions like
+"foobar_syntax" vs. "no_foobar_syntax", because "no foobar_syntax" may
+be used instead. Consequently, the syntax for multiple bundle names has
+been changed slightly, demanding an explicit 'and' keyword. Minor
+INCOMPATIBILITY.
+
 * Command "open_bundle b" is like "bundle b" followed by "unbundle b",
 so its declarations are applied immediately, but also named for later
-re-use.
-
-* The syntax of opnening bundles has changed slightly: multiple bundles
-need to be separated by the keyword 'and'. Minor INCOMPATIBILITY.
+re-use: "unbundle no b" etc.
 
 * Inner syntax translations now support formal dependencies via commands
 'syntax_types' or 'syntax_consts'. This is essentially an abstract
@@ -53,11 +59,11 @@
 * Various declaration bundles support adhoc modification of notation,
 notably like this:
 
-  unbundle no_list_syntax
-  unbundle no_listcompr_syntax
-  unbundle no_rtrancl_syntax
-  unbundle no_trancl_syntax
-  unbundle no_reflcl_syntax
+  unbundle no list_syntax
+  unbundle no listcompr_syntax
+  unbundle no rtrancl_syntax
+  unbundle no trancl_syntax
+  unbundle no reflcl_syntax
 
 This is more robust than individual 'no_syntax' / 'no_notation'
 commands, which need to copy mixfix declarations from elsewhere and thus
--- a/src/Doc/Datatypes/Datatypes.thy	Fri Oct 04 23:38:04 2024 +0200
+++ b/src/Doc/Datatypes/Datatypes.thy	Sat Oct 05 14:58:36 2024 +0200
@@ -453,7 +453,7 @@
 Incidentally, this is how the traditional syntax can be set up:
 \<close>
 (*<*)
-unbundle no_list_syntax
+unbundle no list_syntax
 (*>*)
     syntax "_list" :: "args \<Rightarrow> 'a list" (\<open>[(_)]\<close>)
 
--- a/src/Doc/Implementation/Local_Theory.thy	Fri Oct 04 23:38:04 2024 +0200
+++ b/src/Doc/Implementation/Local_Theory.thy	Sat Oct 05 14:58:36 2024 +0200
@@ -91,7 +91,7 @@
 text %mlref \<open>
   \begin{mldecls}
   @{define_ML_type local_theory = Proof.context} \\
-  @{define_ML Named_Target.init: "string list -> string -> theory -> local_theory"} \\[1ex]
+  @{define_ML Named_Target.init: "Bundle.name list -> string -> theory -> local_theory"} \\[1ex]
   @{define_ML Local_Theory.define: "(binding * mixfix) * (Attrib.binding * term) ->
     local_theory -> (term * (string * thm)) * local_theory"} \\
   @{define_ML Local_Theory.note: "Attrib.binding * thm list ->
--- a/src/Doc/Isar_Ref/Spec.thy	Fri Oct 04 23:38:04 2024 +0200
+++ b/src/Doc/Isar_Ref/Spec.thy	Sat Oct 05 14:58:36 2024 +0200
@@ -246,7 +246,7 @@
     ;
     @{syntax_def "opening"}: @'opening' @{syntax bundles}
     ;
-    @{syntax bundles}: @{syntax name} + @'and'
+    @{syntax bundles}: ('no')? @{syntax name} + @'and'
   \<close>
 
   \<^descr> \<^theory_text>\<open>bundle b = decls\<close> defines a bundle of declarations in the current
@@ -289,6 +289,17 @@
   effect is confined to the surface context within the specification block
   itself and the corresponding \<^theory_text>\<open>begin\<close> / \<^theory_text>\<open>end\<close> block.
 
+  \<^descr> Bundle names may be prefixed by the reserved word \<^verbatim>\<open>no\<close> to indicate that
+  the polarity of certain declaration commands should be inverted, notably:
+
+    \<^item> @{command syntax} versus @{command no_syntax}
+    \<^item> @{command notation} versus @{command no_notation}
+    \<^item> @{command type_notation} versus @{command no_type_notation}
+
+  This also works recursively for the @{command unbundle} command as
+  declaration inside a @{command bundle} definition.
+
+
   Here is an artificial example of bundling various configuration options:
 \<close>
 
--- a/src/HOL/Analysis/Cross3.thy	Fri Oct 04 23:38:04 2024 +0200
+++ b/src/HOL/Analysis/Cross3.thy	Sat Oct 05 14:58:36 2024 +0200
@@ -10,7 +10,7 @@
   imports Determinants Cartesian_Euclidean_Space
 begin
 
-context includes no_set_product_syntax
+context includes no set_product_syntax
 begin \<comment>\<open>locally disable syntax for set product, to avoid warnings\<close>
 
 definition\<^marker>\<open>tag important\<close> cross3 :: "[real^3, real^3] \<Rightarrow> real^3"  (infixr \<open>\<times>\<close> 80)
@@ -24,14 +24,9 @@
 open_bundle cross3_syntax
 begin
 notation cross3 (infixr \<open>\<times>\<close> 80)
-unbundle no_set_product_syntax
+unbundle no set_product_syntax
 end
 
-bundle no_cross3_syntax
-begin
-no_notation cross3 (infixr \<open>\<times>\<close> 80)
-unbundle set_product_syntax
-end
 
 subsection\<open> Basic lemmas\<close>
 
@@ -221,7 +216,7 @@
   shows "\<lbrakk>continuous_on S f; continuous_on S g\<rbrakk> \<Longrightarrow> continuous_on S (\<lambda>x. (f x) \<times> (g x))"
   by (simp add: continuous_on_eq_continuous_within continuous_cross)
 
-unbundle no_cross3_syntax
+unbundle no cross3_syntax
 
 end
 
--- a/src/HOL/Analysis/Finite_Cartesian_Product.thy	Fri Oct 04 23:38:04 2024 +0200
+++ b/src/HOL/Analysis/Finite_Cartesian_Product.thy	Sat Oct 05 14:58:36 2024 +0200
@@ -25,11 +25,6 @@
 notation vec_nth (infixl \<open>$\<close> 90) and vec_lambda (binder \<open>\<chi>\<close> 10)
 end
 
-bundle no_vec_syntax
-begin
-no_notation vec_nth (infixl \<open>$\<close> 90) and vec_lambda (binder \<open>\<chi>\<close> 10)
-end
-
 text \<open>
   Concrete syntax for \<open>('a, 'b) vec\<close>:
     \<^item> \<open>'a^'b\<close> becomes \<open>('a, 'b::finite) vec\<close>
--- a/src/HOL/Analysis/Inner_Product.thy	Fri Oct 04 23:38:04 2024 +0200
+++ b/src/HOL/Analysis/Inner_Product.thy	Sat Oct 05 14:58:36 2024 +0200
@@ -466,9 +466,4 @@
 notation inner (infix \<open>\<bullet>\<close> 70)
 end
 
-bundle no_inner_syntax
-begin
-no_notation inner (infix \<open>\<bullet>\<close> 70)
 end
-
-end
--- a/src/HOL/Analysis/Lipschitz.thy	Fri Oct 04 23:38:04 2024 +0200
+++ b/src/HOL/Analysis/Lipschitz.thy	Sat Oct 05 14:58:36 2024 +0200
@@ -17,11 +17,6 @@
 notation\<^marker>\<open>tag important\<close> lipschitz_on (\<open>_-lipschitz'_on\<close> [1000])
 end
 
-bundle no_lipschitz_syntax
-begin
-no_notation lipschitz_on (\<open>_-lipschitz'_on\<close> [1000])
-end
-
 lemma lipschitz_onI: "L-lipschitz_on X f"
   if "\<And>x y. x \<in> X \<Longrightarrow> y \<in> X \<Longrightarrow> dist (f x) (f y) \<le> L * dist x y" "0 \<le> L"
   using that by (auto simp: lipschitz_on_def)
--- a/src/HOL/Combinatorics/Perm.thy	Fri Oct 04 23:38:04 2024 +0200
+++ b/src/HOL/Combinatorics/Perm.thy	Sat Oct 05 14:58:36 2024 +0200
@@ -792,18 +792,13 @@
 
 subsection \<open>Syntax\<close>
 
-open_bundle no_permutation_syntax
+bundle permutation_syntax
 begin
-no_notation swap    (\<open>\<langle>_ \<leftrightarrow> _\<rangle>\<close>)
-no_notation cycle   (\<open>\<langle>_\<rangle>\<close>)
-no_notation "apply" (infixl \<open>\<langle>$\<rangle>\<close> 999)
+notation swap    (\<open>\<langle>_ \<leftrightarrow> _\<rangle>\<close>)
+notation cycle   (\<open>\<langle>_\<rangle>\<close>)
+notation "apply" (infixl \<open>\<langle>$\<rangle>\<close> 999)
 end
 
-bundle permutation_syntax
-begin
-notation swap       (\<open>\<langle>_ \<leftrightarrow> _\<rangle>\<close>)
-notation cycle      (\<open>\<langle>_\<rangle>\<close>)
-notation "apply"    (infixl \<open>\<langle>$\<rangle>\<close> 999)
-end
+unbundle no permutation_syntax
 
 end
--- a/src/HOL/Decision_Procs/Approximation.thy	Fri Oct 04 23:38:04 2024 +0200
+++ b/src/HOL/Decision_Procs/Approximation.thy	Sat Oct 05 14:58:36 2024 +0200
@@ -1145,7 +1145,6 @@
 
 bundle floatarith_syntax
 begin
-
 notation Add (\<open>Add\<close>)
 notation Minus (\<open>Minus\<close>)
 notation Mult (\<open>Mult\<close>)
@@ -1164,31 +1163,6 @@
 notation Floor (\<open>Floor\<close>)
 notation Var (\<open>Var\<close>)
 notation Num (\<open>Num\<close>)
-
-end
-
-bundle no_floatarith_syntax
-begin
-
-no_notation Add (\<open>Add\<close>)
-no_notation Minus (\<open>Minus\<close>)
-no_notation Mult (\<open>Mult\<close>)
-no_notation Inverse (\<open>Inverse\<close>)
-no_notation Cos (\<open>Cos\<close>)
-no_notation Arctan (\<open>Arctan\<close>)
-no_notation Abs (\<open>Abs\<close>)
-no_notation Max (\<open>Max\<close>)
-no_notation Min (\<open>Min\<close>)
-no_notation Pi (\<open>Pi\<close>)
-no_notation Sqrt (\<open>Sqrt\<close>)
-no_notation Exp (\<open>Exp\<close>)
-no_notation Powr (\<open>Powr\<close>)
-no_notation Ln (\<open>Ln\<close>)
-no_notation Power (\<open>Power\<close>)
-no_notation Floor (\<open>Floor\<close>)
-no_notation Var (\<open>Var\<close>)
-no_notation Num (\<open>Num\<close>)
-
 end
 
 hide_const (open)
--- a/src/HOL/Library/Option_ord.thy	Fri Oct 04 23:38:04 2024 +0200
+++ b/src/HOL/Library/Option_ord.thy	Sat Oct 05 14:58:36 2024 +0200
@@ -449,6 +449,6 @@
 
 instance option :: (complete_linorder) complete_linorder ..
 
-unbundle no_lattice_syntax
+unbundle no lattice_syntax
 
 end
--- a/src/HOL/List.thy	Fri Oct 04 23:38:04 2024 +0200
+++ b/src/HOL/List.thy	Sat Oct 05 14:58:36 2024 +0200
@@ -51,9 +51,9 @@
   "[x, xs]" \<rightleftharpoons> "x#[xs]"
   "[x]" \<rightleftharpoons> "x#[]"
 
-bundle no_list_syntax
+bundle list_syntax
 begin
-no_syntax
+syntax
   "_list" :: "args \<Rightarrow> 'a list"  (\<open>(\<open>indent=1 notation=\<open>mixfix list enumeration\<close>\<close>[_])\<close>)
 end
 
@@ -457,9 +457,9 @@
 syntax (ASCII)
   "_lc_gen" :: "'a \<Rightarrow> 'a list \<Rightarrow> lc_qual"  (\<open>_ <- _\<close>)
 
-bundle no_listcompr_syntax
+bundle listcompr_syntax
 begin
-no_syntax
+syntax
   "_listcompr" :: "'a \<Rightarrow> lc_qual \<Rightarrow> lc_quals \<Rightarrow> 'a list"  (\<open>[_ . __\<close>)
   "_lc_end" :: "lc_quals" (\<open>]\<close>)
 end
--- a/src/HOL/Main.thy	Fri Oct 04 23:38:04 2024 +0200
+++ b/src/HOL/Main.thy	Sat Oct 05 14:58:36 2024 +0200
@@ -69,8 +69,8 @@
 begin
 
 notation
-  bot (\<open>\<bottom>\<close>) and
-  top (\<open>\<top>\<close>) and
+  bot  (\<open>\<bottom>\<close>) and
+  top  (\<open>\<top>\<close>) and
   inf  (infixl \<open>\<sqinter>\<close> 70) and
   sup  (infixl \<open>\<squnion>\<close> 65) and
   Inf  (\<open>\<Sqinter> _\<close> [900] 900) and
@@ -84,25 +84,6 @@
 
 end
 
-bundle no_lattice_syntax
-begin
-
-no_notation
-  bot (\<open>\<bottom>\<close>) and
-  top (\<open>\<top>\<close>) and
-  inf  (infixl \<open>\<sqinter>\<close> 70) and
-  sup  (infixl \<open>\<squnion>\<close> 65) and
-  Inf  (\<open>\<Sqinter> _\<close> [900] 900) and
-  Sup  (\<open>\<Squnion> _\<close> [900] 900)
-
-no_syntax
-  "_INF1"     :: "pttrns \<Rightarrow> 'b \<Rightarrow> 'b"           (\<open>(\<open>indent=3 notation=\<open>binder \<Sqinter>\<close>\<close>\<Sqinter>_./ _)\<close> [0, 10] 10)
-  "_INF"      :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'b \<Rightarrow> 'b"  (\<open>(\<open>indent=3 notation=\<open>binder \<Sqinter>\<close>\<close>\<Sqinter>_\<in>_./ _)\<close> [0, 0, 10] 10)
-  "_SUP1"     :: "pttrns \<Rightarrow> 'b \<Rightarrow> 'b"           (\<open>(\<open>indent=3 notation=\<open>binder \<Squnion>\<close>\<close>\<Squnion>_./ _)\<close> [0, 10] 10)
-  "_SUP"      :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'b \<Rightarrow> 'b"  (\<open>(\<open>indent=3 notation=\<open>binder \<Squnion>\<close>\<close>\<Squnion>_\<in>_./ _)\<close> [0, 0, 10] 10)
+unbundle no lattice_syntax
 
 end
-
-unbundle no_lattice_syntax
-
-end
--- a/src/HOL/Product_Type.thy	Fri Oct 04 23:38:04 2024 +0200
+++ b/src/HOL/Product_Type.thy	Sat Oct 05 14:58:36 2024 +0200
@@ -1008,11 +1008,6 @@
 notation Product_Type.Times (infixr \<open>\<times>\<close> 80)
 end
 
-bundle no_set_product_syntax
-begin
-no_notation Product_Type.Times (infixr \<open>\<times>\<close> 80)
-end
-
 syntax
   "_Sigma" :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'b set \<Rightarrow> ('a \<times> 'b) set"
     (\<open>(\<open>indent=3 notation=\<open>binder SIGMA\<close>\<close>SIGMA _:_./ _)\<close> [0, 0, 10] 10)
--- a/src/HOL/Set.thy	Fri Oct 04 23:38:04 2024 +0200
+++ b/src/HOL/Set.thy	Sat Oct 05 14:58:36 2024 +0200
@@ -38,15 +38,6 @@
   not_member  (\<open>(\<open>notation=\<open>infix ~:\<close>\<close>_/ ~: _)\<close> [51, 51] 50)
 end
 
-bundle no_member_ASCII_syntax
-begin
-no_notation (ASCII)
-  member  (\<open>'(:')\<close>) and
-  member  (\<open>(\<open>notation=\<open>infix :\<close>\<close>_/ : _)\<close> [51, 51] 50) and
-  not_member  (\<open>'(~:')\<close>) and
-  not_member  (\<open>(\<open>notation=\<open>infix ~:\<close>\<close>_/ ~: _)\<close> [51, 51] 50)
-end
-
 
 text \<open>Set comprehensions\<close>
 
--- a/src/HOL/Tools/Lifting/lifting_def_code_dt.ML	Fri Oct 04 23:38:04 2024 +0200
+++ b/src/HOL/Tools/Lifting/lifting_def_code_dt.ML	Sat Oct 05 14:58:36 2024 +0200
@@ -272,7 +272,9 @@
               |> Lifting_Info.lookup_quot_thm_quotients lthy2 |> is_some
             val qty_code_dt_bundle_name = bundle_name_of_rep_isom_data rep_isom_data
             val rep_isom = mk_rep_isom_of_code_dt qty_ret code_dt |> the
-            val lthy3 = if quot_active then lthy2 else Bundle.includes [qty_code_dt_bundle_name] lthy2
+            val lthy3 =
+              if quot_active then lthy2
+              else Bundle.includes [(true, qty_code_dt_bundle_name)] lthy2
             fun qty_isom_of_rep_isom rep = domain_type (dest_Const_type rep)
             val qty_isom = qty_isom_of_rep_isom rep_isom
             val f'_var = (Binding.suffix_name "_aux" (fst var), NoSyn);
--- a/src/HOL/Tools/Lifting/lifting_setup.ML	Fri Oct 04 23:38:04 2024 +0200
+++ b/src/HOL/Tools/Lifting/lifting_setup.ML	Sat Oct 05 14:58:36 2024 +0200
@@ -959,7 +959,7 @@
 
 fun pointer_of_bundle_name bundle_name ctxt =
   let
-    val bundle = Bundle.read ctxt bundle_name
+    val bundle = Bundle.get ctxt (Bundle.check ctxt bundle_name)
     fun err () = error "The provided bundle is not a lifting bundle"
   in
     (case bundle of
--- a/src/HOL/Transitive_Closure.thy	Fri Oct 04 23:38:04 2024 +0200
+++ b/src/HOL/Transitive_Closure.thy	Sat Oct 05 14:58:36 2024 +0200
@@ -64,32 +64,32 @@
   tranclp  (\<open>(\<open>notation=\<open>postfix ++\<close>\<close>_^++)\<close> [1000] 1000) and
   reflclp  (\<open>(\<open>notation=\<open>postfix ==\<close>\<close>_^==)\<close> [1000] 1000)
 
-bundle no_rtrancl_syntax
+bundle rtrancl_syntax
 begin
-no_notation
+notation
   rtrancl  (\<open>(\<open>notation=\<open>postfix *\<close>\<close>_\<^sup>*)\<close> [1000] 999) and
   rtranclp  (\<open>(\<open>notation=\<open>postfix **\<close>\<close>_\<^sup>*\<^sup>*)\<close> [1000] 1000)
-no_notation (ASCII)
+notation (ASCII)
   rtrancl  (\<open>(\<open>notation=\<open>postfix *\<close>\<close>_^*)\<close> [1000] 999) and
   rtranclp  (\<open>(\<open>notation=\<open>postfix **\<close>\<close>_^**)\<close> [1000] 1000)
 end
 
-bundle no_trancl_syntax
+bundle trancl_syntax
 begin
-no_notation
+notation
   trancl  (\<open>(\<open>notation=\<open>postfix +\<close>\<close>_\<^sup>+)\<close> [1000] 999) and
   tranclp  (\<open>(\<open>notation=\<open>postfix ++\<close>\<close>_\<^sup>+\<^sup>+)\<close> [1000] 1000)
-no_notation (ASCII)
+notation (ASCII)
   trancl  (\<open>(\<open>notation=\<open>postfix +\<close>\<close>_^+)\<close> [1000] 999) and
   tranclp  (\<open>(\<open>notation=\<open>postfix ++\<close>\<close>_^++)\<close> [1000] 1000)
 end
 
-bundle no_reflcl_syntax
+bundle reflcl_syntax
 begin
-no_notation
+notation
   reflcl  (\<open>(\<open>notation=\<open>postfix =\<close>\<close>_\<^sup>=)\<close> [1000] 999) and
   reflclp  (\<open>(\<open>notation=\<open>postfix ==\<close>\<close>_\<^sup>=\<^sup>=)\<close> [1000] 1000)
-no_notation (ASCII)
+notation (ASCII)
   reflcl  (\<open>(\<open>notation=\<open>postfix =\<close>\<close>_^=)\<close> [1000] 999) and
   reflclp  (\<open>(\<open>notation=\<open>postfix ==\<close>\<close>_^==)\<close> [1000] 1000)
 end
--- a/src/Pure/Isar/bundle.ML	Fri Oct 04 23:38:04 2024 +0200
+++ b/src/Pure/Isar/bundle.ML	Sat Oct 05 14:58:36 2024 +0200
@@ -6,21 +6,22 @@
 
 signature BUNDLE =
 sig
-  type name = string
+  type name = bool * string
+  type xname = (bool * Position.T) * (xstring * Position.T)
   val bundle_space: Context.generic -> Name_Space.T
   val check: Proof.context -> xstring * Position.T -> string
-  val get: Proof.context -> name -> Attrib.thms
-  val read: Proof.context -> xstring * Position.T -> Attrib.thms
+  val check_name: Proof.context -> xname -> name
+  val get: Proof.context -> string -> Attrib.thms
   val extern: Proof.context -> string -> xstring
   val print_bundles: bool -> Proof.context -> unit
   val unbundle: name list -> local_theory -> local_theory
-  val unbundle_cmd: (xstring * Position.T) list -> local_theory -> local_theory
+  val unbundle_cmd: xname list -> local_theory -> local_theory
   val includes: name list -> Proof.context -> Proof.context
-  val includes_cmd: (xstring * Position.T) list -> Proof.context -> Proof.context
+  val includes_cmd: xname list -> Proof.context -> Proof.context
   val include_: name list -> Proof.state -> Proof.state
-  val include_cmd: (xstring * Position.T) list -> Proof.state -> Proof.state
+  val include_cmd: xname list -> Proof.state -> Proof.state
   val including: name list -> Proof.state -> Proof.state
-  val including_cmd: (xstring * Position.T) list -> Proof.state -> Proof.state
+  val including_cmd: xname list -> Proof.state -> Proof.state
   val bundle: {open_bundle: bool} -> binding * Attrib.thms ->
     (binding * typ option * mixfix) list -> local_theory -> local_theory
   val bundle_cmd: {open_bundle: bool} -> binding * (Facts.ref * Token.src list) list ->
@@ -44,7 +45,8 @@
 
 (* bundles *)
 
-type name = string
+type name = bool * string;
+type xname = (bool * Position.T) * (xstring * Position.T);
 
 val get_all_generic = #1 o Data.get;
 val get_all = get_all_generic o Context.Proof;
@@ -53,11 +55,12 @@
 
 fun check ctxt = #1 o Name_Space.check (Context.Proof ctxt) (get_all ctxt);
 
+fun check_name ctxt ((b: bool, pos), arg) =
+  (Context_Position.report ctxt pos Markup.quasi_keyword; (b, check ctxt arg));
+
 val get_global = Name_Space.get o get_all_generic o Context.Theory;
 val get = Name_Space.get o get_all_generic o Context.Proof;
 
-fun read ctxt = get ctxt o check ctxt;
-
 fun extern ctxt = Name_Space.extern ctxt (Name_Space.space_of_table (get_all ctxt));
 
 
@@ -109,11 +112,19 @@
 
 (** open bundles **)
 
-fun apply_bundle loc bundle ctxt =
-  let val notes = if loc then Local_Theory.notes else Attrib.local_notes "" in
+fun polarity_decls b =
+  [([Drule.dummy_thm],
+    [Attrib.internal \<^here> (K (Thm.declaration_attribute (K (Syntax.set_polarity_generic b))))])];
+
+fun apply_bundle loc (add, bundle) ctxt =
+  let
+    val notes = if loc then Local_Theory.notes else Attrib.local_notes "";
+    val add0 = Syntax.get_polarity ctxt;
+    val add1 = Syntax.effective_polarity ctxt add;
+  in
     ctxt
     |> Context_Position.set_visible false
-    |> notes [(Binding.empty_atts, bundle)] |> snd
+    |> notes [(Binding.empty_atts, polarity_decls add1 @ bundle @ polarity_decls add0)] |> snd
     |> Context_Position.restore_visible ctxt
   end;
 
@@ -122,8 +133,8 @@
 fun gen_unbundle loc prep args ctxt =
   let
     val thy = Proof_Context.theory_of ctxt;
-    val bundle = maps (prep ctxt) args |> transfer_bundle thy;
-  in apply_bundle loc bundle ctxt end;
+    val bundles = map (prep ctxt #> apsnd (get ctxt #> transfer_bundle thy)) args;
+  in fold (apply_bundle loc) bundles ctxt end;
 
 fun gen_includes prep = gen_unbundle false prep;
 
@@ -135,17 +146,17 @@
 
 in
 
-val unbundle = gen_unbundle true get;
-val unbundle_cmd = gen_unbundle true read;
+val unbundle = gen_unbundle true (K I);
+val unbundle_cmd = gen_unbundle true check_name;
 
-val includes = gen_includes get;
-val includes_cmd = gen_includes read;
+val includes = gen_includes (K I);
+val includes_cmd = gen_includes check_name;
 
-val include_ = gen_include get;
-val include_cmd = gen_include read;
+val include_ = gen_include (K I);
+val include_cmd = gen_include check_name;
 
-val including = gen_including get;
-val including_cmd = gen_including read;
+val including = gen_including (K I);
+val including_cmd = gen_including check_name;
 
 end;
 
@@ -180,7 +191,7 @@
       (fn phi => fn context =>
         let val psi = Morphism.set_trim_context'' context phi
         in #2 (define_bundle (Morphism.binding psi binding, transform_bundle psi bundle) context) end)
-    |> open_bundle ? apply_bundle true bundle
+    |> open_bundle ? apply_bundle true (true, bundle)
   end;
 
 in
--- a/src/Pure/Isar/class_declaration.ML	Fri Oct 04 23:38:04 2024 +0200
+++ b/src/Pure/Isar/class_declaration.ML	Sat Oct 05 14:58:36 2024 +0200
@@ -8,7 +8,7 @@
 sig
   val class: binding -> Bundle.name list -> class list ->
     Element.context_i list -> theory -> string * local_theory
-  val class_cmd: binding -> (xstring * Position.T) list -> xstring list ->
+  val class_cmd: binding -> Bundle.xname list -> xstring list ->
     Element.context list -> theory -> string * local_theory
   val prove_subclass: tactic -> class ->
     local_theory -> local_theory
@@ -263,7 +263,7 @@
   in (((sups, supparam_names), (sup_sort, base_sort, supexpr)), (includes, elems, global_syntax)) end;
 
 val cert_class_spec = prep_class_spec (K I) (K I) cert_class_elems;
-val read_class_spec = prep_class_spec Proof_Context.read_class Bundle.check read_class_elems;
+val read_class_spec = prep_class_spec Proof_Context.read_class Bundle.check_name read_class_elems;
 
 
 (* class establishment *)
--- a/src/Pure/Isar/expression.ML	Fri Oct 04 23:38:04 2024 +0200
+++ b/src/Pure/Isar/expression.ML	Sat Oct 05 14:58:36 2024 +0200
@@ -34,7 +34,7 @@
       * Element.context_i list * Proof.context) * ((string * typ) list * Proof.context)
   val add_locale: binding -> binding -> Bundle.name list ->
     expression_i -> Element.context_i list -> theory -> string * local_theory
-  val add_locale_cmd: binding -> binding -> (xstring * Position.T) list ->
+  val add_locale_cmd: binding -> binding -> Bundle.xname list ->
     expression -> Element.context list -> theory -> string * local_theory
 
   (* Processing of locale expressions *)
@@ -874,7 +874,7 @@
 in
 
 val add_locale = gen_add_locale (K I) cert_declaration;
-val add_locale_cmd = gen_add_locale Bundle.check read_declaration;
+val add_locale_cmd = gen_add_locale Bundle.check_name read_declaration;
 
 end;
 
--- a/src/Pure/Isar/parse_spec.ML	Fri Oct 04 23:38:04 2024 +0200
+++ b/src/Pure/Isar/parse_spec.ML	Sat Oct 05 14:58:36 2024 +0200
@@ -17,9 +17,9 @@
   val specification:
     ((binding * string option * mixfix) list * Specification.multi_specs_cmd) parser
   val constdecl: (binding * string option * mixfix) parser
-  val bundles: (xstring * Position.T) list parser
-  val includes: (xstring * Position.T) list parser
-  val opening: (xstring * Position.T) list parser
+  val bundles: Bundle.xname list parser
+  val includes: Bundle.xname list parser
+  val opening: Bundle.xname list parser
   val locale_fixes: (binding * string option * mixfix) list parser
   val locale_insts: (string option list * (Attrib.binding * string) list) parser
   val class_expression: string list parser
@@ -84,7 +84,11 @@
 
 (* bundles *)
 
-val bundles = Parse.and_list1 Parse.name_position;
+val bundle_polarity =
+  Scan.optional (Parse.position (Parse.reserved "no") >> (pair false o snd))
+    (true, Position.none);
+
+val bundles = Parse.and_list1 (bundle_polarity -- Parse.name_position);
 
 val includes = Parse.$$$ "includes" |-- Parse.!!! bundles;
 
--- a/src/Pure/Isar/proof_context.ML	Fri Oct 04 23:38:04 2024 +0200
+++ b/src/Pure/Isar/proof_context.ML	Sat Oct 05 14:58:36 2024 +0200
@@ -1140,8 +1140,10 @@
   else error ("Unknown syntax const: " ^ quote c ^ Position.here pos);
 
 fun syntax add mode args ctxt =
-  let val args' = map (pair Local_Syntax.Const) args
-  in ctxt |> map_syntax (#2 o Local_Syntax.update_modesyntax ctxt add mode args') end;
+  let
+    val add' = Syntax.effective_polarity ctxt add;
+    val args' = map (pair Local_Syntax.Const) args;
+  in ctxt |> map_syntax (#2 o Local_Syntax.update_modesyntax ctxt add' mode args') end;
 
 fun generic_syntax add mode args =
   Context.mapping (Sign.syntax_global add mode args) (syntax add mode args);
@@ -1163,8 +1165,10 @@
   | const_syntax _ _ = NONE;
 
 fun gen_notation make_syntax add mode args ctxt =
-  ctxt |> map_syntax_idents
-    (Local_Syntax.update_modesyntax ctxt add mode (map_filter (make_syntax ctxt) args));
+  let
+    val add' = Syntax.effective_polarity ctxt add;
+    val args' = map_filter (make_syntax ctxt) args;
+  in ctxt |> map_syntax_idents (Local_Syntax.update_modesyntax ctxt add' mode args') end;
 
 in
 
--- a/src/Pure/Isar/specification.ML	Fri Oct 04 23:38:04 2024 +0200
+++ b/src/Pure/Isar/specification.ML	Sat Oct 05 14:58:36 2024 +0200
@@ -56,19 +56,19 @@
     bool -> local_theory -> (string * thm list) list * local_theory
   val theorem: bool -> string -> Method.text option ->
     (thm list list -> local_theory -> local_theory) -> Attrib.binding ->
-    string list -> Element.context_i list -> Element.statement_i ->
+    Bundle.name list -> Element.context_i list -> Element.statement_i ->
     bool -> local_theory -> Proof.state
   val theorem_cmd: bool -> string -> Method.text option ->
     (thm list list -> local_theory -> local_theory) -> Attrib.binding ->
-    (xstring * Position.T) list -> Element.context list -> Element.statement ->
+    Bundle.xname list -> Element.context list -> Element.statement ->
     bool -> local_theory -> Proof.state
   val schematic_theorem: bool -> string -> Method.text option ->
     (thm list list -> local_theory -> local_theory) -> Attrib.binding ->
-    string list -> Element.context_i list -> Element.statement_i ->
+    Bundle.name list -> Element.context_i list -> Element.statement_i ->
     bool -> local_theory -> Proof.state
   val schematic_theorem_cmd: bool -> string -> Method.text option ->
     (thm list list -> local_theory -> local_theory) -> Attrib.binding ->
-    (xstring * Position.T) list -> Element.context list -> Element.statement ->
+    Bundle.xname list -> Element.context list -> Element.statement ->
     bool -> local_theory -> Proof.state
 end;
 
--- a/src/Pure/Isar/target_context.ML	Fri Oct 04 23:38:04 2024 +0200
+++ b/src/Pure/Isar/target_context.ML	Sat Oct 05 14:58:36 2024 +0200
@@ -6,12 +6,12 @@
 
 signature TARGET_CONTEXT =
 sig
-  val context_begin_named_cmd: (xstring * Position.T) list -> xstring * Position.T ->
+  val context_begin_named_cmd: Bundle.xname list -> xstring * Position.T ->
     theory -> local_theory
   val end_named_cmd: local_theory -> Context.generic
   val switch_named_cmd: (xstring * Position.T) option -> Context.generic ->
     (local_theory -> Context.generic) * local_theory
-  val context_begin_nested_cmd: (xstring * Position.T) list -> Element.context list ->
+  val context_begin_nested_cmd: Bundle.xname list -> Element.context list ->
     Context.generic -> local_theory
   val end_nested_cmd: local_theory -> Context.generic
 end;
@@ -20,7 +20,7 @@
 struct
 
 fun prep_includes thy =
-  map (Bundle.check (Proof_Context.init_global thy));
+  map (Bundle.check_name (Proof_Context.init_global thy));
 
 fun context_begin_named_cmd raw_includes ("-", _) thy =
       Named_Target.init (prep_includes thy raw_includes) "" thy
@@ -44,7 +44,7 @@
       end;
 
 fun includes raw_includes lthy =
-  Bundle.includes (map (Bundle.check lthy) raw_includes) lthy;
+  Bundle.includes (map (Bundle.check_name lthy) raw_includes) lthy;
 
 fun context_begin_nested_cmd raw_includes raw_elems gthy =
   gthy
--- a/src/Pure/Syntax/syntax.ML	Fri Oct 04 23:38:04 2024 +0200
+++ b/src/Pure/Syntax/syntax.ML	Sat Oct 05 14:58:36 2024 +0200
@@ -116,6 +116,10 @@
   val update_consts: Proof.context -> (string * string list) list -> syntax -> syntax
   val update_trrules: Proof.context -> Ast.ast trrule list -> syntax -> syntax
   val remove_trrules: Proof.context -> Ast.ast trrule list -> syntax -> syntax
+  val get_polarity: Proof.context -> bool
+  val set_polarity: bool -> Proof.context -> Proof.context
+  val set_polarity_generic: bool -> Context.generic -> Context.generic
+  val effective_polarity: Proof.context -> bool -> bool
   val const: string -> term
   val free: string -> term
   val var: indexname -> term
@@ -708,6 +712,8 @@
 
 (** modify syntax **)
 
+(* updates *)
+
 fun update_trfuns ctxt = update_syntax mode_default o Syntax_Ext.syn_ext_trfuns ctxt;
 
 fun update_type_gram ctxt add prmode decls =
@@ -723,6 +729,17 @@
 fun remove_trrules ctxt = remove_syntax mode_default o Syntax_Ext.syn_ext_rules ctxt o check_rules;
 
 
+(* polarity of declarations: true = add, false = del *)
+
+val polarity = Config.declare_bool ("polarity", Position.none) (K true);
+
+fun get_polarity ctxt = Config.get ctxt polarity;
+val set_polarity = Config.put polarity;
+val set_polarity_generic = Config.put_generic polarity;
+
+fun effective_polarity ctxt add = get_polarity ctxt = add;
+
+
 open Lexicon.Syntax;
 
 end;
--- a/src/Pure/sign.ML	Fri Oct 04 23:38:04 2024 +0200
+++ b/src/Pure/sign.ML	Sat Oct 05 14:58:36 2024 +0200
@@ -393,27 +393,32 @@
   in thy |> map_syn (Syntax.update_const_gram ctxt add (logical_types thy) mode (map prep args)) end;
 
 fun syntax_global add mode args thy =
-  syntax (Proof_Context.init_global thy) add mode args thy;
+  let
+    val thy_ctxt = Proof_Context.init_global thy;
+    val add' = Syntax.effective_polarity thy_ctxt add;
+  in syntax thy_ctxt add' mode args thy end;
 
 val syntax_deps = update_syn_global Syntax.update_consts;
 
 fun type_notation_global add mode args thy =
   let
     val thy_ctxt = Proof_Context.init_global thy;
+    val add' = Syntax.effective_polarity thy_ctxt add;
     fun type_syntax (Type (c, args), mx) =
           SOME (Lexicon.mark_type c, Mixfix.make_type (length args), mx)
       | type_syntax _ = NONE;
-  in map_syn (Syntax.update_type_gram thy_ctxt add mode (map_filter type_syntax args)) thy end;
+  in map_syn (Syntax.update_type_gram thy_ctxt add' mode (map_filter type_syntax args)) thy end;
 
 fun notation_global add mode args thy =
   let
     val thy_ctxt = Proof_Context.init_global thy;
+    val add' = Syntax.effective_polarity thy_ctxt add;
     fun const_syntax (Const (c, _), mx) =
           (case try (Consts.type_scheme (consts_of thy)) c of
             SOME T => SOME (Lexicon.mark_const c, T, mx)
           | NONE => NONE)
       | const_syntax _ = NONE;
-  in syntax thy_ctxt add mode (map_filter const_syntax args) thy end;
+  in syntax thy_ctxt add' mode (map_filter const_syntax args) thy end;
 
 
 (* add constants *)