doc: grind attribute modifiers

This PR adds lemmas about `Nat.fold` and `Nat.foldRev` on sums, to match
the existing theorems about `dfold` and `dfoldRev`.

.github/workflows/build-template.yml

@@ -36,7 +36,7 @@ jobs:
         include: ${{fromJson(inputs.config)}}
       # complete all jobs
       fail-fast: false
-    runs-on: ${{ matrix.os }}
+    runs-on: ${{ endsWith(matrix.os, '-with-cache') && fromJSON(format('["{0}", "nscloud-git-mirror-1gb"]', matrix.os)) || matrix.os }}
     defaults:
       run:
         shell: ${{ matrix.shell || 'nix develop -c bash -euxo pipefail {0}' }}
@@ -69,10 +69,16 @@ jobs:
           brew install ccache tree zstd coreutils gmp libuv
         if: runner.os == 'macOS'
       - name: Checkout
+        if: (!endsWith(matrix.os, '-with-cache'))
         uses: actions/checkout@v4
         with:
           # the default is to use a virtual merge commit between the PR and master: just use the PR
           ref: ${{ github.event.pull_request.head.sha }}
+      - name: Namespace Checkout
+        if: endsWith(matrix.os, '-with-cache')
+        uses: namespacelabs/nscloud-checkout-action@v7
+        with:
+          ref: ${{ github.event.pull_request.head.sha }}
       - name: Open Nix shell once
         run: true
         if: runner.os == 'Linux'
@@ -169,7 +175,9 @@ jobs:
       # Should be done as early as possible and in particular *before* "Check rebootstrap" which
       # changes the state of stage1/
       - name: Save Cache
-        if: steps.restore-cache.outputs.cache-hit != 'true'
+        # Caching on cancellation created some mysterious issues perhaps related to improper build
+        # shutdown
+        if: steps.restore-cache.outputs.cache-hit != 'true' && !cancelled()
         uses: actions/cache/save@v4
         with:
           # NOTE: must be in sync with `restore` above

.github/workflows/ci.yml

@@ -185,7 +185,7 @@ jobs:
               },
               {
                 "name": "Linux Lake",
-                "os": large ? "nscloud-ubuntu-22.04-amd64-8x16" : "ubuntu-latest",
+                "os": large ? "nscloud-ubuntu-22.04-amd64-8x16-with-cache" : "ubuntu-latest",
                 "check-level": 0,
                 "test": true,
                 "check-rebootstrap": level >= 1,
@@ -223,6 +223,7 @@ jobs:
                 "prepare-llvm": "../script/prepare-llvm-macos.sh lean-llvm*",
                 "binary-check": "otool -L",
                 "tar": "gtar", // https://github.com/actions/runner-images/issues/2619
+                "CTEST_OPTIONS": "-E 'leanlaketest_hello'", // started failing from unpack
               },
               {
                 "name": "macOS aarch64",

.github/workflows/update-stage0.yml

@@ -19,6 +19,8 @@ concurrency:
 jobs:
   update-stage0:
     runs-on: nscloud-ubuntu-22.04-amd64-8x16
+    env:
+      CCACHE_DIR: ${{ github.workspace }}/.ccache
     steps:
     # This action should push to an otherwise protected branch, so it
     # uses a deploy key with write permissions, as suggested at

script/AnalyzeGrindAnnotations.lean

@@ -97,5 +97,36 @@ macro "#analyzeEMatchTheorems" : command => `(
 #analyzeEMatchTheorems
 
 -- -- We can analyze specific theorems using commands such as
-set_option trace.grind.ematch.instance true in
-run_meta analyzeEMatchTheorem ``List.filterMap_some {}
+set_option trace.grind.ematch.instance true
+
+-- 1. grind immediately sees `(#[] : Array α) = ([] : List α).toArray` but probably this should be hidden.
+-- 2. `Vector.toArray_empty` keys on `Array.mk []` rather than `#v[].toArray`
+-- I guess we could add `(#[].extract _ _).extract _ _` as a stop pattern.
+run_meta analyzeEMatchTheorem ``Array.extract_empty {}
+
+-- Neither `Option.bind_some` nor `Option.bind_fun_some` fire, because the terms appear inside
+-- lambdas. So we get crazy things like:
+-- `fun x => ((some x).bind some).bind fun x => (some x).bind fun x => (some x).bind some`
+-- We could consider replacing `filterMap_some` with
+-- `filterMap g (filterMap f xs) = filterMap (f >=> g) xs`
+-- to avoid the lambda that `grind` struggles with, but this would require more API around the fish.
+run_meta analyzeEMatchTheorem ``Array.filterMap_some {}
+
+-- Not entirely certain what is wrong here, but certainly
+-- `eq_empty_of_append_eq_empty` is firing too often.
+-- Ideally we could instantiate this is we fine `xs ++ ys` in the same equivalence class,
+-- note just as soon as we see `xs ++ ys`.
+-- I've tried removing this in https://github.com/leanprover/lean4/pull/10162
+run_meta analyzeEMatchTheorem ``Array.range'_succ {}
+
+-- Perhaps the same story here.
+run_meta analyzeEMatchTheorem ``Array.range_succ {}
+
+-- `zip_map_left` and `zip_map_right` are bad grind lemmas,
+-- checking if they can be removed in https://github.com/leanprover/lean4/pull/10163
+run_meta analyzeEMatchTheorem ``Array.zip_map {}
+
+-- It seems crazy to me that as soon as we have `0 >>> n = 0`, we instantiate based on the
+-- pattern `0 >>> n >>> m` by substituting `0` into `0 >>> n` to produce the `0 >>> n >>> n`.
+-- I don't think any forbidden subterms can help us here. I don't know what to do. :-(
+run_meta analyzeEMatchTheorem ``Int.zero_shiftRight {}

src/CMakeLists.txt

@@ -469,6 +469,7 @@ elseif(${CMAKE_SYSTEM_NAME} MATCHES "Darwin")
   string(APPEND CMAKE_CXX_FLAGS " -ftls-model=initial-exec")
   string(APPEND INIT_SHARED_LINKER_FLAGS " -install_name @rpath/libInit_shared.dylib")
   string(APPEND LEANSHARED_1_LINKER_FLAGS " -install_name @rpath/libleanshared_1.dylib")
+  string(APPEND LEANSHARED_2_LINKER_FLAGS " -install_name @rpath/libleanshared_2.dylib")
   string(APPEND LEANSHARED_LINKER_FLAGS " -install_name @rpath/libleanshared.dylib")
   string(APPEND LAKESHARED_LINKER_FLAGS " -Wl,-force_load,${CMAKE_BINARY_DIR}/lib/lean/libLake.a.export -install_name @rpath/libLake_shared.dylib")
   string(APPEND CMAKE_EXE_LINKER_FLAGS " -Wl,-rpath,@executable_path/../lib -Wl,-rpath,@executable_path/../lib/lean")
@@ -502,7 +503,7 @@ endif()
 # are already loaded) and probably fail unless we set up LD_LIBRARY_PATH.
 if(${CMAKE_SYSTEM_NAME} MATCHES "Windows")
   # import libraries created by the stdlib.make targets
-  string(APPEND LEANC_SHARED_LINKER_FLAGS " -lInit_shared -lleanshared_1 -lleanshared")
+  string(APPEND LEANC_SHARED_LINKER_FLAGS " -lInit_shared -lleanshared_2 -lleanshared_1 -lleanshared")
 elseif("${CMAKE_SYSTEM_NAME}" MATCHES "Darwin")
   # The second flag is necessary to even *load* dylibs without resolved symbols, as can happen
   # if a Lake `extern_lib` depends on a symbols defined by the Lean library but is loaded even
@@ -589,7 +590,7 @@ endif()
 
 add_subdirectory(initialize)
 add_subdirectory(shell)
-# to be included in `leanshared` but not the smaller `leanshared_1` (as it would pull
+# to be included in `leanshared` but not the smaller `leanshared_*` (as it would pull
 # in the world)
 add_library(leaninitialize STATIC $<TARGET_OBJECTS:initialize>)
 set_target_properties(leaninitialize PROPERTIES
@@ -714,6 +715,7 @@ if(${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
   )
   add_custom_target(leanshared ALL
     DEPENDS Init_shared leancpp
+    COMMAND touch ${CMAKE_LIBRARY_OUTPUT_DIRECTORY}/libleanshared_2${CMAKE_SHARED_LIBRARY_SUFFIX}
     COMMAND touch ${CMAKE_LIBRARY_OUTPUT_DIRECTORY}/libleanshared_1${CMAKE_SHARED_LIBRARY_SUFFIX}
     COMMAND touch ${CMAKE_LIBRARY_OUTPUT_DIRECTORY}/libleanshared${CMAKE_SHARED_LIBRARY_SUFFIX}
   )
@@ -734,7 +736,7 @@ else()
     COMMAND $(MAKE) -f ${CMAKE_BINARY_DIR}/stdlib.make leanshared
     VERBATIM)
 
-  string(APPEND CMAKE_EXE_LINKER_FLAGS " -lInit_shared -lleanshared_1 -lleanshared")
+  string(APPEND CMAKE_EXE_LINKER_FLAGS " -lInit_shared -lleanshared_2 -lleanshared_1 -lleanshared")
 endif()
 
 if(NOT ${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")

src/Init/Data.lean

@@ -51,5 +51,6 @@ public import Init.Data.Range.Polymorphic
 public import Init.Data.Slice
 public import Init.Data.Order
 public import Init.Data.Rat
+public import Init.Data.Dyadic
 
 public section

src/Init/Data/Array/Zip.lean

@@ -231,11 +231,9 @@ theorem zip_map {f : α → γ} {g : β → δ} {as : Array α} {bs : Array β}
   cases bs
   simp [List.zip_map]
 
-@[grind _=_]
 theorem zip_map_left {f : α → γ} {as : Array α} {bs : Array β} :
     zip (as.map f) bs = (zip as bs).map (Prod.map f id) := by rw [← zip_map, map_id]
 
-@[grind _=_]
 theorem zip_map_right {f : β → γ} {as : Array α} {bs : Array β} :
     zip as (bs.map f) = (zip as bs).map (Prod.map id f) := by rw [← zip_map, map_id]
 

src/Init/Data/BitVec/Bitblast.lean

@@ -2155,4 +2155,238 @@ theorem shiftLeft_add_eq_shiftLeft_or {x y : BitVec w} :
     (y <<< x) + x =  (y <<< x) ||| x := by
   rw [BitVec.add_comm, add_shiftLeft_eq_or_shiftLeft, or_comm]
 
+/- ### Fast Circuit For Unsigned Overflow Detection -/
+
+/-!
+# Note [Fast Unsigned Multiplication Overflow Detection]
+
+The fast unsigned multiplication overflow detection circuit is described in
+`Efficient integer multiplication overflow detection circuits` (https://ieeexplore.ieee.org/abstract/document/987767).
+With this circuit, the computation of the overflow flag for the unsigned multiplication of
+two bitvectors `x` and `y` with bitwidth `w` requires:
+· extending the operands by `1` bit and performing the multiplication with the extended operands,
+· computing the preliminary overflow flag, which describes whether `x` and `y` together have at most
+  `w - 2` leading zeros.
+If the most significant bit of the extended operands' multiplication is `true` or if the
+preliminary overflow flag is `true`, overflow happens.
+In particular, the conditions check two different cases:
+· if the most significant bit of the extended operands' multiplication is `true`, the result of the
+  multiplication 2 ^ w ≤ x.toNat * y.toNat < 2 ^ (w + 1),
+· if the preliminary flag is true, then 2 ^ (w + 1) ≤ x.toNat * y.toNat.
+
+The computation of the preliminary overflow flag `resRec` relies on two quantities:
+· `uppcRec`: the unsigned parallel prefix circuit for the bits until a certain `i`,
+· `aandRec`: the conjunction between the parallel prefix circuit at of the first operand until a certain `i`
+  and the `i`-th bit in the second operand.
+-/
+
+/--
+  `uppcRec` is the unsigned parallel prefix, `x.uppcRec s = true` iff `x.toNat` is greater or equal
+  than `2 ^ (w - 1 - (s - 1))`.
+-/
+def uppcRec {w} (x : BitVec w) (s : Nat) (hs : s < w) : Bool :=
+  match s with
+  | 0 => x.msb
+  | i + 1 =>  x[w - 1 - i] || uppcRec x i (by omega)
+
+/-- The unsigned parallel prefix of `x` at `s` is `true` if and only if x interpreted
+  as a natural number is greater or equal than `2 ^ (w - 1 - (s - 1))`. -/
+@[simp]
+theorem uppcRec_true_iff (x : BitVec w) (s : Nat) (h : s < w) :
+    uppcRec x s h ↔ 2 ^ (w - 1 - (s - 1)) ≤ x.toNat := by
+  rcases w with _|w
+  · omega
+  · induction s
+    · case succ.zero =>
+      simp only [uppcRec, msb_eq_true_iff_two_mul_ge, Nat.pow_add, Nat.pow_one,
+        Nat.mul_comm (2 ^ w) 2, ge_iff_le, Nat.add_one_sub_one, zero_le, Nat.sub_eq_zero_of_le,
+        Nat.sub_zero]
+      apply Nat.mul_le_mul_left_iff (by omega)
+    · case succ.succ s ihs =>
+      simp only [uppcRec, or_eq_true, ihs, Nat.add_one_sub_one]
+      have := Nat.pow_le_pow_of_le (a := 2) ( n := (w - s)) (m := (w - (s - 1))) (by omega) (by omega)
+      constructor
+      · intro h'
+        rcases h' with h'|h'
+        · apply ge_two_pow_of_testBit h'
+        · omega
+      · intro h'
+        by_cases hbit: x[w - s]
+        · simp [hbit]
+        · have := BitVec.le_toNat_iff_getLsbD_eq_true (x := x) (i := w - s) (by omega)
+          simp only [h', true_iff] at this
+          obtain ⟨k, hk⟩ := this
+          by_cases hwk : w - s + k < w + 1
+          · by_cases hk' : 0 < k
+            · have hle := ge_two_pow_of_testBit hk
+              have hpowle := Nat.pow_le_pow_of_le (a := 2) ( n := (w - (s - 1))) (m := (w - s + k)) (by omega) (by omega)
+              omega
+            · rw [getLsbD_eq_getElem (by omega)] at hk
+              simp [hbit, show k = 0 by omega] at hk
+          · simp_all
+
+/--
+  Conjunction for fast umulOverflow circuit
+-/
+def aandRec (x y : BitVec w) (s : Nat) (hs : s < w) : Bool :=
+  y[s] && uppcRec x s (by omega)
+
+
+/--
+  Preliminary overflow flag for fast umulOverflow circuit as introduced in
+  `Efficient integer multiplication overflow detection circuits` (https://ieeexplore.ieee.org/abstract/document/987767).
+-/
+def resRec (x y : BitVec w) (s : Nat) (hs : s < w) (hslt : 0 < s) : Bool :=
+  match hs0 : s with
+  | 0 => by omega
+  | s' + 1 =>
+    match hs' : s' with
+    | 0 => aandRec x y 1 (by omega)
+    | s'' + 1 =>
+      (resRec x y s' (by omega) (by omega)) || (aandRec x y s (by omega))
+
+/-- The preliminary overflow flag is true for a certain `s` if and only if the conjunction returns true at
+  any `k` smaller than or equal to `s`. -/
+theorem resRec_true_iff (x y : BitVec w) (s : Nat) (hs : s < w) (hs' : 0 < s) :
+    resRec x y s hs hs' = true ↔ ∃ (k : Nat), ∃ (h : k ≤ s), ∃ (_ : 0 < k), aandRec x y k (by omega) := by
+  unfold resRec
+  rcases s with _|s
+  · omega
+  · rcases s
+    · case zero =>
+      constructor
+      · intro ha
+        exists 1, by omega, by omega
+      · intro hr
+        obtain ⟨k, hk, hk', hk''⟩ := hr
+        simp only [show k = 1 by omega] at hk''
+        exact hk''
+    · case succ s =>
+      induction s
+      · case zero =>
+        unfold resRec
+        simp only [Nat.zero_add, Nat.reduceAdd, or_eq_true]
+        constructor
+        · intro h
+          rcases h with h|h
+          · exists 1, by omega, by omega
+          · exists 2, by omega, by omega
+        · intro h
+          obtain ⟨k, hk, hk', hk''⟩ := h
+          have h : k = 1 ∨ k = 2 := by omega
+          rcases h with h|h
+          <;> simp only [h] at hk''
+          <;> simp [hk'']
+      · case succ s ihs =>
+        specialize ihs (by omega) (by omega)
+        unfold resRec
+        simp only [or_eq_true, ihs]
+        constructor
+        · intro h
+          rcases h with h|h
+          · obtain ⟨k, hk, hk', hk''⟩ := h
+            exists k, by omega, by omega
+          · exists s + 1 + 1 + 1, by omega, by omega
+        · intro h
+          obtain ⟨k, hk, hk', hk''⟩ := h
+          by_cases h' : x.aandRec y (s + 1 + 1 + 1) (by omega) = true
+          · simp [h']
+          · simp only [h', false_eq_true, _root_.or_false]
+            by_cases h'' : k ≤ s + 1 + 1
+            · exists k, h'', by omega
+            · have : k = s + 1 + 1 + 1 := by omega
+              simp_all
+
+/-- If the sum of the leading zeroes of two bitvecs with bitwidth `w` is less than or equal to
+  (`w - 2`), then the preliminary overflow flag is true and their unsigned multiplication overflows.
+  The explanation is in `Efficient integer multiplication overflow detection circuits`
+  https://ieeexplore.ieee.org/abstract/document/987767
+  -/
+theorem resRec_of_clz_le {x y : BitVec w} (hw : 1 < w) (hx : x ≠ 0#w) (hy : y ≠ 0#w):
+    (clz x).toNat + (clz y).toNat ≤ w - 2 → resRec x y (w - 1) (by omega) (by omega) := by
+  intro h
+  rw [resRec_true_iff]
+  exists (w - 1 - y.clz.toNat), by omega, by omega
+  simp only [aandRec]
+  by_cases hw0 : w - 1 - y.clz.toNat = 0
+  · have := clz_lt_iff_ne_zero.mpr (by omega)
+    omega
+  · simp only [and_eq_true, getLsbD_true_clz_of_ne_zero (x := y) (by omega) (by omega),
+    getElem_of_getLsbD_eq_true, uppcRec_true_iff,
+    show w - 1 - (w - 1 - y.clz.toNat - 1) = y.clz.toNat + 1 by omega, _root_.true_and]
+    exact Nat.le_trans (Nat.pow_le_pow_of_le (a := 2) (n := y.clz.toNat + 1)
+          (m := w - 1 - x.clz.toNat) (by omega) (by omega))
+          (BitVec.two_pow_sub_clz_le_toNat_of_ne_zero (x := x) (by omega) (by omega))
+
+/--
+  Complete fast overflow detection circuit for unsigned multiplication.
+-/
+theorem fastUmulOverflow (x y : BitVec w) :
+    umulOverflow x y = if hw : w ≤ 1 then false
+      else (setWidth (w + 1) x * setWidth (w + 1) y)[w] || x.resRec y (w - 1) (by omega) (by omega) := by
+  rcases w with _|_|w
+  · simp [of_length_zero, umulOverflow]
+  · have hx : x.toNat ≤ 1 := by omega
+    have hy : y.toNat ≤ 1 := by omega
+    have := Nat.mul_le_mul (n₁ := x.toNat) (m₁ := y.toNat) (n₂ := 1) (m₂ := 1) hx hy
+    simp [umulOverflow]
+    omega
+  · by_cases h : umulOverflow x y
+    · simp only [h, Nat.reduceLeDiff, reduceDIte, Nat.add_one_sub_one, true_eq, or_eq_true]
+      simp only [umulOverflow, ge_iff_le, decide_eq_true_eq] at h
+      by_cases h' : x.toNat * y.toNat < 2 ^ (w + 1 + 1 + 1)
+      · have hlt := BitVec.getElem_eq_true_of_lt_of_le
+          (x := (setWidth (w + 1 + 1 + 1) x * setWidth (w + 1 + 1 + 1) y))
+          (k := w + 1 + 1)  (by omega)
+        simp only [toNat_mul, toNat_setWidth, Nat.lt_add_one, toNat_mod_cancel_of_lt,
+          Nat.mod_eq_of_lt (a := x.toNat * y.toNat) (b := 2 ^ (w + 1 + 1 + 1)) (by omega), h', h,
+          forall_const] at hlt
+        simp [hlt]
+      · by_cases hsw : (setWidth (w + 1 + 1 + 1) x * setWidth (w + 1 + 1 + 1) y)[w + 1 + 1] = true
+        · simp [hsw]
+        · simp only [hsw, false_eq_true, _root_.false_or]
+          have := Nat.two_pow_pos (w := w + 1 + 1)
+          have hltx := BitVec.toNat_lt_two_pow_sub_clz (x := x)
+          have hlty := BitVec.toNat_lt_two_pow_sub_clz (x := y)
+          have := Nat.mul_ne_zero_iff (m := y.toNat) (n := x.toNat)
+          simp only [ne_eq, show ¬x.toNat * y.toNat = 0 by omega, not_false_eq_true,
+            true_iff] at this
+          obtain ⟨hxz,hyz⟩ := this
+          apply resRec_of_clz_le (x := x) (y := y) (by omega) (by simp [toNat_eq]; exact hxz) (by simp [toNat_eq]; exact hyz)
+          by_cases hzxy : x.clz.toNat + y.clz.toNat ≤ w
+          · omega
+          · by_cases heq : w + 1 - y.clz.toNat = 0
+            · by_cases heq' : w + 1 + 1 - y.clz.toNat = 0
+              · simp [heq', hyz] at hlty
+              · simp only [show y.clz.toNat = w + 1 by omega, Nat.add_sub_cancel_left,
+                  Nat.pow_one] at hlty
+                simp only [show y.toNat = 1 by omega, Nat.mul_one, Nat.not_lt] at h'
+                omega
+            · by_cases w + 1 < y.clz.toNat
+              · omega
+              · simp only [Nat.not_lt] at h'
+                have := Nat.mul_lt_mul'' (a := x.toNat) (b := y.toNat) (c := 2 ^ (w + 1 + 1 - x.clz.toNat)) (d := 2 ^ (w + 1 + 1 - y.clz.toNat)) hltx hlty
+                simp only [← Nat.pow_add] at this
+                have := Nat.pow_le_pow_of_le (a := 2) (n := w + 1 + 1 - x.clz.toNat + (w + 1 + 1 - y.clz.toNat)) (m := w + 1 + 1 + 1)
+                 (by omega) (by omega)
+                omega
+    · simp only [h, Nat.reduceLeDiff, reduceDIte, Nat.add_one_sub_one, false_eq, or_eq_false_iff]
+      simp only [umulOverflow, ge_iff_le, decide_eq_true_eq, Nat.not_le] at h
+      and_intros
+      · simp only [← getLsbD_eq_getElem, getLsbD_eq_getMsbD, Nat.lt_add_one, decide_true,
+          Nat.add_one_sub_one, Nat.sub_self, ← msb_eq_getMsbD_zero, Bool.true_and,
+          msb_eq_false_iff_two_mul_lt, toNat_mul, toNat_setWidth, toNat_mod_cancel_of_lt]
+        rw [Nat.mod_eq_of_lt (by omega),Nat.pow_add (m := w + 1 + 1) (n := 1)]
+        simp [Nat.mul_comm 2 (x.toNat * y.toNat), h]
+      · apply Classical.byContradiction
+        intro hcontra
+        simp only [not_eq_false, resRec_true_iff, exists_prop, exists_and_left] at hcontra
+        obtain ⟨k,hk,hk',hk''⟩ := hcontra
+        simp only [aandRec, and_eq_true, uppcRec_true_iff, Nat.add_one_sub_one] at hk''
+        obtain ⟨hky, hkx⟩ := hk''
+        have hyle := two_pow_le_toNat_of_getElem_eq_true (x := y) (i := k) (by omega) hky
+        have := Nat.mul_le_mul (n₁ := 2 ^ (w + 1 - (k - 1))) (m₁ := 2 ^ k) (n₂ := x.toNat) (m₂ := y.toNat) hkx hyle
+        simp [← Nat.pow_add, show w + 1 - (k - 1) + k = w + 1 + 1 by omega] at this
+        omega
+
 end BitVec

src/Init/Data/BitVec/Lemmas.lean

@@ -510,6 +510,18 @@ theorem getElem_ofBool {b : Bool} {h : i < 1}: (ofBool b)[i] = b := by
 @[simp] theorem zero_eq_one_iff (w : Nat) : (0#w = 1#w) ↔ (w = 0) := by
   rw [← one_eq_zero_iff, eq_comm]
 
+/-- A bitvector is equal to 0#w if and only if all bits are `false` -/
+theorem zero_iff_eq_false {x: BitVec w} :
+    x = 0#w ↔ ∀ i, x.getLsbD i = false := by
+  rcases w with _|w
+  · simp [of_length_zero]
+  · constructor
+    · intro hzero
+      simp [hzero]
+    · intro hfalse
+      ext j hj
+      simp [← getLsbD_eq_getElem, hfalse]
+
 /-! ### msb -/
 
 @[simp] theorem msb_zero : (0#w).msb = false := by simp [BitVec.msb, getMsbD]
@@ -5767,40 +5779,6 @@ theorem msb_replicate {n w : Nat} {x : BitVec w} :
   simp only [BitVec.msb, getMsbD_replicate, Nat.zero_mod]
   cases n <;> cases w <;> simp
 
-/-! ### Count leading zeros -/
-
-theorem clzAuxRec_zero (x : BitVec w) :
-    x.clzAuxRec 0 = if x.getLsbD 0 then BitVec.ofNat w (w - 1) else BitVec.ofNat w w := by rfl
-
-theorem clzAuxRec_succ (x : BitVec w) :
-    x.clzAuxRec (n + 1) = if x.getLsbD (n + 1) then BitVec.ofNat w (w - 1 - (n + 1)) else BitVec.clzAuxRec x n := by rfl
-
-theorem clzAuxRec_eq_clzAuxRec_of_le (x : BitVec w) (h : w - 1 ≤ n) :
-    x.clzAuxRec n = x.clzAuxRec (w - 1) := by
-  let k := n - (w - 1)
-  rw [show n = (w - 1) + k by omega]
-  induction k
-  case zero => simp
-  case succ k ihk =>
-    simp [show w - 1 + (k + 1) = (w - 1 + k) + 1 by omega, clzAuxRec_succ, ihk,
-      show x.getLsbD (w - 1 + k + 1) = false by simp only [show w ≤ w - 1 + k + 1 by omega, getLsbD_of_ge]]
-
-theorem clzAuxRec_eq_clzAuxRec_of_getLsbD_false {x : BitVec w} (h : ∀ i, n < i → x.getLsbD i = false) :
-    x.clzAuxRec n = x.clzAuxRec (n + k) := by
-  induction k
-  case zero => simp
-  case succ k ihk =>
-    simp only [show n + (k + 1) = (n + k) + 1 by omega, clzAuxRec_succ]
-    by_cases hxn : x.getLsbD (n + k + 1)
-    · have : ¬ ∀ (i : Nat), n < i → x.getLsbD i = false := by
-        simp only [Classical.not_forall, Bool.not_eq_false]
-        exists n + k + 1
-        simp [show n < n + k + 1 by omega, hxn]
-      contradiction
-    · simp only [hxn, Bool.false_eq_true, ↓reduceIte]
-      exact ihk
-
-
 /-! ### Inequalities (le / lt) -/
 
 theorem ule_eq_not_ult (x y : BitVec w) : x.ule y = !y.ult x := by
@@ -5849,6 +5827,362 @@ theorem sle_eq_ule {x y : BitVec w} : x.sle y = (x.msb != y.msb ^^ x.ule y) := b
 theorem sle_eq_ule_of_msb_eq {x y : BitVec w} (h : x.msb = y.msb) : x.sle y = x.ule y := by
   simp [BitVec.sle_eq_ule, h]
 
+/-- A bitvector interpreted as a natural number is greater than or equal to `2 ^ i` if and only if
+  there exists at least one bit with `true` value at position `i` or higher. -/
+theorem le_toNat_iff_getLsbD_eq_true {x : BitVec w} (hi : i < w ) :
+    (2 ^ i ≤ x.toNat) ↔ (∃ k, x.getLsbD (i + k) = true) := by
+  rcases w with _|w
+  · simp [of_length_zero]
+  · constructor
+    · intro hle
+      apply Classical.byContradiction
+      intros hcontra
+      let x' := setWidth (i + 1) x
+      have hx' : setWidth (i + 1) x = x' := by rfl
+      have hcast : w - i + (i + 1) = w + 1 := by omega
+      simp only [not_exists, Bool.not_eq_true] at hcontra
+      have hx'' : x = BitVec.cast hcast (0#(w - i) ++ x') := by
+        ext j
+        by_cases hj : j < i + 1
+        · simp only [← hx', getElem_cast, getElem_append, hj, reduceDIte, getElem_setWidth]
+          rw [getLsbD_eq_getElem]
+        · simp only [getElem_cast, getElem_append, hj, reduceDIte, getElem_zero]
+          let j' := j - i
+          simp only [show j = i + j' by omega]
+          apply hcontra
+      have : x'.toNat < 2 ^ i := by
+        apply Nat.lt_pow_two_of_testBit (n := i) x'.toNat
+        intro j hj
+        let j' := j - i
+        specialize hcontra j'
+        have : x'.getLsbD (i + j') = x.getLsbD (i + j') := by
+          subst x'
+          simp [hcontra]
+        simp [show j = i + j' by omega, testBit_toNat, this, hcontra]
+      have : x'.toNat = x.toNat := by
+        have := BitVec.setWidth_eq_append (w := (w + 1)) (v := i + 1) (x := x')
+        specialize this (by omega)
+        rw [toNat_eq, toNat_setWidth, Nat.mod_eq_of_lt (by omega)] at this
+        simp [hx'']
+      omega
+    · intro h
+      obtain ⟨k, hk⟩ := h
+      by_cases hk' : i + k < w + 1
+      · have := Nat.ge_two_pow_of_testBit hk
+        have := Nat.pow_le_pow_of_le (a := 2) (n := i) (m := i + k) (by omega) (by omega)
+        omega
+      · simp [show w + 1 ≤ i + k by omega] at hk
+
+/-- A bitvector interpreted as a natural number is strictly smaller than `2 ^ i` if and only if
+  all bits at position `i` or higher are false. -/
+theorem toNat_lt_iff_getLsbD_eq_false {x : BitVec w} (i : Nat) (hi : i < w) :
+    x.toNat < 2 ^ i ↔ (∀ k, x.getLsbD (i + k) = false) := by
+  constructor
+  · intro h
+    apply Classical.byContradiction
+    intro hcontra
+    simp only [Classical.not_forall, Bool.not_eq_false] at hcontra
+    obtain ⟨k, hk⟩ := hcontra
+    have hle := Nat.ge_two_pow_of_testBit hk
+    by_cases hlt : i + k < w
+    · have := Nat.pow_le_pow_of_le (a := 2) (n := i) (m := i + k) (by omega) (by omega)
+      omega
+    · simp [show w ≤ i + k by omega] at hk
+  · intro h
+    apply Classical.byContradiction
+    intro hcontra
+    simp [BitVec.le_toNat_iff_getLsbD_eq_true (x := x) (i := i) hi, h] at hcontra
+
+/-- If a bitvector interpreted as a natural number is strictly smaller than `2 ^ (k + 1)` and greater than or
+  equal to 2 ^ k, then the bit at position `k` must be `true` -/
+theorem getElem_eq_true_of_lt_of_le {x : BitVec w} (hk' : k < w) (hlt: x.toNat < 2 ^ (k + 1)) (hle : 2 ^ k ≤ x.toNat) :
+    x[k] = true := by
+  have := le_toNat_iff_getLsbD_eq_true (x := x) (i := k) hk'
+  simp only [hle, true_iff] at this
+  obtain ⟨k',hk'⟩ := this
+  by_cases hkk' : k + k' < w
+  · have := Nat.ge_two_pow_of_testBit hk'
+    by_cases hzk' : k' = 0
+    · simp [hzk'] at hk'; exact hk'
+    · have := Nat.pow_lt_pow_of_lt (a := 2) (n := k) (m := k + k') (by omega) (by omega)
+      have := Nat.pow_le_pow_of_le (a := 2) (n := k + 1) (m := k + k') (by omega) (by omega)
+      omega
+  · simp [show w ≤ k + k' by omega] at hk'
+
+/-! ### Count leading zeros -/
+
+theorem clzAuxRec_zero (x : BitVec w) :
+    x.clzAuxRec 0 = if x.getLsbD 0 then BitVec.ofNat w (w - 1) else BitVec.ofNat w w := by rfl
+
+theorem clzAuxRec_succ (x : BitVec w) :
+    x.clzAuxRec (n + 1) = if x.getLsbD (n + 1) then BitVec.ofNat w (w - 1 - (n + 1)) else BitVec.clzAuxRec x n := by rfl
+
+theorem clzAuxRec_eq_clzAuxRec_of_le {x : BitVec w} (h : w - 1 ≤ n) :
+    x.clzAuxRec n = x.clzAuxRec (w - 1) := by
+  let k := n - (w - 1)
+  rw [show n = (w - 1) + k by omega]
+  induction k
+  · case zero => simp
+  · case succ k ihk =>
+    simp [show w - 1 + (k + 1) = (w - 1 + k) + 1 by omega, clzAuxRec_succ, ihk,
+      show x.getLsbD (w - 1 + k + 1) = false by simp only [show w ≤ w - 1 + k + 1 by omega, getLsbD_of_ge]]
+
+theorem clzAuxRec_eq_clzAuxRec_of_getLsbD_false {x : BitVec w} (h : ∀ i, n < i → x.getLsbD i = false) :
+    x.clzAuxRec n = x.clzAuxRec (n + k) := by
+  induction k
+  · case zero => simp
+  · case succ k ihk =>
+    simp only [show n + (k + 1) = (n + k) + 1 by omega, clzAuxRec_succ]
+    by_cases hxn : x.getLsbD (n + k + 1)
+    · have : ¬ ∀ (i : Nat), n < i → x.getLsbD i = false := by
+        simp only [Classical.not_forall, Bool.not_eq_false]
+        exists n + k + 1
+        simp [show n < n + k + 1 by omega, hxn]
+      contradiction
+    · simp only [hxn, Bool.false_eq_true, ↓reduceIte]
+      exact ihk
+
+theorem clzAuxRec_le {x : BitVec w} (n : Nat) :
+    clzAuxRec x n ≤ w := by
+  have := Nat.lt_pow_self (a := 2) (n := w) (by omega)
+  rcases w with _|w
+  · simp [of_length_zero]
+  · induction n
+    · case zero =>
+      simp only  [clzAuxRec_zero]
+      by_cases hx0 : x.getLsbD 0
+      · simp only [hx0, Nat.add_one_sub_one, reduceIte, natCast_eq_ofNat, ofNat_le_ofNat,
+          Nat.mod_two_pow_self, ge_iff_le, Nat.mod_eq_of_lt (a := w) (b := 2 ^ (w + 1)) (by omega)]
+        omega
+      · simp only [hx0, Bool.false_eq_true, reduceIte, natCast_eq_ofNat, BitVec.le_refl]
+    · case succ n ihn =>
+      simp only [clzAuxRec_succ, Nat.add_one_sub_one, natCast_eq_ofNat, ge_iff_le]
+      by_cases hxn : x.getLsbD (n + 1)
+      · simp [hxn, Nat.mod_eq_of_lt (a := w - (n + 1)) (b := 2 ^(w + 1)) (by omega)]
+        omega
+      · simp only [hxn, Bool.false_eq_true, reduceIte]
+        exact ihn
+
+theorem clzAuxRec_eq_iff_of_getLsbD_false {x : BitVec w} (h : ∀ i, n < i → x.getLsbD i = false) :
+    x.clzAuxRec n = BitVec.ofNat w w ↔ ∀ j, j ≤ n → x.getLsbD j = false := by
+  rcases w with _|w
+  · simp [of_length_zero]
+  · have := Nat.lt_pow_self (a := 2) (n := w + 1)
+    induction n
+    · case zero =>
+      simp only [clzAuxRec_zero, Nat.zero_lt_succ, getLsbD_eq_getElem, Nat.add_one_sub_one,
+        ite_eq_right_iff, Nat.le_zero_eq, forall_eq]
+      by_cases hx0 : x.getLsbD 0
+      · simp [hx0, toNat_eq, toNat_ofNat, Nat.mod_eq_of_lt (a := w) (b := 2 ^ (w + 1)) (by omega)]
+      · simp only [Nat.zero_lt_succ, getLsbD_eq_getElem, Bool.not_eq_true] at hx0
+        simp [hx0]
+    · case succ n ihn =>
+      simp only [clzAuxRec_succ, Nat.add_one_sub_one]
+      by_cases hxn : x.getLsbD (n + 1)
+      · simp only [hxn, reduceIte, toNat_eq, toNat_ofNat,
+          Nat.mod_eq_of_lt (a := w - (n + 1)) (b := 2 ^ (w + 1)) (by omega), Nat.mod_two_pow_self,
+          show ¬w - (n + 1) = w + 1 by omega, false_iff, Classical.not_forall,
+          Bool.not_eq_false]
+        exists n + 1, by omega
+      · have : ∀ (i : Nat), n < i → x.getLsbD i = false := by
+          intro i hi
+          by_cases hi' : i = n + 1
+          · simp [hi', hxn]
+          · apply h; omega
+        specialize ihn this
+        simp only [Bool.not_eq_true] at ihn hxn
+        simp only [hxn, Bool.false_eq_true, reduceIte, ihn]
+        constructor
+        <;> intro h' j hj
+        <;> (by_cases hj' : j = n + 1; simp [hj', hxn]; (apply h'; omega))
+
+theorem clz_le {x : BitVec w} :
+    clz x ≤ w := by
+  unfold clz
+  rcases w with _|w
+  · simp [of_length_zero]
+  · exact clzAuxRec_le (n := w)
+
+@[simp]
+theorem clz_eq_iff_eq_zero {x : BitVec w} :
+    clz x = w ↔ x = 0#w := by
+  rcases w with _|w
+  · simp [clz, of_length_zero]
+  · simp only [clz, Nat.add_one_sub_one, natCast_eq_ofNat, zero_iff_eq_false]
+    rw [clzAuxRec_eq_iff_of_getLsbD_false (x := x) (n := w) (w := w + 1) (by intros i hi; simp [show w + 1 ≤ i by omega])]
+    constructor
+    · intro h i
+      by_cases i ≤ w
+      · apply h; omega
+      · simp [show w + 1 ≤ i by omega]
+    · intro h j hj
+      apply h
+
+theorem clzAuxRec_eq_zero_iff {x : BitVec w} (h : ∀ i, n < i → x.getLsbD i = false) (hw : 0 < w) :
+    (x.clzAuxRec n).toNat = 0 ↔ x[w - 1] = true := by
+  have := Nat.lt_pow_self (a := 2) (n := w)
+  induction n
+  · case zero =>
+    simp only [clzAuxRec_zero]
+    by_cases hw1 : w - 1 = 0
+    · by_cases hx0 : x.getLsbD 0
+      · simp [hw1, hx0]
+      · simp [hw1, show ¬ w = 0 by omega, hx0, ← getLsbD_eq_getElem]
+    · by_cases hx0 : x.getLsbD 0
+      · simp only [hx0, ↓reduceIte, toNat_ofNat,
+          Nat.mod_eq_of_lt (a := w - 1) (b := 2 ^ w) (by omega), show ¬w - 1 = 0 by omega, false_iff,
+          Bool.not_eq_true]
+        specialize h (w - 1) (by omega)
+        exact h
+      · simp [hx0, show ¬ w = 0 by omega]
+        specialize h (w - 1) (by omega)
+        exact h
+  · case succ n ihn =>
+    by_cases hxn : x.getLsbD (n + 1)
+    · simp only [clzAuxRec_succ, hxn, reduceIte, toNat_ofNat]
+      rw [Nat.mod_eq_of_lt (by omega)]
+      by_cases hwn : w - 1 - (n + 1) = 0
+      · have := lt_of_getLsbD hxn
+        simp only [show w - 1 = n + 1 by omega, Nat.sub_self, true_iff]
+        exact hxn
+      · simp only [hwn, false_iff, Bool.not_eq_true]
+        specialize h (w - 1) (by omega)
+        exact h
+    · simp only [clzAuxRec_succ, hxn, Bool.false_eq_true, reduceIte]
+      apply ihn
+      intro i hi
+      by_cases hi : i = n + 1
+      · simp [hi, hxn]
+      · apply h; omega
+
+theorem clz_eq_zero_iff {x : BitVec w} (hw : 0 < w) :
+    (clz x).toNat = 0 ↔ 2 ^ (w - 1) ≤ x.toNat := by
+  simp only [clz, clzAuxRec_eq_zero_iff (x := x) (n := w - 1) (by intro i hi; simp [show w ≤ i by omega]) hw]
+  by_cases hxw : x[w - 1]
+  · simp [hxw, two_pow_le_toNat_of_getElem_eq_true (x := x) (i := w - 1) (by omega) hxw]
+  · simp only [hxw, Bool.false_eq_true, false_iff, Nat.not_le]
+    simp only [← getLsbD_eq_getElem, ← msb_eq_getLsbD_last, Bool.not_eq_true] at hxw
+    exact toNat_lt_of_msb_false hxw
+
+/-- The number of leading zeroes is strictly less than the bitwidth iff the bitvector is nonzero. -/
+theorem clz_lt_iff_ne_zero {x : BitVec w} :
+    clz x < w ↔ x ≠ 0#w := by
+  have hle := clz_le (x := x)
+  have heq := clz_eq_iff_eq_zero (x := x)
+  constructor
+  · intro h
+    simp only [natCast_eq_ofNat, BitVec.ne_of_lt (x := x.clz) (y := BitVec.ofNat w w) h,
+      false_iff] at heq
+    simp only [ne_eq, heq, not_false_eq_true]
+  · intro h
+    simp only [natCast_eq_ofNat, h, iff_false] at heq
+    apply BitVec.lt_of_le_ne (x := x.clz) (y := BitVec.ofNat w w) hle heq
+
+theorem getLsbD_false_of_clzAuxRec {x : BitVec w} (h : ∀ i, n < i → x.getLsbD i = false) :
+    ∀ j, x.getLsbD (w - (x.clzAuxRec n).toNat + j) = false := by
+  rcases w with _|w
+  · simp
+  · have := Nat.lt_pow_self (a := 2) (n := w + 1)
+    induction n
+    · case zero =>
+      intro j
+      simp only [clzAuxRec_zero, Nat.zero_lt_succ, getLsbD_eq_getElem, Nat.add_one_sub_one]
+      by_cases hx0 : x[0]
+      · specialize h (1 + j) (by omega)
+        simp [h, hx0, Nat.mod_eq_of_lt (a := w) (b := 2 ^ (w + 1)) (by omega)]
+      · simp only [hx0, Bool.false_eq_true, ↓reduceIte, toNat_ofNat, Nat.mod_two_pow_self,
+          Nat.sub_self, Nat.zero_add]
+        by_cases hj0 : j = 0
+        · simp [hj0, hx0]
+        · specialize h j (by omega)
+          exact h
+    · case succ n ihn =>
+      intro j
+      by_cases hxn : x.getLsbD (n + 1)
+      · have := lt_of_getLsbD hxn
+        specialize h (n + j + 1 + 1) (by omega)
+        simp [h, clzAuxRec_succ, hxn, Nat.mod_eq_of_lt (a := w - (n + 1)) (b := 2 ^ (w + 1)) (by omega),
+          show (w + 1 - (w - (n + 1)) + j) = n + j + 1 + 1 by omega]
+      · simp only [clzAuxRec_succ, hxn, Bool.false_eq_true, reduceIte]
+        apply ihn
+        intro i hi
+        by_cases hin : i = n + 1
+        · simp [hin, hxn]
+        · specialize h i (by omega)
+          exact h
+
+theorem getLsbD_true_of_eq_clzAuxRec_of_ne_zero {x : BitVec w} (hx : ¬ x = 0#w) (hn : ∀ i, n < i → x.getLsbD i = false) :
+    x.getLsbD (w - 1 - (x.clzAuxRec n).toNat) = true := by
+  rcases w with _|w
+  · simp [of_length_zero] at hx
+  · have := Nat.lt_pow_self (a := 2) (n := w + 1)
+    induction n
+    · case zero =>
+      by_cases hx0 : x[0]
+      · simp only [Nat.add_one_sub_one, clzAuxRec_zero, Nat.zero_lt_succ, getLsbD_eq_getElem, hx0,
+          reduceIte, toNat_ofNat, Nat.mod_eq_of_lt (a := w) (b := 2 ^(w + 1)) (by omega), show w - w = 0 by omega]
+      · simp only [zero_iff_eq_false, Classical.not_forall, Bool.not_eq_false] at hx
+        obtain ⟨m,hm⟩ := hx
+        specialize hn m
+        by_cases hm0 : m = 0
+        · simp [hm0, hx0] at hm
+        · simp [show 0 < m by omega, hm] at hn
+    · case succ n ihn =>
+      by_cases hxn : x.getLsbD (n + 1)
+      · have := lt_of_getLsbD hxn
+        simp [clzAuxRec_succ, hxn, toNat_ofNat, Nat.mod_eq_of_lt (a := w - (n + 1)) (b := 2 ^ (w + 1)) (by omega),
+          show w - (w - (n + 1)) = n + 1 by omega]
+      · simp only [Nat.add_one_sub_one, clzAuxRec_succ, hxn, Bool.false_eq_true, reduceIte]
+        simp only [Nat.add_one_sub_one] at ihn
+        apply ihn
+        intro j hj
+        by_cases hjn : j = n + 1
+        · simp [hjn, hxn]
+        · specialize hn j (by omega)
+          exact hn
+
+theorem getLsbD_true_clz_of_ne_zero {x : BitVec w} (hw : 0 < w) (hx : x ≠ 0#w) :
+    x.getLsbD (w - 1 - (clz x).toNat) = true := by
+  unfold clz
+  apply getLsbD_true_of_eq_clzAuxRec_of_ne_zero (x := x) (n := w - 1) (by omega)
+  intro i hi
+  simp [show w ≤ i by omega]
+
+/-- A nonzero bitvector is lower-bounded by its leading zeroes. -/
+theorem two_pow_sub_clz_le_toNat_of_ne_zero {x : BitVec w} (hw : 0 < w) (hx : x ≠ 0#w) :
+    2 ^ (w - 1 - (clz x).toNat) ≤ x.toNat := by
+  by_cases hc0 : x.clz.toNat  = 0
+  · simp [hc0, ← clz_eq_zero_iff (x := x) hw]
+  · have hclz := getLsbD_true_clz_of_ne_zero (x := x) hw hx
+    rw [getLsbD_eq_getElem (by omega)] at hclz
+    have hge := Nat.ge_two_pow_of_testBit hclz
+    push_cast at hge
+    exact hge
+
+/-- A bitvector is upper bounded by the number of leading zeroes. -/
+theorem toNat_lt_two_pow_sub_clz {x : BitVec w} :
+    x.toNat < 2 ^ (w - (clz x).toNat) := by
+  rcases w with _|w
+  · simp [of_length_zero]
+  · unfold clz
+    have hlt := toNat_lt_iff_getLsbD_eq_false (x := x)
+    have hzero := clzAuxRec_eq_zero_iff (x := x) (n := w) (by intro i hi; simp [show w + 1 ≤ i by omega]) (by omega)
+    simp only [Nat.add_one_sub_one] at hzero
+    by_cases hxw : x[w]
+    · simp only [hxw, iff_true] at hzero
+      simp only [Nat.add_one_sub_one, hzero, Nat.sub_zero, gt_iff_lt]
+      omega
+    · simp only [hxw, Bool.false_eq_true, iff_false] at hzero
+      rw [hlt]
+      · intro k
+        apply getLsbD_false_of_clzAuxRec (x := x) (n := w)
+        intro i hi
+        by_cases hiw : i = w
+        · simp [hiw, hxw]
+        · simp [show w + 1 ≤ i by omega]
+      · simp; omega
+
+
 /-! ### Deprecations -/
 
 set_option linter.missingDocs false

src/Init/Data/Dyadic.lean

@@ -0,0 +1,11 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kim Morrison
+-/
+module
+prelude
+
+public import Init.Data.Dyadic.Basic
+public import Init.Data.Dyadic.Instances
+public import Init.Data.Dyadic.Round

src/Init/Data/Dyadic/Basic.lean

@@ -0,0 +1,659 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kim Morrison, Robin Arnez
+-/
+module
+
+prelude
+public import Init.Data.Rat.Lemmas
+import Init.Data.Int.Bitwise.Lemmas
+import Init.Data.Int.DivMod.Lemmas
+
+/-!
+# The dyadic rationals
+
+Constructs the dyadic rationals as an ordered ring, equipped with a compatible embedding into the rationals.
+-/
+
+set_option linter.missingDocs true
+
+@[expose] public section
+
+open Nat
+
+namespace Int
+
+/-- The number of trailing zeros in the binary representation of `i`. -/
+def trailingZeros (i : Int) : Nat :=
+  if h : i = 0 then 0 else aux i.natAbs i h (Nat.le_refl _) 0
+where
+  aux (k : Nat) (i : Int) (hi : i ≠ 0) (hk : i.natAbs ≤ k) (acc : Nat) : Nat :=
+    match k, (by omega : k ≠ 0) with
+    | k + 1, _ =>
+      if h : i % 2 = 0 then aux k (i / 2) (by omega) (by omega) (acc + 1)
+      else acc
+
+-- TODO: check performance of `trailingZeros` in the kernel and VM.
+
+private theorem trailingZeros_aux_irrel (hi : i ≠ 0) (hk : i.natAbs ≤ k) (hk' : i.natAbs ≤ k') :
+    trailingZeros.aux k i hi hk acc = trailingZeros.aux k' i hi hk' acc := by
+  fun_induction trailingZeros.aux k i hi hk acc generalizing k' <;>
+    fun_cases trailingZeros.aux k' _ _ hk' _
+  · rename_i ih _ _ _ _ _
+    exact ih _
+  · contradiction
+  · contradiction
+  · rfl
+
+private theorem trailingZeros_aux_succ :
+    trailingZeros.aux k i hi hk (acc + 1) = trailingZeros.aux k i hi hk acc + 1 := by
+  fun_induction trailingZeros.aux k i hi hk acc <;> simp_all [trailingZeros.aux]
+
+theorem trailingZeros_zero : trailingZeros 0 = 0 := rfl
+
+theorem trailingZeros_two_mul_add_one (i : Int) :
+    Int.trailingZeros (2 * i + 1) = 0 := by
+  unfold trailingZeros trailingZeros.aux
+  rw [dif_neg (by omega)]
+  split <;> simp_all
+
+theorem trailingZeros_eq_zero_of_mod_eq {i : Int} (h : i % 2 = 1) :
+    Int.trailingZeros i = 0 := by
+  unfold trailingZeros trailingZeros.aux
+  rw [dif_neg (by omega)]
+  split <;> simp_all
+
+theorem trailingZeros_two_mul {i : Int} (h : i ≠ 0) :
+    Int.trailingZeros (2 * i) = Int.trailingZeros i + 1 := by
+  rw [Int.trailingZeros, dif_neg (Int.mul_ne_zero (by decide) h), Int.trailingZeros.aux.eq_def]
+  simp only [ne_eq, mul_emod_right, ↓reduceDIte, Int.reduceEq, not_false_eq_true,
+    mul_ediv_cancel_left, Nat.zero_add]
+  split
+  rw [trailingZeros, trailingZeros_aux_succ, dif_neg h]
+  apply congrArg Nat.succ (trailingZeros_aux_irrel ..) <;> omega
+
+theorem shiftRight_trailingZeros_mod_two {i : Int} (h : i ≠ 0) :
+    (i >>> i.trailingZeros) % 2 = 1 := by
+  rw (occs := .pos [2]) [← Int.emod_add_ediv i 2]
+  rcases i.emod_two_eq with h' | h' <;> rw [h']
+  · rcases Int.dvd_of_emod_eq_zero h' with ⟨a, rfl⟩
+    simp only [ne_eq, Int.mul_eq_zero, Int.reduceEq, false_or] at h
+    rw [Int.zero_add, mul_ediv_cancel_left _ (by decide), trailingZeros_two_mul h, Nat.add_comm,
+      shiftRight_add, shiftRight_eq_div_pow _ 1]
+    simpa using shiftRight_trailingZeros_mod_two h
+  · rwa [Int.add_comm, trailingZeros_two_mul_add_one, shiftRight_zero]
+termination_by i.natAbs
+
+theorem two_pow_trailingZeros_dvd {i : Int} (h : i ≠ 0) :
+    2 ^ i.trailingZeros ∣ i := by
+  rcases i.emod_two_eq with h' | h'
+  · rcases Int.dvd_of_emod_eq_zero h' with ⟨a, rfl⟩
+    simp only [ne_eq, Int.mul_eq_zero, Int.reduceEq, false_or] at h
+    rw [trailingZeros_two_mul h, Int.pow_succ']
+    exact Int.mul_dvd_mul_left _ (two_pow_trailingZeros_dvd h)
+  · rw (occs := .pos [1]) [← Int.emod_add_ediv i 2, h', Int.add_comm, trailingZeros_two_mul_add_one]
+    exact Int.one_dvd _
+termination_by i.natAbs
+
+theorem trailingZeros_shiftLeft {x : Int} (hx : x ≠ 0) (n : Nat) :
+    trailingZeros (x <<< n) = x.trailingZeros + n := by
+  have : NeZero x := ⟨hx⟩
+  induction n <;> simp [Int.shiftLeft_succ', trailingZeros_two_mul (NeZero.ne _), *, Nat.add_assoc]
+
+@[simp]
+theorem trailingZeros_neg (x : Int) : trailingZeros (-x) = x.trailingZeros := by
+  by_cases hx : x = 0
+  · simp [hx]
+  rcases x.emod_two_eq with h | h
+  · rcases Int.dvd_of_emod_eq_zero h with ⟨a, rfl⟩
+    simp only [Int.mul_ne_zero_iff, ne_eq, Int.reduceEq, not_false_eq_true, true_and] at hx
+    rw [← Int.mul_neg, trailingZeros_two_mul hx, trailingZeros_two_mul (Int.neg_ne_zero.mpr hx)]
+    rw [trailingZeros_neg]
+  · simp [trailingZeros_eq_zero_of_mod_eq, h]
+termination_by x.natAbs
+
+end Int
+
+/--
+A dyadic rational is either zero or of the form `n * 2^(-k)` for some (unique) `n k : Int`
+where `n` is odd.
+-/
+inductive Dyadic where
+  /-- The dyadic number `0`. -/
+  | zero
+  /-- The dyadic number `n * 2^(-k)` for some odd `n` and integer `k`. -/
+  | ofOdd (n : Int) (k : Int) (hn : n % 2 = 1)
+deriving DecidableEq
+
+namespace Dyadic
+
+/-- Returns the dyadic number representation of `i * 2 ^ (-exp)`. -/
+def ofIntWithPrec (i : Int) (prec : Int) : Dyadic :=
+  if h : i = 0 then .zero
+  else .ofOdd (i >>> i.trailingZeros) (prec - i.trailingZeros) (Int.shiftRight_trailingZeros_mod_two h)
+
+/-- Convert an integer to a dyadic number (which will necessarily have non-positive precision). -/
+def ofInt (i : Int) : Dyadic :=
+  Dyadic.ofIntWithPrec i 0
+
+instance (n : Nat) : OfNat Dyadic n where
+  ofNat := Dyadic.ofInt n
+
+instance : IntCast Dyadic := ⟨ofInt⟩
+instance : NatCast Dyadic := ⟨fun x => ofInt x⟩
+
+/-- Add two dyadic numbers. -/
+protected def add (x y : Dyadic) : Dyadic :=
+  match x, y with
+  | .zero, y => y
+  | x, .zero => x
+  | .ofOdd n₁ k₁ hn₁, .ofOdd n₂ k₂ hn₂ =>
+    match k₁ - k₂ with
+    | 0 => .ofIntWithPrec (n₁ + n₂) k₁
+    -- TODO: these `simp_all` calls where previously factored out into a `where finally` clause,
+    -- but there is apparently a bad interaction with the module system.
+    | (d@hd:(d' + 1) : Nat) => .ofOdd (n₁ + (n₂ <<< d)) k₁ (by simp_all [Int.shiftLeft_eq, Int.pow_succ, ← Int.mul_assoc])
+    | -(d + 1 : Nat) => .ofOdd (n₁ <<< (d + 1) + n₂) k₂ (by simp_all [Int.shiftLeft_eq, Int.pow_succ, ← Int.mul_assoc])
+
+instance : Add Dyadic := ⟨Dyadic.add⟩
+
+/-- Multiply two dyadic numbers. -/
+protected def mul (x y : Dyadic) : Dyadic :=
+  match x, y with
+  | .zero, _ => .zero
+  | _, .zero => .zero
+  | .ofOdd n₁ k₁ hn₁, .ofOdd n₂ k₂ hn₂ =>
+    .ofOdd (n₁ * n₂) (k₁ + k₂) (by rw [Int.mul_emod, hn₁, hn₂]; rfl)
+
+instance : Mul Dyadic := ⟨Dyadic.mul⟩
+
+/-- Multiply two dyadic numbers. -/
+protected def pow (x : Dyadic) (i : Nat) : Dyadic :=
+  match x with
+  | .zero => if i = 0 then 1 else 0
+  | .ofOdd n k hn =>
+    .ofOdd (n ^ i) (k * i) (by induction i <;> simp [Int.pow_succ, Int.mul_emod, *])
+
+instance : Pow Dyadic Nat := ⟨Dyadic.pow⟩
+
+/-- Negate a dyadic number. -/
+protected def neg (x : Dyadic) : Dyadic :=
+  match x with
+  | .zero => .zero
+  | .ofOdd n k hn => .ofOdd (-n) k (by rwa [Int.neg_emod_two])
+
+instance : Neg Dyadic := ⟨Dyadic.neg⟩
+
+/-- Subtract two dyadic numbers. -/
+protected def sub (x y : Dyadic) : Dyadic := x + (- y)
+
+instance : Sub Dyadic := ⟨Dyadic.sub⟩
+
+/-- Shift a dyadic number left by `i` bits. -/
+protected def shiftLeft (x : Dyadic) (i : Int) : Dyadic :=
+  match x with
+  | .zero => .zero
+  | .ofOdd n k hn => .ofOdd n (k - i) hn
+
+/-- Shift a dyadic number right by `i` bits. -/
+protected def shiftRight (x : Dyadic) (i : Int) : Dyadic :=
+  match x with
+  | .zero => .zero
+  | .ofOdd n k hn => .ofOdd n (k + i) hn
+
+instance : HShiftLeft Dyadic Int Dyadic := ⟨Dyadic.shiftLeft⟩
+instance : HShiftRight Dyadic Int Dyadic := ⟨Dyadic.shiftRight⟩
+
+instance : HShiftLeft Dyadic Nat Dyadic := ⟨fun x y => x <<< (y : Int)⟩
+instance : HShiftRight Dyadic Nat Dyadic := ⟨fun x y => x >>> (y : Int)⟩
+
+-- TODO: move this
+theorem _root_.Int.natAbs_emod_two (i : Int) : i.natAbs % 2 = (i % 2).natAbs := by omega
+
+/-- Convert a dyadic number to a rational number. -/
+def toRat (x : Dyadic) : Rat :=
+  match x with
+  | .zero => 0
+  | .ofOdd n (k : Nat) hn =>
+    have reduced : n.natAbs.Coprime (2 ^ k) := by
+      apply Coprime.pow_right
+      rw [coprime_iff_gcd_eq_one, Nat.gcd_comm, Nat.gcd_def]
+      simp [hn, Int.natAbs_emod_two]
+    ⟨n, 2 ^ k, Nat.ne_of_gt (Nat.pow_pos (by decide)), reduced⟩
+  | .ofOdd n (-((k : Nat) + 1)) hn =>
+    (n * (2 ^ (k + 1) : Nat) : Int)
+
+@[simp] protected theorem zero_eq : Dyadic.zero = 0 := rfl
+@[simp] protected theorem add_zero (x : Dyadic) : x + 0 = x := by cases x <;> rfl
+@[simp] protected theorem zero_add (x : Dyadic) : 0 + x = x := by cases x <;> rfl
+@[simp] protected theorem neg_zero : (-0 : Dyadic) = 0 := rfl
+@[simp] protected theorem mul_zero (x : Dyadic) : x * 0 = 0 := by cases x <;> rfl
+@[simp] protected theorem zero_mul (x : Dyadic) : 0 * x = 0 := by cases x <;> rfl
+
+@[simp] theorem toRat_zero : toRat 0 = 0 := rfl
+
+theorem _root_.Rat.mkRat_one (x : Int) : mkRat x 1 = x := by
+  rw [← Rat.mk_den_one, Rat.mk_eq_mkRat]
+
+theorem toRat_ofOdd_eq_mkRat :
+    toRat (.ofOdd n k hn) = mkRat (n <<< (-k).toNat) (1 <<< k.toNat) := by
+  cases k
+  · simp [toRat, Rat.mk_eq_mkRat, Int.shiftLeft_eq, Nat.shiftLeft_eq]
+  · simp [toRat, Int.neg_negSucc, Rat.mkRat_one, Int.shiftLeft_eq]
+
+theorem toRat_ofIntWithPrec_eq_mkRat :
+    toRat (.ofIntWithPrec n k) = mkRat (n <<< (-k).toNat) (1 <<< k.toNat) := by
+  simp only [ofIntWithPrec]
+  split
+  · simp_all
+  rw [toRat_ofOdd_eq_mkRat, Rat.mkRat_eq_iff (NeZero.ne _) (NeZero.ne _)]
+  simp only [Int.natCast_shiftLeft, Int.cast_ofNat_Int, Int.shiftLeft_mul_shiftLeft, Int.mul_one]
+  have : (-(k - n.trailingZeros) : Int).toNat + k.toNat =
+      n.trailingZeros + ((-k).toNat + (k - n.trailingZeros).toNat) := by omega
+  rw [this, Int.shiftLeft_add, Int.shiftRight_shiftLeft_cancel]
+  exact Int.two_pow_trailingZeros_dvd ‹_›
+
+theorem toRat_ofIntWithPrec_eq_mul_two_pow : toRat (.ofIntWithPrec n k) = n * 2 ^ (-k) := by
+  rw [toRat_ofIntWithPrec_eq_mkRat, Rat.zpow_neg, Int.shiftLeft_eq, Nat.one_shiftLeft]
+  rw [Rat.mkRat_eq_div, Rat.div_def]
+  have : ((2 : Int) : Rat) ≠ 0 := by decide
+  simp only [Rat.intCast_mul, Rat.intCast_pow, ← Rat.zpow_natCast, ← Rat.intCast_natCast,
+    Int.natCast_pow, Int.cast_ofNat_Int, ← Rat.zpow_neg, Rat.mul_assoc, ne_eq,
+    Rat.intCast_eq_zero_iff, Int.reduceEq, not_false_eq_true, ← Rat.zpow_add]
+  rw [Int.add_neg_eq_sub, ← Int.neg_sub, Int.toNat_sub_toNat_neg]
+  rfl
+
+example : ((3 : Dyadic) >>> 2) + ((3 : Dyadic) >>> 2) = ((3 : Dyadic) >>> 1) := rfl -- 3/4 + 3/4 = 3/2
+example : ((7 : Dyadic) >>> 3) + ((1 : Dyadic) >>> 3) = 1 := rfl -- 7/8 + 1/8 = 1
+example : (12 : Dyadic) + ((3 : Dyadic) >>> 1) = (27 : Dyadic) >>> 1 := rfl -- 12 + 3/2 = 27/2 = (2 * 13 + 1)/2^1
+example : ((3 : Dyadic) >>> 1).add 12 =  (27 : Dyadic) >>> 1 := rfl -- 3/2 + 12 = 27/2 = (2 * 13 + 1)/2^1
+example : (12 : Dyadic).add 12 = 24 := rfl -- 12 + 12 = 24
+
+@[simp]
+theorem toRat_add (x y : Dyadic) : toRat (x + y) = toRat x + toRat y := by
+  match x, y with
+  | .zero, _ => simp [toRat, Rat.zero_add]
+  | _, .zero => simp [toRat, Rat.add_zero]
+  | .ofOdd n₁ k₁ hn₁, .ofOdd n₂ k₂ hn₂ =>
+    change (Dyadic.add _ _).toRat = _
+    rw [Dyadic.add, toRat_ofOdd_eq_mkRat, toRat_ofOdd_eq_mkRat]
+    rw [Rat.mkRat_add_mkRat _ _ (NeZero.ne _) (NeZero.ne _)]
+    split
+    · rename_i h
+      cases Int.sub_eq_zero.mp h
+      rw [toRat_ofIntWithPrec_eq_mkRat, Rat.mkRat_eq_iff (NeZero.ne _) (NeZero.ne _)]
+      simp [Int.shiftLeft_mul_shiftLeft, Int.add_shiftLeft, Int.add_mul, Nat.add_assoc]
+    · rename_i h
+      cases Int.sub_eq_iff_eq_add.mp h
+      rw [toRat_ofOdd_eq_mkRat, Rat.mkRat_eq_iff (NeZero.ne _) (NeZero.ne _)]
+      simp only [succ_eq_add_one, Int.ofNat_eq_coe, Int.add_shiftLeft, ← Int.shiftLeft_add,
+        Int.natCast_mul, Int.natCast_shiftLeft, Int.shiftLeft_mul_shiftLeft, Int.add_mul]
+      congr 2 <;> omega
+    · rename_i h
+      cases Int.sub_eq_iff_eq_add.mp h
+      rw [toRat_ofOdd_eq_mkRat, Rat.mkRat_eq_iff (NeZero.ne _) (NeZero.ne _)]
+      simp only [Int.add_shiftLeft, ← Int.shiftLeft_add, Int.natCast_mul, Int.natCast_shiftLeft,
+        Int.cast_ofNat_Int, Int.shiftLeft_mul_shiftLeft, Int.mul_one, Int.add_mul]
+      congr 2 <;> omega
+
+@[simp]
+theorem toRat_neg (x : Dyadic) : toRat (-x) = - toRat x := by
+  change x.neg.toRat = _
+  cases x
+  · rfl
+  · simp [Dyadic.neg, Rat.neg_mkRat, Int.neg_shiftLeft, toRat_ofOdd_eq_mkRat]
+
+@[simp]
+theorem toRat_sub (x y : Dyadic) : toRat (x - y) = toRat x - toRat y := by
+  change toRat (x + -y) = _
+  simp [Rat.sub_eq_add_neg]
+
+@[simp]
+theorem toRat_mul (x y : Dyadic) : toRat (x * y) = toRat x * toRat y := by
+  match x, y with
+  | .zero, _ => simp
+  | _, .zero => simp
+  | .ofOdd n₁ k₁ hn₁, .ofOdd n₂ k₂ hn₂ =>
+    change (Dyadic.mul _ _).toRat = _
+    rw [Dyadic.mul, toRat_ofOdd_eq_mkRat, toRat_ofOdd_eq_mkRat, toRat_ofOdd_eq_mkRat,
+      Rat.mkRat_mul_mkRat, Rat.mkRat_eq_iff (NeZero.ne _) (NeZero.ne _)]
+    simp only [Int.natCast_mul, Int.natCast_shiftLeft, Int.cast_ofNat_Int,
+      Int.shiftLeft_mul_shiftLeft, Int.mul_one]
+    congr 1; omega
+
+@[simp]
+protected theorem pow_zero (x : Dyadic) : x ^ 0 = 1 := by
+  change x.pow 0 = 1
+  cases x <;> simp [Dyadic.pow] <;> rfl
+
+protected theorem pow_succ (x : Dyadic) (n : Nat) : x ^ (n + 1) = x ^ n * x := by
+  change x.pow (n + 1) = x.pow n * x
+  cases x
+  · simp [Dyadic.pow]
+  · change _ = Dyadic.mul _ _
+    simp [Dyadic.pow, Dyadic.mul, Int.pow_succ, Int.mul_add]
+
+@[simp]
+theorem toRat_pow (x : Dyadic) (n : Nat) : toRat (x ^ n) = toRat x ^ n := by
+  induction n with
+  | zero => simp; rfl
+  | succ k ih => simp [Dyadic.pow_succ, Rat.pow_succ, ih]
+
+@[simp]
+theorem toRat_intCast (x : Int) : (x : Dyadic).toRat = x := by
+  change (ofInt x).toRat = x
+  simp [ofInt, toRat_ofIntWithPrec_eq_mul_two_pow]
+
+@[simp]
+theorem toRat_natCast (x : Nat) : (x : Dyadic).toRat = x := by
+  change (ofInt x).toRat = x
+  simp [ofInt, toRat_ofIntWithPrec_eq_mul_two_pow, Rat.intCast_natCast]
+
+@[simp] theorem of_ne_zero : ofOdd n k hn ≠ 0 := Dyadic.noConfusion
+@[simp] theorem zero_ne_of : 0 ≠ ofOdd n k hn := Dyadic.noConfusion
+
+@[simp]
+theorem toRat_eq_zero_iff {x : Dyadic} : x.toRat = 0 ↔ x = 0 := by
+  refine ⟨fun h => ?_, fun h => h ▸ rfl⟩
+  cases x
+  · rfl
+  · simp only [toRat_ofOdd_eq_mkRat, ne_eq, shiftLeft_eq_zero_iff, succ_ne_self, not_false_eq_true,
+      Rat.mkRat_eq_zero, Int.shiftLeft_eq_zero_iff] at h
+    cases h
+    contradiction
+
+theorem ofOdd_eq_ofIntWithPrec : ofOdd n k hn = ofIntWithPrec n k := by
+  simp only [ofIntWithPrec, Dyadic.zero_eq, Int.trailingZeros_eq_zero_of_mod_eq hn,
+    Int.shiftRight_zero, Int.cast_ofNat_Int, Int.sub_zero, right_eq_dite_iff, of_ne_zero, imp_false]
+  intro rfl; contradiction
+
+theorem toRat_ofOdd_eq_mul_two_pow : toRat (.ofOdd n k hn) = n * 2 ^ (-k) := by
+  rw [ofOdd_eq_ofIntWithPrec, toRat_ofIntWithPrec_eq_mul_two_pow]
+
+@[simp]
+theorem ofIntWithPrec_zero {i : Int} : ofIntWithPrec 0 i = 0 := rfl
+
+@[simp]
+theorem neg_ofOdd : -ofOdd n k hn = ofOdd (-n) k (by simpa using hn) := rfl
+
+@[simp]
+theorem neg_ofIntWithPrec {i prec : Int} : -ofIntWithPrec i prec = ofIntWithPrec (-i) prec := by
+  rw [ofIntWithPrec, ofIntWithPrec]
+  simp only [Dyadic.zero_eq, Int.neg_eq_zero, Int.trailingZeros_neg]
+  split
+  · rfl
+  · obtain ⟨a, h⟩ := Int.two_pow_trailingZeros_dvd ‹_›
+    rw [Int.mul_comm, ← Int.shiftLeft_eq] at h
+    conv => enter [1, 1, 1, 1]; rw [h]
+    conv => enter [2, 1, 1]; rw [h]
+    simp only [Int.shiftLeft_shiftRight_cancel, neg_ofOdd, ← Int.neg_shiftLeft]
+
+theorem ofIntWithPrec_shiftLeft_add {n : Nat} :
+    ofIntWithPrec ((x : Int) <<< n) (i + n) = ofIntWithPrec x i := by
+  rw [ofIntWithPrec, ofIntWithPrec]
+  simp only [Int.shiftLeft_eq_zero_iff]
+  split
+  · rfl
+  · simp [Int.trailingZeros_shiftLeft, *, Int.shiftLeft_shiftRight_eq_shiftRight_of_le,
+      Int.add_comm x.trailingZeros n, ← Int.sub_sub]
+
+/-- The "precision" of a dyadic number, i.e. in `n * 2^(-p)` with `n` odd the precision is `p`. -/
+-- TODO: If `WithBot` is upstreamed, replace this with `WithBot Int`.
+def precision : Dyadic → Option Int
+  | .zero => none
+  | .ofOdd _ p _ => some p
+
+theorem precision_ofIntWithPrec_le {i : Int} (h : i ≠ 0) (prec : Int) :
+    (ofIntWithPrec i prec).precision ≤ some prec := by
+  simp [ofIntWithPrec, h, precision]
+  omega
+
+@[simp] theorem precision_zero : (0 : Dyadic).precision = none := rfl
+@[simp] theorem precision_neg {x : Dyadic} : (-x).precision = x.precision :=
+  match x with
+  | .zero => rfl
+  | .ofOdd _ _ _ => rfl
+
+/--
+Convert a rational number `x` to the greatest dyadic number with precision at most `prec`
+which is less than or equal to `x`.
+-/
+def _root_.Rat.toDyadic (x : Rat) (prec : Int) : Dyadic :=
+  match prec with
+  | (n : Nat) => .ofIntWithPrec ((x.num <<< n) / x.den) prec
+  | -(n + 1 : Nat) => .ofIntWithPrec (x.num / (x.den <<< (n + 1))) prec
+
+theorem _root_.Rat.toDyadic_mkRat (a : Int) (b : Nat) (prec : Int) :
+    Rat.toDyadic (mkRat a b) prec =
+      .ofIntWithPrec ((a <<< prec.toNat) / (b <<< (-prec).toNat)) prec := by
+  by_cases hb : b = 0
+  · cases prec <;> simp [hb, Rat.toDyadic]
+  rcases h : mkRat a b with ⟨n, d, hnz, hr⟩
+  obtain ⟨m, hm, rfl, rfl⟩ := Rat.mkRat_num_den hb h
+  cases prec
+  · simp only [Rat.toDyadic, Int.ofNat_eq_coe, Int.toNat_natCast, Int.toNat_neg_nat,
+      shiftLeft_zero, Int.natCast_mul]
+    rw [Int.mul_comm d, ← Int.ediv_ediv (by simp), ← Int.shiftLeft_mul,
+      Int.mul_ediv_cancel _ (by simpa using hm)]
+  · simp only [Rat.toDyadic, Int.natCast_shiftLeft, Int.negSucc_eq, ← Int.natCast_add_one,
+      Int.toNat_neg_nat, Int.shiftLeft_zero, Int.neg_neg, Int.toNat_natCast, Int.natCast_mul]
+    rw [Int.mul_comm d, ← Int.mul_shiftLeft, ← Int.ediv_ediv (by simp),
+      Int.mul_ediv_cancel _ (by simpa using hm)]
+
+/--
+Rounds a dyadic rational `x` down to the greatest dyadic number with precision at most `prec`
+which is less than or equal to `x`.
+-/
+def roundDown (x : Dyadic) (prec : Int) : Dyadic :=
+  match x with
+  | .zero => .zero
+  | .ofOdd n k _ =>
+    match k - prec with
+    | .ofNat l => .ofIntWithPrec (n >>> l) prec
+    | .negSucc _ => x
+
+theorem roundDown_eq_self_of_le {x : Dyadic} {prec : Int} (h : x.precision ≤ some prec) :
+    roundDown x prec = x := by
+  rcases x with _ | ⟨n, k, hn⟩
+  · rfl
+  · simp only [precision] at h
+    obtain ⟨a, rfl⟩ := h.dest
+    rcases a with _ | a
+    · simp [roundDown, ofOdd_eq_ofIntWithPrec]
+    · have : k - (k + (a + 1 : Nat)) = Int.negSucc a := by omega
+      simp only [roundDown, this]
+
+@[simp]
+theorem toDyadic_toRat (x : Dyadic) (prec : Int) :
+    x.toRat.toDyadic prec = x.roundDown prec := by
+  rcases x with _ | ⟨n, k, hn⟩
+  · cases prec <;> simp [Rat.toDyadic, roundDown]
+  · simp only [toRat_ofOdd_eq_mkRat, roundDown]
+    rw [Rat.toDyadic_mkRat]
+    simp only [← Int.shiftLeft_add, Int.natCast_shiftLeft, Int.cast_ofNat_Int]
+    rw [Int.shiftLeft_eq' 1, Int.one_mul, ← Int.shiftRight_eq_div_pow]
+    rw [Int.shiftLeft_shiftRight_eq, ← Int.toNat_sub, ← Int.toNat_sub, ← Int.neg_sub]
+    have : ((k.toNat + (-prec).toNat : Nat) - ((-k).toNat + prec.toNat : Nat) : Int) = k - prec := by
+      omega
+    rw [this]
+    cases h : k - prec
+    · simp
+    · simp
+      rw [Int.negSucc_eq, Int.eq_neg_comm, Int.neg_sub, eq_comm, Int.sub_eq_iff_eq_add] at h
+      simp only [Int.neg_negSucc, h, ← Int.natCast_add_one, Int.add_comm _ k,
+        Nat.succ_eq_add_one, Int.toNat_natCast, ofIntWithPrec_shiftLeft_add, ofOdd_eq_ofIntWithPrec]
+
+theorem toRat_inj {x y : Dyadic} : x.toRat = y.toRat ↔ x = y := by
+  refine ⟨fun h => ?_, fun h => h ▸ rfl⟩
+  cases x <;> cases y
+  · rfl
+  · simp [eq_comm (a := (0 : Rat))] at h
+  · simp at h
+  · rename_i n₁ k₁ hn₁ n₂ k₂ hn₂
+    replace h := congrArg (·.toDyadic (max k₁ k₂)) h
+    simpa [toDyadic_toRat, roundDown_eq_self_of_le, precision, Int.le_max_left, Int.le_max_right]
+      using h
+
+theorem add_comm (x y : Dyadic) : x + y = y + x := by
+  rw [← toRat_inj, toRat_add, toRat_add, Rat.add_comm]
+
+theorem add_assoc (x y z : Dyadic) : (x + y) + z = x + (y + z) := by
+  rw [← toRat_inj, toRat_add, toRat_add, toRat_add, toRat_add, Rat.add_assoc]
+
+theorem mul_comm (x y : Dyadic) : x * y = y * x := by
+  rw [← toRat_inj, toRat_mul, toRat_mul, Rat.mul_comm]
+
+theorem mul_assoc (x y z : Dyadic) : (x * y) * z = x * (y * z) := by
+  rw [← toRat_inj, toRat_mul, toRat_mul, toRat_mul, toRat_mul, Rat.mul_assoc]
+
+theorem mul_one (x : Dyadic) : x * 1 = x := by
+  rw [← toRat_inj, toRat_mul]
+  exact Rat.mul_one x.toRat
+
+theorem one_mul (x : Dyadic) : 1 * x = x := by
+  rw [← toRat_inj, toRat_mul]
+  exact Rat.one_mul x.toRat
+
+theorem add_mul (x y z : Dyadic) : (x + y) * z = x * z + y * z := by
+  simp [← toRat_inj, Rat.add_mul]
+
+theorem mul_add (x y z : Dyadic) : x * (y + z) = x * y + x * z := by
+  simp [← toRat_inj, Rat.mul_add]
+
+theorem neg_add_cancel (x : Dyadic) : -x + x = 0 := by
+  simp [← toRat_inj, Rat.neg_add_cancel]
+
+theorem neg_mul (x y : Dyadic) : -x * y = -(x * y) := by
+  simp [← toRat_inj, Rat.neg_mul]
+
+/-- Determine if a dyadic rational is strictly less than another. -/
+def blt (x y : Dyadic) : Bool :=
+  match x, y with
+  | .zero, .zero => false
+  | .zero, .ofOdd n₂ _ _ => 0 < n₂
+  | .ofOdd n₁ _ _, .zero => n₁ < 0
+  | .ofOdd n₁ k₁ _, .ofOdd n₂ k₂ _ =>
+    match k₂ - k₁ with
+    | (l : Nat) => (n₁ <<< l) < n₂
+    | -((l+1 : Nat)) => n₁ < (n₂ <<< (l + 1))
+
+/-- Determine if a dyadic rational is less than or equal to another. -/
+def ble (x y : Dyadic) : Bool :=
+  match x, y with
+  | .zero, .zero => true
+  | .zero, .ofOdd n₂ _ _ => 0 ≤ n₂
+  | .ofOdd n₁ _ _, .zero => n₁ ≤ 0
+  | .ofOdd n₁ k₁ _, .ofOdd n₂ k₂ _ =>
+    match k₂ - k₁ with
+    | (l : Nat) => (n₁ <<< l) ≤ n₂
+    | -((l+1 : Nat)) => n₁ ≤ (n₂ <<< (l + 1))
+
+theorem blt_iff_toRat {x y : Dyadic} : blt x y ↔ x.toRat < y.toRat := by
+  rcases x with _ | ⟨n₁, k₁, hn₁⟩ <;> rcases y with _ | ⟨n₂, k₂, hn₂⟩
+  · decide
+  · simp only [blt, decide_eq_true_eq, Dyadic.zero_eq, toRat_zero, toRat_ofOdd_eq_mul_two_pow,
+      Rat.mul_pos_iff_of_pos_right (Rat.zpow_pos (by decide : (0 : Rat) < 2)), Rat.intCast_pos]
+  · simp only [blt, decide_eq_true_eq, Dyadic.zero_eq, toRat_zero, toRat_ofOdd_eq_mul_two_pow,
+      Rat.mul_neg_iff_of_pos_right (Rat.zpow_pos (by decide : (0 : Rat) < 2)), Rat.intCast_neg_iff]
+  · simp only [blt, toRat_ofOdd_eq_mul_two_pow,
+      ← Rat.div_lt_iff (Rat.zpow_pos (by decide : (0 : Rat) < 2)), Rat.div_def, ← Rat.zpow_neg,
+      Int.neg_neg, Rat.mul_assoc, ne_eq, Rat.ofNat_eq_ofNat, reduceCtorEq, not_false_eq_true,
+      ← Rat.zpow_add, Int.shiftLeft_eq]
+    rw [Int.add_comm, Int.add_neg_eq_sub]
+    split
+    · simp [decide_eq_true_eq, ← Rat.intCast_lt_intCast, Rat.zpow_natCast, *]
+    · simp only [decide_eq_true_eq, Int.negSucc_eq, *]
+      rw [Rat.zpow_neg, ← Rat.div_def, Rat.div_lt_iff (Rat.zpow_pos (by decide))]
+      simp [← Rat.intCast_lt_intCast, ← Rat.zpow_natCast, *]
+
+theorem blt_eq_false_iff : blt x y = false ↔ ble y x = true := by
+  cases x <;> cases y
+  · simp [ble, blt]
+  · simp [ble, blt]
+  · simp [ble, blt]
+  · rename_i n₁ k₁ hn₁ n₂ k₂ hn₂
+    simp only [blt, ble]
+    rw [← Int.neg_sub]
+    rcases k₁ - k₂ with (_ | _) | _
+    · simp
+    · simp [← Int.negSucc_eq]
+    · simp only [Int.neg_negSucc, succ_eq_add_one, decide_eq_false_iff_not, Int.not_lt,
+        decide_eq_true_eq]
+
+theorem ble_iff_toRat : ble x y ↔ x.toRat ≤ y.toRat := by
+  rw [← blt_eq_false_iff, Bool.eq_false_iff]
+  simp only [ne_eq, blt_iff_toRat, Rat.not_lt]
+
+instance : LT Dyadic where
+  lt x y := blt x y
+
+instance : LE Dyadic where
+  le x y := ble x y
+
+instance : DecidableLT Dyadic := fun _ _ => inferInstanceAs (Decidable (_ = true))
+instance : DecidableLE Dyadic := fun _ _ => inferInstanceAs (Decidable (_ = true))
+
+theorem lt_iff_toRat {x y : Dyadic} : x < y ↔ x.toRat < y.toRat := blt_iff_toRat
+
+theorem le_iff_toRat {x y : Dyadic} : x ≤ y ↔ x.toRat ≤ y.toRat := ble_iff_toRat
+
+@[simp]
+protected theorem not_le {x y : Dyadic} : ¬x < y ↔ y ≤ x := by
+  simp only [· ≤ ·, · < ·, Bool.not_eq_true, blt_eq_false_iff]
+
+@[simp]
+protected theorem not_lt {x y : Dyadic} : ¬x ≤ y ↔ y < x := by
+  rw [← Dyadic.not_le, Decidable.not_not]
+
+@[simp]
+protected theorem le_refl (x : Dyadic) : x ≤ x := by
+  rw [le_iff_toRat]
+  exact Rat.le_refl
+
+protected theorem le_trans {x y z : Dyadic} (h : x ≤ y) (h' : y ≤ z) : x ≤ z := by
+  rw [le_iff_toRat] at h h' ⊢
+  exact Rat.le_trans h h'
+
+protected theorem le_antisymm {x y : Dyadic} (h : x ≤ y) (h' : y ≤ x) : x = y := by
+  rw [le_iff_toRat] at h h'
+  rw [← toRat_inj]
+  exact Rat.le_antisymm h h'
+
+protected theorem le_total (x y : Dyadic) : x ≤ y ∨ y ≤ x := by
+  rw [le_iff_toRat, le_iff_toRat]
+  exact Rat.le_total
+
+instance : Std.LawfulOrderLT Dyadic where
+  lt_iff a b := by rw [← Dyadic.not_lt, iff_and_self]; exact (Dyadic.le_total _ _).resolve_left
+
+instance : Std.IsPreorder Dyadic where
+  le_refl := Dyadic.le_refl
+  le_trans _ _ _ := Dyadic.le_trans
+
+instance : Std.IsPartialOrder Dyadic where
+  le_antisymm _ _ := Dyadic.le_antisymm
+
+instance : Std.IsLinearPreorder Dyadic where
+  le_total := Dyadic.le_total
+
+instance : Std.IsLinearOrder Dyadic where
+
+/-- `roundUp x prec` is the least dyadic number with precision at most `prec` which is greater than or equal to `x`. -/
+def roundUp (x : Dyadic) (prec : Int) : Dyadic :=
+  match x with
+  | .zero => .zero
+  | .ofOdd n k _ =>
+    match k - prec with
+    | .ofNat l => .ofIntWithPrec (-((-n) >>> l)) prec
+    | .negSucc _ => x
+
+theorem roundUp_eq_neg_roundDown_neg (x : Dyadic) (prec : Int) :
+    x.roundUp prec = -((-x).roundDown prec) := by
+  rcases x with _ | ⟨n, k, hn⟩
+  · rfl
+  · change _ = -(ofOdd ..).roundDown prec
+    rw [roundDown, roundUp]
+    split <;> simp
+
+end Dyadic

src/Init/Data/Dyadic/Instances.lean

@@ -0,0 +1,60 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kim Morrison, Robin Arnez
+-/
+module
+
+prelude
+public import Init.Data.Dyadic.Basic
+public import Init.Grind.Ring.Basic
+public import Init.Grind.Ordered.Ring
+
+/-! # Internal `grind` algebra instances for `Dyadic`. -/
+
+open Lean.Grind
+
+namespace Dyadic
+
+instance : CommRing Dyadic where
+  nsmul := ⟨(· * ·)⟩
+  zsmul := ⟨(· * ·)⟩
+  add_zero := Dyadic.add_zero
+  add_comm := Dyadic.add_comm
+  add_assoc := Dyadic.add_assoc
+  mul_assoc := Dyadic.mul_assoc
+  mul_one := Dyadic.mul_one
+  one_mul := Dyadic.one_mul
+  zero_mul := Dyadic.zero_mul
+  mul_zero := Dyadic.mul_zero
+  mul_comm := Dyadic.mul_comm
+  pow_zero := Dyadic.pow_zero
+  pow_succ := Dyadic.pow_succ
+  sub_eq_add_neg _ _ := rfl
+  neg_add_cancel := Dyadic.neg_add_cancel
+  neg_zsmul i a := by
+    change ((-i : Int) : Dyadic) * a = -(i * a)
+    simp [← toRat_inj, Rat.neg_mul]
+  left_distrib := Dyadic.mul_add
+  right_distrib := Dyadic.add_mul
+  intCast_neg _ := by simp [← toRat_inj]
+  ofNat_succ n := by
+    change ((n + 1 : Int) : Dyadic) = ((n : Int) : Dyadic) + 1
+    simp [← toRat_inj, Rat.intCast_add]; rfl
+
+instance : IsCharP Dyadic 0 := IsCharP.mk' _ _
+  (ofNat_eq_zero_iff := fun x => by change (x : Dyadic) = 0 ↔ _; simp [← toRat_inj])
+
+instance : NoNatZeroDivisors Dyadic where
+  no_nat_zero_divisors k a b h₁ h₂ := by
+    change k * a = k * b at h₂
+    simp only [← toRat_inj, toRat_mul, toRat_natCast] at h₂ ⊢
+    simpa [← Rat.mul_assoc, Rat.inv_mul_cancel, h₁] using congrArg ((k : Rat)⁻¹ * ·) h₂
+
+instance : OrderedRing Dyadic where
+  zero_lt_one := by decide
+  add_le_left_iff _ := by simp [le_iff_toRat, Rat.add_le_add_right]
+  mul_lt_mul_of_pos_left {_ _ _} := by simpa [lt_iff_toRat] using Rat.mul_lt_mul_of_pos_left
+  mul_lt_mul_of_pos_right {_ _ _} := by simpa [lt_iff_toRat] using Rat.mul_lt_mul_of_pos_right
+
+end Dyadic

src/Init/Data/Dyadic/Round.lean

@@ -0,0 +1,77 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kim Morrison
+-/
+module
+
+prelude
+public import Init.Data.Dyadic.Basic
+import all Init.Data.Dyadic.Instances
+import Init.Data.Int.Bitwise.Lemmas
+import Init.Grind.Ordered.Rat
+import Init.Grind.Ordered.Field
+
+namespace Dyadic
+
+/-!
+Theorems about `roundUp` and `roundDown`.
+-/
+
+public section
+
+theorem roundDown_le {x : Dyadic} {prec : Int} : roundDown x prec ≤ x :=
+  match x with
+  | .zero => Dyadic.le_refl _
+  | .ofOdd n k _ => by
+    unfold roundDown
+    dsimp
+    match h : k - prec with
+    | .ofNat l =>
+      dsimp
+      rw [ofOdd_eq_ofIntWithPrec, le_iff_toRat]
+      replace h : k = Int.ofNat l + prec := by omega
+      subst h
+      simp only [toRat_ofIntWithPrec_eq_mul_two_pow]
+      rw [Int.neg_add, Rat.zpow_add (by decide), ← Rat.mul_assoc]
+      refine Lean.Grind.OrderedRing.mul_le_mul_of_nonneg_right ?_ (Rat.zpow_nonneg (by decide))
+      rw [Int.shiftRight_eq_div_pow]
+      rw [← Lean.Grind.Field.IsOrdered.mul_le_mul_iff_of_pos_right (c := 2^(Int.ofNat l)) (Rat.zpow_pos (by decide))]
+      simp only [Int.natCast_pow, Int.cast_ofNat_Int, Int.ofNat_eq_coe]
+      rw [Rat.mul_assoc, ← Rat.zpow_add (by decide), Int.add_left_neg, Rat.zpow_zero, Rat.mul_one]
+      have : (2 : Rat) ^ (l : Int) = (2 ^ l : Int) := by
+        rw [Rat.zpow_natCast, Rat.intCast_pow, Rat.intCast_ofNat]
+      rw [this, ← Rat.intCast_mul, Rat.intCast_le_intCast]
+      exact Int.ediv_mul_le n (Int.pow_ne_zero (by decide))
+    | .negSucc _ =>
+      apply Dyadic.le_refl
+
+theorem precision_roundDown {x : Dyadic} {prec : Int} : (roundDown x prec).precision ≤ some prec := by
+  unfold roundDown
+  match x with
+  | zero => simp [precision]
+  | ofOdd n k hn =>
+    dsimp
+    split
+    · rename_i n' h
+      by_cases h' : n >>> n' = 0
+      · simp [h']
+      · exact precision_ofIntWithPrec_le h' _
+    · simp [precision]
+      omega
+
+-- This theorem would characterize `roundDown` in terms of the order and `precision`.
+-- theorem le_roundDown {x y : Dyadic} {prec : Int} (h : y.precision ≤ some prec) (h' : y ≤ x) :
+--     y ≤ x.roundDown prec := sorry
+
+theorem le_roundUp {x : Dyadic} {prec : Int} : x ≤ roundUp x prec := by
+  rw [roundUp_eq_neg_roundDown_neg, Lean.Grind.OrderedAdd.le_neg_iff]
+  apply roundDown_le
+
+theorem precision_roundUp {x : Dyadic} {prec : Int} : (roundUp x prec).precision ≤ some prec := by
+  rw [roundUp_eq_neg_roundDown_neg, precision_neg]
+  exact precision_roundDown
+
+-- This theorem would characterize `roundUp` in terms of the order and `precision`.
+-- theorem roundUp_le {x y : Dyadic} {prec : Int} (h : y.precision ≤ some prec) (h' : x ≤ y) :
+--    x.roundUp prec ≤ y := sorry

src/Init/Data/List/Zip.lean

@@ -274,11 +274,9 @@ theorem zip_map {f : α → γ} {g : β → δ} :
   | _, [] => by simp only [map, zip_nil_right]
   | _ :: _, _ :: _ => by simp only [map, zip_cons_cons, zip_map, Prod.map]
 
-@[grind _=_]
 theorem zip_map_left {f : α → γ} {l₁ : List α} {l₂ : List β} :
     zip (l₁.map f) l₂ = (zip l₁ l₂).map (Prod.map f id) := by rw [← zip_map, map_id]
 
-@[grind _=_]
 theorem zip_map_right {f : β → γ} {l₁ : List α} {l₂ : List β} :
     zip l₁ (l₂.map f) = (zip l₁ l₂).map (Prod.map id f) := by rw [← zip_map, map_id]
 

src/Init/Data/Nat/Fold.lean

@@ -128,6 +128,12 @@ theorem fold_congr {α : Type u} {n m : Nat} (w : n = m)
   subst m
   rfl
 
+theorem foldRev_congr {α : Type u} {n m : Nat} (w : n = m)
+     (f : (i : Nat) → i < n → α → α) (init : α) :
+     foldRev n f init = foldRev m (fun i h => f i (by omega)) init := by
+  subst m
+  rfl
+
 private theorem foldTR_loop_congr {α : Type u} {n m : Nat} (w : n = m)
      (f : (i : Nat) → i < n → α → α) (j : Nat) (h : j ≤ n) (init : α) :
      foldTR.loop n f j h init = foldTR.loop m (fun i h => f i (by omega)) j (by omega) init := by
@@ -270,6 +276,16 @@ def dfoldRev (n : Nat) {α : (i : Nat) → (h : i ≤ n := by omega) → Type u}
   | succ n ih =>
     simp [ih, List.finRange_succ_last, List.foldl_map]
 
+theorem fold_add
+    {α n m} (f : (i : Nat) → i < n + m → α → α) (init : α) :
+    fold (n + m) f init =
+      fold m (fun i h => f (n + i) (by omega))
+        (fold n (fun i h => f i (by omega)) init) := by
+  induction m with
+  | zero => simp; rfl
+  | succ m ih =>
+    simp [fold_congr (Nat.add_assoc n m 1).symm, ih]
+
 /-! ### `foldRev` -/
 
 @[simp] theorem foldRev_zero {α : Type u} (f : (i : Nat) → i < 0 → α → α) (init : α) :
@@ -285,6 +301,17 @@ def dfoldRev (n : Nat) {α : (i : Nat) → (h : i ≤ n := by omega) → Type u}
   | zero => simp
   | succ n ih => simp [ih, List.finRange_succ_last, List.foldr_map]
 
+theorem foldRev_add
+    {α n m} (f : (i : Nat) → i < n + m → α → α) (init : α) :
+    foldRev (n + m) f init =
+      foldRev n (fun i h => f i (by omega))
+        (foldRev m (fun i h => f (n + i) (by omega)) init) := by
+  induction m generalizing init with
+  | zero => simp; rfl
+  | succ m ih =>
+    rw [foldRev_congr (Nat.add_assoc n m 1).symm]
+    simp [ih]
+
 /-! ### `any` -/
 
 @[simp] theorem any_zero {f : (i : Nat) → i < 0 → Bool} : any 0 f = false := by simp [any]

src/Init/Data/Option/Lemmas.lean

@@ -797,7 +797,7 @@ theorem get_merge {o o' : Option α} {f : α → α → α} {i : α} [Std.Lawful
     (o.merge f o').get h = f (o.getD i) (o'.getD i) := by
   cases o <;> cases o' <;> simp [Std.LawfulLeftIdentity.left_id, Std.LawfulRightIdentity.right_id]
 
-@[simp, grind =] theorem elim_none (x : β) (f : α → β) : none.elim x f = x := rfl
+@[simp, grind =] theorem elim_none (x : β) (f : α → β) : Option.elim none x f = x := rfl
 
 @[simp, grind =] theorem elim_some (x : β) (f : α → β) (a : α) : (some a).elim x f = f a := rfl
 

src/Init/Data/Order/Ord.lean

@@ -37,6 +37,10 @@ namespace ReflCmp
 theorem cmp_eq_of_eq {α : Type u} {cmp : α → α → Ordering} [Std.ReflCmp cmp] {a b : α} : a = b → cmp a b = .eq := by
   intro h; subst a; apply compare_self
 
+theorem ne_of_cmp_ne_eq {α : Type u} {cmp : α → α → Ordering} [Std.ReflCmp cmp] {a b : α} :
+    cmp a b ≠ .eq → a ≠ b :=
+  mt cmp_eq_of_eq
+
 end ReflCmp
 
 /-- A typeclasses for ordered types for which `compare a a = .eq` for all `a`. -/

src/Init/Data/Rat/Lemmas.lean

@@ -251,8 +251,10 @@ theorem add_def (a b : Rat) :
 theorem add_def' (a b : Rat) : a + b = mkRat (a.num * b.den + b.num * a.den) (a.den * b.den) := by
   rw [add_def, normalize_eq_mkRat]
 
-@[simp] protected theorem add_zero (a : Rat) : a + 0 = a := by simp [add_def', mkRat_self]
-@[simp] protected theorem zero_add (a : Rat) : 0 + a = a := by simp [add_def', mkRat_self]
+@[local simp]
+protected theorem add_zero (a : Rat) : a + 0 = a := by simp [add_def', mkRat_self]
+@[local simp]
+protected theorem zero_add (a : Rat) : 0 + a = a := by simp [add_def', mkRat_self]
 
 theorem normalize_add_normalize (n₁ n₂) {d₁ d₂} (z₁ z₂) :
     normalize n₁ d₁ z₁ + normalize n₂ d₂ z₂ =
@@ -383,7 +385,7 @@ theorem mkRat_mul_mkRat (n₁ n₂ : Int) (d₁ d₂) :
   if z₁ : d₁ = 0 then simp [z₁] else if z₂ : d₂ = 0 then simp [z₂] else
   rw [← normalize_eq_mkRat z₁, ← normalize_eq_mkRat z₂, normalize_mul_normalize, normalize_eq_mkRat]
 
-theorem divInt_mul_divInt (n₁ n₂ : Int) {d₁ d₂} (z₁ : d₁ ≠ 0) (z₂ : d₂ ≠ 0) :
+theorem divInt_mul_divInt (n₁ n₂ : Int) {d₁ d₂} :
     (n₁ /. d₁) * (n₂ /. d₂) = (n₁ * n₂) /. (d₁ * d₂) := by
   rcases Int.eq_nat_or_neg d₁ with ⟨_, rfl | rfl⟩ <;>
   rcases Int.eq_nat_or_neg d₂ with ⟨_, rfl | rfl⟩ <;>
@@ -441,9 +443,22 @@ protected theorem mul_inv_cancel (a : Rat) : a ≠ 0 → a * a⁻¹ = 1 :=
 protected theorem inv_mul_cancel (a : Rat) (h : a ≠ 0) : a⁻¹ * a = 1 :=
   Eq.trans (Rat.mul_comm _ _) (Rat.mul_inv_cancel _ h)
 
+protected theorem inv_eq_of_mul_eq_one {a b : Rat} (h : a * b = 1) : a⁻¹ = b := by
+  have : a ≠ 0 := by intro h; simp_all +decide
+  simpa [← Rat.mul_assoc, Rat.inv_mul_cancel _ this, eq_comm] using congrArg (a⁻¹ * ·) h
+
 protected theorem inv_inv (a : Rat) : a⁻¹⁻¹ = a :=
   numDenCasesOn' a fun n d hd ↦ by simp only [inv_divInt]
 
+protected theorem inv_mul_rev (a b : Rat) : (a * b)⁻¹ = b⁻¹ * a⁻¹ := by
+  by_cases ha : a = 0
+  · simp [ha]
+  by_cases hb : b = 0
+  · simp [hb]
+  apply Rat.inv_eq_of_mul_eq_one
+  rw [← Rat.mul_assoc, Rat.mul_assoc a, Rat.mul_inv_cancel _ hb, Rat.mul_one,
+    Rat.mul_inv_cancel _ ha]
+
 protected theorem mul_eq_zero {a b : Rat} : a * b = 0 ↔ a = 0 ∨ b = 0 := by
   constructor
   · intro h
@@ -456,19 +471,34 @@ protected theorem mul_eq_zero {a b : Rat} : a * b = 0 ↔ a = 0 ∨ b = 0 := by
 
 theorem div_def (a b : Rat) : a / b = a * b⁻¹ := rfl
 
+theorem divInt_eq_div (a b : Int) : a /. b = a / b := by
+  rw [← Rat.mk_den_one, ← Rat.mk_den_one, Rat.mk'_eq_divInt, Rat.mk'_eq_divInt, div_def,
+    inv_divInt, divInt_mul_divInt, Int.cast_ofNat_Int, Int.mul_one, Int.one_mul]
+
+theorem mkRat_eq_div (a : Int) (b : Nat) : mkRat a b = a / b := by
+  rw [← divInt_ofNat, divInt_eq_div]; rfl
+
+protected theorem div_mul_cancel {a b : Rat} (hb : b ≠ 0) : a / b * b = a := by
+  rw [div_def, Rat.mul_assoc, Rat.inv_mul_cancel _ hb, Rat.mul_one]
+
+protected theorem mul_div_cancel {a b : Rat} (hb : b ≠ 0) : a * b / b = a := by
+  rw [div_def, Rat.mul_assoc, Rat.mul_inv_cancel _ hb, Rat.mul_one]
+
 theorem pow_def (q : Rat) (n : Nat) :
     q ^ n = ⟨q.num ^ n, q.den ^ n, by simp [q.den_nz],
       by rw [Int.natAbs_pow]; exact q.reduced.pow _ _⟩ := rfl
 
-protected theorem pow_zero (q : Rat) : q ^ 0 = 1 := rfl
+@[simp] protected theorem pow_zero (q : Rat) : q ^ 0 = 1 := rfl
 
 protected theorem pow_succ (q : Rat) (n : Nat) : q ^ (n + 1) = q ^ n * q := by
   rcases q with ⟨n, d, hn, r⟩
   simp only [pow_def, Int.pow_succ, Nat.pow_succ]
-  simp only [mk'_eq_divInt, divInt_mul_divInt, Int.natCast_eq_zero, hn, Nat.pow_eq_zero,
-    not_false_eq_true, false_and, ne_eq, Int.natCast_mul]
+  simp only [mk'_eq_divInt, Int.natCast_mul, divInt_mul_divInt]
 
-protected theorem zpow_zero (q : Rat) : q ^ (0 : Int) = 1 := Rat.pow_zero q
+@[simp] protected theorem pow_one (q : Rat) : q ^ 1 = q := by simp [Rat.pow_succ]
+
+@[simp] protected theorem zpow_zero (q : Rat) : q ^ (0 : Int) = 1 := Rat.pow_zero q
+@[simp] protected theorem zpow_one (q : Rat) : q ^ (1 : Int) = q := Rat.pow_one q
 
 protected theorem zpow_natCast (q : Rat) (n : Nat) : q ^ (n : Int) = q ^ n := rfl
 
@@ -478,6 +508,30 @@ protected theorem zpow_neg (q : Rat) (n : Int) : q ^ (-n : Int) = (q ^ n)⁻¹ :
   · rfl
   · exact (Rat.inv_inv _).symm
 
+protected theorem zpow_add_one {q : Rat} (hq : q ≠ 0) (m : Int) :
+    q ^ (m + 1) = q ^ m * q := by
+  rcases m with _ | (_ | m)
+  · apply Rat.pow_succ
+  · simp [Rat.zpow_neg, Rat.inv_mul_cancel _ hq]
+  · change q ^ (-(m + 1 : Nat) : Int) = q ^ (-(m + 2 : Nat) : Int) * q
+    simp only [Rat.zpow_neg, Rat.zpow_natCast, Rat.pow_succ, Rat.inv_mul_rev]
+    rw [Rat.mul_comm (_ * _), ← Rat.mul_assoc, Rat.mul_inv_cancel _ hq, Rat.one_mul]
+
+protected theorem zpow_sub_one {q : Rat} (hq : q ≠ 0) (m : Int) :
+    q ^ (m - 1) = q ^ m * q⁻¹ := by
+  calc
+    _ = q ^ (m - 1) * q * q⁻¹ := by simp [Rat.mul_assoc, Rat.mul_inv_cancel _ hq]
+    _ = q ^ m * q⁻¹ := by simp [← Rat.zpow_add_one hq]
+
+protected theorem zpow_add {q : Rat} (hq : q ≠ 0) (m n : Int) :
+    q ^ (m + n) = q ^ m * q ^ n := by
+  rcases n with n | n
+  · induction n <;> simp_all [Rat.zpow_add_one hq, ← Int.add_assoc, Rat.mul_assoc]
+  · induction n with
+    | zero => simp [Rat.zpow_neg, ← Int.sub_eq_add_neg, Rat.zpow_sub_one hq]
+    | succ k ih => simp [← Int.negSucc_sub_one, ← Int.add_sub_assoc, Rat.zpow_sub_one hq, ih,
+      Rat.mul_assoc]
+
 /-! ### `ofScientific` -/
 
 theorem ofScientific_true_def : Rat.ofScientific m true e = mkRat m (10 ^ e) := by
@@ -496,43 +550,6 @@ theorem ofScientific_ofNat_ofNat :
     Rat.ofScientific (no_index (OfNat.ofNat m)) s (no_index (OfNat.ofNat e))
       = OfScientific.ofScientific m s e := rfl
 
-/-! ### `intCast` -/
-
-@[simp] theorem den_intCast (a : Int) : (a : Rat).den = 1 := rfl
-
-@[simp] theorem num_intCast (a : Int) : (a : Rat).num = a := rfl
-
-@[deprecated den_intCast (since := "2025-08-22")]
-abbrev intCast_den := @den_intCast
-@[deprecated num_intCast (since := "2025-08-22")]
-abbrev intCast_num := @num_intCast
-
-@[simp, norm_cast] theorem intCast_inj {a b : Int} : (a : Rat) = (b : Rat) ↔ a = b := by
-  constructor
-  · rintro ⟨⟩; rfl
-  · simp_all
-
-protected theorem intCast_zero : ((0 : Int) : Rat) = (0 : Rat) := rfl
-
-protected theorem intCast_one : ((1 : Int) : Rat) = (1 : Rat) := rfl
-
-@[simp, norm_cast] protected theorem intCast_add (a b : Int) :
-    ((a + b : Int) : Rat) = (a : Rat) + (b : Rat) := by
-  rw [add_def]
-  simp [normalize_eq]
-
-@[simp, norm_cast] protected theorem intCast_neg (a : Int) : ((-a : Int) : Rat) = -(a : Rat) := rfl
-
-@[simp, norm_cast] protected theorem intCast_sub (a b : Int) :
-    ((a - b : Int) : Rat) = (a : Rat) - (b : Rat) := by
-  rw [sub_def]
-  simp [normalize_eq]
-
-@[simp, norm_cast] protected theorem intCast_mul (a b : Int) :
-    ((a * b : Int) : Rat) = (a : Rat) * (b : Rat) := by
-  rw [mul_def]
-  simp [normalize_eq]
-
 /-! ### `≤` and `<` -/
 
 @[simp] theorem num_nonneg {q : Rat} : 0 ≤ q.num ↔ 0 ≤ q := by
@@ -579,8 +596,7 @@ protected theorem mul_nonneg {a b : Rat} : 0 ≤ a → 0 ≤ b → 0 ≤ a * b :
     numDenCasesOn' b fun n₂ d₂ h₂ => by
       have d₁0 : 0 < (d₁ : Int) := mod_cast Nat.pos_of_ne_zero h₁
       have d₂0 : 0 < (d₂ : Int) := mod_cast Nat.pos_of_ne_zero h₂
-      simp only [d₁0, d₂0, Int.mul_pos, divInt_nonneg_iff_of_pos_right,
-        divInt_mul_divInt _ _ (Int.ne_of_gt d₁0) (Int.ne_of_gt d₂0)]
+      simp only [d₁0, divInt_nonneg_iff_of_pos_right, d₂0, divInt_mul_divInt, Int.mul_pos]
       apply Int.mul_nonneg
 
 protected theorem not_le {a b : Rat} : ¬a ≤ b ↔ b < a := (Bool.not_eq_false _).to_iff
@@ -644,9 +660,13 @@ protected theorem le_antisymm {a b : Rat} (hab : a ≤ b) (hba : b ≤ a) : a =
 protected theorem le_of_lt {a b : Rat} (ha : a < b) : a ≤ b :=
   Rat.le_total.resolve_left (Rat.not_le.mpr ha)
 
+@[simp]
+protected theorem lt_irrefl {a : Rat} : ¬a < a :=
+  Rat.not_lt.mpr Rat.le_refl
+
 protected theorem ne_of_lt {a b : Rat} (ha : a < b) : a ≠ b := by
   intro rfl
-  exact Rat.not_le.mpr ha Rat.le_refl
+  exact Rat.lt_irrefl ha
 
 protected theorem ne_of_gt {a b : Rat} (ha : a < b) : b ≠ a :=
   (Rat.ne_of_lt ha).symm
@@ -662,6 +682,9 @@ protected theorem add_le_add_left {a b c : Rat} : c + a ≤ c + b ↔ a ≤ b :=
     Rat.add_zero, Rat.add_assoc, Rat.add_left_comm (-a), Rat.neg_add_cancel, Rat.add_zero,
     Rat.add_comm]
 
+protected theorem add_le_add_right {a b c : Rat} : a + c ≤ b + c ↔ a ≤ b := by
+  rw [Rat.add_comm _ c, Rat.add_comm _ c, Rat.add_le_add_left]
+
 protected theorem lt_iff_sub_pos (a b : Rat) : a < b ↔ 0 < b - a := by
   simp only [← Rat.not_le]
   apply not_congr
@@ -685,6 +708,230 @@ protected theorem mul_lt_mul_of_pos_left {a b c : Rat} (ha : a < b) (hc : 0 < c)
 
 protected theorem mul_lt_mul_of_pos_right {a b c : Rat} (ha : a < b) (hc : 0 < c) :
     a * c < b * c := by
-  rw [Rat.lt_iff_sub_pos, Rat.sub_eq_add_neg] at ha ⊢
-  rw [← Rat.neg_mul, ← Rat.add_mul]
-  exact Rat.mul_pos ha hc
+  rw [Rat.mul_comm _ c, Rat.mul_comm _ c]
+  exact Rat.mul_lt_mul_of_pos_left ha hc
+
+protected theorem le_of_mul_le_mul_left {a b c : Rat} (ha : c * a ≤ c * b) (hc : 0 < c) :
+    a ≤ b := by
+  simp only [← Rat.not_lt] at ha ⊢
+  exact mt (Rat.mul_lt_mul_of_pos_left · hc) ha
+
+protected theorem le_of_mul_le_mul_right {a b c : Rat} (ha : a * c ≤ b * c) (hc : 0 < c) :
+    a ≤ b := by
+  rw [Rat.mul_comm _ c, Rat.mul_comm _ c] at ha
+  exact Rat.le_of_mul_le_mul_left ha hc
+
+protected theorem lt_of_mul_lt_mul_left {a b c : Rat} (h : c * a < c * b) (hc : 0 ≤ c) :
+    a < b := by
+  have hc' : 0 ≠ c := by intro rfl; simp at h
+  apply Rat.lt_of_le_of_ne
+  · exact Rat.le_of_mul_le_mul_left (Rat.le_of_lt h) (Rat.lt_of_le_of_ne hc hc')
+  · intro rfl
+    exact Rat.lt_irrefl h
+
+protected theorem lt_of_mul_lt_mul_right {a b c : Rat} (h : a * c < b * c) (hc : 0 ≤ c) :
+    a < b := by
+  rw [Rat.mul_comm _ c, Rat.mul_comm _ c] at h
+  exact Rat.lt_of_mul_lt_mul_left h hc
+
+protected theorem mul_lt_mul_left {a b c : Rat} (hc : 0 < c) : c * a < c * b ↔ a < b :=
+  ⟨(Rat.lt_of_mul_lt_mul_left · (Rat.le_of_lt hc)), (Rat.mul_lt_mul_of_pos_left · hc)⟩
+
+protected theorem mul_lt_mul_right {a b c : Rat} (hc : 0 < c) : a * c < b * c ↔ a < b :=
+  ⟨(Rat.lt_of_mul_lt_mul_right · (Rat.le_of_lt hc)), (Rat.mul_lt_mul_of_pos_right · hc)⟩
+
+protected theorem mul_pos_iff_of_pos_left {a b : Rat} (ha : 0 < a) : 0 < a * b ↔ 0 < b := by
+  constructor
+  · intro h
+    rw [← Rat.mul_zero a] at h
+    exact Rat.lt_of_mul_lt_mul_left h (Rat.le_of_lt ha)
+  · exact Rat.mul_pos ha
+
+protected theorem mul_pos_iff_of_pos_right {a b : Rat} (hb : 0 < b) : 0 < a * b ↔ 0 < a := by
+  rw [Rat.mul_comm, Rat.mul_pos_iff_of_pos_left hb]
+
+protected theorem mul_neg_iff_of_pos_left {a b : Rat} (ha : 0 < a) : a * b < 0 ↔ b < 0 := by
+  constructor
+  · intro h
+    rw [← Rat.mul_zero a] at h
+    exact Rat.lt_of_mul_lt_mul_left h (Rat.le_of_lt ha)
+  · intro h
+    simpa using Rat.mul_lt_mul_of_pos_left h ha
+
+protected theorem mul_neg_iff_of_pos_right {a b : Rat} (hb : 0 < b) : a * b < 0 ↔ a < 0 := by
+  rw [Rat.mul_comm, Rat.mul_neg_iff_of_pos_left hb]
+
+protected theorem inv_pos {a : Rat} : 0 < a⁻¹ ↔ 0 < a := by
+  suffices ∀ a : Rat, 0 < a → 0 < a⁻¹ from ⟨fun h => Rat.inv_inv a ▸ this _ h, this a⟩
+  intro a ha
+  apply Rat.lt_of_mul_lt_mul_left _ (Rat.le_of_lt ha)
+  apply Rat.lt_of_mul_lt_mul_left _ (Rat.le_of_lt ha)
+  simpa [Rat.mul_inv_cancel _ (Rat.ne_of_gt ha)]
+
+protected theorem pow_pos {a : Rat} {n : Nat} (h : 0 < a) : 0 < a ^ n := by
+  induction n with
+  | zero => simp +decide
+  | succ k ih => rw [Rat.pow_succ]; exact Rat.mul_pos ih h
+
+protected theorem pow_nonneg {a : Rat} {n : Nat} (h : 0 ≤ a) : 0 ≤ a ^ n := by
+  by_cases h' : a = 0
+  · simp [h']
+    match n with
+    | 0 => simp; rfl
+    | n + 1 => simp [Rat.pow_succ]; apply Rat.le_refl
+  · exact Rat.le_of_lt (Rat.pow_pos (Rat.lt_of_le_of_ne h (Ne.symm h')))
+
+protected theorem zpow_pos {a : Rat} {n : Int} (h : 0 < a) : 0 < a ^ n := by
+  cases n
+  · simp [Rat.zpow_natCast, Rat.pow_pos h]
+  · simp only [Int.negSucc_eq, Rat.zpow_neg, Rat.inv_pos, ← Int.natCast_add_one,
+      Rat.zpow_natCast, Rat.pow_pos h]
+
+protected theorem zpow_nonneg {a : Rat} {n : Int} (h : 0 ≤ a) : 0 ≤ a ^ n := by
+  by_cases h' : a = 0
+  · simp [h']
+    match n with
+    | (0 : Nat) => simp; rfl
+    | (n + 1 : Nat) =>
+      rw [Rat.zpow_natCast, Rat.pow_succ, Rat.mul_zero]
+      rfl
+    | -(n + 1 : Nat) =>
+      rw [Rat.zpow_neg, Rat.zpow_natCast, Rat.pow_succ, Rat.mul_zero, Rat.inv_zero]
+      rfl
+  · exact Rat.le_of_lt (Rat.zpow_pos (Rat.lt_of_le_of_ne h (Ne.symm h')))
+
+protected theorem div_lt_iff {a b c : Rat} (hb : 0 < b) : a / b < c ↔ a < c * b := by
+  rw [← Rat.mul_lt_mul_right hb, Rat.div_mul_cancel (Rat.ne_of_gt hb)]
+
+protected theorem div_lt_iff' {a b c : Rat} (hb : 0 < b) : a / b < c ↔ a < b * c := by
+  rw [Rat.div_lt_iff hb, Rat.mul_comm]
+
+protected theorem lt_div_iff {a b c : Rat} (hc : 0 < c) : a < b / c ↔ a * c < b := by
+  rw [← Rat.mul_lt_mul_right hc, Rat.div_mul_cancel (Rat.ne_of_gt hc)]
+
+protected theorem lt_div_iff' {a b c : Rat} (hc : 0 < c) : a < b / c ↔ c * a < b := by
+  rw [Rat.lt_div_iff hc, Rat.mul_comm]
+
+/-! ### `intCast` -/
+
+@[simp] theorem den_intCast (a : Int) : (a : Rat).den = 1 := rfl
+
+@[simp] theorem num_intCast (a : Int) : (a : Rat).num = a := rfl
+
+@[deprecated den_intCast (since := "2025-08-22")]
+abbrev intCast_den := @den_intCast
+@[deprecated num_intCast (since := "2025-08-22")]
+abbrev intCast_num := @num_intCast
+
+/-!
+The following lemmas are later subsumed by e.g. `Int.cast_add` and `Int.cast_mul` in Mathlib
+but it is convenient to have these earlier, for users who only need `Int` and `Rat`.
+-/
+
+@[norm_cast] theorem intCast_natCast (n : Nat) : ((n : Int) : Rat) = n := rfl
+
+@[simp, norm_cast] theorem intCast_inj {a b : Int} : (a : Rat) = (b : Rat) ↔ a = b := by
+  constructor
+  · rintro ⟨⟩; rfl
+  · simp_all
+
+@[simp, norm_cast] theorem natCast_inj {a b : Nat} : (a : Rat) = (b : Rat) ↔ a = b := by
+  constructor
+  · rintro ⟨⟩; rfl
+  · simp_all
+
+@[simp, norm_cast] theorem intCast_eq_zero_iff {a : Int} : (a : Rat) = 0 ↔ a = 0 :=
+  intCast_inj
+
+@[simp, norm_cast] theorem natCast_eq_zero_iff {a : Nat} : (a : Rat) = 0 ↔ a = 0 :=
+  natCast_inj
+
+@[simp] theorem ofNat_eq_ofNat {a b : Nat} :
+    no_index (OfNat.ofNat a : Rat) = no_index (OfNat.ofNat b : Rat) ↔ a = b :=
+  natCast_inj
+
+@[simp, norm_cast] theorem intCast_ofNat {a : Nat} :
+    (no_index (OfNat.ofNat a : Int) : Rat) = OfNat.ofNat a :=
+  rfl
+
+@[simp, norm_cast] theorem natCast_ofNat {a : Nat} :
+    (no_index (OfNat.ofNat a : Nat) : Rat) = OfNat.ofNat a :=
+  rfl
+
+protected theorem intCast_zero : ((0 : Int) : Rat) = (0 : Rat) := rfl
+
+protected theorem intCast_one : ((1 : Int) : Rat) = (1 : Rat) := rfl
+
+@[simp, norm_cast] protected theorem intCast_add (a b : Int) :
+    ((a + b : Int) : Rat) = (a : Rat) + (b : Rat) := by
+  rw [add_def]
+  simp [normalize_eq]
+
+@[simp, norm_cast] theorem natCast_add (a b : Nat) :
+    ((a + b : Nat) : Rat) = (a : Rat) + (b : Rat) := by
+  simp [← intCast_natCast]
+
+@[simp, norm_cast] protected theorem intCast_neg (a : Int) : ((-a : Int) : Rat) = -(a : Rat) := rfl
+
+@[simp, norm_cast] protected theorem intCast_sub (a b : Int) :
+    ((a - b : Int) : Rat) = (a : Rat) - (b : Rat) := by
+  rw [sub_def]
+  simp [normalize_eq]
+
+@[simp, norm_cast] protected theorem intCast_mul (a b : Int) :
+    ((a * b : Int) : Rat) = (a : Rat) * (b : Rat) := by
+  rw [mul_def]
+  simp [normalize_eq]
+
+@[simp, norm_cast] theorem natCast_mul (a b : Nat) :
+    ((a * b : Nat) : Rat) = (a : Rat) * (b : Rat) := by
+  simp [← intCast_natCast]
+
+@[simp, norm_cast] theorem intCast_pow (a : Int) (n : Nat) :
+    ((a ^ n : Int) : Rat) = (a : Rat) ^ n := by
+  simp [pow_def]
+
+@[simp, norm_cast] theorem natCast_pow (a b : Nat) :
+    ((a ^ b : Nat) : Rat) = (a : Rat) ^ b := by
+  simp [← intCast_natCast]
+
+@[norm_cast]
+theorem intCast_le_intCast {a b : Int} :
+    (a : Rat) ≤ (b : Rat) ↔ a ≤ b := by
+  simp [Rat.le_iff]
+
+@[norm_cast]
+theorem intCast_lt_intCast {a b : Int} :
+    (a : Rat) < (b : Rat) ↔ a < b := by
+  simp [Rat.lt_iff]
+
+@[norm_cast]
+theorem natCast_le_natCast {a b : Nat} :
+    (a : Rat) ≤ (b : Rat) ↔ a ≤ b := by
+  simp [← intCast_natCast, intCast_le_intCast]
+
+@[norm_cast]
+theorem natCast_lt_natCast {a b : Nat} :
+    (a : Rat) < (b : Rat) ↔ a < b := by
+  simp [← intCast_natCast, intCast_lt_intCast]
+
+theorem intCast_nonneg {a : Int} :
+    0 ≤ (a : Rat) ↔ 0 ≤ a :=
+  Rat.intCast_le_intCast
+
+theorem natCast_nonneg {a : Nat} : 0 ≤ (a : Rat) :=
+  Rat.intCast_nonneg.mpr (Int.natCast_nonneg _)
+
+theorem intCast_pos {a : Int} : 0 < (a : Rat) ↔ 0 < a :=
+  Rat.intCast_lt_intCast
+
+theorem natCast_pos {a : Nat} : 0 < (a : Rat) ↔ 0 < a :=
+  intCast_pos.trans Int.natCast_pos
+
+theorem intCast_nonpos {a : Int} :
+    (a : Rat) ≤ 0 ↔ a ≤ 0 :=
+  Rat.intCast_le_intCast
+
+theorem intCast_neg_iff {a : Int} :
+    (a : Rat) < 0 ↔ a < 0 :=
+  Rat.intCast_lt_intCast

src/Init/Data/Vector/Algebra.lean

@@ -145,19 +145,19 @@ instance [AddCommGroup α] : AddCommGroup (Vector α n) where
   sub_eq_add_neg x y := sub_eq_add_neg AddCommGroup.sub_eq_add_neg x y
 
 instance [NatModule α] : NatModule (Vector α n) where
-  zero_nsmul x := zero_hmul NatModule.zero_nsmul x
+  zero_nsmul x := zero_smul NatModule.zero_nsmul x
   add_one_nsmul x xs := by
     ext i h
-    simpa [NatModule.one_nsmul] using congrArg (·[i]) (add_hmul NatModule.add_nsmul x 1 xs)
+    simpa [NatModule.one_nsmul] using congrArg (·[i]) (add_smul NatModule.add_nsmul x 1 xs)
 
 instance [IntModule α] : IntModule (Vector α n) where
-  zero_zsmul x := zero_hmul IntModule.zero_zsmul x
+  zero_zsmul x := zero_smul IntModule.zero_zsmul x
   one_zsmul x := by
     ext i h
     simp [IntModule.one_zsmul]
   add_zsmul x xs ys := by
     ext i h
-    simpa using congrArg (·[i]) (add_hmul IntModule.add_zsmul x xs ys)
+    simpa using congrArg (·[i]) (add_smul IntModule.add_zsmul x xs ys)
   zsmul_natCast_eq_nsmul n xs := by
     ext i h
     simp [IntModule.zsmul_natCast_eq_nsmul]

src/Init/Data/Vector/Zip.lean

@@ -207,11 +207,9 @@ theorem zip_map {f : α → γ} {g : β → δ} {as : Vector α n} {bs : Vector
   rcases bs with ⟨bs, h⟩
   simp [Array.zip_map]
 
-@[grind _=_]
 theorem zip_map_left {f : α → γ} {as : Vector α n} {bs : Vector β n} :
     zip (as.map f) bs = (zip as bs).map (Prod.map f id) := by rw [← zip_map, map_id]
 
-@[grind _=_]
 theorem zip_map_right {f : β → γ} {as : Vector α n} {bs : Vector β n} :
     zip as (bs.map f) = (zip as bs).map (Prod.map id f) := by rw [← zip_map, map_id]
 

src/Init/Dynamic.lean

@@ -14,7 +14,8 @@ public section
 open Lean
 
 -- Implementation detail of TypeName, since classes cannot be opaque
-private opaque TypeNameData (α : Type u) : NonemptyType.{0} :=
+-- TODO: should be private; #10098
+opaque TypeNameData (α : Type u) : NonemptyType.{0} :=
   ⟨Name, inferInstance⟩
 
 /--

src/Init/Grind/AC.lean

@@ -15,19 +15,22 @@ public import Init.Data.Bool
 namespace Lean.Grind.AC
 abbrev Var := Nat
 
-structure Context (α : Type u) where
-  vars    : RArray α
+structure Context (α : Sort u) where
+  vars    : RArray (PLift α)
   op      : α → α → α
 
 inductive Expr where
-  | var (x : Nat)
+  | var (x : Var)
   | op (lhs rhs : Expr)
   deriving Inhabited, Repr, BEq
 
-noncomputable def Expr.denote {α} (ctx : Context α) (e : Expr) : α :=
-  Expr.rec (fun x => ctx.vars.get x) (fun _ _ ih₁ ih₂ => ctx.op ih₁ ih₂) e
+noncomputable def Var.denote {α : Sort u} (ctx : Context α) (x : Var) : α :=
+  PLift.rec (fun x => x) (ctx.vars.get x)
 
-theorem Expr.denote_var {α} (ctx : Context α) (x : Var) : (Expr.var x).denote ctx = ctx.vars.get x := rfl
+noncomputable def Expr.denote {α} (ctx : Context α) (e : Expr) : α :=
+  Expr.rec (fun x => x.denote ctx) (fun _ _ ih₁ ih₂ => ctx.op ih₁ ih₂) e
+
+theorem Expr.denote_var {α} (ctx : Context α) (x : Var) : (Expr.var x).denote ctx = x.denote ctx := rfl
 theorem Expr.denote_op {α} (ctx : Context α) (a b : Expr) : (Expr.op a b).denote ctx = ctx.op (a.denote ctx) (b.denote ctx) := rfl
 
 attribute [local simp] Expr.denote_var Expr.denote_op
@@ -59,10 +62,10 @@ instance : LawfulBEq Seq where
   rfl := by intro a; induction a <;> simp! [BEq.beq]; assumption
 
 noncomputable def Seq.denote {α} (ctx : Context α) (s : Seq) : α :=
-  Seq.rec (fun x => ctx.vars.get x) (fun x _ ih => ctx.op (ctx.vars.get x) ih) s
+  Seq.rec (fun x => x.denote ctx) (fun x _ ih => ctx.op (x.denote ctx) ih) s
 
-theorem Seq.denote_var {α} (ctx : Context α) (x : Var) : (Seq.var x).denote ctx = ctx.vars.get x := rfl
-theorem Seq.denote_op {α} (ctx : Context α) (x : Var) (s : Seq) : (Seq.cons x s).denote ctx = ctx.op (ctx.vars.get x) (s.denote ctx) := rfl
+theorem Seq.denote_var {α} (ctx : Context α) (x : Var) : (Seq.var x).denote ctx = x.denote ctx := rfl
+theorem Seq.denote_op {α} (ctx : Context α) (x : Var) (s : Seq) : (Seq.cons x s).denote ctx = ctx.op (x.denote ctx) (s.denote ctx) := rfl
 
 attribute [local simp] Seq.denote_var Seq.denote_op
 
@@ -152,7 +155,7 @@ theorem Seq.erase0_k_eq_erase0 (s : Seq) : s.erase0_k = s.erase0 := by
 
 attribute [local simp] Seq.erase0_k_eq_erase0
 
-theorem Seq.denote_erase0 {α} (ctx : Context α) {inst : Std.LawfulIdentity ctx.op (ctx.vars.get 0)} (s : Seq)
+theorem Seq.denote_erase0 {α} (ctx : Context α) {inst : Std.LawfulIdentity ctx.op (Var.denote ctx 0)} (s : Seq)
     : s.erase0.denote ctx = s.denote ctx := by
   fun_induction erase0 s <;> simp_all +zetaDelta
   next => rw [Std.LawfulLeftIdentity.left_id (self := inst.toLawfulLeftIdentity)]
@@ -179,12 +182,12 @@ theorem Seq.insert_k_eq_insert (x : Var) (s : Seq) : insert_k x s = insert x s :
 attribute [local simp] Seq.insert_k_eq_insert
 
 theorem Seq.denote_insert {α} (ctx : Context α) {inst₁ : Std.Associative ctx.op} {inst₂ : Std.Commutative ctx.op} (x : Var) (s : Seq)
-    : (s.insert x).denote ctx = ctx.op (ctx.vars.get x) (s.denote ctx) := by
+    : (s.insert x).denote ctx = ctx.op (x.denote ctx) (s.denote ctx) := by
   fun_induction insert x s <;> simp
   next => rw [Std.Commutative.comm (self := inst₂)]
   next y s h ih =>
     simp [ih, ← Std.Associative.assoc (self := inst₁)]
-    rw [Std.Commutative.comm (self := inst₂) (ctx.vars.get x)]
+    rw [Std.Commutative.comm (self := inst₂) (x.denote ctx)]
 
 attribute [local simp] Seq.denote_insert
 
@@ -208,7 +211,7 @@ theorem Seq.denote_sort' {α} (ctx : Context α) {inst₁ : Std.Associative ctx.
   fun_induction sort' s acc <;> simp
   next x s ih =>
     simp [ih, ← Std.Associative.assoc (self := inst₁)]
-    rw [Std.Commutative.comm (self := inst₂) (ctx.vars.get x) (s.denote ctx)]
+    rw [Std.Commutative.comm (self := inst₂) (x.denote ctx) (s.denote ctx)]
 
 attribute [local simp] Seq.denote_sort'
 
@@ -267,17 +270,11 @@ theorem Seq.eraseDup_k_eq_eraseDup (s : Seq) : s.eraseDup_k = s.eraseDup := by
 
 attribute [local simp] Seq.eraseDup_k_eq_eraseDup
 
--- theorem Seq.denote_eraseDup {α} (ctx : Context α) {inst₁ : Std.Associative ctx.op} {inst₂ : Std.IdempotentOp ctx.op} (s : Seq)
---    : s.eraseDup.denote ctx = s.denote ctx := by
---   fun_induction eraseDup s -- FAILED
-
 theorem Seq.denote_eraseDup {α} (ctx : Context α) {inst₁ : Std.Associative ctx.op} {inst₂ : Std.IdempotentOp ctx.op} (s : Seq)
     : s.eraseDup.denote ctx = s.denote ctx := by
-  induction s <;> simp [eraseDup] <;> split <;> split
-  next ih _ _ h₁ h₂ => simp [← ih, h₁, h₂, Std.IdempotentOp.idempotent]
-  next ih _ _ h₁ _ => simp [← ih, h₁]
-  next ih _ _ _ h₁ h₂ => simp [← ih, h₁, h₂, ← Std.Associative.assoc (self := inst₁), Std.IdempotentOp.idempotent]
-  next ih _ _ _ h₁ _ => simp [← ih, h₁]
+  fun_induction eraseDup s <;> simp_all +zetaDelta
+  next ih => simp [← ih, Std.IdempotentOp.idempotent]
+  next ih => simp [← ih, ← Std.Associative.assoc (self := inst₁), Std.IdempotentOp.idempotent]
 
 attribute [local simp] Seq.denote_eraseDup
 
@@ -348,7 +345,7 @@ theorem superpose_prefix_suffix {α} (ctx : Context α) {inst₁ : Std.Associati
   simp [superpose_prefix_suffix_cert]; intro _ _ _ _; subst lhs₁ lhs₂ lhs rhs; simp
   intro h₁ h₂; simp [← h₁, ← h₂, Std.Associative.assoc (self := inst₁)]
 
-def Seq.combineFuel (fuel : Nat) (s₁ s₂ : Seq) : Seq :=
+def Seq.unionFuel (fuel : Nat) (s₁ s₂ : Seq) : Seq :=
   match fuel with
   | 0 => s₁.concat s₂
   | fuel + 1 =>
@@ -358,12 +355,12 @@ def Seq.combineFuel (fuel : Nat) (s₁ s₂ : Seq) : Seq :=
     | .cons .., .var x₂ => s₁.insert x₂
     | .cons x₁ s₁, .cons x₂ s₂ =>
       if Nat.blt x₁ x₂ then
-        .cons x₁ (combineFuel fuel s₁ (.cons x₂ s₂))
+        .cons x₁ (unionFuel fuel s₁ (.cons x₂ s₂))
       else
-        .cons x₂ (combineFuel fuel (.cons x₁ s₁) s₂)
+        .cons x₂ (unionFuel fuel (.cons x₁ s₁) s₂)
 
--- Kernel version for `combineFuel`
-noncomputable def Seq.combineFuel_k (fuel : Nat) : Seq → Seq → Seq :=
+-- Kernel version for `unionFuel`
+noncomputable def Seq.unionFuel_k (fuel : Nat) : Seq → Seq → Seq :=
   Nat.rec concat
     (fun _ ih s₁ s₂ => Seq.rec
       (fun x₁ => Seq.rec (fun x₂ => Bool.rec (.cons x₂ (.var x₁)) (.cons x₁ (.var x₂)) (Nat.blt x₁ x₂)) (fun _ _ _ => s₂.insert x₁) s₂)
@@ -371,69 +368,69 @@ noncomputable def Seq.combineFuel_k (fuel : Nat) : Seq → Seq → Seq :=
         (fun x₂ s₂' _ => Bool.rec (.cons x₂ (ih s₁ s₂')) (.cons x₁ (ih s₁' s₂)) (Nat.blt x₁ x₂)) s₂)
       s₁) fuel
 
-theorem Seq.combineFuel_k_eq_combineFuel (fuel : Nat) (s₁ s₂ : Seq) : combineFuel_k fuel s₁ s₂ = combineFuel fuel s₁ s₂ := by
-  fun_induction combineFuel <;> simp [combineFuel_k, *]
+theorem Seq.unionFuel_k_eq_unionFuel (fuel : Nat) (s₁ s₂ : Seq) : unionFuel_k fuel s₁ s₂ = unionFuel fuel s₁ s₂ := by
+  fun_induction unionFuel <;> simp [unionFuel_k, *]
   next => rfl
   next ih => rw [← ih]; rfl
   next ih => rw [← ih]; rfl
 
-attribute [local simp] Seq.combineFuel_k_eq_combineFuel
+attribute [local simp] Seq.unionFuel_k_eq_unionFuel
 
-theorem Seq.denote_combineFuel {α} (ctx : Context α) {inst₁ : Std.Associative ctx.op} {inst₂ : Std.Commutative ctx.op} (fuel : Nat) (s₁ s₂ : Seq)
-    : (s₁.combineFuel fuel s₂).denote ctx = ctx.op (s₁.denote ctx) (s₂.denote ctx) := by
-  fun_induction combineFuel <;> simp
+theorem Seq.denote_unionFuel {α} (ctx : Context α) {inst₁ : Std.Associative ctx.op} {inst₂ : Std.Commutative ctx.op} (fuel : Nat) (s₁ s₂ : Seq)
+    : (s₁.unionFuel fuel s₂).denote ctx = ctx.op (s₁.denote ctx) (s₂.denote ctx) := by
+  fun_induction unionFuel <;> simp
   next => simp [Std.Commutative.comm (self := inst₂)]
   next => simp [Std.Commutative.comm (self := inst₂)]
   next ih => simp [ih, Std.Associative.assoc (self := inst₁)]
   next x₁ s₁ x₂ s₂ h ih =>
     simp [ih]
-    rw [← Std.Associative.assoc (self := inst₁), ← Std.Associative.assoc (self := inst₁), Std.Commutative.comm (self := inst₂) (ctx.vars.get x₂)]
-    rw [Std.Associative.assoc (self := inst₁), Std.Associative.assoc (self := inst₁), Std.Associative.assoc (self := inst₁) (ctx.vars.get x₁)]
-    apply congrArg (ctx.op (ctx.vars.get x₁))
+    rw [← Std.Associative.assoc (self := inst₁), ← Std.Associative.assoc (self := inst₁), Std.Commutative.comm (self := inst₂) (x₂.denote ctx)]
+    rw [Std.Associative.assoc (self := inst₁), Std.Associative.assoc (self := inst₁), Std.Associative.assoc (self := inst₁) (x₁.denote ctx)]
+    apply congrArg (ctx.op (x₁.denote ctx))
     rw [← Std.Associative.assoc (self := inst₁), ← Std.Associative.assoc (self := inst₁) (s₁.denote ctx)]
-    rw [Std.Commutative.comm (self := inst₂) (ctx.vars.get x₂)]
+    rw [Std.Commutative.comm (self := inst₂) (x₂.denote ctx)]
 
-attribute [local simp] Seq.denote_combineFuel
+attribute [local simp] Seq.denote_unionFuel
 
 def hugeFuel := 1000000
 
-def Seq.combine (s₁ s₂ : Seq) : Seq :=
-  combineFuel hugeFuel s₁ s₂
+def Seq.union (s₁ s₂ : Seq) : Seq :=
+  unionFuel hugeFuel s₁ s₂
 
-noncomputable def Seq.combine_k (s₁ s₂ : Seq) : Seq :=
-  combineFuel_k hugeFuel s₁ s₂
+noncomputable def Seq.union_k (s₁ s₂ : Seq) : Seq :=
+  unionFuel_k hugeFuel s₁ s₂
 
-theorem Seq.combine_k_eq_combine (s₁ s₂ : Seq) : s₁.combine_k s₂ = s₁.combine s₂ := by
-  simp [combine, combine_k]
+theorem Seq.union_k_eq_union (s₁ s₂ : Seq) : s₁.union_k s₂ = s₁.union s₂ := by
+  simp [union, union_k]
 
-attribute [local simp] Seq.combine_k_eq_combine
+attribute [local simp] Seq.union_k_eq_union
 
-theorem Seq.denote_combine {α} (ctx : Context α) {inst₁ : Std.Associative ctx.op} {inst₂ : Std.Commutative ctx.op} (s₁ s₂ : Seq)
-    : (s₁.combine s₂).denote ctx = ctx.op (s₁.denote ctx) (s₂.denote ctx) := by
-  simp [combine]
+theorem Seq.denote_union {α} (ctx : Context α) {inst₁ : Std.Associative ctx.op} {inst₂ : Std.Commutative ctx.op} (s₁ s₂ : Seq)
+    : (s₁.union s₂).denote ctx = ctx.op (s₁.denote ctx) (s₂.denote ctx) := by
+  simp [union]
 
-attribute [local simp] Seq.denote_combine
+attribute [local simp] Seq.denote_union
 
 noncomputable def simp_ac_cert (c lhs rhs s s' : Seq) : Bool :=
-  s.beq' (c.combine_k lhs) |>.and'
-  (s'.beq' (c.combine_k rhs))
+  s.beq' (c.union_k lhs) |>.and'
+  (s'.beq' (c.union_k rhs))
 
 /--
-Given `lhs = rhs`, and a term `s := combine a lhs`, rewrite it to `s' := combine a rhs`
+Given `lhs = rhs`, and a term `s := union a lhs`, rewrite it to `s' := union a rhs`
 -/
 theorem simp_ac {α} (ctx : Context α) {inst₁ : Std.Associative ctx.op} {inst₂ : Std.Commutative ctx.op} (c lhs rhs s s' : Seq)
     : simp_ac_cert c lhs rhs s s' → lhs.denote ctx = rhs.denote ctx → s.denote ctx = s'.denote ctx := by
   simp [simp_ac_cert]; intro _ _; subst s s'; simp; intro h; rw [h]
 
 noncomputable def superpose_ac_cert (a b c lhs₁ rhs₁ lhs₂ rhs₂ lhs rhs : Seq) : Bool :=
-  lhs₁.beq' (c.combine_k a) |>.and'
-  (lhs₂.beq' (c.combine_k b)) |>.and'
-  (lhs.beq' (b.combine_k rhs₁)) |>.and'
-  (rhs.beq' (a.combine_k rhs₂))
+  lhs₁.beq' (c.union_k a) |>.and'
+  (lhs₂.beq' (c.union_k b)) |>.and'
+  (lhs.beq' (b.union_k rhs₁)) |>.and'
+  (rhs.beq' (a.union_k rhs₂))
 
 /--
-Given `lhs₁ = rhs₁` and `lhs₂ = rhs₂` where `lhs₁ := combine c a` and `lhs₂ := combine c b`,
-`lhs = rhs` where `lhs := combine b rhs₁` and `rhs := combine a rhs₂`
+Given `lhs₁ = rhs₁` and `lhs₂ = rhs₂` where `lhs₁ := union c a` and `lhs₂ := union c b`,
+`lhs = rhs` where `lhs := union b rhs₁` and `rhs := union a rhs₂`
 -/
 theorem superpose_ac {α} (ctx : Context α) {inst₁ : Std.Associative ctx.op} {inst₂ : Std.Commutative ctx.op}  (a b c lhs₁ rhs₁ lhs₂ rhs₂ lhs rhs : Seq)
     : superpose_ac_cert a b c lhs₁ rhs₁ lhs₂ rhs₂ lhs rhs → lhs₁.denote ctx = rhs₁.denote ctx → lhs₂.denote ctx = rhs₂.denote ctx
@@ -446,54 +443,72 @@ theorem superpose_ac {α} (ctx : Context α) {inst₁ : Std.Associative ctx.op}
   apply congrArg (ctx.op (c.denote ctx))
   rw [Std.Commutative.comm (self := inst₂) (b.denote ctx)]
 
-noncomputable def norm_a_cert (lhs rhs : Expr) (lhs' rhs' : Seq) : Bool :=
+noncomputable def eq_norm_a_cert (lhs rhs : Expr) (lhs' rhs' : Seq) : Bool :=
   lhs.toSeq.beq' lhs' |>.and' (rhs.toSeq.beq' rhs')
 
-theorem norm_a {α} (ctx : Context α) {_ : Std.Associative ctx.op} (lhs rhs : Expr) (lhs' rhs' : Seq)
-    : norm_a_cert lhs rhs lhs' rhs' → lhs.denote ctx = rhs.denote ctx → lhs'.denote ctx = rhs'.denote ctx := by
-  simp [norm_a_cert]; intro _ _; subst lhs' rhs'; simp
+theorem eq_norm_a {α} (ctx : Context α) {_ : Std.Associative ctx.op} (lhs rhs : Expr) (lhs' rhs' : Seq)
+    : eq_norm_a_cert lhs rhs lhs' rhs' → lhs.denote ctx = rhs.denote ctx → lhs'.denote ctx = rhs'.denote ctx := by
+  simp [eq_norm_a_cert]; intro _ _; subst lhs' rhs'; simp
 
-noncomputable def norm_ac_cert (lhs rhs : Expr) (lhs' rhs' : Seq) : Bool :=
+noncomputable def eq_norm_ac_cert (lhs rhs : Expr) (lhs' rhs' : Seq) : Bool :=
   lhs.toSeq.sort.beq' lhs' |>.and' (rhs.toSeq.sort.beq' rhs')
 
-theorem norm_ac {α} (ctx : Context α) {_ : Std.Associative ctx.op} {_ : Std.Commutative ctx.op} (lhs rhs : Expr) (lhs' rhs' : Seq)
-    : norm_ac_cert lhs rhs lhs' rhs' → lhs.denote ctx = rhs.denote ctx → lhs'.denote ctx = rhs'.denote ctx := by
-  simp [norm_ac_cert]; intro _ _; subst lhs' rhs'; simp
+theorem eq_norm_ac {α} (ctx : Context α) {_ : Std.Associative ctx.op} {_ : Std.Commutative ctx.op} (lhs rhs : Expr) (lhs' rhs' : Seq)
+    : eq_norm_ac_cert lhs rhs lhs' rhs' → lhs.denote ctx = rhs.denote ctx → lhs'.denote ctx = rhs'.denote ctx := by
+  simp [eq_norm_ac_cert]; intro _ _; subst lhs' rhs'; simp
 
-noncomputable def norm_aci_cert (lhs rhs : Expr) (lhs' rhs' : Seq) : Bool :=
-  lhs.toSeq.erase0.sort.beq' lhs' |>.and' (rhs.toSeq.erase0.sort.beq' rhs')
-
-theorem norm_aci {α} (ctx : Context α) {_ : Std.Associative ctx.op} {_ : Std.Commutative ctx.op} {_ : Std.LawfulIdentity ctx.op (ctx.vars.get 0)}
-      (lhs rhs : Expr) (lhs' rhs' : Seq) : norm_aci_cert lhs rhs lhs' rhs' → lhs.denote ctx = rhs.denote ctx → lhs'.denote ctx = rhs'.denote ctx := by
-  simp [norm_aci_cert]; intro _ _; subst lhs' rhs'; simp
-
-noncomputable def norm_ai_cert (lhs rhs : Expr) (lhs' rhs' : Seq) : Bool :=
+noncomputable def eq_norm_ai_cert (lhs rhs : Expr) (lhs' rhs' : Seq) : Bool :=
   lhs.toSeq.erase0.beq' lhs' |>.and' (rhs.toSeq.erase0.beq' rhs')
 
-theorem norm_ai {α} (ctx : Context α) {_ : Std.Associative ctx.op} {_ : Std.LawfulIdentity ctx.op (ctx.vars.get 0)}
-      (lhs rhs : Expr) (lhs' rhs' : Seq) : norm_ai_cert lhs rhs lhs' rhs' → lhs.denote ctx = rhs.denote ctx → lhs'.denote ctx = rhs'.denote ctx := by
-  simp [norm_ai_cert]; intro _ _; subst lhs' rhs'; simp
+theorem eq_norm_ai {α} (ctx : Context α) {_ : Std.Associative ctx.op} {_ : Std.LawfulIdentity ctx.op (Var.denote ctx 0)}
+      (lhs rhs : Expr) (lhs' rhs' : Seq) : eq_norm_ai_cert lhs rhs lhs' rhs' → lhs.denote ctx = rhs.denote ctx → lhs'.denote ctx = rhs'.denote ctx := by
+  simp [eq_norm_ai_cert]; intro _ _; subst lhs' rhs'; simp
 
-noncomputable def norm_acip_cert (lhs rhs : Expr) (lhs' rhs' : Seq) : Bool :=
-  lhs.toSeq.erase0.sort.eraseDup.beq' lhs' |>.and' (rhs.toSeq.erase0.sort.eraseDup.beq' rhs')
+noncomputable def eq_norm_aci_cert (lhs rhs : Expr) (lhs' rhs' : Seq) : Bool :=
+  lhs.toSeq.erase0.sort.beq' lhs' |>.and' (rhs.toSeq.erase0.sort.beq' rhs')
 
-theorem norm_acip {α} (ctx : Context α) {_ : Std.Associative ctx.op} {_ : Std.Commutative ctx.op}
-      {_ : Std.LawfulIdentity ctx.op (ctx.vars.get 0)} {_ : Std.IdempotentOp ctx.op}
-      (lhs rhs : Expr) (lhs' rhs' : Seq) : norm_acip_cert lhs rhs lhs' rhs' → lhs.denote ctx = rhs.denote ctx → lhs'.denote ctx = rhs'.denote ctx := by
-  simp [norm_acip_cert]; intro _ _; subst lhs' rhs'; simp
+theorem eq_norm_aci {α} (ctx : Context α) {_ : Std.Associative ctx.op} {_ : Std.Commutative ctx.op} {_ : Std.LawfulIdentity ctx.op (Var.denote ctx 0)}
+      (lhs rhs : Expr) (lhs' rhs' : Seq) : eq_norm_aci_cert lhs rhs lhs' rhs' → lhs.denote ctx = rhs.denote ctx → lhs'.denote ctx = rhs'.denote ctx := by
+  simp [eq_norm_aci_cert]; intro _ _; subst lhs' rhs'; simp
 
-noncomputable def norm_acp_cert (lhs rhs : Expr) (lhs' rhs' : Seq) : Bool :=
-  lhs.toSeq.sort.eraseDup.beq' lhs' |>.and' (rhs.toSeq.sort.eraseDup.beq' rhs')
-
-theorem norm_acp {α} (ctx : Context α) {_ : Std.Associative ctx.op} {_ : Std.Commutative ctx.op} {_ : Std.IdempotentOp ctx.op}
-      (lhs rhs : Expr) (lhs' rhs' : Seq) : norm_acp_cert lhs rhs lhs' rhs' → lhs.denote ctx = rhs.denote ctx → lhs'.denote ctx = rhs'.denote ctx := by
-  simp [norm_acp_cert]; intro _ _; subst lhs' rhs'; simp
-
-noncomputable def norm_dup_cert (lhs rhs lhs' rhs' : Seq) : Bool :=
+noncomputable def eq_erase_dup_cert (lhs rhs lhs' rhs' : Seq) : Bool :=
   lhs.eraseDup.beq' lhs' |>.and' (rhs.eraseDup.beq' rhs')
 
-theorem norm_dup (ctx : Context α) {_ : Std.Associative ctx.op} {_ : Std.IdempotentOp ctx.op}
-      (lhs rhs lhs' rhs' : Seq) : norm_dup_cert lhs rhs lhs' rhs' → lhs.denote ctx = rhs.denote ctx → lhs'.denote ctx = rhs'.denote ctx := by
-  simp [norm_dup_cert]; intro _ _; subst lhs' rhs'; simp
+theorem eq_erase_dup {α} (ctx : Context α) {_ : Std.Associative ctx.op} {_ : Std.IdempotentOp ctx.op}
+      (lhs rhs lhs' rhs' : Seq) : eq_erase_dup_cert lhs rhs lhs' rhs' → lhs.denote ctx = rhs.denote ctx → lhs'.denote ctx = rhs'.denote ctx := by
+  simp [eq_erase_dup_cert]; intro _ _; subst lhs' rhs'; simp
+
+noncomputable def eq_erase0_cert (lhs rhs lhs' rhs' : Seq) : Bool :=
+  lhs.erase0.beq' lhs' |>.and' (rhs.erase0.beq' rhs')
+
+theorem eq_erase0 {α} (ctx : Context α) {_ : Std.Associative ctx.op} {_ : Std.LawfulIdentity ctx.op (Var.denote ctx 0)}
+      (lhs rhs lhs' rhs' : Seq) : eq_erase0_cert lhs rhs lhs' rhs' → lhs.denote ctx = rhs.denote ctx → lhs'.denote ctx = rhs'.denote ctx := by
+  simp [eq_erase0_cert]; intro _ _; subst lhs' rhs'; simp
+
+theorem diseq_norm_a {α} (ctx : Context α) {_ : Std.Associative ctx.op} (lhs rhs : Expr) (lhs' rhs' : Seq)
+    : eq_norm_a_cert lhs rhs lhs' rhs' → lhs.denote ctx ≠ rhs.denote ctx → lhs'.denote ctx ≠ rhs'.denote ctx := by
+  simp [eq_norm_a_cert]; intro _ _; subst lhs' rhs'; simp
+
+theorem diseq_norm_ac {α} (ctx : Context α) {_ : Std.Associative ctx.op} {_ : Std.Commutative ctx.op} (lhs rhs : Expr) (lhs' rhs' : Seq)
+    : eq_norm_ac_cert lhs rhs lhs' rhs' → lhs.denote ctx ≠ rhs.denote ctx → lhs'.denote ctx ≠ rhs'.denote ctx := by
+  simp [eq_norm_ac_cert]; intro _ _; subst lhs' rhs'; simp
+
+theorem diseq_norm_ai {α} (ctx : Context α) {_ : Std.Associative ctx.op} {_ : Std.LawfulIdentity ctx.op (Var.denote ctx 0)}
+      (lhs rhs : Expr) (lhs' rhs' : Seq) : eq_norm_ai_cert lhs rhs lhs' rhs' → lhs.denote ctx ≠ rhs.denote ctx → lhs'.denote ctx ≠ rhs'.denote ctx := by
+  simp [eq_norm_ai_cert]; intro _ _; subst lhs' rhs'; simp
+
+theorem diseq_norm_aci {α} (ctx : Context α) {_ : Std.Associative ctx.op} {_ : Std.Commutative ctx.op} {_ : Std.LawfulIdentity ctx.op (Var.denote ctx 0)}
+      (lhs rhs : Expr) (lhs' rhs' : Seq) : eq_norm_aci_cert lhs rhs lhs' rhs' → lhs.denote ctx ≠ rhs.denote ctx → lhs'.denote ctx ≠ rhs'.denote ctx := by
+  simp [eq_norm_aci_cert]; intro _ _; subst lhs' rhs'; simp
+
+theorem diseq_erase_dup {α} (ctx : Context α) {_ : Std.Associative ctx.op} {_ : Std.IdempotentOp ctx.op}
+      (lhs rhs lhs' rhs' : Seq) : eq_erase_dup_cert lhs rhs lhs' rhs' → lhs.denote ctx ≠ rhs.denote ctx → lhs'.denote ctx ≠ rhs'.denote ctx := by
+  simp [eq_erase_dup_cert]; intro _ _; subst lhs' rhs'; simp
+
+noncomputable def diseq_unsat_cert (lhs rhs : Seq) : Bool :=
+  lhs.beq' rhs
+
+theorem diseq_unsat {α} (ctx : Context α) (lhs rhs : Seq) : diseq_unsat_cert lhs rhs → lhs.denote ctx ≠ rhs.denote ctx → False := by
+  simp [diseq_unsat_cert]; intro; subst lhs; simp
 
 end Lean.Grind.AC

src/Init/Grind/Attr.lean

@@ -69,19 +69,126 @@ syntax (name := resetGrindAttrs) "reset_grind_attrs%" : command
 
 namespace Attr
 syntax grindGen    := ppSpace &"gen"
+/--
+The `=` modifier instructs `grind` to check that the conclusion of the theorem is an equality,
+and then uses the left-hand side of the equality as a pattern. This may fail if not all of the arguments appear
+in the left-hand side.
+-/
 syntax grindEq     := "=" (grindGen)?
-syntax grindEqBoth := atomic("_" "=" "_") (grindGen)?
+/--
+The `=_` modifier instructs `grind` to check that the conclusion of the theorem is an equality,
+and then uses the right-hand side of the equality as a pattern. This may fail if not all of the arguments appear
+in the right-hand side.
+-/
 syntax grindEqRhs  := atomic("=" "_") (grindGen)?
+/--
+The `_=_` modifier acts like a macro which expands to `=` and `=_`.  It adds two patterns,
+allowing the equality theorem to trigger in either direction.
+-/
+syntax grindEqBoth := atomic("_" "=" "_") (grindGen)?
+/--
+The `←=` modifier is unlike the other `grind` modifiers, and it used specifically for
+backwards reasoning on equality. When a theorem's conclusion is an equality proposition and it
+is annotated with `@[grind ←=]`, grind `will` instantiate it whenever the corresponding disequality
+is assumed—this is a consequence of the fact that grind performs all proofs by contradiction.
+Ordinarily, the grind attribute does not consider the `=` symbol when generating patterns.
+-/
 syntax grindEqBwd  := patternIgnore(atomic("←" "=") <|> atomic("<-" "="))
+/--
+The `→` modifier instructs `grind` to select a multi-pattern from the conclusion of theorem.
+In other words, `grind` will use the theorem for backwards reasoning.
+This may fail if not all of the arguments to the theorem appear in the conclusion.
+-/
 syntax grindBwd    := patternIgnore("←" <|> "<-") (grindGen)?
+/--
+The `→` modifier instructs `grind` to select a multi-pattern from the hypotheses of the theorem.
+In other words, `grind` will use the theorem for forwards reasoning.
+To generate a pattern, it traverses the hypotheses of the theorem from left to right.
+Each time it encounters a minimal indexable subexpression which covers an argument which was not
+previously covered, it adds that subexpression as a pattern, until all arguments have been covered.
+-/
 syntax grindFwd    := patternIgnore("→" <|> "->")
+/--
+The `⇐` modifier instructs `grind` to select a multi-pattern by traversing the conclusion, and then
+all the hypotheses from right to left.
+Each time it encounters a minimal indexable subexpression which covers an argument which was not
+previously covered, it adds that subexpression as a pattern, until all arguments have been covered.
+-/
 syntax grindRL     := patternIgnore("⇐" <|> "<=")
+/--
+The `⇒` modifier instructs `grind` to select a multi-pattern by traversing all the hypotheses from
+left to right, followed by the conclusion.
+Each time it encounters a minimal indexable subexpression which covers an argument which was not
+previously covered, it adds that subexpression as a pattern, until all arguments have been covered.
+-/
 syntax grindLR     := patternIgnore("⇒" <|> "=>")
+/--
+The `usr` modifier indicates that this theorem was applied using a
+**user-defined instantiation pattern**. Such patterns are declared with
+the `grind_pattern` command, which lets you specify how `grind` should
+match and use particular theorems.
+
+Example:
+- `grind [usr myThm]` means `grind` is using `myThm`, but with the
+  the custom pattern you defined with `grind_pattern`.
+-/
 syntax grindUsr    := &"usr"
+/--
+The `cases` modifier marks inductively-defined predicates as suitable for case splitting.
+-/
 syntax grindCases  := &"cases"
+/--
+The `cases eager` modifier marks inductively-defined predicates as suitable for case splitting,
+and instructs `grind` to perform it eagerly while preprocessing hypotheses.
+-/
 syntax grindCasesEager := atomic(&"cases" &"eager")
+/--
+The `intro` modifier instructs `grind` to use the constructors (introduction rules)
+of an inductive predicate as E-matching theorems.Example:
+```
+inductive Even : Nat → Prop where
+| zero : Even 0
+| add2 : Even x → Even (x + 2)
+
+attribute [grind intro] Even
+example (h : Even x) : Even (x + 6) := by grind
+example : Even 0 := by grind
+```
+Here `attribute [grind intro] Even` acts like a macro that expands to
+`attribute [grind] Even.zero` and `attribute [grind] Even.add2`.
+This is especially convenient for inductive predicates with many constructors.
+-/
 syntax grindIntro  := &"intro"
+/--
+The `ext` modifier marks extensionality theorems for use by `grind`.
+For example, the standard library marks `funext` with this attribute.
+
+Whenever `grind` encounters a disequality `a ≠ b`, it attempts to apply any
+available extensionality theorems whose matches the type of `a` and `b`.
+-/
 syntax grindExt    := &"ext"
+/--
+`symbol <prio>` sets the priority of a constant for `grind`’s pattern-selection
+procedure. `grind` prefers patterns that contain higher-priority symbols.
+Example:
+```
+opaque p : Nat → Nat → Prop
+opaque q : Nat → Nat → Prop
+opaque r : Nat → Nat → Prop
+
+attribute [grind symbol low] p
+attribute [grind symbol high] q
+
+axiom bar {x y} : p x y → q x x → r x y → r y x
+attribute [grind →] bar
+```
+Here `p` is low priority, `q` is high priority, and `r` is default. `grind` first
+tries to find a multi-pattern covering `x` and `y` using only high-priority
+symbols while scanning hypotheses left to right. This fails because `q x x` does
+not cover `y`. It then allows both high and default symbols and succeeds with
+the multi-pattern `q x x, r x y`. The term `p x y` is ignored due to `p`’s low
+priority. Symbols with priority `0` are never used in patterns.
+-/
 syntax grindSym    := &"symbol" ppSpace prio
 syntax grindMod :=
     grindEqBoth <|> grindEqRhs <|> grindEq <|> grindEqBwd <|> grindBwd

src/Init/Grind/Module/Basic.lean

@@ -55,11 +55,11 @@ Use `IntModule` if the type has negation.
 -/
 class NatModule (M : Type u) extends AddCommMonoid M where
   /-- Scalar multiplication by natural numbers. -/
-  [nsmul : HMul Nat M M]
+  [nsmul : SMul Nat M]
   /-- Scalar multiplication by zero is zero. -/
-  zero_nsmul : ∀ a : M, 0 * a = 0
+  zero_nsmul : ∀ a : M, 0 • a = 0
   /-- Scalar multiplication by a successor. -/
-  add_one_nsmul : ∀ n : Nat, ∀ a : M, (n + 1) * a = n * a + a
+  add_one_nsmul : ∀ n : Nat, ∀ a : M, (n + 1) • a = n • a + a
 
 attribute [instance 100] NatModule.toAddCommMonoid NatModule.nsmul
 
@@ -71,17 +71,17 @@ Equivalently, an additive commutative group.
 -/
 class IntModule (M : Type u) extends AddCommGroup M where
   /-- Scalar multiplication by natural numbers. -/
-  [nsmul : HMul Nat M M]
+  [nsmul : SMul Nat M]
   /-- Scalar multiplication by integers. -/
-  [zsmul : HMul Int M M]
+  [zsmul : SMul Int M]
   /-- Scalar multiplication by zero is zero. -/
-  zero_zsmul : ∀ a : M, (0 : Int) * a = 0
+  zero_zsmul : ∀ a : M, (0 : Int) • a = 0
   /-- Scalar multiplication by one is the identity. -/
-  one_zsmul : ∀ a : M, (1 : Int) * a = a
+  one_zsmul : ∀ a : M, (1 : Int) • a = a
   /-- Scalar multiplication is distributive over addition in the integers. -/
-  add_zsmul : ∀ n m : Int, ∀ a : M, (n + m) * a = n * a + m * a
+  add_zsmul : ∀ n m : Int, ∀ a : M, (n + m) • a = n • a + m • a
   /-- Scalar multiplication by natural numbers is consistent with scalar multiplication by integers. -/
-  zsmul_natCast_eq_nsmul : ∀ n : Nat, ∀ a : M, (n : Int) * a = n * a
+  zsmul_natCast_eq_nsmul : ∀ n : Nat, ∀ a : M, (n : Int) • a = n • a
 
 attribute [instance 100] IntModule.toAddCommGroup IntModule.zsmul
 
@@ -174,79 +174,73 @@ namespace NatModule
 
 variable {M : Type u} [NatModule M]
 
-theorem one_nsmul (a : M) : 1 * a = a := by
+theorem one_nsmul (a : M) : 1 • a = a := by
   rw [← Nat.zero_add 1, add_one_nsmul, zero_nsmul, AddCommMonoid.zero_add]
 
-theorem add_nsmul (n m : Nat) (a : M) : (n + m) * a = n * a + m * a := by
+theorem add_nsmul (n m : Nat) (a : M) : (n + m) • a = n • a + m • a := by
   induction m with
   | zero => rw [Nat.add_zero, zero_nsmul, AddCommMonoid.add_zero]
   | succ m ih => rw [add_one_nsmul, ← Nat.add_assoc, add_one_nsmul, ih, AddCommMonoid.add_assoc]
 
-theorem nsmul_zero (n : Nat) : n * (0 : M) = 0 := by
+theorem nsmul_zero (n : Nat) : n • (0 : M) = 0 := by
   induction n with
   | zero => rw [zero_nsmul]
   | succ n ih => rw [add_one_nsmul, ih, AddCommMonoid.zero_add]
 
-theorem nsmul_add (n : Nat) (a b : M) : n * (a + b) = n * a + n * b := by
+theorem nsmul_add (n : Nat) (a b : M) : n • (a + b) = n • a + n • b := by
   induction n with
   | zero => rw [zero_nsmul, zero_nsmul, zero_nsmul, AddCommMonoid.zero_add]
   | succ n ih => rw [add_one_nsmul, add_one_nsmul, add_one_nsmul, ih, AddCommMonoid.add_assoc,
-      AddCommMonoid.add_left_comm (n * b), AddCommMonoid.add_assoc]
+      AddCommMonoid.add_left_comm (n • b), AddCommMonoid.add_assoc]
 
-theorem mul_nsmul (n m : Nat) (a : M) : (n * m) * a = n * (m * a) := by
+theorem mul_nsmul (n m : Nat) (a : M) : (n * m) • a = n • (m • a) := by
   induction n with
   | zero => simp [zero_nsmul]
   | succ n ih =>
     rw [Nat.add_one_mul, add_nsmul, ih, add_nsmul, one_nsmul]
 
-instance (priority := 100) (M : Type u) [NatModule M] : SMul Nat M where
-  smul a x := a * x
-
 end NatModule
 
 namespace IntModule
 
 open NatModule AddCommGroup
 
-instance (priority := 100) (M : Type u) [IntModule M] : SMul Int M where
-  smul a x := a * x
-
 variable {M : Type u} [IntModule M]
 
-theorem neg_zsmul (n : Int) (a : M) : (-n) * a = - (n * a) := by
-  apply (add_left_inj (n * a)).mp
+theorem neg_zsmul (n : Int) (a : M) : (-n) • a = - (n • a) := by
+  apply (add_left_inj (n • a)).mp
   rw [← add_zsmul, Int.add_left_neg, zero_zsmul, neg_add_cancel]
 
-theorem zsmul_zero (n : Int) : n * (0 : M) = 0 := by
+theorem zsmul_zero (n : Int) : n • (0 : M) = 0 := by
   match n with
   | (n : Nat) => rw [zsmul_natCast_eq_nsmul, NatModule.nsmul_zero]
   | -(n + 1 : Nat) => rw [neg_zsmul, zsmul_natCast_eq_nsmul, NatModule.nsmul_zero, neg_zero]
 
-theorem zsmul_add (n : Int) (a b : M) : n * (a + b) = n * a + n * b := by
+theorem zsmul_add (n : Int) (a b : M) : n • (a + b) = n • a + n • b := by
   match n with
   | (n : Nat) => rw [zsmul_natCast_eq_nsmul, NatModule.nsmul_add, zsmul_natCast_eq_nsmul, zsmul_natCast_eq_nsmul]
   | -(n + 1 : Nat) => rw [neg_zsmul, zsmul_natCast_eq_nsmul, NatModule.nsmul_add,
       neg_zsmul, zsmul_natCast_eq_nsmul, neg_zsmul, zsmul_natCast_eq_nsmul, neg_add]
 
-theorem zsmul_neg (n : Int) (a : M) : n * (-a) = - (n * a) := by
-  apply (add_left_inj (n * a)).mp
+theorem zsmul_neg (n : Int) (a : M) : n • (-a) = - (n • a) := by
+  apply (add_left_inj (n • a)).mp
   rw [← zsmul_add, neg_add_cancel, neg_add_cancel, zsmul_zero]
 
-theorem zsmul_sub (k : Int) (a b : M) : k * (a - b) = k * a - k * b := by
+theorem zsmul_sub (k : Int) (a b : M) : k • (a - b) = k • a - k • b := by
   rw [sub_eq_add_neg, zsmul_add, zsmul_neg, ← sub_eq_add_neg]
 
-theorem sub_zsmul (k₁ k₂ : Int) (a : M) : (k₁ - k₂) * a = k₁ * a - k₂ * a := by
+theorem sub_zsmul (k₁ k₂ : Int) (a : M) : (k₁ - k₂) • a = k₁ • a - k₂ • a := by
   rw [Int.sub_eq_add_neg, add_zsmul, neg_zsmul, ← sub_eq_add_neg]
 
 private theorem mul_zsmul_aux (n : Nat) (m : Int) (a : M) :
-    ((n : Int) * m) * a = (n : Int) * (m * a) := by
+    ((n : Int) * m) • a = (n : Int) • (m • a) := by
   induction n with
   | zero => simp [zero_zsmul]
   | succ n ih =>
     rw [Int.natCast_add, Int.add_mul, add_zsmul, Int.natCast_one,
       Int.one_mul, add_zsmul, one_zsmul, ih]
 
-theorem mul_zsmul (n m : Int) (a : M) : (n * m) * a = n * (m * a) := by
+theorem mul_zsmul (n m : Int) (a : M) : (n * m) • a = n • (m • a) := by
   match n with
   | (n : Nat) => exact mul_zsmul_aux n m a
   | -(n + 1 : Nat) => rw [Int.neg_mul, neg_zsmul, mul_zsmul_aux, neg_zsmul]
@@ -264,7 +258,7 @@ and the theorem `eq_zero_of_mul_eq_zero`.)
 -/
 class NoNatZeroDivisors (α : Type u) [NatModule α] where
   /-- If `k * a ≠ k * b` then `k ≠ 0` or `a ≠ b`.-/
-  no_nat_zero_divisors : ∀ (k : Nat) (a b : α), k ≠ 0 → k * a = k * b → a = b
+  no_nat_zero_divisors : ∀ (k : Nat) (a b : α), k ≠ 0 → k • a = k • b → a = b
 
 export NoNatZeroDivisors (no_nat_zero_divisors)
 
@@ -272,7 +266,7 @@ namespace NoNatZeroDivisors
 
 /-- Alternative constructor for `NoNatZeroDivisors` when we have an `IntModule`. -/
 def mk' {α} [IntModule α]
-    (eq_zero_of_mul_eq_zero : ∀ (k : Nat) (a : α), k ≠ 0 → k * a = 0 → a = 0) :
+    (eq_zero_of_mul_eq_zero : ∀ (k : Nat) (a : α), k ≠ 0 → k • a = 0 → a = 0) :
     NoNatZeroDivisors α where
   no_nat_zero_divisors k a b h₁ h₂ := by
     rw [← AddCommGroup.sub_eq_zero_iff, ← IntModule.zsmul_natCast_eq_nsmul,
@@ -282,7 +276,7 @@ def mk' {α} [IntModule α]
     apply eq_zero_of_mul_eq_zero k (a - b) h₁ h₂
 
 theorem eq_zero_of_mul_eq_zero {α : Type u} [NatModule α] [NoNatZeroDivisors α] {k : Nat} {a : α}
-    : k ≠ 0 → k * a = 0 → a = 0 := by
+    : k ≠ 0 → k • a = 0 → a = 0 := by
   intro h₁ h₂
   replace h₁ : k ≠ 0 := by intro h; simp [h] at h₁
   exact no_nat_zero_divisors k a 0 h₁ (by rwa [NatModule.nsmul_zero])

src/Init/Grind/Module/Envelope.lean

@@ -12,6 +12,8 @@ import all Init.Data.AC
 
 public section
 
+open Std
+
 namespace Lean.Grind.IntModule
 
 namespace OfNatModule
@@ -69,25 +71,25 @@ def Q.ind {β : Q α → Prop} (mk : ∀ (a : α × α), β (Q.mk a)) (q : Q α)
   Quot.ind mk q
 
 @[local simp] def nsmul (n : Nat) (q : Q α) : (Q α) :=
-  q.liftOn (fun (a, b) => Q.mk (n * a, n * b))
+  q.liftOn (fun (a, b) => Q.mk (n • a, n • b))
     (by intro (a₁, b₁) (a₂, b₂)
         simp; intro k h; apply Quot.sound; simp
-        refine ⟨n * k, ?_⟩
-        replace h := congrArg (fun x : α => n * x) h
+        refine ⟨n • k, ?_⟩
+        replace h := congrArg (fun x : α => n • x) h
         simpa [NatModule.nsmul_add] using h)
 
 @[local simp] def zsmul (n : Int) (q : Q α) : (Q α) :=
-  q.liftOn (fun (a, b) => if n < 0 then Q.mk (n.natAbs * b, n.natAbs * a) else Q.mk (n.natAbs * a, n.natAbs * b))
+  q.liftOn (fun (a, b) => if n < 0 then Q.mk (n.natAbs • b, n.natAbs • a) else Q.mk (n.natAbs • a, n.natAbs • b))
     (by intro (a₁, b₁) (a₂, b₂)
         simp; intro k h;
         split
         · apply Quot.sound; simp
-          refine ⟨n.natAbs * k, ?_⟩
-          replace h := congrArg (fun x : α => n.natAbs * x) h
+          refine ⟨n.natAbs • k, ?_⟩
+          replace h := congrArg (fun x : α => n.natAbs • x) h
           simpa [NatModule.nsmul_add] using h.symm
         · apply Quot.sound; simp
-          refine ⟨n.natAbs * k, ?_⟩
-          replace h := congrArg (fun x : α => n.natAbs * x) h
+          refine ⟨n.natAbs • k, ?_⟩
+          replace h := congrArg (fun x : α => n.natAbs • x) h
           simpa [NatModule.nsmul_add] using h)
 
 @[local simp] def sub (q₁ q₂ : Q α) : Q α :=
@@ -168,12 +170,12 @@ theorem add_zsmul (a b : Int) (c : Q α) : zsmul (a + b) c = add (zsmul a c) (zs
       ac_rfl
     · split
       · apply Quot.sound
-        refine ⟨a.natAbs * c₁ + a.natAbs * c₂, ?_⟩
+        refine ⟨a.natAbs • c₁ + a.natAbs • c₂, ?_⟩
         have : (a + b).natAbs + a.natAbs = b.natAbs := by omega
         simp [← this]
         ac_rfl
       · apply Quot.sound
-        refine ⟨b.natAbs * c₁ + b.natAbs * c₂, ?_⟩
+        refine ⟨b.natAbs • c₁ + b.natAbs • c₂, ?_⟩
         have : (a + b).natAbs + b.natAbs = a.natAbs := by omega
         simp [← this]
         ac_rfl
@@ -181,12 +183,12 @@ theorem add_zsmul (a b : Int) (c : Q α) : zsmul (a + b) c = add (zsmul a c) (zs
     by_cases ha : a < 0
     · split
       · apply Quot.sound
-        refine ⟨a.natAbs * c₁ + a.natAbs * c₂, ?_⟩
+        refine ⟨a.natAbs • c₁ + a.natAbs • c₂, ?_⟩
         have : (a + b).natAbs + b.natAbs = a.natAbs := by omega
         simp [← this]
         ac_rfl
       · apply Quot.sound
-        refine ⟨b.natAbs * c₁ + b.natAbs * c₂, ?_⟩
+        refine ⟨b.natAbs • c₁ + b.natAbs • c₂, ?_⟩
         have : (a + b).natAbs + a.natAbs = b.natAbs := by omega
         simp [← this]
         ac_rfl
@@ -226,7 +228,7 @@ theorem toQ_zero : toQ (0 : α) = 0 := by
   simp; apply Quot.sound; simp
 
 theorem toQ_smul (n : Nat) (a : α) : toQ (n • a) = (↑n : Int) • toQ a := by
-  simp; apply Quot.sound; simp; exists 0
+  simp; apply Quot.sound; simp
 
 /-!
 Helper definitions and theorems for proving `toQ` is injective when
@@ -263,7 +265,7 @@ theorem toQ_inj [AddRightCancel α] {a b : α} : toQ a = toQ b → a = b := by
 instance [NatModule α] [AddRightCancel α] [NoNatZeroDivisors α] : NoNatZeroDivisors (OfNatModule.Q α) where
   no_nat_zero_divisors := by
     intro k a b h₁ h₂
-    replace h₂ : k * a = k * b := h₂
+    replace h₂ : k • a = k • b := h₂
     obtain ⟨⟨a₁, a₂⟩⟩ := a
     obtain ⟨⟨b₁, b₂⟩⟩ := b
     replace h₂ := Q.exact h₂
@@ -274,7 +276,7 @@ instance [NatModule α] [AddRightCancel α] [NoNatZeroDivisors α] : NoNatZeroDi
     replace h₂ := NoNatZeroDivisors.no_nat_zero_divisors k (a₁ + b₂) (a₂ + b₁) h₁ h₂
     apply Quot.sound; simp [r]; exists 0; simp [h₂]
 
-instance [LE α] [LT α] [Preorder α] [OrderedAdd α] : LE (OfNatModule.Q α) where
+instance [LE α] [IsPreorder α] [OrderedAdd α] : LE (OfNatModule.Q α) where
   le a b := Q.liftOn₂ a b (fun (a, b) (c, d) => a + d ≤ b + c)
     (by intro (a₁, b₁) (a₂, b₂) (a₃, b₃) (a₄, b₄)
         simp; intro k₁ h₁ k₂ h₂
@@ -290,19 +292,19 @@ instance [LE α] [LT α] [Preorder α] [OrderedAdd α] : LE (OfNatModule.Q α) w
         rw [this]; clear this
         rw [← OrderedAdd.add_le_left_iff])
 
-instance [LE α] [LT α] [Preorder α] [OrderedAdd α] : LT (OfNatModule.Q α) where
+instance [LE α] [IsPreorder α] [OrderedAdd α] : LT (OfNatModule.Q α) where
   lt a b := a ≤ b ∧ ¬b ≤ a
 
-@[local simp] theorem mk_le_mk [LE α] [LT α] [Preorder α] [OrderedAdd α] {a₁ a₂ b₁ b₂ : α}  :
+@[local simp] theorem mk_le_mk [LE α] [IsPreorder α] [OrderedAdd α] {a₁ a₂ b₁ b₂ : α}  :
     Q.mk (a₁, a₂) ≤ Q.mk (b₁, b₂) ↔ a₁ + b₂ ≤ a₂ + b₁ := by
   rfl
 
-instance [LE α] [LT α] [Preorder α] [OrderedAdd α] : Preorder (OfNatModule.Q α) where
+instance [LE α] [IsPreorder α] [OrderedAdd α] : IsPreorder (OfNatModule.Q α) where
   le_refl a := by
     obtain ⟨⟨a₁, a₂⟩⟩ := a
     change Q.mk _ ≤ Q.mk _
     simp only [mk_le_mk]
-    simp [AddCommMonoid.add_comm]; exact Preorder.le_refl (a₁ + a₂)
+    simp [AddCommMonoid.add_comm]; exact le_refl (a₁ + a₂)
   le_trans {a b c} h₁ h₂ := by
     induction a using Q.ind with | _ a
     induction b using Q.ind with | _ b
@@ -318,24 +320,26 @@ instance [LE α] [LT α] [Preorder α] [OrderedAdd α] : Preorder (OfNatModule.Q
 
 attribute [-simp] Q.mk
 
-@[local simp] private theorem mk_lt_mk [LE α] [LT α] [Preorder α] [OrderedAdd α] {a₁ a₂ b₁ b₂ : α}  :
+@[local simp] private theorem mk_lt_mk
+    [LE α] [LT α] [LawfulOrderLT α] [IsPreorder α] [OrderedAdd α] {a₁ a₂ b₁ b₂ : α}  :
     Q.mk (a₁, a₂) < Q.mk (b₁, b₂) ↔ a₁ + b₂ < a₂ + b₁ := by
-  simp [Preorder.lt_iff_le_not_le, AddCommMonoid.add_comm]
+  simp [lt_iff_le_and_not_ge, AddCommMonoid.add_comm]
 
-@[local simp] private theorem mk_pos [LE α] [LT α] [Preorder α] [OrderedAdd α] {a₁ a₂ : α} :
+@[local simp] private theorem mk_pos
+    [LE α] [LT α] [LawfulOrderLT α] [IsPreorder α] [OrderedAdd α] {a₁ a₂ : α} :
     0 < Q.mk (a₁, a₂) ↔ a₂ < a₁ := by
   change Q.mk (0,0) < _ ↔ _
   simp [mk_lt_mk, AddCommMonoid.zero_add]
 
 @[local simp]
-theorem toQ_le [LE α] [LT α] [Preorder α] [OrderedAdd α] {a b : α} : toQ a ≤ toQ b ↔ a ≤ b := by
+theorem toQ_le [LE α] [IsPreorder α] [OrderedAdd α] {a b : α} : toQ a ≤ toQ b ↔ a ≤ b := by
   simp
 
 @[local simp]
-theorem toQ_lt [LE α] [LT α] [Preorder α] [OrderedAdd α] {a b : α} : toQ a < toQ b ↔ a < b := by
-  simp [Preorder.lt_iff_le_not_le]
+theorem toQ_lt [LE α] [LT α] [LawfulOrderLT α] [IsPreorder α] [OrderedAdd α] {a b : α} : toQ a < toQ b ↔ a < b := by
+  simp [lt_iff_le_and_not_ge]
 
-instance [LE α] [LT α] [Preorder α] [OrderedAdd α] : OrderedAdd (OfNatModule.Q α) where
+instance [LE α] [IsPreorder α] [OrderedAdd α] : OrderedAdd (OfNatModule.Q α) where
   add_le_left_iff := by
     intro a b c
     obtain ⟨⟨a₁, a₂⟩⟩ := a

src/Init/Grind/Module/OfNatModule.lean

@@ -8,6 +8,8 @@ module
 prelude
 import Init.Grind.Module.Envelope
 
+open Std
+
 namespace Lean.Grind.IntModule.OfNatModule
 
 /-!
@@ -22,19 +24,19 @@ theorem of_diseq {α} [NatModule α] [AddRightCancel α] {a b : α} {a' b' : Q
     (h₁ : toQ a = a') (h₂ : toQ b = b') : a ≠ b → a' ≠ b' := by
   rw [← h₁, ← h₂]; intro h₃ h₄; replace h₄ := toQ_inj h₄; contradiction
 
-theorem of_le {α} [NatModule α] [LE α] [LT α] [Preorder α] [OrderedAdd α] {a b : α} {a' b' : Q α}
+theorem of_le {α} [NatModule α] [LE α] [IsPreorder α] [OrderedAdd α] {a b : α} {a' b' : Q α}
     (h₁ : toQ a = a') (h₂ : toQ b = b') : a ≤ b → a' ≤ b' := by
   rw [← h₁, ← h₂, toQ_le]; intro; assumption
 
-theorem of_not_le {α} [NatModule α] [LE α] [LT α] [Preorder α] [OrderedAdd α] {a b : α} {a' b' : Q α}
+theorem of_not_le {α} [NatModule α] [LE α] [IsPreorder α] [OrderedAdd α] {a b : α} {a' b' : Q α}
     (h₁ : toQ a = a') (h₂ : toQ b = b') : ¬ a ≤ b → ¬ a' ≤ b' := by
   rw [← h₁, ← h₂, toQ_le]; intro; assumption
 
-theorem of_lt {α} [NatModule α] [LE α] [LT α] [Preorder α] [OrderedAdd α] {a b : α} {a' b' : Q α}
+theorem of_lt {α} [NatModule α] [LE α] [LT α] [LawfulOrderLT α] [IsPreorder α] [OrderedAdd α] {a b : α} {a' b' : Q α}
     (h₁ : toQ a = a') (h₂ : toQ b = b') : a < b → a' < b' := by
   rw [← h₁, ← h₂, toQ_lt]; intro; assumption
 
-theorem of_not_lt {α} [NatModule α] [LE α] [LT α] [Preorder α] [OrderedAdd α] {a b : α} {a' b' : Q α}
+theorem of_not_lt {α} [NatModule α] [LE α] [LT α] [LawfulOrderLT α] [IsPreorder α] [OrderedAdd α] {a b : α} {a' b' : Q α}
     (h₁ : toQ a = a') (h₂ : toQ b = b') : ¬ a < b → ¬ a' < b' := by
   rw [← h₁, ← h₂, toQ_lt]; intro; assumption
 

src/Init/Grind/Norm.lean

@@ -148,11 +148,9 @@ theorem zero_sub (a : Nat) : 0 - a = 0 := by
 
 attribute [local instance] Semiring.natCast Ring.intCast
 theorem smul_nat_eq_mul {α} [Semiring α] (n : Nat) (a : α) : n • a = NatCast.natCast n * a := by
-  show HMul.hMul (α := Nat) (β := α) n a = Nat.cast n * a
   rw [Semiring.nsmul_eq_natCast_mul]
 
 theorem smul_int_eq_mul {α} [Ring α] (i : Int) (a : α) : i • a = Int.cast i * a := by
-  show HMul.hMul (α := Int) (β := α) i a = IntCast.intCast i * a
   rw [Ring.zsmul_eq_intCast_mul]
 
 -- Remark: for additional `grind` simprocs, check `Lean/Meta/Tactic/Grind`

src/Init/Grind/Ordered/Field.lean

@@ -11,11 +11,13 @@ public import Init.Grind.Ordered.Ring
 
 public section
 
+open Std
+
 namespace Lean.Grind
 
 namespace Field.IsOrdered
 
-variable {R : Type u} [Field R] [LE R] [LT R] [LinearOrder R] [OrderedRing R]
+variable {R : Type u} [Field R] [LE R] [LT R] [LawfulOrderLT R] [IsLinearOrder R] [OrderedRing R]
 
 open OrderedAdd
 open OrderedRing

src/Init/Grind/Ordered/Int.lean

@@ -16,15 +16,19 @@ public section
 # `grind` instances for `Int` as an ordered module.
 -/
 
+open Std
+
 namespace Lean.Grind
 
-instance : LinearOrder Int where
+instance : IsLinearOrder Int where
   le_refl := Int.le_refl
-  le_trans := Int.le_trans
-  lt_iff_le_not_le := by omega
-  le_antisymm := Int.le_antisymm
+  le_trans _ _ _ := Int.le_trans
+  le_antisymm _ _ := Int.le_antisymm
   le_total := Int.le_total
 
+instance : LawfulOrderLT Int where
+  lt_iff := by omega
+
 instance : OrderedAdd Int where
   add_le_left_iff := by omega
 

src/Init/Grind/Ordered/Linarith.lean

@@ -16,6 +16,8 @@ public import Init.Data.RArray
 
 @[expose] public section
 
+open Std
+
 /-!
 Support for the linear arithmetic module for `IntModule` in `grind`
 -/
@@ -46,8 +48,8 @@ def Expr.denote {α} [IntModule α] (ctx : Context α) : Expr → α
   | .var v    => v.denote ctx
   | .add a b  => denote ctx a + denote ctx b
   | .sub a b  => denote ctx a - denote ctx b
-  | .natMul k a  => k * denote ctx a
-  | .intMul k a  => k * denote ctx a
+  | .natMul k a  => k • denote ctx a
+  | .intMul k a  => k • denote ctx a
   | .neg a    => -denote ctx a
 
 inductive Poly where
@@ -58,7 +60,7 @@ inductive Poly where
 def Poly.denote {α} [IntModule α] (ctx : Context α) (p : Poly) : α :=
   match p with
   | .nil => 0
-  | .add k v p => k * v.denote ctx + denote ctx p
+  | .add k v p => k • v.denote ctx + denote ctx p
 
 /--
 Similar to `Poly.denote`, but produces a denotation better for normalization.
@@ -67,13 +69,13 @@ def Poly.denote' {α} [IntModule α] (ctx : Context α) (p : Poly) : α :=
   match p with
   | .nil => 0
   | .add 1 v p => go (v.denote ctx) p
-  | .add k v p => go (k * v.denote ctx) p
+  | .add k v p => go (k • v.denote ctx) p
 where
   go (r : α)  (p : Poly) : α :=
     match p with
     | .nil => r
     | .add 1 v p => go (r + v.denote ctx) p
-    | .add k v p => go (r + k * v.denote ctx) p
+    | .add k v p => go (r + k • v.denote ctx) p
 
 -- Helper instance for `ac_rfl`
 local instance {α} [IntModule α] : Std.Associative (· + · : α → α → α) where
@@ -172,7 +174,7 @@ def Poly.mul (p : Poly) (k : Int) : Poly :=
   else
     p.mul' k
 
-@[simp] theorem Poly.denote_mul {α} [IntModule α] (ctx : Context α) (p : Poly) (k : Int) : (p.mul k).denote ctx = k * p.denote ctx := by
+@[simp] theorem Poly.denote_mul {α} [IntModule α] (ctx : Context α) (p : Poly) (k : Int) : (p.mul k).denote ctx = k • p.denote ctx := by
   simp [mul]
   split
   next => simp [*, denote]
@@ -181,7 +183,7 @@ def Poly.mul (p : Poly) (k : Int) : Poly :=
     rw [mul_zsmul, zsmul_add]
 
 theorem Poly.denote_insert {α} [IntModule α] (ctx : Context α) (k : Int) (v : Var) (p : Poly) :
-    (p.insert k v).denote ctx = p.denote ctx + k * v.denote ctx := by
+    (p.insert k v).denote ctx = p.denote ctx + k • v.denote ctx := by
   fun_induction p.insert k v <;> simp [denote]
   next => ac_rfl
   next h₁ h₂ h₃ =>
@@ -217,7 +219,7 @@ theorem Poly.denote_combine {α} [IntModule α] (ctx : Context α) (p₁ p₂ :
 attribute [local simp] Poly.denote_combine
 
 private theorem Expr.denote_toPoly'_go {α} [IntModule α] {k p} (ctx : Context α) (e : Expr)
-    : (toPoly'.go k e p).denote ctx = k * e.denote ctx + p.denote ctx := by
+    : (toPoly'.go k e p).denote ctx = k • e.denote ctx + p.denote ctx := by
   induction k, e using Expr.toPoly'.go.induct generalizing p <;> simp [toPoly'.go, denote, Poly.denote, *, zsmul_add]
   next => ac_rfl
   next => rw [sub_eq_add_neg, neg_zsmul, zsmul_add, zsmul_neg]; ac_rfl
@@ -256,17 +258,17 @@ open OrderedAdd
 Helper theorems for conflict resolution during model construction.
 -/
 
-private theorem le_add_le {α} [IntModule α] [LE α] [LT α] [Preorder α] [OrderedAdd α] {a b : α}
+private theorem le_add_le {α} [IntModule α] [LE α] [IsPreorder α] [OrderedAdd α] {a b : α}
     (h₁ : a ≤ 0) (h₂ : b ≤ 0) : a + b ≤ 0 := by
   replace h₁ := add_le_left h₁ b; simp at h₁
-  exact Preorder.le_trans h₁ h₂
+  exact le_trans h₁ h₂
 
-private theorem le_add_lt {α} [IntModule α] [LE α] [LT α] [Preorder α] [OrderedAdd α] {a b : α}
+private theorem le_add_lt {α} [IntModule α] [LE α] [LT α] [LawfulOrderLT α] [IsPreorder α] [OrderedAdd α] {a b : α}
     (h₁ : a ≤ 0) (h₂ : b < 0) : a + b < 0 := by
   replace h₁ := add_le_left h₁ b; simp at h₁
   exact Preorder.lt_of_le_of_lt h₁ h₂
 
-private theorem lt_add_lt {α} [IntModule α] [LE α] [LT α] [Preorder α] [OrderedAdd α] {a b : α}
+private theorem lt_add_lt {α} [IntModule α] [LE α] [LT α] [LawfulOrderLT α] [IsPreorder α] [OrderedAdd α] {a b : α}
     (h₁ : a < 0) (h₂ : b < 0) : a + b < 0 := by
   replace h₁ := add_lt_left h₁ b; simp at h₁
   exact Preorder.lt_trans h₁ h₂
@@ -279,7 +281,7 @@ def le_le_combine_cert (p₁ p₂ p₃ : Poly) : Bool :=
   let a₂ := p₂.leadCoeff.natAbs
   p₃ == (p₁.mul a₂ |>.combine (p₂.mul a₁))
 
-theorem le_le_combine {α} [IntModule α] [LE α] [LT α] [Preorder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ p₃ : Poly)
+theorem le_le_combine {α} [IntModule α] [LE α] [IsPreorder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ p₃ : Poly)
     : le_le_combine_cert p₁ p₂ p₃ → p₁.denote' ctx ≤ 0 → p₂.denote' ctx ≤ 0 → p₃.denote' ctx ≤ 0 := by
   simp [le_le_combine_cert]; intro _ h₁ h₂; subst p₃; simp
   replace h₁ := zsmul_nonpos (coe_natAbs_nonneg p₂.leadCoeff) h₁
@@ -291,7 +293,7 @@ def le_lt_combine_cert (p₁ p₂ p₃ : Poly) : Bool :=
   let a₂ := p₂.leadCoeff.natAbs
   a₁ > (0 : Int) && p₃ == (p₁.mul a₂ |>.combine (p₂.mul a₁))
 
-theorem le_lt_combine {α} [IntModule α] [LE α] [LT α] [Preorder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ p₃ : Poly)
+theorem le_lt_combine {α} [IntModule α] [LE α] [LT α] [LawfulOrderLT α] [IsPreorder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ p₃ : Poly)
     : le_lt_combine_cert p₁ p₂ p₃ → p₁.denote' ctx ≤ 0 → p₂.denote' ctx < 0 → p₃.denote' ctx < 0 := by
   simp [-Int.natAbs_pos, -Int.ofNat_pos, le_lt_combine_cert]; intro hp _ h₁ h₂; subst p₃; simp
   replace h₁ := zsmul_nonpos (coe_natAbs_nonneg p₂.leadCoeff) h₁
@@ -303,7 +305,7 @@ def lt_lt_combine_cert (p₁ p₂ p₃ : Poly) : Bool :=
   let a₂ := p₂.leadCoeff.natAbs
   a₂ > (0 : Int) && a₁ > (0 : Int) && p₃ == (p₁.mul a₂ |>.combine (p₂.mul a₁))
 
-theorem lt_lt_combine {α} [IntModule α] [LE α] [LT α] [Preorder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ p₃ : Poly)
+theorem lt_lt_combine {α} [IntModule α] [LE α] [LT α] [LawfulOrderLT α] [IsPreorder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ p₃ : Poly)
     : lt_lt_combine_cert p₁ p₂ p₃ → p₁.denote' ctx < 0 → p₂.denote' ctx < 0 → p₃.denote' ctx < 0 := by
   simp [-Int.natAbs_pos, -Int.ofNat_pos, lt_lt_combine_cert]; intro hp₁ hp₂ _ h₁ h₂; subst p₃; simp
   replace h₁ := zsmul_neg_iff (↑p₂.leadCoeff.natAbs) h₁ |>.mpr hp₁
@@ -314,7 +316,7 @@ def diseq_split_cert (p₁ p₂ : Poly) : Bool :=
   p₂ == p₁.mul (-1)
 
 -- We need `LinearOrder` to use `trichotomy`
-theorem diseq_split {α} [IntModule α] [LE α] [LT α] [LinearOrder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ : Poly)
+theorem diseq_split {α} [IntModule α] [LE α] [LT α] [LawfulOrderLT α] [IsLinearOrder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ : Poly)
     : diseq_split_cert p₁ p₂ → p₁.denote' ctx ≠ 0 → p₁.denote' ctx < 0 ∨ p₂.denote' ctx < 0 := by
   simp [diseq_split_cert]; intro _ h₁; subst p₂; simp
   cases LinearOrder.trichotomy (p₁.denote ctx) 0
@@ -324,7 +326,7 @@ theorem diseq_split {α} [IntModule α] [LE α] [LT α] [LinearOrder α] [Ordere
     simp [h₁] at h
     rw [← neg_pos_iff, neg_zsmul, neg_neg, one_zsmul]; assumption
 
-theorem diseq_split_resolve {α} [IntModule α] [LE α] [LT α] [LinearOrder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ : Poly)
+theorem diseq_split_resolve {α} [IntModule α] [LE α] [LT α] [LawfulOrderLT α] [IsLinearOrder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ : Poly)
     : diseq_split_cert p₁ p₂ → p₁.denote' ctx ≠ 0 → ¬p₁.denote' ctx < 0 → p₂.denote' ctx < 0 := by
   intro h₁ h₂ h₃
   exact (diseq_split ctx p₁ p₂ h₁ h₂).resolve_left h₃
@@ -340,10 +342,10 @@ theorem eq_norm {α} [IntModule α] (ctx : Context α) (lhs rhs : Expr) (p : Pol
     : norm_cert lhs rhs p → lhs.denote ctx = rhs.denote ctx → p.denote' ctx = 0 := by
   simp [norm_cert]; intro _ h₁; subst p; simp [Expr.denote, h₁, sub_self]
 
-theorem le_of_eq {α} [IntModule α] [LE α] [LT α] [Preorder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem le_of_eq {α} [IntModule α] [LE α] [IsPreorder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
     : norm_cert lhs rhs p → lhs.denote ctx = rhs.denote ctx → p.denote' ctx ≤ 0 := by
   simp [norm_cert]; intro _ h₁; subst p; simp [Expr.denote, h₁, sub_self]
-  apply Preorder.le_refl
+  apply le_refl
 
 theorem diseq_norm {α} [IntModule α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
     : norm_cert lhs rhs p → lhs.denote ctx ≠ rhs.denote ctx → p.denote' ctx ≠ 0 := by
@@ -353,21 +355,21 @@ theorem diseq_norm {α} [IntModule α] (ctx : Context α) (lhs rhs : Expr) (p :
   rw [add_left_comm, ← sub_eq_add_neg, sub_self, add_zero] at h
   contradiction
 
-theorem le_norm {α} [IntModule α] [LE α] [LT α] [Preorder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem le_norm {α} [IntModule α] [LE α] [IsPreorder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
     : norm_cert lhs rhs p → lhs.denote ctx ≤ rhs.denote ctx → p.denote' ctx ≤ 0 := by
   simp [norm_cert]; intro _ h₁; subst p; simp [Expr.denote]
   replace h₁ := add_le_left h₁ (-rhs.denote ctx)
   simp [← sub_eq_add_neg, sub_self] at h₁
   assumption
 
-theorem lt_norm {α} [IntModule α] [LE α] [LT α] [Preorder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem lt_norm {α} [IntModule α] [LE α] [LT α] [LawfulOrderLT α] [IsPreorder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
     : norm_cert lhs rhs p → lhs.denote ctx < rhs.denote ctx → p.denote' ctx < 0 := by
   simp [norm_cert]; intro _ h₁; subst p; simp [Expr.denote]
   replace h₁ := add_lt_left h₁ (-rhs.denote ctx)
   simp [← sub_eq_add_neg, sub_self] at h₁
   assumption
 
-theorem not_le_norm {α} [IntModule α] [LE α] [LT α] [LinearOrder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem not_le_norm {α} [IntModule α] [LE α] [LT α] [LawfulOrderLT α] [IsLinearOrder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
     : norm_cert rhs lhs p → ¬ lhs.denote ctx ≤ rhs.denote ctx → p.denote' ctx < 0 := by
   simp [norm_cert]; intro _ h₁; subst p; simp [Expr.denote]
   replace h₁ := LinearOrder.lt_of_not_le h₁
@@ -375,7 +377,7 @@ theorem not_le_norm {α} [IntModule α] [LE α] [LT α] [LinearOrder α] [Ordere
   simp [← sub_eq_add_neg, sub_self] at h₁
   assumption
 
-theorem not_lt_norm {α} [IntModule α] [LE α] [LT α] [LinearOrder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem not_lt_norm {α} [IntModule α] [LE α] [LT α] [LawfulOrderLT α] [IsLinearOrder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
     : norm_cert rhs lhs p → ¬ lhs.denote ctx < rhs.denote ctx → p.denote' ctx ≤ 0 := by
   simp [norm_cert]; intro _ h₁; subst p; simp [Expr.denote]
   replace h₁ := LinearOrder.le_of_not_lt h₁
@@ -385,14 +387,14 @@ theorem not_lt_norm {α} [IntModule α] [LE α] [LT α] [LinearOrder α] [Ordere
 
 -- If the module does not have a linear order, we can still put the expressions in polynomial forms
 
-theorem not_le_norm' {α} [IntModule α] [LE α] [LT α] [Preorder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem not_le_norm' {α} [IntModule α] [LE α] [IsPreorder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
     : norm_cert lhs rhs p → ¬ lhs.denote ctx ≤ rhs.denote ctx → ¬ p.denote' ctx ≤ 0 := by
   simp [norm_cert]; intro _ h₁; subst p; simp [Expr.denote]; intro h
   replace h := add_le_right (rhs.denote ctx) h
   rw [sub_eq_add_neg, add_left_comm, ← sub_eq_add_neg, sub_self] at h; simp at h
   contradiction
 
-theorem not_lt_norm' {α} [IntModule α] [LE α] [LT α] [Preorder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem not_lt_norm' {α} [IntModule α] [LE α] [LT α] [LawfulOrderLT α] [IsPreorder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
     : norm_cert lhs rhs p → ¬ lhs.denote ctx < rhs.denote ctx → ¬ p.denote' ctx < 0 := by
   simp [norm_cert]; intro _ h₁; subst p; simp [Expr.denote]; intro h
   replace h := add_lt_right (rhs.denote ctx) h
@@ -405,14 +407,14 @@ Equality detection
 def eq_of_le_ge_cert (p₁ p₂ : Poly) : Bool :=
   p₂ == p₁.mul (-1)
 
-theorem eq_of_le_ge {α} [IntModule α] [LE α] [LT α] [PartialOrder α] [OrderedAdd α] (ctx : Context α) (p₁ : Poly) (p₂ : Poly)
+theorem eq_of_le_ge {α} [IntModule α] [LE α] [IsPartialOrder α] [OrderedAdd α] (ctx : Context α) (p₁ : Poly) (p₂ : Poly)
     : eq_of_le_ge_cert p₁ p₂ → p₁.denote' ctx ≤ 0 → p₂.denote' ctx ≤ 0 → p₁.denote' ctx = 0 := by
   simp [eq_of_le_ge_cert]
   intro; subst p₂; simp
   intro h₁ h₂
   replace h₂ := add_le_left h₂ (p₁.denote ctx)
   rw [add_comm, neg_zsmul, one_zsmul, ← sub_eq_add_neg, sub_self, zero_add] at h₂
-  exact PartialOrder.le_antisymm h₁ h₂
+  exact le_antisymm h₁ h₂
 
 /-!
 Helper theorems for closing the goal
@@ -421,15 +423,15 @@ Helper theorems for closing the goal
 theorem diseq_unsat {α} [IntModule α] (ctx : Context α) : (Poly.nil).denote ctx ≠ 0 → False := by
   simp [Poly.denote]
 
-theorem lt_unsat {α} [IntModule α] [LE α] [LT α] [Preorder α] (ctx : Context α) : (Poly.nil).denote ctx < 0 → False := by
+theorem lt_unsat {α} [IntModule α] [LE α] [LT α] [LawfulOrderLT α] [IsPreorder α] (ctx : Context α) : (Poly.nil).denote ctx < 0 → False := by
   simp [Poly.denote]; intro h
-  have := Preorder.lt_iff_le_not_le.mp h
+  have := lt_iff_le_and_not_ge.mp h
   simp at this
 
 def zero_lt_one_cert (p : Poly) : Bool :=
   p == .add (-1) 0 .nil
 
-theorem zero_lt_one {α} [Ring α] [LE α] [LT α] [Preorder α] [OrderedRing α] (ctx : Context α) (p : Poly)
+theorem zero_lt_one {α} [Ring α] [LE α] [LT α] [LawfulOrderLT α] [IsPreorder α] [OrderedRing α] (ctx : Context α) (p : Poly)
     : zero_lt_one_cert p → (0 : Var).denote ctx = One.one → p.denote' ctx < 0 := by
   simp [zero_lt_one_cert]; intro _ h; subst p; simp [Poly.denote, h, One.one, neg_zsmul]
   rw [neg_lt_iff, neg_zero]; apply OrderedRing.zero_lt_one
@@ -437,7 +439,7 @@ theorem zero_lt_one {α} [Ring α] [LE α] [LT α] [Preorder α] [OrderedRing α
 def zero_ne_one_cert (p : Poly) : Bool :=
   p == .add 1 0 .nil
 
-theorem zero_ne_one_of_ord_ring {α} [Ring α] [LE α] [LT α] [Preorder α] [OrderedRing α] (ctx : Context α) (p : Poly)
+theorem zero_ne_one_of_ord_ring {α} [Ring α] [LE α] [LT α] [LawfulOrderLT α] [IsPreorder α] [OrderedRing α] (ctx : Context α) (p : Poly)
     : zero_ne_one_cert p → (0 : Var).denote ctx = One.one → p.denote' ctx ≠ 0 := by
   simp [zero_ne_one_cert]; intro _ h; subst p; simp [Poly.denote, h, One.one]
   intro h; have := OrderedRing.zero_lt_one (R := α); simp [h, Preorder.lt_irrefl] at this
@@ -486,7 +488,7 @@ theorem eq_coeff {α} [IntModule α] [NoNatZeroDivisors α] (ctx : Context α) (
 def coeff_cert (p₁ p₂ : Poly) (k : Nat) :=
   k > 0 && p₁ == p₂.mul k
 
-theorem le_coeff {α} [IntModule α] [LE α] [LT α] [LinearOrder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ : Poly) (k : Nat)
+theorem le_coeff {α} [IntModule α] [LE α] [LT α] [LawfulOrderLT α] [IsLinearOrder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ : Poly) (k : Nat)
     : coeff_cert p₁ p₂ k → p₁.denote' ctx ≤ 0 → p₂.denote' ctx ≤ 0 := by
   simp [coeff_cert]; intro h _; subst p₁; simp
   have : ↑k > (0 : Int) := Int.natCast_pos.mpr h
@@ -495,7 +497,7 @@ theorem le_coeff {α} [IntModule α] [LE α] [LT α] [LinearOrder α] [OrderedAd
   replace h₂ := zsmul_pos_iff (↑k) h₂ |>.mpr this
   exact Preorder.lt_irrefl 0 (Preorder.lt_of_lt_of_le h₂ h₁)
 
-theorem lt_coeff {α} [IntModule α] [LE α] [LT α] [LinearOrder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ : Poly) (k : Nat)
+theorem lt_coeff {α} [IntModule α] [LE α] [LT α] [LawfulOrderLT α] [IsLinearOrder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ : Poly) (k : Nat)
     : coeff_cert p₁ p₂ k → p₁.denote' ctx < 0 → p₂.denote' ctx < 0 := by
   simp [coeff_cert]; intro h _; subst p₁; simp
   have : ↑k > (0 : Int) := Int.natCast_pos.mpr h
@@ -520,8 +522,8 @@ theorem eq_diseq_subst {α} [IntModule α] [NoNatZeroDivisors α] (ctx : Context
     : eq_diseq_subst_cert k₁ k₂ p₁ p₂ p₃ → p₁.denote' ctx = 0 → p₂.denote' ctx ≠ 0 → p₃.denote' ctx ≠ 0 := by
   simp [eq_diseq_subst_cert, - Int.natAbs_eq_zero, -Int.natCast_eq_zero]; intro hne _ h₁ h₂; subst p₃
   simp [h₁]; intro h₃
-  have :  k₁.natAbs * Poly.denote ctx p₂ = 0 := by
-    have : (k₁.natAbs : Int) * Poly.denote ctx p₂ = 0 := by
+  have :  k₁.natAbs • Poly.denote ctx p₂ = 0 := by
+    have : (k₁.natAbs : Int) • Poly.denote ctx p₂ = 0 := by
       cases Int.natAbs_eq_iff.mp (Eq.refl k₁.natAbs)
       next h => rw [← h]; assumption
       next h => replace h := congrArg (- ·) h; simp at h; rw [← h, neg_zsmul, h₃, neg_zero]
@@ -546,7 +548,7 @@ def eq_le_subst_cert (x : Var) (p₁ p₂ p₃ : Poly) :=
   let b := p₂.coeff x
   a ≥ 0 && p₃ == (p₂.mul a |>.combine (p₁.mul (-b)))
 
-theorem eq_le_subst {α} [IntModule α] [LE α] [LT α] [Preorder α] [OrderedAdd α] (ctx : Context α) (x : Var) (p₁ p₂ p₃ : Poly)
+theorem eq_le_subst {α} [IntModule α] [LE α] [IsPreorder α] [OrderedAdd α] (ctx : Context α) (x : Var) (p₁ p₂ p₃ : Poly)
     : eq_le_subst_cert x p₁ p₂ p₃ → p₁.denote' ctx = 0 → p₂.denote' ctx ≤ 0 → p₃.denote' ctx ≤ 0 := by
   simp [eq_le_subst_cert]; intro h _ h₁ h₂; subst p₃; simp [h₁]
   exact zsmul_nonpos h h₂
@@ -556,7 +558,7 @@ def eq_lt_subst_cert (x : Var) (p₁ p₂ p₃ : Poly) :=
   let b := p₂.coeff x
   a > 0 && p₃ == (p₂.mul a |>.combine (p₁.mul (-b)))
 
-theorem eq_lt_subst {α} [IntModule α] [LE α] [LT α] [Preorder α] [OrderedAdd α] (ctx : Context α) (x : Var) (p₁ p₂ p₃ : Poly)
+theorem eq_lt_subst {α} [IntModule α] [LE α] [LT α] [LawfulOrderLT α] [IsPreorder α] [OrderedAdd α] (ctx : Context α) (x : Var) (p₁ p₂ p₃ : Poly)
     : eq_lt_subst_cert x p₁ p₂ p₃ → p₁.denote' ctx = 0 → p₂.denote' ctx < 0 → p₃.denote' ctx < 0 := by
   simp [eq_lt_subst_cert]; intro h _ h₁ h₂; subst p₃; simp [h₁]
   exact zsmul_neg_iff (p₁.coeff x) h₂ |>.mpr h

src/Init/Grind/Ordered/Module.lean

@@ -12,12 +12,14 @@ public import Init.Grind.Ordered.Order
 
 public section
 
+open Std
+
 namespace Lean.Grind
 
 /--
 Addition is compatible with a preorder if `a ≤ b ↔ a + c ≤ b + c`.
 -/
-class OrderedAdd (M : Type u) [HAdd M M M] [LE M] [LT M] [Preorder M] where
+class OrderedAdd (M : Type u) [HAdd M M M] [LE M] [IsPreorder M] where
   /-- `a + c ≤ b + c` iff `a ≤ b`. -/
   add_le_left_iff : ∀ {a b : M} (c : M), a ≤ b ↔ a + c ≤ b + c
 
@@ -30,7 +32,7 @@ open AddCommMonoid NatModule
 
 section
 
-variable {M : Type u} [LE M] [LT M] [Preorder M] [AddCommMonoid M] [OrderedAdd M]
+variable {M : Type u} [LE M] [IsPreorder M] [AddCommMonoid M] [OrderedAdd M]
 
 theorem add_le_right_iff {a b : M} (c : M) : a ≤ b ↔ c + a ≤ c + b := by
   rw [add_comm c a, add_comm c b, add_le_left_iff]
@@ -41,8 +43,13 @@ theorem add_le_left {a b : M} (h : a ≤ b) (c : M) : a + c ≤ b + c :=
 theorem add_le_right {a b : M} (c : M) (h : a ≤ b) : c + a ≤ c + b :=
   (add_le_right_iff c).mp h
 
+theorem add_le_add {a b c d : M} (hab : a ≤ b) (hcd : c ≤ d) : a + c ≤ b + d :=
+  le_trans (add_le_right a hcd) (add_le_left hab d)
+
+variable [LT M] [LawfulOrderLT M]
+
 theorem add_lt_left {a b : M} (h : a < b) (c : M) : a + c < b + c := by
-  simp only [Preorder.lt_iff_le_not_le] at h ⊢
+  simp only [lt_iff_le_and_not_ge] at h ⊢
   constructor
   · exact add_le_left h.1 _
   · intro w
@@ -57,7 +64,7 @@ theorem add_lt_left_iff {a b : M} (c : M) : a < b ↔ a + c < b + c := by
   constructor
   · exact fun h => add_lt_left h c
   · intro w
-    simp only [Preorder.lt_iff_le_not_le] at w ⊢
+    simp only [lt_iff_le_and_not_ge] at w ⊢
     constructor
     · exact (add_le_left_iff c).mpr w.1
     · intro h
@@ -66,23 +73,38 @@ theorem add_lt_left_iff {a b : M} (c : M) : a < b ↔ a + c < b + c := by
 theorem add_lt_right_iff {a b : M} (c : M) : a < b ↔ c + a < c + b := by
   rw [add_comm c a, add_comm c b, add_lt_left_iff]
 
-theorem add_le_add {a b c d : M} (hab : a ≤ b) (hcd : c ≤ d) : a + c ≤ b + d :=
-  Preorder.le_trans (add_le_right a hcd) (add_le_left hab d)
-
 end
 
 section
 
-variable {M : Type u} [LE M] [LT M] [Preorder M] [NatModule M] [OrderedAdd M]
+variable {M : Type u} [LE M] [IsPreorder M] [NatModule M] [OrderedAdd M]
 
-theorem nsmul_le_nsmul {k : Nat} {a b : M} (h : a ≤ b) : k * a ≤ k * b := by
+theorem nsmul_le_nsmul {k : Nat} {a b : M} (h : a ≤ b) : k • a ≤ k • b := by
   induction k with
-  | zero => simp [zero_nsmul, Preorder.le_refl]
+  | zero => simp [zero_nsmul, le_refl]
   | succ k ih =>
     rw [add_nsmul, one_nsmul, add_nsmul, one_nsmul]
-    exact Preorder.le_trans ((add_le_left_iff a).mp ih) ((add_le_right_iff (k * b)).mp h)
+    exact le_trans ((add_le_left_iff a).mp ih) ((add_le_right_iff (k • b)).mp h)
 
-theorem nsmul_lt_nsmul_iff (k : Nat) {a b : M} (h : a < b) : k * a < k * b ↔ 0 < k := by
+theorem nsmul_nonneg {k : Nat} {a : M} (h : 0 ≤ a) : 0 ≤ k • a := by
+  have := nsmul_le_nsmul (k := k) h
+  rwa [nsmul_zero] at this
+
+theorem nsmul_le_nsmul_of_le_of_le_of_nonneg
+    {k₁ k₂ : Nat} {x y : M} (hk : k₁ ≤ k₂) (h : x ≤ y) (w : 0 ≤ x) :
+    k₁ • x ≤ k₂ • y := by
+  apply le_trans
+  · change k₁ • x ≤ k₂ • x
+    obtain ⟨k', rfl⟩ := Nat.exists_eq_add_of_le hk
+    rw [add_nsmul]
+    conv => lhs; rw [← add_zero (k₁ • x)]
+    rw [← add_le_right_iff]
+    exact nsmul_nonneg w
+  · exact nsmul_le_nsmul h
+
+variable [LT M] [LawfulOrderLT M]
+
+theorem nsmul_lt_nsmul_iff (k : Nat) {a b : M} (h : a < b) : k • a < k • b ↔ 0 < k := by
   induction k with
   | zero => simp [zero_nsmul, Preorder.lt_irrefl]
   | succ k ih =>
@@ -90,34 +112,18 @@ theorem nsmul_lt_nsmul_iff (k : Nat) {a b : M} (h : a < b) : k * a < k * b ↔ 0
     simp only [Nat.zero_lt_succ, iff_true]
     by_cases hk : 0 < k
     · simp only [hk, iff_true] at ih
-      exact Preorder.lt_trans ((add_lt_left_iff a).mp ih) ((add_lt_right_iff (k * b)).mp h)
+      exact Preorder.lt_trans ((add_lt_left_iff a).mp ih) ((add_lt_right_iff (k • b)).mp h)
     · simp [Nat.eq_zero_of_not_pos hk, zero_nsmul, zero_add, h]
 
-theorem nsmul_pos_iff {k : Nat} {a : M} (h : 0 < a) : 0 < k * a ↔ 0 < k:= by
+theorem nsmul_pos_iff {k : Nat} {a : M} (h : 0 < a) : 0 < k • a ↔ 0 < k:= by
   rw [← nsmul_lt_nsmul_iff k h, nsmul_zero]
 
-theorem nsmul_nonneg {k : Nat} {a : M} (h : 0 ≤ a) : 0 ≤ k * a := by
-  have := nsmul_le_nsmul (k := k) h
-  rwa [nsmul_zero] at this
-
-theorem nsmul_le_nsmul_of_le_of_le_of_nonneg
-    {k₁ k₂ : Nat} {x y : M} (hk : k₁ ≤ k₂) (h : x ≤ y) (w : 0 ≤ x) :
-    k₁ * x ≤ k₂ * y := by
-  apply Preorder.le_trans
-  · change k₁ * x ≤ k₂ * x
-    obtain ⟨k', rfl⟩ := Nat.exists_eq_add_of_le hk
-    rw [add_nsmul]
-    conv => lhs; rw [← add_zero (k₁ * x)]
-    rw [← add_le_right_iff]
-    exact nsmul_nonneg w
-  · exact nsmul_le_nsmul h
-
 end
 
 section
 
 open AddCommGroup
-variable {M : Type u} [LE M] [LT M] [Preorder M] [AddCommGroup M] [OrderedAdd M]
+variable {M : Type u} [LE M] [IsPreorder M] [AddCommGroup M] [OrderedAdd M]
 
 theorem neg_le_iff {a b : M} : -a ≤ b ↔ -b ≤ a := by
   rw [OrderedAdd.add_le_left_iff a, neg_add_cancel]
@@ -127,10 +133,17 @@ theorem neg_le_iff {a b : M} : -a ≤ b ↔ -b ≤ a := by
 end
 section
 
-variable {M : Type u} [LE M] [LT M] [Preorder M] [IntModule M] [OrderedAdd M]
+variable {M : Type u} [LE M] [IsPreorder M] [IntModule M] [OrderedAdd M]
 open AddCommGroup IntModule
 
-theorem zsmul_pos_iff (k : Int) {x : M} (h : 0 < x) : 0 < k * x ↔ 0 < k :=
+theorem zsmul_nonneg {k : Int} {x : M} (h : 0 ≤ k) (hx : 0 ≤ x) : 0 ≤ k • x :=
+  match k, h with
+  | (k : Nat), _ => by
+    simpa [zsmul_natCast_eq_nsmul] using nsmul_nonneg hx
+
+variable [LT M] [LawfulOrderLT M]
+
+theorem zsmul_pos_iff (k : Int) {x : M} (h : 0 < x) : 0 < k • x ↔ 0 < k :=
   match k with
   | (k + 1 : Nat) => by
     simpa [zsmul_zero, ← zsmul_natCast_eq_nsmul] using nsmul_lt_nsmul_iff (k := k + 1) h
@@ -139,22 +152,17 @@ theorem zsmul_pos_iff (k : Int) {x : M} (h : 0 < x) : 0 < k * x ↔ 0 < k :=
     have : ¬ (k : Int) + 1 < 0 := by omega
     simp [this]; clear this
     rw [neg_zsmul]
-    rw [Preorder.lt_iff_le_not_le]
+    rw [lt_iff_le_and_not_ge]
     simp
     intro h'
     rw [OrderedAdd.neg_le_iff, neg_zero]
     simpa [zsmul_zero, ← zsmul_natCast_eq_nsmul] using
       nsmul_le_nsmul (k := k + 1) (Preorder.le_of_lt h)
 
-theorem zsmul_nonneg {k : Int} {x : M} (h : 0 ≤ k) (hx : 0 ≤ x) : 0 ≤ k * x :=
-  match k, h with
-  | (k : Nat), _ => by
-    simpa [zsmul_natCast_eq_nsmul] using nsmul_nonneg hx
-
 end
 
 section
-variable {M : Type u} [LE M] [LT M] [Preorder M] [AddCommGroup M] [OrderedAdd M]
+variable {M : Type u} [LE M] [IsPreorder M] [AddCommGroup M] [OrderedAdd M]
 
 open AddCommGroup
 
@@ -162,23 +170,25 @@ theorem le_neg_iff {a b : M} : a ≤ -b ↔ b ≤ -a := by
   conv => lhs; rw [← neg_neg a]
   rw [neg_le_iff, neg_neg]
 
+theorem neg_nonneg_iff {a : M} : 0 ≤ -a ↔ a ≤ 0 := by
+  rw [le_neg_iff, neg_zero]
+
+theorem sub_nonneg_iff {a b : M} : 0 ≤ a - b ↔ b ≤ a := by
+  rw [add_le_left_iff b, zero_add, sub_add_cancel]
+
+variable [LT M] [LawfulOrderLT M]
+
 theorem neg_lt_iff {a b : M} : -a < b ↔ -b < a := by
-  simp [Preorder.lt_iff_le_not_le]
+  simp [lt_iff_le_and_not_ge]
   rw [neg_le_iff, le_neg_iff]
 
 theorem lt_neg_iff {a b : M} : a < -b ↔ b < -a := by
   conv => lhs; rw [← neg_neg a]
   rw [neg_lt_iff, neg_neg]
 
-theorem neg_nonneg_iff {a : M} : 0 ≤ -a ↔ a ≤ 0 := by
-  rw [le_neg_iff, neg_zero]
-
 theorem neg_pos_iff {a : M} : 0 < -a ↔ a < 0 := by
   rw [lt_neg_iff, neg_zero]
 
-theorem sub_nonneg_iff {a b : M} : 0 ≤ a - b ↔ b ≤ a := by
-  rw [add_le_left_iff b, zero_add, sub_add_cancel]
-
 theorem sub_pos_iff {a b : M} : 0 < a - b ↔ b < a := by
   rw [add_lt_left_iff b, zero_add, sub_add_cancel]
 
@@ -186,30 +196,32 @@ end
 
 section
 
-variable {M : Type u} [LE M] [LT M] [Preorder M] [IntModule M] [OrderedAdd M]
+variable {M : Type u} [LE M] [IsPreorder M] [IntModule M] [OrderedAdd M]
 open IntModule
 
-theorem zsmul_neg_iff (k : Int) {a : M} (h : a < 0) : k * a < 0 ↔ 0 < k := by
-  simpa [IntModule.zsmul_neg, neg_pos_iff] using zsmul_pos_iff k (neg_pos_iff.mpr h)
-
-theorem zsmul_nonpos {k : Int} {a : M} (hk : 0 ≤ k) (ha : a ≤ 0) : k * a ≤ 0 := by
+theorem zsmul_nonpos {k : Int} {a : M} (hk : 0 ≤ k) (ha : a ≤ 0) : k • a ≤ 0 := by
   simpa [IntModule.zsmul_neg, neg_nonneg_iff] using zsmul_nonneg hk (neg_nonneg_iff.mpr ha)
 
-theorem zsmul_le_zsmul {a b : M} {k : Int} (hk : 0 ≤ k) (h : a ≤ b) : k * a ≤ k * b := by
+theorem zsmul_le_zsmul {a b : M} {k : Int} (hk : 0 ≤ k) (h : a ≤ b) : k • a ≤ k • b := by
   simpa [zsmul_sub, sub_nonneg_iff] using zsmul_nonneg hk (sub_nonneg_iff.mpr h)
 
-theorem zsmul_lt_zsmul_iff (k : Int) {a b : M} (h : a < b) : k * a < k * b ↔ 0 < k := by
-  simpa [zsmul_sub, sub_pos_iff] using zsmul_pos_iff k (sub_pos_iff.mpr h)
-
 theorem zsmul_le_zsmul_of_le_of_le_of_nonneg_of_nonneg
     {k₁ k₂ : Int} {x y : M} (hk : k₁ ≤ k₂) (h : x ≤ y) (w : 0 ≤ k₁) (w' : 0 ≤ x) :
-    k₁ * x ≤ k₂ * y := by
-  apply Preorder.le_trans
-  · have : 0 ≤ k₁ * (y - x) := zsmul_nonneg w (sub_nonneg_iff.mpr h)
+    k₁ • x ≤ k₂ • y := by
+  apply le_trans
+  · have : 0 ≤ k₁ • (y - x) := zsmul_nonneg w (sub_nonneg_iff.mpr h)
     rwa [IntModule.zsmul_sub, sub_nonneg_iff] at this
-  · have : 0 ≤ (k₂ - k₁) * y := zsmul_nonneg (Int.sub_nonneg.mpr hk) (Preorder.le_trans w' h)
+  · have : 0 ≤ (k₂ - k₁) • y := zsmul_nonneg (Int.sub_nonneg.mpr hk) (le_trans w' h)
     rwa [IntModule.sub_zsmul, sub_nonneg_iff] at this
 
+variable [LT M] [LawfulOrderLT M]
+
+theorem zsmul_neg_iff (k : Int) {a : M} (h : a < 0) : k • a < 0 ↔ 0 < k := by
+  simpa [IntModule.zsmul_neg, neg_pos_iff] using zsmul_pos_iff k (neg_pos_iff.mpr h)
+
+theorem zsmul_lt_zsmul_iff (k : Int) {a b : M} (h : a < b) : k • a < k • b ↔ 0 < k := by
+  simpa [zsmul_sub, sub_pos_iff] using zsmul_pos_iff k (sub_pos_iff.mpr h)
+
 end
 
 end OrderedAdd

src/Init/Grind/Ordered/Order.lean

@@ -7,40 +7,23 @@ module
 
 prelude
 public import Init.Data.Int.Order
+public import Init.Data.Order.Lemmas
 
 public section
 
-namespace Lean.Grind
+open Std
 
-/-- A preorder is a reflexive, transitive relation `≤` with `a < b` defined in the obvious way. -/
-class Preorder (α : Type u) [LE α] [LT α] where
-  /-- The less-than-or-equal relation is reflexive. -/
-  le_refl : ∀ a : α, a ≤ a
-  /-- The less-than-or-equal relation is transitive. -/
-  le_trans : ∀ {a b c : α}, a ≤ b → b ≤ c → a ≤ c
-  /-- The less-than relation is determined by the less-than-or-equal relation. -/
-  lt_iff_le_not_le : ∀ {a b : α}, a < b ↔ a ≤ b ∧ ¬b ≤ a := by intros; rfl
+namespace Lean.Grind
 
 namespace Preorder
 
-variable {α : Type u} [LE α] [LT α] [Preorder α]
+variable {α : Type u} [LE α] [LT α] [LawfulOrderLT α]
 
-theorem le_of_lt {a b : α} (h : a < b) : a ≤ b := (lt_iff_le_not_le.mp h).1
-
-theorem lt_of_lt_of_le {a b c : α} (h₁ : a < b) (h₂ : b ≤ c) : a < c := by
-  simp [lt_iff_le_not_le] at h₁ ⊢
-  exact ⟨le_trans h₁.1 h₂, fun h => h₁.2 (le_trans h₂ h)⟩
-
-theorem lt_of_le_of_lt {a b c : α} (h₁ : a ≤ b) (h₂ : b < c) : a < c := by
-  simp [lt_iff_le_not_le] at h₂ ⊢
-  exact ⟨le_trans h₁ h₂.1, fun h => h₂.2 (le_trans h h₁)⟩
-
-theorem lt_trans {a b c : α} (h₁ : a < b) (h₂ : b < c) : a < c :=
-  lt_of_lt_of_le h₁ (le_of_lt h₂)
+theorem le_of_lt {a b : α} (h : a < b) : a ≤ b := (lt_iff_le_and_not_ge.mp h).1
 
 theorem lt_irrefl (a : α) : ¬ (a < a) := by
   intro h
-  simp [lt_iff_le_not_le] at h
+  simp [lt_iff_le_and_not_ge] at h
 
 theorem ne_of_lt {a b : α} (h : a < b) : a ≠ b :=
   fun w => lt_irrefl a (w.symm ▸ h)
@@ -48,6 +31,19 @@ theorem ne_of_lt {a b : α} (h : a < b) : a ≠ b :=
 theorem ne_of_gt {a b : α} (h : a > b) : a ≠ b :=
   fun w => lt_irrefl b (w.symm ▸ h)
 
+variable [IsPreorder α]
+
+theorem lt_of_lt_of_le {a b c : α} (h₁ : a < b) (h₂ : b ≤ c) : a < c := by
+  simp [lt_iff_le_and_not_ge] at h₁ ⊢
+  exact ⟨le_trans h₁.1 h₂, fun h => h₁.2 (le_trans h₂ h)⟩
+
+theorem lt_of_le_of_lt {a b c : α} (h₁ : a ≤ b) (h₂ : b < c) : a < c := by
+  simp [lt_iff_le_and_not_ge] at h₂ ⊢
+  exact ⟨le_trans h₁ h₂.1, fun h => h₂.2 (le_trans h h₁)⟩
+
+theorem lt_trans {a b c : α} (h₁ : a < b) (h₂ : b < c) : a < c :=
+  lt_of_lt_of_le h₁ (le_of_lt h₂)
+
 theorem not_ge_of_lt {a b : α} (h : a < b) : ¬b ≤ a :=
   fun w => lt_irrefl a (lt_of_lt_of_le h w)
 
@@ -56,38 +52,28 @@ theorem not_gt_of_lt {a b : α} (h : a < b) : ¬a > b :=
 
 end Preorder
 
-/-- A partial order is a preorder with the additional property that `a ≤ b` and `b ≤ a` implies `a = b`. -/
-class PartialOrder (α : Type u) [LE α] [LT α] extends Preorder α where
-  /-- The less-than-or-equal relation is antisymmetric. -/
-  le_antisymm : ∀ {a b : α}, a ≤ b → b ≤ a → a = b
-
 namespace PartialOrder
 
-variable {α : Type u} [LE α] [LT α] [PartialOrder α]
+variable {α : Type u} [LE α] [LT α] [LawfulOrderLT α] [IsPartialOrder α]
 
 theorem le_iff_lt_or_eq {a b : α} : a ≤ b ↔ a < b ∨ a = b := by
   constructor
   · intro h
-    rw [Preorder.lt_iff_le_not_le, Classical.or_iff_not_imp_right]
+    rw [LawfulOrderLT.lt_iff, Classical.or_iff_not_imp_right]
     exact fun w => ⟨h, fun w' => w (le_antisymm h w')⟩
   · intro h
     cases h with
     | inl h => exact Preorder.le_of_lt h
-    | inr h => subst h; exact Preorder.le_refl a
+    | inr h => subst h; exact le_refl a
 
 end PartialOrder
 
-/-- A linear order is a partial order with the additional property that every pair of elements is comparable. -/
-class LinearOrder (α : Type u) [LE α] [LT α] extends PartialOrder α where
-  /-- For every two elements `a` and `b`, either `a ≤ b` or `b ≤ a`. -/
-  le_total : ∀ a b : α, a ≤ b ∨ b ≤ a
-
 namespace LinearOrder
 
-variable {α : Type u} [LE α] [LT α] [LinearOrder α]
+variable {α : Type u} [LE α] [LT α] [LawfulOrderLT α] [IsLinearOrder α]
 
 theorem trichotomy (a b : α) : a < b ∨ a = b ∨ b < a := by
-  cases LinearOrder.le_total a b with
+  cases le_total (a := a) (b := b) with
   | inl h =>
     rw [PartialOrder.le_iff_lt_or_eq] at h
     cases h with
@@ -106,10 +92,10 @@ theorem le_of_not_lt {a b : α} (h : ¬ a < b) : b ≤ a := by
 
 theorem lt_of_not_le {a b : α} (h : ¬ a ≤ b) : b < a := by
   cases LinearOrder.trichotomy a b
-  next h₁ h₂ => have := Preorder.lt_iff_le_not_le.mp h₂; simp [h] at this
+  next h₁ h₂ => have := lt_iff_le_and_not_ge.mp h₂; simp [h] at this
   next h =>
     cases h
-    next h => subst a; exact False.elim <| h (Preorder.le_refl b)
+    next h => subst a; exact False.elim <| h (le_refl b)
     next => assumption
 
 end LinearOrder

src/Init/Grind/Ordered/Rat.lean

@@ -16,15 +16,19 @@ public section
 # `grind` instances for `Rat` as an ordered module.
 -/
 
+open Std
+
 namespace Lean.Grind
 
-instance : LinearOrder Rat where
+instance : IsLinearOrder Rat where
   le_refl _ := Rat.le_refl
-  le_trans := Rat.le_trans
-  lt_iff_le_not_le {a b} := by rw [← Rat.not_le, iff_and_self]; exact Rat.le_total.resolve_left
-  le_antisymm := Rat.le_antisymm
+  le_trans _ _ _ := Rat.le_trans
+  le_antisymm _ _ := Rat.le_antisymm
   le_total _ _ := Rat.le_total
 
+instance : LawfulOrderLT Rat where
+  lt_iff _ _ := by rw [← Rat.not_le, iff_and_self]; exact Rat.le_total.resolve_left
+
 instance : OrderedAdd Rat where
   add_le_left_iff {a b} c := by simp [Rat.add_comm _ c, Rat.add_le_add_left]
 

src/Init/Grind/Ordered/Ring.lean

@@ -11,13 +11,14 @@ public import Init.Grind.Ordered.Module
 
 public section
 
+open Std
 namespace Lean.Grind
 
 /--
 A ring which is also equipped with a preorder is considered a strict ordered ring if addition, negation,
 and multiplication are compatible with the preorder, and `0 < 1`.
 -/
-class OrderedRing (R : Type u) [Semiring R] [LE R] [LT R] [Preorder R] extends OrderedAdd R where
+class OrderedRing (R : Type u) [Semiring R] [LE R] [LT R] [IsPreorder R] extends OrderedAdd R where
   /-- In a strict ordered semiring, we have `0 < 1`. -/
   zero_lt_one : (0 : R) < 1
   /-- In a strict ordered semiring, we can multiply an inequality `a < b` on the left
@@ -33,7 +34,7 @@ variable {R : Type u} [Ring R]
 
 section Preorder
 
-variable [LE R] [LT R] [Preorder R] [OrderedRing R]
+variable [LE R] [LT R] [LawfulOrderLT R] [IsPreorder R] [OrderedRing R]
 
 theorem neg_one_lt_zero : (-1 : R) < 0 := by
   have h := zero_lt_one (R := R)
@@ -43,7 +44,7 @@ theorem neg_one_lt_zero : (-1 : R) < 0 := by
 
 theorem ofNat_nonneg (x : Nat) : (OfNat.ofNat x : R) ≥ 0 := by
   induction x
-  next => simp [OfNat.ofNat, Zero.zero]; apply Preorder.le_refl
+  next => simp [OfNat.ofNat, Zero.zero]; apply le_refl
   next n ih =>
     have := OrderedRing.zero_lt_one (R := R)
     rw [Semiring.ofNat_succ]
@@ -52,7 +53,8 @@ theorem ofNat_nonneg (x : Nat) : (OfNat.ofNat x : R) ≥ 0 := by
     have := Preorder.lt_of_lt_of_le this ih
     exact Preorder.le_of_lt this
 
-instance [Ring R] [LE R] [LT R] [Preorder R] [OrderedRing R] : IsCharP R 0 := IsCharP.mk' _ _ <| by
+instance [Ring R] [LE R] [LT R] [LawfulOrderLT R] [IsPreorder R] [OrderedRing R] :
+    IsCharP R 0 := IsCharP.mk' _ _ <| by
   intro x
   simp only [Nat.mod_zero]; constructor
   next =>
@@ -77,7 +79,12 @@ end Preorder
 
 section PartialOrder
 
-variable [LE R] [LT R] [PartialOrder R] [OrderedRing R]
+variable [LE R] [LT R] [IsPartialOrder R] [OrderedRing R]
+
+theorem mul_pos {a b : R} (h₁ : 0 < a) (h₂ : 0 < b) : 0 < a * b := by
+  simpa [Semiring.zero_mul] using mul_lt_mul_of_pos_right h₁ h₂
+
+variable [LawfulOrderLT R]
 
 theorem zero_le_one : (0 : R) ≤ 1 := Preorder.le_of_lt zero_lt_one
 
@@ -92,8 +99,8 @@ theorem mul_le_mul_of_nonneg_left {a b c : R} (h : a ≤ b) (h' : 0 ≤ c) : c *
     rw [PartialOrder.le_iff_lt_or_eq] at h
     cases h with
     | inl h => exact Preorder.le_of_lt (p h h')
-    | inr h => subst h; exact Preorder.le_refl (c * a)
-  | inr h' => subst h'; simp [Semiring.zero_mul, Preorder.le_refl]
+    | inr h => subst h; exact le_refl (c * a)
+  | inr h' => subst h'; simp [Semiring.zero_mul, le_refl]
 
 theorem mul_le_mul_of_nonneg_right {a b c : R} (h : a ≤ b) (h' : 0 ≤ c) : a * c ≤ b * c := by
   rw [PartialOrder.le_iff_lt_or_eq] at h'
@@ -103,8 +110,8 @@ theorem mul_le_mul_of_nonneg_right {a b c : R} (h : a ≤ b) (h' : 0 ≤ c) : a
     rw [PartialOrder.le_iff_lt_or_eq] at h
     cases h with
     | inl h => exact Preorder.le_of_lt (p h h')
-    | inr h => subst h; exact Preorder.le_refl (a * c)
-  | inr h' => subst h'; simp [Semiring.mul_zero, Preorder.le_refl]
+    | inr h => subst h; exact le_refl (a * c)
+  | inr h' => subst h'; simp [Semiring.mul_zero, le_refl]
 
 open OrderedAdd
 
@@ -139,9 +146,6 @@ theorem mul_nonpos_of_nonpos_of_nonneg {a b : R} (h₁ : a ≤ 0) (h₂ : 0 ≤
   rw [← neg_nonneg_iff, ← Ring.neg_mul]
   apply mul_nonneg (neg_nonneg_iff.mpr h₁) h₂
 
-theorem mul_pos {a b : R} (h₁ : 0 < a) (h₂ : 0 < b) : 0 < a * b := by
-  simpa [Semiring.zero_mul] using mul_lt_mul_of_pos_right h₁ h₂
-
 theorem mul_pos_of_neg_of_neg {a b : R} (h₁ : a < 0) (h₂ : b < 0) : 0 < a * b := by
   have := mul_pos (neg_pos_iff.mpr h₁) (neg_pos_iff.mpr h₂)
   simpa [Ring.neg_mul, Ring.mul_neg, AddCommGroup.neg_neg] using this
@@ -158,22 +162,22 @@ end PartialOrder
 
 section LinearOrder
 
-variable [LE R] [LT R] [LinearOrder R] [OrderedRing R]
+variable [LE R] [LT R] [LawfulOrderLT R] [IsLinearOrder R] [OrderedRing R]
 
 theorem mul_nonneg_iff {a b : R} : 0 ≤ a * b ↔ 0 ≤ a ∧ 0 ≤ b ∨ a ≤ 0 ∧ b ≤ 0 := by
   rcases LinearOrder.trichotomy 0 a with (ha | rfl | ha)
   · rcases LinearOrder.trichotomy 0 b with (hb | rfl | hb)
     · simp [Preorder.le_of_lt ha, Preorder.le_of_lt hb, mul_nonneg]
-    · simp [Semiring.mul_zero, Preorder.le_refl, LinearOrder.le_total]
+    · simp [Semiring.mul_zero, le_refl, le_total]
     · have m : a * b < 0 := mul_neg_of_pos_of_neg ha hb
       simp [Preorder.le_of_lt ha, Preorder.le_of_lt hb, Preorder.not_ge_of_lt m,
         Preorder.not_ge_of_lt ha, Preorder.not_ge_of_lt hb]
-  · simp [Semiring.zero_mul, Preorder.le_refl, LinearOrder.le_total]
+  · simp [Semiring.zero_mul, le_refl, le_total]
   · rcases LinearOrder.trichotomy 0 b with (hb | rfl | hb)
     · have m : a * b < 0 := mul_neg_of_neg_of_pos ha hb
       simp [Preorder.le_of_lt ha, Preorder.le_of_lt hb, Preorder.not_ge_of_lt m,
         Preorder.not_ge_of_lt ha, Preorder.not_ge_of_lt hb]
-    · simp [Semiring.mul_zero, Preorder.le_refl, LinearOrder.le_total]
+    · simp [Semiring.mul_zero, le_refl, le_total]
     · simp [Preorder.le_of_lt ha, Preorder.le_of_lt hb, mul_nonneg_of_nonpos_of_nonpos]
 
 theorem mul_pos_iff {a b : R} : 0 < a * b ↔ 0 < a ∧ 0 < b ∨ a < 0 ∧ b < 0 := by
@@ -194,7 +198,7 @@ theorem mul_pos_iff {a b : R} : 0 < a * b ↔ 0 < a ∧ 0 < b ∨ a < 0 ∧ b <
 
 theorem sq_nonneg {a : R} : 0 ≤ a^2 := by
   rw [Semiring.pow_two, mul_nonneg_iff]
-  rcases LinearOrder.le_total 0 a with (h | h)
+  rcases le_total (a := 0) (b := a) with (h | h)
   · exact .inl ⟨h, h⟩
   · exact .inr ⟨h, h⟩
 

src/Init/Grind/Ring/Basic.lean

@@ -54,7 +54,7 @@ class Semiring (α : Type u) extends Add α, Mul α where
   -/
   [ofNat : ∀ n, OfNat α n]
   /-- Scalar multiplication by natural numbers. -/
-  [nsmul : HMul Nat α α]
+  [nsmul : SMul Nat α]
   /-- Exponentiation by a natural number. -/
   [npow : HPow α Nat α]
   /-- Zero is the right identity for addition. -/
@@ -85,7 +85,7 @@ class Semiring (α : Type u) extends Add α, Mul α where
   ofNat_succ : ∀ a : Nat, OfNat.ofNat (α := α) (a + 1) = OfNat.ofNat a + 1 := by intros; rfl
   /-- Numerals are consistently defined with respect to the canonical map from natural numbers. -/
   ofNat_eq_natCast : ∀ n : Nat, OfNat.ofNat (α := α) n = Nat.cast n := by intros; rfl
-  nsmul_eq_natCast_mul : ∀ n : Nat, ∀ a : α, HMul.hMul (α := Nat) n a = Nat.cast n * a := by intros; rfl
+  nsmul_eq_natCast_mul : ∀ n : Nat, ∀ a : α, n • a = Nat.cast n * a := by intros; rfl
 
 /--
 A ring, i.e. a type equipped with addition, negation, multiplication, and a map from the integers,
@@ -97,15 +97,15 @@ class Ring (α : Type u) extends Semiring α, Neg α, Sub α where
   /-- In every ring there is a canonical map from the integers to the ring. -/
   [intCast : IntCast α]
   /-- Scalar multiplication by integers. -/
-  [zsmul : HMul Int α α]
+  [zsmul : SMul Int α]
   /-- Negation is the left inverse of addition. -/
   neg_add_cancel : ∀ a : α, -a + a = 0
   /-- Subtraction is addition of the negative. -/
   sub_eq_add_neg : ∀ a b : α, a - b = a + -b
   /-- Scalar multiplication by the negation of an integer is the negation of scalar multiplication by that integer. -/
-  neg_zsmul : ∀ (i : Int) (a : α), HMul.hMul (α := Int) (-i : Int) a = -(HMul.hMul (α := Int) i a)
+  neg_zsmul : ∀ (i : Int) (a : α), (-i : Int) • a = -(i • a)
   /-- Scalar multiplication by natural numbers is consistent with scalar multiplication by integers. -/
-  zsmul_natCast_eq_nsmul : ∀ n : Nat, ∀ a : α, HMul.hMul (α := Int) (n : Int) a = HMul.hMul (α := Nat) n a := by intros; rfl
+  zsmul_natCast_eq_nsmul : ∀ n : Nat, ∀ a : α, (n : Int) • a = n • a := by intros; rfl
   /-- The canonical map from the integers is consistent with the canonical map from the natural numbers. -/
   intCast_ofNat : ∀ n : Nat, Int.cast (OfNat.ofNat (α := Int) n) = OfNat.ofNat (α := α) n := by intros; rfl
   /-- The canonical map from the integers is consistent with negation. -/
@@ -195,7 +195,7 @@ theorem natCast_pow (x : Nat) (k : Nat) : ((x ^ k : Nat) : α) = (x : α) ^ k :=
   next => simp [pow_zero, Nat.pow_zero, natCast_one]
   next k ih => simp [pow_succ, Nat.pow_succ, natCast_mul, *]
 
-theorem nsmul_eq_ofNat_mul {α} [Semiring α] {k : Nat} {a : α} : HMul.hMul (α := Nat) k a = OfNat.ofNat k * a := by
+theorem nsmul_eq_ofNat_mul {α} [Semiring α] {k : Nat} {a : α} : k • a = OfNat.ofNat k * a := by
   simp [ofNat_eq_natCast, nsmul_eq_natCast_mul]
 
 end Semiring
@@ -303,7 +303,7 @@ theorem mul_neg (a b : α) : a * (-b) = -(a * b) := by
   rw [neg_eq_mul_neg_one b, neg_eq_mul_neg_one (a * b), mul_assoc]
 
 attribute [local instance] Ring.zsmul in
-theorem zsmul_eq_intCast_mul {k : Int} {a : α} : (HMul.hMul (α := Int) (γ := α) k a : α) = (k : α) * a := by
+theorem zsmul_eq_intCast_mul {k : Int} {a : α} : (k • a : α) = (k : α) * a := by
   match k with
   | (k : Nat) =>
     rw [intCast_natCast, zsmul_natCast_eq_nsmul, nsmul_eq_natCast_mul]
@@ -516,7 +516,7 @@ end IsCharP
 open AddCommGroup
 
 theorem no_int_zero_divisors {α : Type u} [IntModule α] [NoNatZeroDivisors α] {k : Int} {a : α}
-    : k ≠ 0 → k * a = 0 → a = 0 := by
+    : k ≠ 0 → k • a = 0 → a = 0 := by
   match k with
   | (k : Nat) =>
     simp only [ne_eq, Int.natCast_eq_zero]

src/Init/Grind/Ring/Envelope.lean

@@ -13,6 +13,8 @@ import all Init.Data.AC
 
 @[expose] public section
 
+open Std
+
 namespace Lean.Grind.Ring
 
 namespace OfSemiring
@@ -360,7 +362,7 @@ instance {p} [Semiring α] [AddRightCancel α] [IsCharP α p] : IsCharP (OfSemir
       apply Quot.sound
       exists 0; simp [← Semiring.ofNat_eq_natCast, this]
 
-instance [LE α] [LT α] [Preorder α] [OrderedAdd α] : LE (OfSemiring.Q α) where
+instance [LE α] [IsPreorder α] [OrderedAdd α] : LE (OfSemiring.Q α) where
   le a b := Q.liftOn₂ a b (fun (a, b) (c, d) => a + d ≤ b + c)
     (by intro (a₁, b₁) (a₂, b₂) (a₃, b₃) (a₄, b₄)
         simp; intro k₁ h₁ k₂ h₂
@@ -376,19 +378,19 @@ instance [LE α] [LT α] [Preorder α] [OrderedAdd α] : LE (OfSemiring.Q α) wh
         rw [this]; clear this
         rw [← OrderedAdd.add_le_left_iff])
 
-instance [LE α] [LT α] [Preorder α] [OrderedAdd α] : LT (OfSemiring.Q α) where
+instance [LE α] [IsPreorder α] [OrderedAdd α] : LT (OfSemiring.Q α) where
   lt a b := a ≤ b ∧ ¬b ≤ a
 
-@[local simp] theorem mk_le_mk [LE α] [LT α] [Preorder α] [OrderedAdd α] {a₁ a₂ b₁ b₂ : α}  :
+@[local simp] theorem mk_le_mk [LE α] [IsPreorder α] [OrderedAdd α] {a₁ a₂ b₁ b₂ : α}  :
     Q.mk (a₁, a₂) ≤ Q.mk (b₁, b₂) ↔ a₁ + b₂ ≤ a₂ + b₁ := by
   rfl
 
-instance [LE α] [LT α] [Preorder α] [OrderedAdd α] : Preorder (OfSemiring.Q α) where
+instance [LE α] [IsPreorder α] [OrderedAdd α] : IsPreorder (OfSemiring.Q α) where
   le_refl a := by
     obtain ⟨⟨a₁, a₂⟩⟩ := a
     change Q.mk _ ≤ Q.mk _
     simp only [mk_le_mk]
-    simp [Semiring.add_comm]; exact Preorder.le_refl (a₁ + a₂)
+    simp [Semiring.add_comm]; exact le_refl (a₁ + a₂)
   le_trans {a b c} h₁ h₂ := by
     induction a using Q.ind with | _ a
     induction b using Q.ind with | _ b
@@ -402,23 +404,23 @@ instance [LE α] [LT α] [Preorder α] [OrderedAdd α] : Preorder (OfSemiring.Q
     rw [this]; clear this
     exact OrderedAdd.add_le_add h₁ h₂
 
-@[local simp] private theorem mk_lt_mk [LE α] [LT α] [Preorder α] [OrderedAdd α] {a₁ a₂ b₁ b₂ : α}  :
+@[local simp] private theorem mk_lt_mk [LE α] [LT α] [LawfulOrderLT α] [IsPreorder α] [OrderedAdd α] {a₁ a₂ b₁ b₂ : α}  :
     Q.mk (a₁, a₂) < Q.mk (b₁, b₂) ↔ a₁ + b₂ < a₂ + b₁ := by
-  simp [Preorder.lt_iff_le_not_le, Semiring.add_comm]
+  simp [lt_iff_le_and_not_ge, Semiring.add_comm]
 
-@[local simp] private theorem mk_pos [LE α] [LT α] [Preorder α] [OrderedAdd α] {a₁ a₂ : α} :
+@[local simp] private theorem mk_pos [LE α] [LT α] [LawfulOrderLT α] [IsPreorder α] [OrderedAdd α] {a₁ a₂ : α} :
     0 < Q.mk (a₁, a₂) ↔ a₂ < a₁ := by
   simp [← toQ_ofNat, toQ, mk_lt_mk, AddCommMonoid.zero_add]
 
 @[local simp]
-theorem toQ_le [LE α] [LT α] [Preorder α] [OrderedAdd α] {a b : α} : toQ a ≤ toQ b ↔ a ≤ b := by
+theorem toQ_le [LE α] [IsPreorder α] [OrderedAdd α] {a b : α} : toQ a ≤ toQ b ↔ a ≤ b := by
   simp
 
 @[local simp]
-theorem toQ_lt [LE α] [LT α] [Preorder α] [OrderedAdd α] {a b : α} : toQ a < toQ b ↔ a < b := by
-  simp [Preorder.lt_iff_le_not_le]
+theorem toQ_lt [LE α] [LT α] [LawfulOrderLT α] [IsPreorder α] [OrderedAdd α] {a b : α} : toQ a < toQ b ↔ a < b := by
+  simp [lt_iff_le_and_not_ge]
 
-instance [LE α] [LT α] [Preorder α] [OrderedAdd α] : OrderedAdd (OfSemiring.Q α) where
+instance [LE α] [IsPreorder α] [OrderedAdd α] : OrderedAdd (OfSemiring.Q α) where
   add_le_left_iff := by
     intro a b c
     obtain ⟨⟨a₁, a₂⟩⟩ := a
@@ -432,7 +434,7 @@ instance [LE α] [LT α] [Preorder α] [OrderedAdd α] : OrderedAdd (OfSemiring.
     rw [← OrderedAdd.add_le_left_iff]
 
 -- This perhaps works in more generality than `ExistsAddOfLT`?
-instance [LE α] [LT α] [Preorder α] [OrderedRing α] [ExistsAddOfLT α] : OrderedRing (OfSemiring.Q α) where
+instance [LE α] [LT α] [LawfulOrderLT α] [IsPreorder α] [OrderedRing α] [ExistsAddOfLT α] : OrderedRing (OfSemiring.Q α) where
   zero_lt_one := by
     rw [← toQ_ofNat, ← toQ_ofNat, toQ_lt]
     exact OrderedRing.zero_lt_one

src/Init/Grind/Ring/Poly.lean

@@ -19,6 +19,8 @@ public import Init.GrindInstances.Ring.Int
 
 @[expose] public section
 
+open Std
+
 namespace Lean.Grind
 -- These are no longer global instances, so we need to turn them on here.
 attribute [local instance] Semiring.natCast Ring.intCast
@@ -362,7 +364,7 @@ instance : LawfulBEq Poly where
 def Poly.denote [Ring α] (ctx : Context α) (p : Poly) : α :=
   match p with
   | .num k => Int.cast k
-  | .add k m p => HMul.hMul (α := Int) k (m.denote ctx) + denote ctx p
+  | .add k m p => k • (m.denote ctx) + denote ctx p
 
 @[expose]
 def Poly.denote' [Ring α] (ctx : Context α) (p : Poly) : α :=
@@ -374,7 +376,7 @@ where
     bif k == 1 then
       m.denote' ctx
     else
-      HMul.hMul (α := Int) k (m.denote' ctx)
+      k • m.denote' ctx
 
   go (p : Poly) (acc : α) : α :=
     match p with
@@ -1411,8 +1413,8 @@ where
 @[expose]
 def Poly.denoteAsIntModule [CommRing α] (ctx : Context α) (p : Poly) : α :=
   match p with
-  | .num k => HMul.hMul (α := Int) k (One.one : α)
-  | .add k m p => HMul.hMul (α := Int) k (m.denoteAsIntModule ctx) + denoteAsIntModule ctx p
+  | .num k => k • (One.one : α)
+  | .add k m p => k • (m.denoteAsIntModule ctx) + denoteAsIntModule ctx p
 
 theorem Mon.denoteAsIntModule_go_eq_denote {α} [CommRing α] (ctx : Context α) (m : Mon) (acc : α)
     : denoteAsIntModule.go ctx m acc = acc * m.denote ctx := by
@@ -1438,21 +1440,21 @@ theorem diseq_norm {α} [CommRing α] (ctx : Context α) (lhs rhs : Expr) (p : P
 
 open OrderedAdd
 
-theorem le_norm {α} [CommRing α] [LE α] [LT α] [Preorder α] [OrderedRing α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem le_norm {α} [CommRing α] [LE α] [LT α] [IsPreorder α] [OrderedRing α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
     : core_cert lhs rhs p → lhs.denote ctx ≤ rhs.denote ctx → p.denoteAsIntModule ctx ≤ 0 := by
   simp [core_cert, Poly.denoteAsIntModule_eq_denote]; intro _ h; subst p; simp [Expr.denote_toPoly, Expr.denote]
   replace h := add_le_left h ((-1) * rhs.denote ctx)
   rw [neg_mul, ← sub_eq_add_neg, one_mul, ← sub_eq_add_neg, sub_self] at h
   assumption
 
-theorem lt_norm {α} [CommRing α] [LE α] [LT α] [Preorder α] [OrderedRing α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem lt_norm {α} [CommRing α] [LE α] [LT α] [LawfulOrderLT α] [IsPreorder α] [OrderedRing α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
     : core_cert lhs rhs p → lhs.denote ctx < rhs.denote ctx → p.denoteAsIntModule ctx < 0 := by
   simp [core_cert, Poly.denoteAsIntModule_eq_denote]; intro _ h; subst p; simp [Expr.denote_toPoly, Expr.denote]
   replace h := add_lt_left h ((-1) * rhs.denote ctx)
   rw [neg_mul, ← sub_eq_add_neg, one_mul, ← sub_eq_add_neg, sub_self] at h
   assumption
 
-theorem not_le_norm {α} [CommRing α] [LE α] [LT α] [LinearOrder α] [OrderedRing α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem not_le_norm {α} [CommRing α] [LE α] [LT α] [LawfulOrderLT α] [IsLinearOrder α] [OrderedRing α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
     : core_cert rhs lhs p → ¬ lhs.denote ctx ≤ rhs.denote ctx → p.denoteAsIntModule ctx < 0 := by
   simp [core_cert, Poly.denoteAsIntModule_eq_denote]; intro _ h₁; subst p; simp [Expr.denote_toPoly, Expr.denote]
   replace h₁ := LinearOrder.lt_of_not_le h₁
@@ -1460,7 +1462,7 @@ theorem not_le_norm {α} [CommRing α] [LE α] [LT α] [LinearOrder α] [Ordered
   simp [← sub_eq_add_neg, sub_self] at h₁
   assumption
 
-theorem not_lt_norm {α} [CommRing α] [LE α] [LT α] [LinearOrder α] [OrderedRing α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem not_lt_norm {α} [CommRing α] [LE α] [LT α] [LawfulOrderLT α] [IsLinearOrder α] [OrderedRing α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
     : core_cert rhs lhs p → ¬ lhs.denote ctx < rhs.denote ctx → p.denoteAsIntModule ctx ≤ 0 := by
   simp [core_cert, Poly.denoteAsIntModule_eq_denote]; intro _ h₁; subst p; simp [Expr.denote_toPoly, Expr.denote]
   replace h₁ := LinearOrder.le_of_not_lt h₁
@@ -1468,14 +1470,14 @@ theorem not_lt_norm {α} [CommRing α] [LE α] [LT α] [LinearOrder α] [Ordered
   simp [← sub_eq_add_neg, sub_self] at h₁
   assumption
 
-theorem not_le_norm' {α} [CommRing α] [LE α] [LT α] [Preorder α] [OrderedRing α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem not_le_norm' {α} [CommRing α] [LE α] [LT α] [IsPreorder α] [OrderedRing α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
     : core_cert lhs rhs p → ¬ lhs.denote ctx ≤ rhs.denote ctx → ¬ p.denoteAsIntModule ctx ≤ 0 := by
   simp [core_cert, Poly.denoteAsIntModule_eq_denote]; intro _ h₁; subst p; simp [Expr.denote_toPoly, Expr.denote]; intro h
   replace h : rhs.denote ctx + (lhs.denote ctx - rhs.denote ctx) ≤ _ := add_le_right (rhs.denote ctx) h
   rw [sub_eq_add_neg, add_left_comm, ← sub_eq_add_neg, sub_self] at h; simp [add_zero] at h
   contradiction
 
-theorem not_lt_norm' {α} [CommRing α] [LE α] [LT α] [Preorder α] [OrderedRing α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem not_lt_norm' {α} [CommRing α] [LE α] [LT α] [LawfulOrderLT α] [IsPreorder α] [OrderedRing α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
     : core_cert lhs rhs p → ¬ lhs.denote ctx < rhs.denote ctx → ¬ p.denoteAsIntModule ctx < 0 := by
   simp [core_cert, Poly.denoteAsIntModule_eq_denote]; intro _ h₁; subst p; simp [Expr.denote_toPoly, Expr.denote]; intro h
   replace h : rhs.denote ctx + (lhs.denote ctx - rhs.denote ctx) < _ := add_lt_right (rhs.denote ctx) h

src/Init/Grind/Tactics.lean

@@ -114,6 +114,7 @@ structure Config where
   When `true` (default: `true`), uses procedure for handling associative (and commutative) operators.
   -/
   ac := true
+  acSteps := 1000
   /--
   Maximum exponent eagerly evaluated while computing bounds for `ToInt` and
   the characteristic of a ring.
@@ -432,7 +433,7 @@ are only internalized after `grind` decided whether the condition is
 -/
 
 -- The following symbols are only used as the root pattern symbol if there isn't another option
-attribute [grind symbol low] HAdd.hAdd HSub.hSub HMul.hMul Dvd.dvd HDiv.hDiv HMod.hMod
+attribute [grind symbol low] HAdd.hAdd HSub.hSub HMul.hMul HSMul.hSMul Dvd.dvd HDiv.hDiv HMod.hMod
 
 -- TODO: improve pattern inference heuristics and reduce priority for LT.lt and LE.le
 -- attribute [grind symbol low] LT.lt LE.le

src/Init/GrindInstances/Ring/BitVec.lean

@@ -56,15 +56,4 @@ example : ToInt.Sub (BitVec w) (.uint w) := inferInstance
 instance : ToInt.Pow (BitVec w) (.uint w) :=
   ToInt.pow_of_semiring (by simp)
 
-instance : Preorder (BitVec w) where
-  le_refl := BitVec.le_refl
-  le_trans := BitVec.le_trans
-  lt_iff_le_not_le {a b} := Std.LawfulOrderLT.lt_iff a b
-
-instance : PartialOrder (BitVec w) where
-  le_antisymm := BitVec.le_antisymm
-
-instance : LinearOrder (BitVec w) where
-  le_total := BitVec.le_total
-
 end Lean.Grind

src/Init/GrindInstances/Ring/Fin.lean

@@ -126,7 +126,9 @@ instance (n : Nat) [NeZero n] : CommRing (Fin n) where
   ofNat_succ := Fin.ofNat_succ
   sub_eq_add_neg := Fin.sub_eq_add_neg
   intCast_neg := Fin.intCast_neg
-  neg_zsmul i a := by simp [intCast_neg, neg_mul]
+  neg_zsmul i a := by
+    change (((-i) : Int) : Fin n)* a = - ((i : Fin n) * a)
+    simp [intCast_neg, neg_mul]
   zsmul_natCast_eq_nsmul _ _ := rfl
 
 instance (n : Nat) [NeZero n] : IsCharP (Fin n) n := IsCharP.mk' _ _

src/Init/GrindInstances/Ring/Nat.lean

@@ -9,6 +9,8 @@ prelude
 public import Init.Grind.Ordered.Ring
 public import Init.Data.Int.Lemmas
 
+open Std
+
 public section
 
 namespace Lean.Grind
@@ -29,10 +31,12 @@ instance : CommSemiring Nat where
   pow_succ _ _ := by rfl
   ofNat_succ _ := by rfl
 
-instance : Preorder Nat where
+instance : IsPreorder Nat where
   le_refl := by omega
   le_trans := by omega
-  lt_iff_le_not_le := by omega
+
+instance : LawfulOrderLT Nat where
+  lt_iff := by omega
 
 instance : OrderedRing Nat where
   add_le_left_iff := by omega

src/Init/GrindInstances/Ring/Rat.lean

@@ -35,7 +35,9 @@ instance : Field Rat where
     simp only [Int.natCast_add, Int.cast_ofNat_Int, Rat.intCast_add]
     rfl
   sub_eq_add_neg := Rat.sub_eq_add_neg
-  neg_zsmul i a := by simp [Rat.intCast_neg, Rat.neg_mul]
+  neg_zsmul i a := by
+    change ((-i : Int) : Rat) * a = -(i * a)
+    simp [Rat.intCast_neg, Rat.neg_mul]
   div_eq_mul_inv := Rat.div_def
   zero_ne_one := by decide
   inv_zero := Rat.inv_zero
@@ -51,8 +53,7 @@ instance : IsCharP Rat 0 := IsCharP.mk' _ _
 
 instance : NoNatZeroDivisors Rat where
   no_nat_zero_divisors k a b h₁ h₂ := by
-    replace h₁ : (k : Rat) ≠ 0 := by change ((k : Int) : Rat) ≠ ((0 : Int) : Rat); simp [h₁]
-    replace h₂ : (k : Rat)⁻¹ * (k * a) = (k : Rat)⁻¹ * (k * b) := congrArg (_ * ·) h₂
-    simpa only [← Rat.mul_assoc, Rat.inv_mul_cancel _ h₁, Rat.one_mul] using h₂
+    change k * a = k * b at h₂
+    simpa [← Rat.mul_assoc, Rat.inv_mul_cancel, h₁] using congrArg ((k : Rat)⁻¹ * ·) h₂
 
 end Lean.Grind

src/Init/GrindInstances/Ring/SInt.lean

@@ -56,7 +56,9 @@ instance : CommRing Int8 where
   pow_succ := Int8.pow_succ
   ofNat_succ x := Int8.ofNat_add x 1
   intCast_neg := Int8.ofInt_neg
-  neg_zsmul i x := by simp [Int8.intCast_neg, Int8.neg_mul]
+  neg_zsmul i x := by
+    change (-i : Int) * x = - (i * x)
+    simp [Int8.intCast_neg, Int8.neg_mul]
   zsmul_natCast_eq_nsmul n a := congrArg (· * a) (Int8.intCast_ofNat _)
 
 instance : IsCharP Int8 (2 ^ 8) := IsCharP.mk' _ _
@@ -109,7 +111,9 @@ instance : CommRing Int16 where
   pow_succ := Int16.pow_succ
   ofNat_succ x := Int16.ofNat_add x 1
   intCast_neg := Int16.ofInt_neg
-  neg_zsmul i x := by simp [Int16.intCast_neg, Int16.neg_mul]
+  neg_zsmul i x := by
+    change (-i : Int) * x = - (i * x)
+    simp [Int16.intCast_neg, Int16.neg_mul]
   zsmul_natCast_eq_nsmul n a := congrArg (· * a) (Int16.intCast_ofNat _)
 
 instance : IsCharP Int16 (2 ^ 16) := IsCharP.mk' _ _
@@ -162,7 +166,9 @@ instance : CommRing Int32 where
   pow_succ := Int32.pow_succ
   ofNat_succ x := Int32.ofNat_add x 1
   intCast_neg := Int32.ofInt_neg
-  neg_zsmul i x := by simp [Int32.intCast_neg, Int32.neg_mul]
+  neg_zsmul i x := by
+    change (-i : Int) * x = - (i * x)
+    simp [Int32.intCast_neg, Int32.neg_mul]
   zsmul_natCast_eq_nsmul n a := congrArg (· * a) (Int32.intCast_ofNat _)
 
 instance : IsCharP Int32 (2 ^ 32) := IsCharP.mk' _ _
@@ -215,7 +221,9 @@ instance : CommRing Int64 where
   pow_succ := Int64.pow_succ
   ofNat_succ x := Int64.ofNat_add x 1
   intCast_neg := Int64.ofInt_neg
-  neg_zsmul i x := by simp [Int64.intCast_neg, Int64.neg_mul]
+  neg_zsmul i x := by
+    change (-i : Int) * x = - (i * x)
+    simp [Int64.intCast_neg, Int64.neg_mul]
   zsmul_natCast_eq_nsmul n a := congrArg (· * a) (Int64.intCast_ofNat _)
 
 instance : IsCharP Int64 (2 ^ 64) := IsCharP.mk' _ _
@@ -268,7 +276,9 @@ instance : CommRing ISize where
   pow_succ := ISize.pow_succ
   ofNat_succ x := ISize.ofNat_add x 1
   intCast_neg := ISize.ofInt_neg
-  neg_zsmul i x := by simp [ISize.intCast_neg, ISize.neg_mul]
+  neg_zsmul i x := by
+    change (-i : Int) * x = - (i * x)
+    simp [ISize.intCast_neg, ISize.neg_mul]
   zsmul_natCast_eq_nsmul n a := congrArg (· * a) (ISize.intCast_ofNat _)
 
 open System.Platform (numBits)

src/Init/GrindInstances/Ring/UInt.lean

@@ -186,7 +186,9 @@ instance : CommRing UInt8 where
   ofNat_succ x := UInt8.ofNat_add x 1
   intCast_neg := UInt8.ofInt_neg
   intCast_ofNat := UInt8.intCast_ofNat
-  neg_zsmul i a := by simp [UInt8.intCast_neg, UInt8.neg_mul]
+  neg_zsmul i a := by
+    change (-i : Int) * a = - (i * a)
+    simp [UInt8.intCast_neg, UInt8.neg_mul]
   zsmul_natCast_eq_nsmul n a := congrArg (· * a) (UInt8.intCast_ofNat _)
 
 instance : IsCharP UInt8 256 := IsCharP.mk' _ _
@@ -223,7 +225,9 @@ instance : CommRing UInt16 where
   ofNat_succ x := UInt16.ofNat_add x 1
   intCast_neg := UInt16.ofInt_neg
   intCast_ofNat := UInt16.intCast_ofNat
-  neg_zsmul i a := by simp [UInt16.intCast_neg, UInt16.neg_mul]
+  neg_zsmul i a := by
+    change (-i : Int) * a = - (i * a)
+    simp [UInt16.intCast_neg, UInt16.neg_mul]
   zsmul_natCast_eq_nsmul n a := congrArg (· * a) (UInt16.intCast_ofNat _)
 
 instance : IsCharP UInt16 65536 := IsCharP.mk' _ _
@@ -260,7 +264,9 @@ instance : CommRing UInt32 where
   ofNat_succ x := UInt32.ofNat_add x 1
   intCast_neg := UInt32.ofInt_neg
   intCast_ofNat := UInt32.intCast_ofNat
-  neg_zsmul i a := by simp [UInt32.intCast_neg, UInt32.neg_mul]
+  neg_zsmul i a := by
+    change (-i : Int) * a = - (i * a)
+    simp [UInt32.intCast_neg, UInt32.neg_mul]
   zsmul_natCast_eq_nsmul n a := congrArg (· * a) (UInt32.intCast_ofNat _)
 
 instance : IsCharP UInt32 4294967296 := IsCharP.mk' _ _
@@ -297,7 +303,9 @@ instance : CommRing UInt64 where
   ofNat_succ x := UInt64.ofNat_add x 1
   intCast_neg := UInt64.ofInt_neg
   intCast_ofNat := UInt64.intCast_ofNat
-  neg_zsmul i a := by simp [UInt64.intCast_neg, UInt64.neg_mul]
+  neg_zsmul i a := by
+    change (-i : Int) * a = - (i * a)
+    simp [UInt64.intCast_neg, UInt64.neg_mul]
   zsmul_natCast_eq_nsmul n a := congrArg (· * a) (UInt64.intCast_ofNat _)
 
 instance : IsCharP UInt64 18446744073709551616 := IsCharP.mk' _ _
@@ -334,7 +342,9 @@ instance : CommRing USize where
   ofNat_succ x := USize.ofNat_add x 1
   intCast_neg := USize.ofInt_neg
   intCast_ofNat := USize.intCast_ofNat
-  neg_zsmul i a := by simp [USize.intCast_neg, USize.neg_mul]
+  neg_zsmul i a := by
+    change (-i : Int) * a = - (i * a)
+    simp [USize.intCast_neg, USize.neg_mul]
   zsmul_natCast_eq_nsmul n a := congrArg (· * a) (USize.intCast_ofNat _)
 
 open System.Platform

src/Init/Meta.lean

@@ -131,6 +131,12 @@ def isInaccessibleUserName : Name → Bool
   | Name.num p _   => isInaccessibleUserName p
   | _              => false
 
+-- FIXME: `getUtf8Byte` is in `Init.Data.String.Extra`, which causes an import cycle with
+-- `Init.Meta`. Moving `getUtf8Byte` up to `Init.Data.String.Basic` creates another import cycle.
+-- Please replace this definition with `getUtf8Byte` when the string refactor is through.
+@[extern "lean_string_get_byte_fast"]
+private opaque getUtf8Byte' (s : @& String) (n : Nat) (h : n < s.utf8ByteSize) : UInt8
+
 /--
 Creates a round-trippable string name component if possible, otherwise returns `none`.
 Names that are valid identifiers are not escaped, and otherwise, if they do not contain `»`, they are escaped.

src/Init/Notation.lean

@@ -751,7 +751,24 @@ Message ordering for `#guard_msgs`:
 syntax guardMsgsOrdering := &"ordering" " := " guardMsgsOrderingArg
 
 set_option linter.missingDocs false in
-syntax guardMsgsSpecElt := guardMsgsFilter <|> guardMsgsWhitespace <|> guardMsgsOrdering
+syntax guardMsgsPositionsArg := &"true" <|> &"false"
+
+/--
+Position reporting for `#guard_msgs`:
+- `positions := true` will report the positions of messages with the line numbers computed
+  relative to the line of the `#guard_msgs` token, e.g.
+  ```
+  @ +3:7...+4:2
+  info: <message>
+  ```
+  Note that the reported column is absolute.
+- `positions := false` (the default) will not render positions.
+-/
+syntax guardMsgsPositions := &"positions" " := " guardMsgsPositionsArg
+
+set_option linter.missingDocs false in
+syntax guardMsgsSpecElt :=
+  guardMsgsFilter <|> guardMsgsWhitespace <|> guardMsgsOrdering <|> guardMsgsPositions
 
 set_option linter.missingDocs false in
 syntax guardMsgsSpec := "(" guardMsgsSpecElt,* ")"
@@ -795,7 +812,8 @@ In general, `#guard_msgs` accepts a comma-separated list of configuration clause
 ```
 #guard_msgs (configElt,*) in cmd
 ```
-By default, the configuration list is `(check all, whitespace := normalized, ordering := exact)`.
+By default, the configuration list is
+`(check all, whitespace := normalized, ordering := exact, positions := false)`.
 
 Message filters select messages by severity:
 - `info`, `warning`, `error`: (non-trace) messages with the given severity level.
@@ -821,6 +839,11 @@ Message ordering:
 - `ordering := sorted` sorts the messages in lexicographic order.
   This helps with testing commands that are non-deterministic in their ordering.
 
+Position reporting:
+- `positions := true` reports the ranges of all messages relative to the line on which
+  `#guard_msgs` appears.
+- `positions := false` does not report position info.
+
 For example, `#guard_msgs (error, drop all) in cmd` means to check warnings and drop
 everything else.
 

src/Lean/AddDecl.lean

@@ -94,6 +94,10 @@ def addDecl (decl : Declaration) : CoreM Unit := do
       if (← getEnv).header.isModule && !(← getEnv).isExporting then
         exportedInfo? := some <| .axiomInfo { defn with isUnsafe := defn.safety == .unsafe }
       pure (defn.name, .defnInfo defn, .defn)
+    | .opaqueDecl op =>
+      if (← getEnv).header.isModule && !(← getEnv).isExporting then
+        exportedInfo? := some <| .axiomInfo { op with }
+      pure (op.name, .opaqueInfo op, .opaque)
     | .axiomDecl ax => pure (ax.name, .axiomInfo ax, .axiom)
     | _ => return (← doAdd)
 

src/Lean/Compiler/IR/CompilerM.lean

@@ -172,7 +172,7 @@ def containsDecl (n : Name) : CompilerM Bool :=
   return (← findDecl n).isSome
 
 def getDecl (n : Name) : CompilerM Decl := do
-  let (some decl) ← findDecl n | throwError s!"unknown declaration '{n}'"
+  let (some decl) ← findDecl n | throwError s!"unknown declaration `{n}`"
   return decl
 
 def findLocalDecl (n : Name) : CompilerM (Option Decl) :=
@@ -203,7 +203,7 @@ def containsDecl' (n : Name) (decls : Array Decl) : CompilerM Bool := do
     containsDecl n
 
 def getDecl' (n : Name) (decls : Array Decl) : CompilerM Decl := do
-  let (some decl) ← findDecl' n decls | throwError s!"unknown declaration '{n}'"
+  let (some decl) ← findDecl' n decls | throwError s!"unknown declaration `{n}`"
   return decl
 
 @[export lean_decl_get_sorry_dep]

src/Lean/Compiler/IR/EmitC.lean

@@ -102,9 +102,7 @@ def emitFnDeclAux (decl : Decl) (cppBaseName : String) (isExternal : Bool) : M U
   let env ← getEnv
   if ps.isEmpty then
     if isExternal then emit "extern "
-    -- The first half is a pre-module system approximation, we keep it around for the benefit of
-    -- unported code.
-    else if isClosedTermName env decl.name || !Compiler.LCNF.isDeclPublic env decl.name then emit "static "
+    else if isClosedTermName env decl.name then emit "static "
     else emit "LEAN_EXPORT "
   else
     if !isExternal then emit "LEAN_EXPORT "

src/Lean/Compiler/IR/ToIR.lean

@@ -201,9 +201,9 @@ partial def lowerLet (decl : LCNF.LetDecl) (k : LCNF.Code) : M FnBody := do
     | some (.defnInfo ..) | some (.opaqueInfo ..) =>
       mkFap name irArgs
     | some (.axiomInfo ..) | .some (.quotInfo ..) | .some (.inductInfo ..) | .some (.thmInfo ..) =>
-      throwNamedError lean.dependsOnNoncomputable f!"'{name}' not supported by code generator; consider marking definition as 'noncomputable'"
+      throwNamedError lean.dependsOnNoncomputable f!"`{name}` not supported by code generator; consider marking definition as `noncomputable`"
     | some (.recInfo ..) =>
-      throwError f!"code generator does not support recursor '{name}' yet, consider using 'match ... with' and/or structural recursion"
+      throwError f!"code generator does not support recursor `{name}` yet, consider using 'match ... with' and/or structural recursion"
     | none => panic! "reference to unbound name"
   | .fvar fvarId args =>
     match (← getFVarValue fvarId) with

src/Lean/Compiler/InitAttr.lean

@@ -53,10 +53,10 @@ unsafe def registerInitAttrUnsafe (attrName : Name) (runAfterImport : Bool) (ref
         let initFnName ← Elab.realizeGlobalConstNoOverloadWithInfo initFnName
         let initDecl ← getConstInfo initFnName
         match getIOTypeArg initDecl.type with
-        | none => throwError "initialization function '{initFnName}' must have type of the form `IO <type>`"
+        | none => throwError "initialization function `{initFnName}` must have type of the form `IO <type>`"
         | some initTypeArg =>
           if decl.type == initTypeArg then pure initFnName
-          else throwError "initialization function '{initFnName}' type mismatch"
+          else throwError "initialization function `{initFnName}` type mismatch"
       | none =>
         if isIOUnit decl.type then pure Name.anonymous
         else throwError "initialization function must have type `IO Unit`"

src/Lean/Compiler/InlineAttrs.lean

@@ -79,7 +79,7 @@ builtin_initialize inlineAttrs : EnumAttributes InlineAttributeKind ←
           throwError "Cannot add `[macro_inline]` attribute to `{.ofConstName declName}`: This attribute does not support this kind of declaration; only non-recursive definitions are supported"
         withExporting (isExporting := !isPrivateName declName) do
           if !(← getConstInfo declName).isDefinition then
-            throwError "invalid `[macro_inline]` attribute, '{.ofConstName declName}' must be an exposed definition"
+            throwError "invalid `[macro_inline]` attribute, `{.ofConstName declName}` must be an exposed definition"
 
 def setInlineAttribute (env : Environment) (declName : Name) (kind : InlineAttributeKind) : Except String Environment :=
   inlineAttrs.setValue env declName kind

src/Lean/Compiler/LCNF/Visibility.lean

@@ -30,10 +30,15 @@ where
     | .const declName .. => s.insert declName
     | _ => s
 
--- TODO: refine? balance run time vs export size
-private def isBodyRelevant (decl : Decl) : CompilerM Bool := do
-  let opts := (← getOptions)
-  decl.isTemplateLike <||> decl.value.isCodeAndM (pure <| ·.sizeLe (compiler.small.get opts))
+private def shouldExportBody (decl : Decl) : CompilerM Bool := do
+  -- Export body if template-like...
+  decl.isTemplateLike <||>
+  -- ...or it is below the (local) opportunistic inlining threshold and its `Expr` is exported
+  -- anyway, unlikely leading to more rebuilds
+  decl.value.isCodeAndM fun code => do
+    return (
+      ((← getEnv).setExporting true |>.findAsync? decl.name |>.any (·.kind == .defn)) &&
+      code.sizeLe (compiler.small.get (← getOptions)))
 
 /--
 Marks the given declaration as to be exported and recursively infers the correct visibility of its
@@ -41,7 +46,7 @@ body and referenced declarations based on that.
 -/
 partial def markDeclPublicRec (phase : Phase) (decl : Decl) : CompilerM Unit := do
   modifyEnv (setDeclPublic · decl.name)
-  if (← isBodyRelevant decl) && !isDeclTransparent (← getEnv) phase decl.name then
+  if (← shouldExportBody decl) && !isDeclTransparent (← getEnv) phase decl.name then
     trace[Compiler.inferVisibility] m!"Marking {decl.name} as transparent because it is opaque and its body looks relevant"
     modifyEnv (setDeclTransparent · phase decl.name)
     decl.value.forCodeM fun code =>

src/Lean/CoreM.lean

@@ -674,7 +674,7 @@ private def checkUnsupported [Monad m] [MonadEnv m] [MonadError m] (decl : Decla
         && !supportedRecursors.contains declName
       | _ => false
     match unsupportedRecursor? with
-    | some (Expr.const declName ..) => throwError "code generator does not support recursor '{.ofConstName declName}' yet, consider using 'match ... with' and/or structural recursion"
+    | some (Expr.const declName ..) => throwError "code generator does not support recursor `{.ofConstName declName}` yet, consider using `match ... with` and/or structural recursion"
     | _ => pure ()
 
 /--

src/Lean/DocString/Add.lean

@@ -48,8 +48,11 @@ Adds a docstring to the environment, validating documentation links.
 def addDocString
     [Monad m] [MonadError m] [MonadEnv m] [MonadLog m] [AddMessageContext m] [MonadOptions m] [MonadLiftT IO m]
     (declName : Name) (docComment : TSyntax `Lean.Parser.Command.docComment) : m Unit := do
+  if declName.isAnonymous then
+    -- This case might happen on partial elaboration; ignore instead of triggering any panics below
+    return
   unless (← getEnv).getModuleIdxFor? declName |>.isNone do
-    throwError "invalid doc string, declaration '{.ofConstName declName}' is in an imported module"
+    throwError "invalid doc string, declaration `{.ofConstName declName}` is in an imported module"
   validateDocComment docComment
   let docString : String ← getDocStringText docComment
   modifyEnv fun env => docStringExt.insert env declName docString.removeLeadingSpaces

src/Lean/DocString/Extension.lean

@@ -34,7 +34,7 @@ def addBuiltinDocString (declName : Name) (docString : String) : IO Unit := do
 
 def addDocStringCore [Monad m] [MonadError m] [MonadEnv m] (declName : Name) (docString : String) : m Unit := do
   unless (← getEnv).getModuleIdxFor? declName |>.isNone do
-    throwError "invalid doc string, declaration '{.ofConstName declName}' is in an imported module"
+    throwError "invalid doc string, declaration `{.ofConstName declName}` is in an imported module"
   modifyEnv fun env => docStringExt.insert env declName docString.removeLeadingSpaces
 
 def addDocStringCore' [Monad m] [MonadError m] [MonadEnv m] (declName : Name) (docString? : Option String) : m Unit :=

src/Lean/Elab/App.lean

@@ -1270,7 +1270,7 @@ If it resolves to `name`, returns `(S', name)`.
 private partial def findMethod? (structName fieldName : Name) : MetaM (Option (Name × Name)) := do
   let env ← getEnv
   let find? structName' : MetaM (Option (Name × Name)) := do
-    let fullName := structName' ++ fieldName
+    let fullName := privateToUserName structName' ++ fieldName
     -- We do not want to make use of the current namespace for resolution.
     let candidates := ResolveName.resolveGlobalName (← getEnv) Name.anonymous (← getOpenDecls) fullName
       |>.filter (fun (_, fieldList) => fieldList.isEmpty)

src/Lean/Elab/Binders.lean

@@ -195,7 +195,7 @@ def addLocalVarInfo (stx : Syntax) (fvar : Expr) : TermElabM Unit :=
 private def ensureAtomicBinderName (binderView : BinderView) : TermElabM Unit :=
   let n := binderView.id.getId.eraseMacroScopes
   unless n.isAtomic do
-    throwErrorAt binderView.id "invalid binder name '{n}', it must be atomic"
+    throwErrorAt binderView.id "invalid binder name `{n}`, it must be atomic"
 
 register_builtin_option checkBinderAnnotations : Bool := {
   defValue := true
@@ -781,8 +781,8 @@ def elabLetDeclAux (id : Syntax) (binders : Array Syntax) (typeStx : Syntax) (va
     -/
     let type ← withSynthesize (postpone := .partial) <| elabType typeStx
     let letMsg := if config.nondep then "have" else "let"
-    registerCustomErrorIfMVar type typeStx m!"failed to infer '{letMsg}' declaration type"
-    registerLevelMVarErrorExprInfo type typeStx m!"failed to infer universe levels in '{letMsg}' declaration type"
+    registerCustomErrorIfMVar type typeStx m!"failed to infer `{letMsg}` declaration type"
+    registerLevelMVarErrorExprInfo type typeStx m!"failed to infer universe levels in `{letMsg}` declaration type"
     if config.postponeValue then
       let type ← mkForallFVars fvars type
       let val  ← mkFreshExprMVar type

src/Lean/Elab/BuiltinCommand.lean

@@ -16,6 +16,7 @@ public import Lean.Elab.Open
 public import Lean.Elab.SetOption
 public import Init.System.Platform
 public import Lean.Meta.Hint
+public import Lean.Parser.Command
 
 public section
 
@@ -103,6 +104,9 @@ private def checkEndHeader : Name → List Scope → Option Name
       addScope (isNewNamespace := false) (isNoncomputable := ncTk.isSome) (isPublic := publicTk.isSome) (attrs := attrs) "" (← getCurrNamespace)
   | _                        => throwUnsupportedSyntax
 
+@[builtin_command_elab InternalSyntax.end_local_scope] def elabEndLocalScope : CommandElab := fun _ => do
+  setDelimitsLocal
+
 /--
 Produces a `Name` composed of the names of at most the innermost `n` scopes in `ss`, truncating if an
 empty scope is reached (so that we do not suggest names like `Foo.«».Bar`).
@@ -349,7 +353,7 @@ private def replaceBinderAnnotation (binder : TSyntax ``Parser.Term.bracketedBin
         | .strictImplicit => `(bracketedBinderF| {{$id $[: $ty?]?}})
         | .instImplicit => do
           let some ty := ty?
-            | throwErrorAt binder "cannot update binder annotation of variable '{id}' to instance implicit:\n\
+            | throwErrorAt binder "cannot update binder annotation of variable `{id}` to instance implicit:\n\
                 variable was originally declared without an explicit type"
           `(bracketedBinderF| [$(⟨id⟩) : $ty])
       for id in ids.reverse do
@@ -363,7 +367,7 @@ private def replaceBinderAnnotation (binder : TSyntax ``Parser.Term.bracketedBin
               runTermElabM fun _ => Term.withSynthesize <| Term.withAutoBoundImplicit <|
                 Term.elabBinder newBinder fun _ => pure ()
             catch e =>
-              throwErrorAt binder m!"cannot update binder annotation of variable '{id}' to instance implicit:\n\
+              throwErrorAt binder m!"cannot update binder annotation of variable `{id}` to instance implicit:\n\
                 {e.toMessageData}"
           varDeclsNew := varDeclsNew.push (← mkBinder id binderInfo)
         else
@@ -484,10 +488,11 @@ def failIfSucceeds (x : CommandElabM Unit) : CommandElabM Unit := do
   modify fun s => { s with maxRecDepth := maxRecDepth.get options }
   modifyScope fun scope => { scope with opts := options }
 
+open Lean.Parser.Command.InternalSyntax in
 @[builtin_macro Lean.Parser.Command.«in»] def expandInCmd : Macro
   | `($cmd₁ in%$tk $cmd₂) =>
     -- Limit ref variability for incrementality; see Note [Incremental Macros]
-    withRef tk `(section $cmd₁:command $cmd₂ end)
+    withRef tk `(section $cmd₁:command $endLocalScopeSyntax:command $cmd₂ end)
   | _                 => Macro.throwUnsupported
 
 @[builtin_command_elab Parser.Command.addDocString] def elabAddDeclDoc : CommandElab := fun stx => do
@@ -512,7 +517,7 @@ def failIfSucceeds (x : CommandElabM Unit) : CommandElabM Unit := do
       if let some idx := vars.findIdx? (· == id.getId) then
         uids := uids.push sc.varUIds[idx]!
       else
-        throwError "invalid 'include', variable '{id}' has not been declared in the current scope"
+        throwError "invalid 'include', variable `{id}` has not been declared in the current scope"
     modifyScope fun sc => { sc with
       includedVars := sc.includedVars ++ uids.toList
       omittedVars := sc.omittedVars.filter (!uids.contains ·) }
@@ -551,10 +556,10 @@ def failIfSucceeds (x : CommandElabM Unit) : CommandElabM Unit := do
             omittedVars := omittedVars.push uid
             omitsUsed := omitsUsed.set! idx true
           else
-            throwError "invalid 'omit', '{ldecl.userName}' has not been declared in the current scope"
+            throwError "invalid 'omit', `{ldecl.userName}` has not been declared in the current scope"
       for o in omits, used in omitsUsed do
         unless used do
-          throwError "'{o}' did not match any variables in the current scope"
+          throwError "`{o}` did not match any variables in the current scope"
       return omittedVars
     modifyScope fun sc => { sc with
       omittedVars := sc.omittedVars ++ omittedVars.toList

src/Lean/Elab/BuiltinEvalCommand.lean

@@ -140,13 +140,13 @@ private def mkFormat (e : Expr) : MetaM Expr := do
     if eval.derive.repr.get (← getOptions) then
       if let .const name _ := (← whnf (← inferType e)).getAppFn then
         try
-          trace[Elab.eval] "Attempting to derive a 'Repr' instance for '{.ofConstName name}'"
+          trace[Elab.eval] "Attempting to derive a `Repr` instance for `{.ofConstName name}`"
           liftCommandElabM do applyDerivingHandlers ``Repr #[name]
           resetSynthInstanceCache
           return ← mkRepr e
         catch ex =>
-          trace[Elab.eval] "Failed to use derived 'Repr' instance. Exception: {ex.toMessageData}"
-    throwError m!"could not synthesize a 'Repr' or 'ToString' instance for type{indentExpr (← inferType e)}"
+          trace[Elab.eval] "Failed to use derived `Repr` instance. Exception: {ex.toMessageData}"
+    throwError m!"could not synthesize a `Repr` or `ToString` instance for type{indentExpr (← inferType e)}"
 
 /--
 Returns a representation of `e` using `MessageData`, or else fails.
@@ -155,7 +155,7 @@ Tries `mkFormat` if a `ToExpr` instance can't be synthesized.
 private def mkMessageData (e : Expr) : MetaM Expr := do
   (do guard <| eval.pp.get (← getOptions); mkAppM ``MessageData.ofExpr #[← mkToExpr e])
   <|> (return mkApp (mkConst ``MessageData.ofFormat) (← mkFormat e))
-  <|> do throwError m!"could not synthesize a 'ToExpr', 'Repr', or 'ToString' instance for type{indentExpr (← inferType e)}"
+  <|> do throwError m!"could not synthesize a `ToExpr`, `Repr`, or `ToString` instance for type{indentExpr (← inferType e)}"
 
 private structure EvalAction where
   eval : CommandElabM MessageData
@@ -205,9 +205,9 @@ unsafe def elabEvalCoreUnsafe (bang : Bool) (tk term : Syntax) (expectedType? :
           discard <| withLocalDeclD `x ty fun x => mkT x
         catch _ =>
           throw ex
-        throwError m!"unable to synthesize '{.ofConstName ``MonadEval}' instance \
+        throwError m!"unable to synthesize `{.ofConstName ``MonadEval}` instance \
           to adapt{indentExpr (← inferType e)}\n\
-          to '{.ofConstName ``IO}' or '{.ofConstName ``CommandElabM}'."
+          to `{.ofConstName ``IO}` or `{.ofConstName ``CommandElabM}`."
       addAndCompileExprForEval declName r (allowSorry := bang)
       -- `evalConst` may emit IO, but this is collected by `withIsolatedStreams` below.
       let r ← toMessageData <$> evalConst t declName (checkMeta := !Elab.inServer.get (← getOptions))

src/Lean/Elab/BuiltinTerm.lean

@@ -119,7 +119,7 @@ private def elabOptLevel (stx : Syntax) : TermElabM Level :=
   match stx with
   | `(let_mvar% ? $n := $e; $b) =>
      match (← getMCtx).findUserName? n.getId with
-     | some _ => throwError "invalid 'let_mvar%', metavariable '?{n.getId}' has already been used"
+     | some _ => throwError "invalid `let_mvar%`, metavariable `?{n.getId}` has already been used"
      | none =>
        let e ← elabTerm e none
        let mvar ← mkFreshExprMVar (← inferType e) MetavarKind.syntheticOpaque n.getId
@@ -130,7 +130,7 @@ private def elabOptLevel (stx : Syntax) : TermElabM Level :=
 
 private def getMVarFromUserName (ident : Syntax) : MetaM Expr := do
   match (← getMCtx).findUserName? ident.getId with
-  | none => throwError "unknown metavariable '?{ident.getId}'"
+  | none => throwError "unknown metavariable `?{ident.getId}`"
   | some mvarId => instantiateMVars (mkMVar mvarId)
 
 
@@ -366,7 +366,7 @@ private opaque evalFilePath (stx : Syntax) : TermElabM System.FilePath
     let ctx ← readThe Lean.Core.Context
     let srcPath := System.FilePath.mk ctx.fileName
     let some srcDir := srcPath.parent
-      | throwError "cannot compute parent directory of '{srcPath}'"
+      | throwError "cannot compute parent directory of `{srcPath}`"
     let path := srcDir / path
     mkStrLit <$> IO.FS.readFile path
   | _, _ => throwUnsupportedSyntax

src/Lean/Elab/Command.lean

@@ -595,7 +595,7 @@ where go := do
           match commandElabAttribute.getEntries s.env k with
           | []      =>
             withInfoTreeContext (mkInfoTree := mkInfoTree `no_elab stx) <|
-              throwError "elaboration function for '{k}' has not been implemented"
+              throwError "elaboration function for `{k}` has not been implemented"
           | elabFns => elabCommandUsing s stx elabFns
     | _ =>
       withInfoTreeContext (mkInfoTree := mkInfoTree `no_elab stx) <|

src/Lean/Elab/DeclModifiers.lean

@@ -35,19 +35,19 @@ def checkNotAlreadyDeclared {m} [Monad m] [MonadEnv m] [MonadError m] [MonadFina
   if env.contains declName then
     addInfo declName
     match privateToUserName? declName with
-    | none          => throwError "'{.ofConstName declName true}' has already been declared"
-    | some declName => throwError "private declaration '{.ofConstName declName true}' has already been declared"
+    | none          => throwError "`{.ofConstName declName true}` has already been declared"
+    | some declName => throwError "private declaration `{.ofConstName declName true}` has already been declared"
   if isReservedName env (privateToUserName declName) || isReservedName env (mkPrivateName (← getEnv) declName) then
-    throwError "'{.ofConstName declName}' is a reserved name"
+    throwError "`{.ofConstName declName}` is a reserved name"
   if env.contains (mkPrivateName env declName) then
     addInfo (mkPrivateName env declName)
-    throwError "a private declaration '{.ofConstName declName true}' has already been declared"
+    throwError "a private declaration `{.ofConstName declName true}` has already been declared"
   match privateToUserName? declName with
   | none => pure ()
   | some declName =>
     if env.contains declName then
       addInfo declName
-      throwError "a non-private declaration '{.ofConstName declName true}' has already been declared"
+      throwError "a non-private declaration `{.ofConstName declName true}` has already been declared"
 
 /-- Declaration visibility modifier. That is, whether a declaration is public or private or inherits its visibility from the outer scope. -/
 inductive Visibility where
@@ -225,7 +225,7 @@ def checkIfShadowingStructureField (declName : Name) : m Unit := do
       let fieldNames := getStructureFieldsFlattened (← getEnv) pre
       for fieldName in fieldNames do
         if pre ++ fieldName == declName then
-          throwError "invalid declaration name '{.ofConstName declName}', structure '{pre}' has field '{fieldName}'"
+          throwError "invalid declaration name `{.ofConstName declName}`, structure `{pre}` has field `{fieldName}`"
   | _ => pure ()
 
 def mkDeclName (currNamespace : Name) (modifiers : Modifiers) (shortName : Name) : m (Name × Name) := do
@@ -238,7 +238,7 @@ def mkDeclName (currNamespace : Name) (modifiers : Modifiers) (shortName : Name)
     throwError "invalid declaration name `_root_`, `_root_` is a prefix used to refer to the 'root' namespace"
   let declName := if isRootName then { view with name := name.replacePrefix `_root_ Name.anonymous }.review else currNamespace ++ shortName
   if isRootName then
-    let .str p s := name | throwError "invalid declaration name '{name}'"
+    let .str p s := name | throwError "invalid declaration name `{name}`"
     shortName := Name.mkSimple s
     currNamespace := p.replacePrefix `_root_ Name.anonymous
   checkIfShadowingStructureField declName

src/Lean/Elab/Declaration.lean

@@ -12,6 +12,7 @@ public import Lean.Elab.DefView
 public import Lean.Elab.MutualDef
 public import Lean.Elab.MutualInductive
 public import Lean.Elab.DeclarationRange
+public import Lean.Parser.Command
 import Lean.Parser.Command
 
 public section
@@ -23,9 +24,9 @@ private def ensureValidNamespace (name : Name) : MacroM Unit := do
   match name with
   | .str p s =>
     if s == "_root_" then
-      Macro.throwError s!"invalid namespace '{name}', '_root_' is a reserved namespace"
+      Macro.throwError s!"invalid namespace `{name}`, `_root_` is a reserved namespace"
     ensureValidNamespace p
-  | .num .. => Macro.throwError s!"invalid namespace '{name}', it must not contain numeric parts"
+  | .num .. => Macro.throwError s!"invalid namespace `{name}`, it must not contain numeric parts"
   | .anonymous => return ()
 
 private def setDeclIdName (declId : Syntax) (nameNew : Name) : Syntax :=
@@ -141,7 +142,7 @@ def elabAxiom (modifiers : Modifiers) (stx : Syntax) : CommandElabM Unit := do
         if isExtern (← getEnv) declName then
           compileDecl decl
         Term.applyAttributesAt declName modifiers.attrs AttributeApplicationTime.afterCompilation
-
+open Lean.Parser.Command.InternalSyntax in
 /--
 Macro that expands a declaration with a complex name into an explicit `namespace` block.
 Implementing this step as a macro means that reuse checking is handled by `elabCommand`.
@@ -153,7 +154,7 @@ def expandNamespacedDeclaration : Macro := fun stx => do
     -- Limit ref variability for incrementality; see Note [Incremental Macros]
     let declTk := stx[1][0]
     let ns := mkIdentFrom declTk ns
-    withRef declTk `(namespace $ns $(⟨newStx⟩) end $ns)
+    withRef declTk `(namespace $ns $endLocalScopeSyntax:command $(⟨newStx⟩) end $ns)
   | none => Macro.throwUnsupported
 
 @[builtin_command_elab declaration, builtin_incremental]

src/Lean/Elab/Deriving/BEq.lean

@@ -104,12 +104,10 @@ def mkAuxFunction (ctx : Context) (i : Nat) : TermElabM Command := do
     let letDecls ← mkLocalInstanceLetDecls ctx `BEq header.argNames
     body ← mkLet letDecls body
   let binders    := header.binders
-  let vis := ctx.mkVisibilityFromTypes
   if ctx.usePartial then
     `(partial def $(mkIdent auxFunName):ident $binders:bracketedBinder* : Bool := $body:term)
   else
-    let expAttr := ctx.mkNoExposeAttrFromCtors
-    `(@[$[$expAttr],*] $vis:visibility def $(mkIdent auxFunName):ident $binders:bracketedBinder* : Bool := $body:term)
+    `(def $(mkIdent auxFunName):ident $binders:bracketedBinder* : Bool := $body:term)
 
 def mkMutualBlock (ctx : Context) : TermElabM Syntax := do
   let mut auxDefs := #[]
@@ -128,9 +126,7 @@ private def mkBEqInstanceCmds (declName : Name) : TermElabM (Array Syntax) := do
 
 private def mkBEqEnumFun (ctx : Context) (name : Name) : TermElabM Syntax := do
   let auxFunName := ctx.auxFunNames[0]!
-  let vis := ctx.mkVisibilityFromTypes
-  let expAttr := ctx.mkNoExposeAttrFromCtors
-  `(@[$[$expAttr],*] $vis:visibility def $(mkIdent auxFunName):ident  (x y : $(mkCIdent name)) : Bool := x.ctorIdx == y.ctorIdx)
+  `(def $(mkIdent auxFunName):ident  (x y : $(mkCIdent name)) : Bool := x.ctorIdx == y.ctorIdx)
 
 private def mkBEqEnumCmd (name : Name): TermElabM (Array Syntax) := do
   let ctx ← mkContext "beq" name
@@ -141,6 +137,7 @@ private def mkBEqEnumCmd (name : Name): TermElabM (Array Syntax) := do
 open Command
 
 def mkBEqInstance (declName : Name) : CommandElabM Unit := do
+  withoutExposeFromCtors declName do
     let cmds ← liftTermElabM <|
       if (← isEnumType declName) then
         mkBEqEnumCmd declName

src/Lean/Elab/Deriving/Basic.lean

@@ -229,12 +229,14 @@ def registerDerivingHandler (className : Name) (handler : DerivingHandler) : IO
     | some handlers => m.insert className (handler :: handlers)
     | none => m.insert className [handler]
 
-def applyDerivingHandlers (className : Name) (typeNames : Array Name) : CommandElabM Unit := do
-  -- When any of the types are private, the deriving handler will need access to the private scope
-  -- (and should also make sure to put its outputs in the private scope).
-  withoutExporting (when := typeNames.any isPrivateName) do
-  -- Deactivate some linting options that only make writing deriving handlers more painful.
-  withScope (fun sc => { sc with opts := sc.opts.setBool `warn.exposeOnPrivate false }) do
+def applyDerivingHandlers (className : Name) (typeNames : Array Name) (setExpose := false) : CommandElabM Unit := do
+  withScope (fun sc => { sc with
+    attrs := if setExpose then Unhygienic.run `(Parser.Term.attrInstance| expose) :: sc.attrs else sc.attrs
+    -- Deactivate some linting options that only make writing deriving handlers more painful.
+    opts := sc.opts.setBool `warn.exposeOnPrivate false
+    -- When any of the types are private, the deriving handler will need access to the private scope
+    -- and should create private instances.
+    isPublic := !typeNames.any isPrivateName }) do
   withTraceNode `Elab.Deriving (fun _ => return m!"running deriving handlers for `{.ofConstName className}`") do
     match (← derivingHandlersRef.get).find? className with
     | some handlers =>
@@ -262,10 +264,7 @@ def getOptDerivingClasses (optDeriving : Syntax) : CoreM (Array DerivingClassVie
 
 def DerivingClassView.applyHandlers (view : DerivingClassView) (declNames : Array Name) : CommandElabM Unit :=
   withRef view.ref do
-    (if view.hasExpose then withScope fun sc =>
-      { sc with attrs := Unhygienic.run `(Parser.Term.attrInstance| expose) :: sc.attrs }
-     else id) do
-      applyDerivingHandlers (← liftCoreM <| view.getClassName) declNames
+    applyDerivingHandlers (setExpose := view.hasExpose) (← liftCoreM <| view.getClassName) declNames
 
 private def elabDefDeriving (classes : Array DerivingClassView) (decls : Array Syntax) :
     CommandElabM Unit := runTermElabM fun _ => do

src/Lean/Elab/Deriving/DecEq.lean

@@ -101,8 +101,7 @@ def mkAuxFunction (ctx : Context) (auxFunName : Name) (indVal : InductiveVal): T
     then `(Parser.Termination.suffix|termination_by structural $target₁)
     else `(Parser.Termination.suffix|)
   let type    ← `(Decidable ($target₁ = $target₂))
-  let vis := ctx.mkVisibilityFromTypes
-  `($vis:visibility def $(mkIdent auxFunName):ident $binders:bracketedBinder* : $type:term := $body:term
+  `(def $(mkIdent auxFunName):ident $binders:bracketedBinder* : $type:term := $body:term
     $termSuffix:suffix)
 
 def mkAuxFunctions (ctx : Context) : TermElabM (TSyntax `command) := do
@@ -178,13 +177,11 @@ def mkEnumOfNatThm (declName : Name) : MetaM Unit := do
 
 def mkDecEqEnum (declName : Name) : CommandElabM Unit := do
   let cmd ← liftTermElabM do
-    let ctx ← mkContext "decEq" declName
     mkEnumOfNat declName
     mkEnumOfNatThm declName
     let ofNatIdent  := mkIdent (Name.mkStr declName "ofNat")
     let auxThmIdent := mkIdent (Name.mkStr declName "ofNat_ctorIdx")
-    let vis := ctx.mkVisibilityFromTypes
-    `($vis:visibility instance : DecidableEq $(mkCIdent declName) :=
+    `(instance : DecidableEq $(mkCIdent declName) :=
         fun x y =>
           if h : x.ctorIdx = y.ctorIdx then
             -- We use `rfl` in the following proof because the first script fails for unit-like datatypes due to etaStruct.
@@ -195,6 +192,7 @@ def mkDecEqEnum (declName : Name) : CommandElabM Unit := do
   elabCommand cmd
 
 def mkDecEqInstance (declName : Name) : CommandElabM Bool := do
+  withoutExposeFromCtors declName do
   if (← isEnumType declName) then
     mkDecEqEnum declName
     return true

src/Lean/Elab/Deriving/Hashable.lean

@@ -68,12 +68,11 @@ def mkAuxFunction (ctx : Context) (i : Nat) : TermElabM Command := do
     let letDecls ← mkLocalInstanceLetDecls ctx `Hashable header.argNames
     body ← mkLet letDecls body
   let binders    := header.binders
-  let vis := ctx.mkVisibilityFromTypes
   if ctx.usePartial then
     -- TODO(Dany): Get rid of this code branch altogether once we have well-founded recursion
-    `($vis:visibility partial def $(mkIdent auxFunName):ident $binders:bracketedBinder* : UInt64 := $body:term)
+    `(partial def $(mkIdent auxFunName):ident $binders:bracketedBinder* : UInt64 := $body:term)
   else
-    `(@[no_expose] $vis:visibility def $(mkIdent auxFunName):ident $binders:bracketedBinder* : UInt64 := $body:term)
+    `(@[no_expose] def $(mkIdent auxFunName):ident $binders:bracketedBinder* : UInt64 := $body:term)
 
 def mkHashFuncs (ctx : Context) : TermElabM Syntax := do
   let mut auxDefs := #[]
@@ -91,8 +90,9 @@ def mkHashableHandler (declNames : Array Name) : CommandElabM Bool := do
   withoutExporting do  -- This deriving handler handles visibility of generated decls syntactically
   if (← declNames.allM isInductive)  then
     for declName in declNames do
-      let cmds ← liftTermElabM <| mkHashableInstanceCmds declName
-      cmds.forM elabCommand
+      withoutExposeFromCtors declName do
+        let cmds ← liftTermElabM <| mkHashableInstanceCmds declName
+        cmds.forM elabCommand
     return true
   else
     return false

src/Lean/Elab/Deriving/Inhabited.lean

@@ -12,15 +12,12 @@ import Lean.Elab.Deriving.Util
 
 public section
 
-namespace Lean.Elab
+namespace Lean.Elab.Deriving
 open Command Meta Parser Term
 
 private abbrev IndexSet := Std.TreeSet Nat
 private abbrev LocalInst2Index := FVarIdMap Nat
 
-private def implicitBinderF := Parser.Term.implicitBinder
-private def instBinderF     := Parser.Term.instBinder
-
 private def mkInhabitedInstanceUsing (inductiveTypeName : Name) (ctorName : Name) (addHypotheses : Bool) : CommandElabM Bool := do
   match (← liftTermElabM mkInstanceCmd?) with
   | some cmd =>
@@ -77,16 +74,18 @@ where
       if assumingParamIdxs.contains i then
         let binder ← `(bracketedBinderF| [Inhabited $arg:ident ])
         binders := binders.push binder
-    let type ← `(Inhabited (@$(mkCIdent inductiveTypeName):ident $indArgs:ident*))
+    let type ← `(@$(mkCIdent inductiveTypeName):ident $indArgs:ident*)
     let mut ctorArgs := #[]
     for _ in *...ctorVal.numParams do
       ctorArgs := ctorArgs.push (← `(_))
     for _ in *...ctorVal.numFields do
       ctorArgs := ctorArgs.push (← ``(Inhabited.default))
-    let val ← `(⟨@$(mkIdent ctorName):ident $ctorArgs*⟩)
-    let vis := ctx.mkVisibilityFromTypes
-    let expAttr := ctx.mkNoExposeAttrFromCtors
-    `(@[$[$expAttr],*] $vis:visibility instance $binders:bracketedBinder* : $type := $val)
+    let val ← `(@$(mkIdent ctorName):ident $ctorArgs*)
+    let ctx ← mkContext "default" inductiveTypeName
+    let auxFunName := ctx.auxFunNames[0]!
+    `(def $(mkIdent auxFunName):ident $binders:bracketedBinder* : $type := $val
+      instance $binders:bracketedBinder* : Inhabited $type := ⟨$(mkIdent auxFunName)⟩)
+
 
   mkInstanceCmd? : TermElabM (Option Syntax) := do
     let ctorVal ← getConstInfoCtor ctorName
@@ -97,23 +96,24 @@ where
         for h : i in ctorVal.numParams...xs.size do
           let x := xs[i]
           let instType ← mkAppM `Inhabited #[(← inferType x)]
-          trace[Elab.Deriving.inhabited] "checking {instType} for '{ctorName}'"
+          trace[Elab.Deriving.inhabited] "checking {instType} for `{ctorName}`"
           match (← trySynthInstance instType) with
           | LOption.some e =>
             usedInstIdxs := collectUsedLocalsInsts usedInstIdxs localInst2Index e
           | _ =>
-            trace[Elab.Deriving.inhabited] "failed to generate instance using '{ctorName}' {if addHypotheses then "(assuming parameters are inhabited)" else ""} because of field with type{indentExpr (← inferType x)}"
+            trace[Elab.Deriving.inhabited] "failed to generate instance using `{ctorName}` {if addHypotheses then "(assuming parameters are inhabited)" else ""} because of field with type{indentExpr (← inferType x)}"
             ok := false
             break
         if !ok then
           return none
         else
-          trace[Elab.Deriving.inhabited] "inhabited instance using '{ctorName}' {if addHypotheses then "(assuming parameters are inhabited)" else ""} {usedInstIdxs.toList}"
+          trace[Elab.Deriving.inhabited] "inhabited instance using `{ctorName}` {if addHypotheses then "(assuming parameters are inhabited)" else ""} {usedInstIdxs.toList}"
           let cmd ← mkInstanceCmdWith usedInstIdxs
           trace[Elab.Deriving.inhabited] "\n{cmd}"
           return some cmd
 
 private def mkInhabitedInstance (declName : Name) : CommandElabM Unit := do
+  withoutExposeFromCtors declName do
   let indVal ← getConstInfoInduct declName
   let doIt (addHypotheses : Bool) : CommandElabM Bool := do
     for ctorName in indVal.ctors do
@@ -121,7 +121,7 @@ private def mkInhabitedInstance (declName : Name) : CommandElabM Unit := do
         return true
     return false
   unless (← doIt false <||> doIt true) do
-    throwError "failed to generate 'Inhabited' instance for '{.ofConstName declName}'"
+    throwError "failed to generate `Inhabited` instance for `{.ofConstName declName}`"
 
 def mkInhabitedInstanceHandler (declNames : Array Name) : CommandElabM Bool := do
   if (← declNames.allM isInductive) then
@@ -133,5 +133,3 @@ def mkInhabitedInstanceHandler (declNames : Array Name) : CommandElabM Bool := d
 builtin_initialize
   registerDerivingHandler `Inhabited mkInhabitedInstanceHandler
   registerTraceClass `Elab.Deriving.inhabited
-
-end Lean.Elab

src/Lean/Elab/Deriving/Nonempty.lean

@@ -11,11 +11,10 @@ import Lean.Elab.Deriving.Util
 
 public section
 
-namespace Lean.Elab
+namespace Lean.Elab.Deriving
 open Command Meta Parser Term
 
 private def mkNonemptyInstance (declName : Name) : TermElabM Syntax.Command := do
-  let ctx ← Deriving.mkContext "nonempty" declName
   let indVal ← getConstInfoInduct declName
   forallTelescopeReducing indVal.type fun paramsIndices _ => do
   let mut indArgs := #[]
@@ -29,21 +28,18 @@ private def mkNonemptyInstance (declName : Name) : TermElabM Syntax.Command := d
         binders := binders.push (← `(bracketedBinderF| [Nonempty $arg]))
   let ctorTacs ← indVal.ctors.toArray.mapM fun ctor =>
     `(tactic| apply @$(mkCIdent ctor) <;> exact Classical.ofNonempty)
-  let vis := ctx.mkVisibilityFromTypes
-  let expAttr := ctx.mkNoExposeAttrFromCtors
   `(command| variable $binders* in
-    @[$[$expAttr],*] $vis:visibility instance : Nonempty (@$(mkCIdent declName) $indArgs*) :=
+    instance : Nonempty (@$(mkCIdent declName) $indArgs*) :=
       by constructor; first $[| $ctorTacs:tactic]*)
 
 def mkNonemptyInstanceHandler (declNames : Array Name) : CommandElabM Bool := do
   if (← declNames.allM isInductive) then
     for declName in declNames do
-      elabCommand (← liftTermElabM do mkNonemptyInstance declName)
+      withoutExposeFromCtors declName do
+        elabCommand (← liftTermElabM do mkNonemptyInstance declName)
     return true
   else
     return false
 
 builtin_initialize
   registerDerivingHandler `Nonempty mkNonemptyInstanceHandler
-
-end Lean.Elab

src/Lean/Elab/Deriving/Ord.lean

@@ -100,7 +100,7 @@ open Command
 def mkOrdInstanceHandler (declNames : Array Name) : CommandElabM Bool := do
   if (← declNames.allM isInductive) then
     for declName in declNames do
-      let cmds ← liftTermElabM <| mkOrdInstanceCmds declName
+      let cmds ← withoutExposeFromCtors declName <| liftTermElabM <| mkOrdInstanceCmds declName
       cmds.forM elabCommand
     return true
   else

src/Lean/Elab/Deriving/Repr.lean

@@ -100,11 +100,10 @@ def mkAuxFunction (ctx : Context) (i : Nat) : TermElabM Command := do
     let letDecls ← mkLocalInstanceLetDecls ctx `Repr header.argNames
     body ← mkLet letDecls body
   let binders    := header.binders
-  let vis := ctx.mkVisibilityFromTypes
   if ctx.usePartial then
-    `(@[no_expose] $vis:visibility partial def $(mkIdent auxFunName):ident $binders:bracketedBinder* : Format := $body:term)
+    `(@[no_expose] partial def $(mkIdent auxFunName):ident $binders:bracketedBinder* : Format := $body:term)
   else
-    `(@[no_expose] $vis:visibility def $(mkIdent auxFunName):ident $binders:bracketedBinder* : Format := $body:term)
+    `(@[no_expose] def $(mkIdent auxFunName):ident $binders:bracketedBinder* : Format := $body:term)
 
 def mkMutualBlock (ctx : Context) : TermElabM Syntax := do
   let mut auxDefs := #[]
@@ -125,8 +124,9 @@ open Command
 def mkReprInstanceHandler (declNames : Array Name) : CommandElabM Bool := do
   if (← declNames.allM isInductive) then
     for declName in declNames do
-      let cmds ← liftTermElabM <| mkReprInstanceCmd declName
-      cmds.forM elabCommand
+      withoutExposeFromCtors declName do
+        let cmds ← liftTermElabM <| mkReprInstanceCmd declName
+        cmds.forM elabCommand
     return true
   else
     return false

src/Lean/Elab/Deriving/SizeOf.lean

@@ -8,6 +8,7 @@ module
 prelude
 public import Lean.Meta.SizeOf
 public import Lean.Elab.Deriving.Basic
+import Lean.Elab.Deriving.Util
 
 public section
 
@@ -23,7 +24,7 @@ open Command
 def mkSizeOfHandler (declNames : Array Name) : CommandElabM Bool := do
   if (← declNames.allM isInductive) then
     for declName in declNames do
-      liftTermElabM <| Meta.mkSizeOfInstances declName
+      withoutExposeFromCtors declName <| liftTermElabM <| Meta.mkSizeOfInstances declName
     return true
   else
     return false

src/Lean/Elab/Deriving/Util.lean

@@ -7,12 +7,13 @@ module
 
 prelude
 public import Lean.Elab.Term
+public import Lean.Elab.Command
 meta import Lean.Parser.Command
 
 public section
 
 namespace Lean.Elab.Deriving
-open Meta
+open Meta Command
 
 meta def implicitBinderF := Parser.Term.implicitBinder
 meta def instBinderF     := Parser.Term.instBinder
@@ -65,30 +66,28 @@ def mkInstImplicitBinders (className : Name) (indVal : InductiveVal) (argNames :
         pure ()
     return binders
 
+/--
+Removes any `[expose]` section attributes when running `cont` if `typeName` has private ctors.
+-/
+def withoutExposeFromCtors (typeName : Name) (cont : CommandElabM α) : CommandElabM α := do
+  -- TODO: some duplication with `mkContext` but it is in `TermElabM`; should it be?
+  let indVal ← getConstInfoInduct typeName
+  let mut typeInfos := #[]
+  for typeName in indVal.all do
+    typeInfos := typeInfos.push (← getConstInfoInduct typeName)
+  if typeInfos.any (·.ctors.any isPrivateName) then
+    -- The topmost scope should be the one form
+    if (← getScope).attrs.any (· matches `(Parser.Term.attrInstance| expose)) then
+      throwError "cannot use `deriving ... @[expose]` with `{.ofConstName typeName}` as it has one or more private constructors"
+    withScope (fun sc => { sc with
+        attrs := sc.attrs.filter (!· matches `(Parser.Term.attrInstance| expose)) }) cont
+  else cont
+
 structure Context where
   typeInfos   : Array InductiveVal
   auxFunNames : Array Name
   usePartial  : Bool
 
-open Parser.Command in
-/--
-Returns `private` or `public` depending on whether any private types are referenced in the
-`deriving` clause.
--/
-def Context.mkVisibilityFromTypes (ctx : Context) : TSyntax ``visibility :=
-  Unhygienic.run <|
-    if ctx.typeInfos.any (isPrivateName ·.name) then `(visibility| private) else `(visibility| public)
-
-open Parser.Term in
-/--
-Returns `no_expose` if any types with private constructors are referenced in the `deriving` clause.
-`expose` is assumed to be specified explicitly by the user.
--/
-def Context.mkNoExposeAttrFromCtors (ctx : Context) : Array (TSyntax ``attrInstance) :=
-  if ctx.typeInfos.any (·.ctors.any isPrivateName) then
-    #[Unhygienic.run <| `(attrInstance| no_expose)]
-  else #[]
-
 def mkContext (fnPrefix : String) (typeName : Name) : TermElabM Context := do
   let indVal ← getConstInfoInduct typeName
   let mut typeInfos := #[]
@@ -144,9 +143,7 @@ def mkInstanceCmds (ctx : Context) (className : Name) (typeNames : Array Name) (
       let mut val      := mkIdent auxFunName
       if useAnonCtor then
         val ← `(⟨$val⟩)
-      let vis := ctx.mkVisibilityFromTypes
-      let expAttr := ctx.mkNoExposeAttrFromCtors
-      let instCmd ← `(@[$[$expAttr],*] $vis:visibility instance $binders:implicitBinder* : $type := $val)
+      let instCmd ← `(instance $binders:implicitBinder* : $type := $val)
       instances := instances.push instCmd
   return instances
 

src/Lean/Elab/ElabRules.lean

@@ -32,13 +32,13 @@ def elabElabRulesAux (doc? : Option (TSyntax ``docComment))
         pure alt
       else if k' == choiceKind then
          match quoted.getArgs.find? fun quotAlt => checkRuleKind quotAlt.getKind k with
-         | none        => throwErrorAt alt "invalid elab_rules alternative, expected syntax node kind '{k}'"
+         | none        => throwErrorAt alt "invalid elab_rules alternative, expected syntax node kind `{k}`"
          | some quoted =>
            let pat := pat.setArg 1 quoted
            let pats := ⟨pats.elemsAndSeps.set! 0 pat⟩
            `(matchAltExpr| | $pats,* => $rhs)
       else
-        throwErrorAt alt "invalid elab_rules alternative, unexpected syntax node kind '{k'}'"
+        throwErrorAt alt "invalid elab_rules alternative, unexpected syntax node kind `{k'}`"
     | _ => throwUnsupportedSyntax
   let catName ← match cat?, expty? with
     | some cat, _ => pure cat.getId
@@ -58,7 +58,7 @@ def elabElabRulesAux (doc? : Option (TSyntax ``docComment))
         fun stx expectedType? => Lean.Elab.Term.withExpectedType expectedType? fun $expId => match stx with
           $alts:matchAlt* | _ => no_error_if_unused% throwUnsupportedSyntax)
     else
-      throwErrorAt expId "syntax category '{catName}' does not support expected type specification"
+      throwErrorAt expId "syntax category `{catName}` does not support expected type specification"
   else if catName == `term then
     `($[$doc?:docComment]? @[$(← mkAttrs `term_elab),*] $vis:visibility
       aux_def elabRules $(mkIdent k) : Lean.Elab.Term.TermElab :=
@@ -75,7 +75,7 @@ def elabElabRulesAux (doc? : Option (TSyntax ``docComment))
   else
     -- We considered making the command extensible and support new user-defined categories. We think it is unnecessary.
     -- If users want this feature, they add their own `elab_rules` macro that uses this one as a fallback.
-    throwError "unsupported syntax category '{catName}'"
+    throwError "unsupported syntax category `{catName}`"
 
 @[builtin_command_elab «elab_rules»] def elabElabRules : CommandElab :=
   adaptExpander fun stx => match stx with

src/Lean/Elab/Exception.lean

@@ -42,7 +42,7 @@ def isAutoBoundImplicitLocalException? (ex : Exception) : Option Name :=
   | _ => none
 
 def throwAlreadyDeclaredUniverseLevel [Monad m] [MonadError m] (u : Name) : m α :=
-  throwError "a universe level named '{u}' has already been declared"
+  throwError "a universe level named `{u}` has already been declared"
 
 -- Throw exception to abort elaboration of the current command without producing any error message
 def throwAbortCommand {α m} [MonadExcept Exception m] : m α :=

src/Lean/Elab/GuardMsgs.lean

@@ -28,9 +28,10 @@ register_builtin_option guard_msgs.diff : Bool := {
 
 namespace Lean.Elab.Tactic.GuardMsgs
 
-/-- Gives a string representation of a message without source position information.
-Ensures the message ends with a '\n'. -/
-private def messageToStringWithoutPos (msg : Message) : BaseIO String := do
+/-- Gives a string representation of a message with optional position information. If
+`reportPos? := some line` is provided, the range of `msg` is reported relative to `line`.  -/
+private def messageToString (msg : Message) (reportPos? : Option Nat) :
+    BaseIO String := do
   let mut str ← msg.data.toString
   unless msg.caption == "" do
     str := msg.caption ++ ":\n" ++ str
@@ -42,12 +43,18 @@ private def messageToStringWithoutPos (msg : Message) : BaseIO String := do
     | MessageSeverity.information => str := "info:" ++ str
     | MessageSeverity.warning     => str := "warning:" ++ str
     | MessageSeverity.error       => str := "error:" ++ str
+  if let some line := reportPos? then
+    let showRelPos (line : Nat) (pos : Position) := s!"+{pos.line - line}:{pos.column}"
+    let showEndPos := msg.endPos.elim "*" fun endPos =>
+      -- Omit ending line if the same as starting line:
+      if endPos.line = msg.pos.line then s!"{endPos.column}" else showRelPos line endPos
+    str := s!"@ {showRelPos line msg.pos}...{showEndPos}\n" ++ str
   if str.isEmpty || str.back != '\n' then
     str := str ++ "\n"
   return str
 
 /-- The decision made by a specification for a message. -/
-inductive SpecResult
+inductive FilterSpec
   /-- Capture the message and check it matches the docstring. -/
   | check
   /-- Drop the message and delete it. -/
@@ -71,8 +78,20 @@ inductive MessageOrdering
   /-- Sort the produced messages. -/
   | sorted
 
+/-- The specification options for `#guard_msgs`. The default field values provide the default
+behavior of `#guard_msgs`. -/
+structure GuardMsgsSpec where
+  /-- Method for deciding whether and how to filter messages; see `FilterSpec`. -/
+  filterFn : Message → FilterSpec := fun _ => .check
+  /-- Method to use when normalizing whitespace, after trimming; see `WhitespaceMode`. -/
+  whitespace : WhitespaceMode := .normalized
+  /-- Method to use when combining multiple messages; see `MessageOrdering`. -/
+  ordering : MessageOrdering := .exact
+  /-- Whether to report position information. -/
+  reportPositions : Bool := false
+
 def parseGuardMsgsFilterAction (action? : Option (TSyntax ``guardMsgsFilterAction)) :
-    CommandElabM SpecResult := do
+    CommandElabM FilterSpec := do
   if let some action := action? then
     match action with
     | `(guardMsgsFilterAction| check) => pure .check
@@ -90,23 +109,20 @@ def parseGuardMsgsFilterSeverity : TSyntax ``guardMsgsFilterSeverity → Command
   | `(guardMsgsFilterSeverity| all)   => pure fun _ => true
   | _ => throwUnsupportedSyntax
 
-/-- Parses a `guardMsgsSpec`.
+/-- Parses a `GuardMsgsSpec`.
 - No specification: check everything.
 - With a specification: interpret the spec, and if nothing applies pass it through. -/
-def parseGuardMsgsSpec (spec? : Option (TSyntax ``guardMsgsSpec)) :
-    CommandElabM (WhitespaceMode × MessageOrdering × (Message → SpecResult)) := do
-  let elts ←
-    if let some spec := spec? then
-      match spec with
-      | `(guardMsgsSpec| ($[$elts:guardMsgsSpecElt],*)) => pure elts
-      | _ => throwUnsupportedSyntax
-    else
-      pure #[]
-  let mut whitespace : WhitespaceMode := .normalized
-  let mut ordering : MessageOrdering := .exact
-  let mut p? : Option (Message → SpecResult) := none
-  let pushP (action : SpecResult) (msgP : Message → Bool) (p? : Option (Message → SpecResult))
-      (msg : Message) : SpecResult :=
+def parseGuardMsgsSpec (spec? : Option (TSyntax ``guardMsgsSpec)) : CommandElabM GuardMsgsSpec := do
+  let cfg : GuardMsgsSpec := {}
+  let some spec := spec? | return cfg
+  let elts ← match spec with
+    | `(guardMsgsSpec| ($[$elts:guardMsgsSpecElt],*)) => pure elts
+    | _ => throwUnsupportedSyntax
+  let defaultFilterFn := cfg.filterFn
+  let mut { whitespace, ordering, reportPositions .. } := cfg
+  let mut p? : Option (Message → FilterSpec) := none
+  let pushP (action : FilterSpec) (msgP : Message → Bool) (p? : Option (Message → FilterSpec))
+      (msg : Message) : FilterSpec :=
     if msgP msg then
       action
     else
@@ -119,9 +135,11 @@ def parseGuardMsgsSpec (spec? : Option (TSyntax ``guardMsgsSpec)) :
     | `(guardMsgsSpecElt| whitespace := lax)        => whitespace := .lax
     | `(guardMsgsSpecElt| ordering := exact)        => ordering := .exact
     | `(guardMsgsSpecElt| ordering := sorted)       => ordering := .sorted
+    | `(guardMsgsSpecElt| positions := true)        => reportPositions := true
+    | `(guardMsgsSpecElt| positions := false)       => reportPositions := false
     | _ => throwUnsupportedSyntax
-  let defaultP := fun _ => .check
-  return (whitespace, ordering, p?.getD defaultP)
+  let filterFn := p?.getD defaultFilterFn
+  return { filterFn, whitespace, ordering, reportPositions }
 
 /-- An info tree node corresponding to a failed `#guard_msgs` invocation,
 used for code action support. -/
@@ -163,7 +181,7 @@ def MessageOrdering.apply (mode : MessageOrdering) (msgs : List String) : List S
   | `(command| $[$dc?:docComment]? #guard_msgs%$tk $(spec?)? in $cmd) => do
     let expected : String := (← dc?.mapM (getDocStringText ·)).getD ""
         |>.trim |> removeTrailingWhitespaceMarker
-    let (whitespace, ordering, specFn) ← parseGuardMsgsSpec spec?
+    let { whitespace, ordering, filterFn, reportPositions } ← parseGuardMsgsSpec spec?
     let initMsgs ← modifyGet fun st => (st.messages, { st with messages := {} })
     -- do not forward snapshot as we don't want messages assigned to it to leak outside
     withReader ({ · with snap? := none }) do
@@ -179,11 +197,16 @@ def MessageOrdering.apply (mode : MessageOrdering) (msgs : List String) : List S
     for msg in msgs.toList do
       if msg.isSilent then
         continue
-      match specFn msg with
+      match filterFn msg with
       | .check       => toCheck := toCheck.add msg
       | .drop        => pure ()
       | pass => toPassthrough := toPassthrough.add msg
-    let strings ← toCheck.toList.mapM (messageToStringWithoutPos ·)
+    let map ← getFileMap
+    let reportPos? :=
+      if reportPositions then
+        tk.getPos?.map (map.toPosition · |>.line)
+      else none
+    let strings ← toCheck.toList.mapM (messageToString · reportPos?)
     let strings := ordering.apply strings
     let res := "---\n".intercalate strings |>.trim
     if whitespace.apply expected == whitespace.apply res then

src/Lean/Elab/Inductive.lean

@@ -196,7 +196,7 @@ private def elabCtors (indFVars : Array Expr) (params : Array Expr) (r : ElabHea
           match ctorView.type? with
           | none          =>
             if indFamily then
-              throwError "Missing resulting type for constructor '{ctorView.declName}': \
+              throwError "Missing resulting type for constructor `{ctorView.declName}`: \
                 Its resulting type must be specified because it is part of an inductive family declaration"
             return mkAppN indFVar params
           | some ctorType =>
@@ -265,7 +265,7 @@ where
             let (arg, param) ← addPPExplicitToExposeDiff arg param
             let msg := m!"Mismatched inductive type parameter in{indentExpr e}\nThe provided argument\
               {indentExpr arg}\nis not definitionally equal to the expected parameter{indentExpr param}"
-            let noteMsg := m!"The value of parameter '{param}' must be fixed throughout the inductive \
+            let noteMsg := m!"The value of parameter `{param}` must be fixed throughout the inductive \
               declaration. Consider making this parameter an index if it must vary."
             throwNamedError lean.inductiveParamMismatch (msg ++ .note noteMsg)
           args := args.set! i param
@@ -295,14 +295,14 @@ where
           if (← whnfD decl.type).isForall then
             return m!" an application of"
       return m!""
-    throwNamedErrorAt ctorType lean.ctorResultingTypeMismatch "Unexpected resulting type for constructor '{declName}': \
+    throwNamedErrorAt ctorType lean.ctorResultingTypeMismatch "Unexpected resulting type for constructor `{declName}`: \
       Expected{lazyAppMsg}{indentExpr indFVar}\nbut found{indentExpr resultingType}"
 
   throwUnexpectedResultingTypeNotType (resultingType : Expr) (declName : Name) (ctorType : Syntax) := do
     let lazyMsg := MessageData.ofLazyM do
       let resultingTypeType ← inferType resultingType
       return indentExpr resultingTypeType
-    throwNamedErrorAt ctorType lean.ctorResultingTypeMismatch "Unexpected resulting type for constructor '{declName}': \
+    throwNamedErrorAt ctorType lean.ctorResultingTypeMismatch "Unexpected resulting type for constructor `{declName}`: \
       Expected a type, but found{indentExpr resultingType}\nof type{lazyMsg}"
 
 @[builtin_inductive_elab Lean.Parser.Command.inductive, builtin_inductive_elab Lean.Parser.Command.classInductive]

src/Lean/Elab/LetRec.lean

@@ -53,7 +53,7 @@ private def mkLetRecDeclView (letRec : Syntax) : TermElabM LetRecView := do
       let declName := parentName?.getD Name.anonymous ++ shortDeclName
       if decls.any fun decl => decl.declName == declName then
         withRef declId do
-          throwError "'{.ofConstName declName}' has already been declared"
+          throwError "`{.ofConstName declName}` has already been declared"
       checkNotAlreadyDeclared declName
       applyAttributesAt declName attrs AttributeApplicationTime.beforeElaboration
       addDocString' declName docStr?
@@ -108,7 +108,7 @@ private def registerLetRecsToLift (views : Array LetRecDeclView) (fvars : Array
   for view in views do
     if letRecsToLiftCurr.any fun toLift => toLift.declName == view.declName then
       withRef view.ref do
-        throwError "'{view.declName}' has already been declared"
+        throwError "`{view.declName}` has already been declared"
   let lctx ← getLCtx
   let localInstances ← getLocalInstances
 

src/Lean/Elab/Level.lean

@@ -84,7 +84,7 @@ partial def elabLevel (stx : Syntax) : LevelElabM Level := withRef stx do
       if (← read).autoBoundImplicit && isValidAutoBoundLevelName paramName (relaxedAutoImplicit.get (← read).options) then
         modify fun s => { s with levelNames := paramName :: s.levelNames }
       else
-        throwError "unknown universe level '{mkIdent paramName}'"
+        throwError "unknown universe level `{mkIdent paramName}`"
     return mkLevelParam paramName
   else if kind == `Lean.Parser.Level.addLit then
     let lvl ← elabLevel (stx.getArg 0)

src/Lean/Elab/MacroArgUtil.lean

@@ -65,7 +65,7 @@ where
           let id := id.getId.eraseMacroScopes
           let kind := (← Parser.getSyntaxKindOfParserAlias? id).getD Name.anonymous
           return ⟨Syntax.mkAntiquotNode kind term⟩
-        | _ => throwError "unknown parser declaration/category/alias '{id}'"
+        | _ => throwError "unknown parser declaration/category/alias `{id}`"
     | stx, term => do
       -- can't match against `` `(stx| ($stxs*)) `` as `*` is interpreted as the `stx` operator
       if stx.raw.isOfKind ``Parser.Syntax.paren then

src/Lean/Elab/MacroRules.lean

@@ -35,13 +35,13 @@ def elabMacroRulesAux (doc? : Option (TSyntax ``docComment))
         pure alt
       else if k' == choiceKind then
          match quoted.getArgs.find? fun quotAlt => checkRuleKind quotAlt.getKind k with
-         | none        => throwErrorAt alt "invalid macro_rules alternative, expected syntax node kind '{k}'"
+         | none        => throwErrorAt alt "invalid macro_rules alternative, expected syntax node kind `{k}`"
          | some quoted =>
            let pat := pat.setArg 1 quoted
            let pats := pats.elemsAndSeps.set! 0 pat
            `(matchAltExpr| | $(⟨pats⟩),* => $rhs)
       else
-        throwErrorAt alt "invalid macro_rules alternative, unexpected syntax node kind '{k'}'"
+        throwErrorAt alt "invalid macro_rules alternative, unexpected syntax node kind `{k'}`"
     | _ => throwUnsupportedSyntax
   let attr ← `(attrInstance| $attrKind macro $(Lean.mkIdent k))
   let attrs := match attrs? with

src/Lean/Elab/MutualDef.lean

@@ -465,7 +465,7 @@ where
       for var in (← get).fvarIds do
         if let some uid := revSectionFVars[var]? then
           if sc.omittedVars.contains uid then
-            throwError "cannot omit referenced section variable '{Expr.fvar var}'"
+            throwError "cannot omit referenced section variable `{Expr.fvar var}`"
     -- instances (`addDependencies` unnecessary as by definition they may only reference variables
     -- already included)
     for var in vars do
@@ -559,7 +559,7 @@ private def elabFunValues (headers : Array DefViewElabHeader) (vars : Array Expr
                 some m!"{var}"
           if unusedVars.size > 0 then
             Linter.logLint linter.unusedSectionVars header.ref
-              m!"automatically included section variable(s) unused in theorem '{header.declName}':\
+              m!"automatically included section variable(s) unused in theorem `{header.declName}`:\
               \n  {MessageData.joinSep unusedVars.toList "\n  "}\
               \nconsider restructuring your `variable` declarations so that the variables are not \
                 in scope or explicitly omit them:\
@@ -636,7 +636,7 @@ private def checkLetRecsToLiftTypes (funVars : Array Expr) (letRecsToLift : List
     | none        => pure ()
     | some fvarId => do
       let fnName ← getFunName fvarId letRecsToLift
-      throwErrorAt toLift.ref "invalid type in 'let rec', it uses '{fnName}' which is being defined simultaneously"
+      throwErrorAt toLift.ref "invalid type in `let rec`, it uses `{fnName}` which is being defined simultaneously"
 
 private structure ExprWithHoles where
   ref : Syntax
@@ -656,20 +656,44 @@ private def ExprWithHoles.getHoles (e : ExprWithHoles) : TermElabM (Array MVarId
 private def fillHolesFromWhereFinally (name : Name) (es : Array ExprWithHoles) (whereFinally : WhereFinallyView) : TermElabM PUnit := do
   if whereFinally.isNone then return
   let goals := (← es.mapM fun e => e.getHoles).flatten
+
+  -- Exit exporting context if entering proof(s), analogous to `Term.runTactic`.
+  -- NOTE: when entering a proof/data mix, we must conservatively default to not changing the
+  -- context.
+  let wasExporting := (← getEnv).isExporting
+  let isNoLongerExporting ← pure wasExporting <&&> goals.allM fun mvarId => do
+    mvarId.withContext do
+      isProp (← mvarId.getType)
+
+  let mut goals' := goals
+  if isNoLongerExporting then
+    goals' ← goals.mapM fun mvarId => do
+      let mvarDecl ← getMVarDecl mvarId
+      return (← mkFreshExprMVarAt mvarDecl.lctx mvarDecl.localInstances mvarDecl.type mvarDecl.kind mvarDecl.userName).mvarId!
+
+  withExporting (isExporting := wasExporting && !isNoLongerExporting) do
   Lean.Elab.Term.TermElabM.run' do
   Term.withDeclName name do
   withRef whereFinally.ref do
     unless goals.isEmpty do
       -- make info from `runTactic` available
-      goals.forM fun goal => pushInfoTree (.hole goal)
+      goals'.forM fun goal => pushInfoTree (.hole goal)
       -- assign goals
-      let remainingGoals ← Tactic.run goals[0]! do
-        Tactic.setGoals goals.toList
+      let remainingGoals ← Tactic.run goals'[0]! do
+        Tactic.setGoals goals'.toList
         Tactic.withTacticInfoContext whereFinally.ref do
           Tactic.evalTactic whereFinally.tactic
       -- complain if any goals remain
       unless remainingGoals.isEmpty do
         Term.reportUnsolvedGoals remainingGoals
+      if isNoLongerExporting then
+        for mvarId in goals, mvarId' in goals' do
+          let mut e ← instantiateExprMVars (.mvar mvarId')
+          if !e.isFVar then
+            e ← mvarId'.withContext do
+              withExporting (isExporting := wasExporting) do
+                abstractProof e
+          mvarId.assign e
 
 namespace MutualClosure
 
@@ -1019,7 +1043,7 @@ def pushMain (preDefs : Array PreDefinition) (sectionVars : Array Expr) (mainHea
     let type ← mkForallFVars sectionVars header.type
     if header.kind.isTheorem then
       unless (← isProp type) do
-        throwErrorAt header.ref "type of theorem '{header.declName}' is not a proposition{indentExpr type}"
+        throwErrorAt header.ref "type of theorem `{header.declName}` is not a proposition{indentExpr type}"
     return preDefs.push {
       ref         := getDeclarationSelectionRef header.ref
       kind        := header.kind
@@ -1133,7 +1157,7 @@ private def checkAllDeclNamesDistinct (preDefs : Array PreDefinition) : TermElab
   for preDef in preDefs do
     let userName := privateToUserName preDef.declName
     if let some dupStx := names[userName]? then
-      let errorMsg := m!"'mutual' block contains two declarations of the same name '{userName}'"
+      let errorMsg := m!"`mutual` block contains two declarations of the same name `{userName}`"
       Lean.logErrorAt dupStx errorMsg
       throwErrorAt preDef.ref errorMsg
     names := names.insert userName preDef.ref

src/Lean/Elab/MutualInductive.lean

@@ -22,6 +22,7 @@ public import Lean.Elab.Deriving.Basic
 public import Lean.Elab.DeclarationRange
 import Lean.Elab.ComputedFields
 import Lean.Meta.Constructions.CtorIdx
+import Lean.Meta.Constructions.CtorElim
 
 public section
 
@@ -977,6 +978,7 @@ private def mkAuxConstructions (declNames : Array Name) : TermElabM Unit := do
     mkRecOn n
     if hasUnit then mkCasesOn n
     if hasNat then mkCtorIdx n
+    if hasNat then mkCtorElim n
     if hasUnit && hasEq && hasHEq then mkNoConfusion n
     if hasUnit && hasProd then mkBelow n
   for n in declNames do

src/Lean/Elab/Open.lean

@@ -62,7 +62,7 @@ private def resolveNameUsingNamespacesCore (nss : List Name) (idStx : Syntax) :
   if h : result.size = 1 then
     return result[0]
   else
-    withRef idStx do throwError "ambiguous identifier '{idStx.getId}', possible interpretations: {result.map mkConst}"
+    withRef idStx do throwError "ambiguous identifier `{idStx.getId}`, possible interpretations: {result.map mkConst}"
 
 def elabOpenDecl [MonadResolveName m] [MonadInfoTree m] (stx : TSyntax ``Parser.Command.openDecl) : m (List OpenDecl) := do
   StateRefT'.run' (s := { openDecls := (← getOpenDecls), currNamespace := (← getCurrNamespace) }) do

src/Lean/Elab/PatternVar.lean

@@ -69,7 +69,7 @@ private def throwCtorExpected {α} (ident : Option Syntax) : M α := do
   if candidates.size = 0 then
     throwError message
   else if h : candidates.size = 1 then
-    throwError message ++ .hint' m!"'{candidates[0]}' is similar"
+    throwError message ++ .hint' m!"`{candidates[0]}` is similar"
   else
     let sorted := candidates.qsort (·.toString < ·.toString)
     let diff :=
@@ -164,7 +164,7 @@ private def throwWrongArgCount (ctx : Context) (tooMany : Bool) : M α := do
   let argKind := if ctx.explicit then "" else "explicit "
   let argWord := if numExpectedArgs == 1 then "argument" else "arguments"
   let discrepancyKind := if tooMany then "Too many" else "Not enough"
-  let mut msg := m!"Invalid pattern: {discrepancyKind} arguments to '{ctx.funId}'; \
+  let mut msg := m!"Invalid pattern: {discrepancyKind} arguments to `{ctx.funId}`; \
     expected {numExpectedArgs} {argKind}{argWord}"
   if !tooMany then
     msg := msg ++ .hint' "To ignore all remaining arguments, use the ellipsis notation `..`"
@@ -211,9 +211,9 @@ private def processVar (idStx : Syntax) : M Syntax := do
     throwErrorAt idStx "Invalid pattern variable: Identifier expected, but found{indentD idStx}"
   let id := idStx.getId
   unless id.eraseMacroScopes.isAtomic do
-    throwError "Invalid pattern variable: Variable name must be atomic, but '{id}' has multiple components"
+    throwError "Invalid pattern variable: Variable name must be atomic, but `{id}` has multiple components"
   if (← get).found.contains id then
-    throwError "Invalid pattern variable: Variable name '{id}' was already used"
+    throwError "Invalid pattern variable: Variable name `{id}` was already used"
   modify fun s => { s with vars := s.vars.push idStx, found := s.found.insert id }
   return idStx
 

src/Lean/Elab/PreDefinition/Basic.lean

@@ -167,9 +167,9 @@ private def checkMeta (preDef : PreDefinition) : TermElabM Unit := do
     if let .const c .. := e then
       match getIRPhases (← getEnv) c, preDef.modifiers.isMeta with
       | .runtime, true =>
-        throwError "Invalid meta definition, '{.ofConstName c}' must be `meta` to access"
+        throwError "Invalid meta definition, `{.ofConstName c}` must be `meta` to access"
       | .comptime, false =>
-        throwError "Invalid definition, may not access `meta` declaration '{.ofConstName c}'"
+        throwError "Invalid definition, may not access `meta` declaration `{.ofConstName c}`"
       | _, _ => pure ()
     return true
 

src/Lean/Elab/PreDefinition/Eqns.lean

@@ -394,7 +394,7 @@ private partial def mkEqnProof (declName : Name) (type : Expr) (tryRefl : Bool)
         else if let some mvarIds ← splitTarget? mvarId (useNewSemantics := true) then
           mvarIds.forM go
         else
-          throwError "failed to generate equational theorem for '{.ofConstName declName}'\n{MessageData.ofGoal mvarId}"
+          throwError "failed to generate equational theorem for `{.ofConstName declName}`\n{MessageData.ofGoal mvarId}"
 
 
 /--
@@ -449,7 +449,7 @@ where
   until one of the equational theorems is applicable.
 -/
 partial def mkUnfoldProof (declName : Name) (mvarId : MVarId) : MetaM Unit := do
-  let some eqs ← getEqnsFor? declName | throwError "failed to generate equations for '{.ofConstName declName}'"
+  let some eqs ← getEqnsFor? declName | throwError "failed to generate equations for `{.ofConstName declName}`"
   let tryEqns (mvarId : MVarId) : MetaM Bool :=
     eqs.anyM fun eq => commitWhen do checkpointDefEq (mayPostpone := false) do
       try
@@ -475,7 +475,7 @@ partial def mkUnfoldProof (declName : Name) (mvarId : MVarId) : MetaM Unit := do
     if (← tryContradiction mvarId) then
       return ()
 
-    throwError "failed to generate unfold theorem for '{.ofConstName declName}'\n{MessageData.ofGoal mvarId}"
+    throwError "failed to generate unfold theorem for `{.ofConstName declName}`\n{MessageData.ofGoal mvarId}"
   go mvarId
 
 builtin_initialize

src/Lean/Elab/PreDefinition/Main.lean

@@ -27,7 +27,7 @@ private def addAndCompilePartial (preDefs : Array PreDefinition) (useSorry := fa
       let value ← if useSorry then
         mkLambdaFVars xs (← withRef preDef.ref <| mkLabeledSorry type (synthetic := true) (unique := true))
       else
-        let msg := m!"failed to compile 'partial' definition '{preDef.declName}'"
+        let msg := m!"failed to compile 'partial' definition `{preDef.declName}`"
         liftM <| mkInhabitantFor msg xs type
       addNonRec { preDef with
         kind  := DefKind.«opaque»
@@ -87,7 +87,7 @@ private partial def ensureNoUnassignedLevelMVarsAtPreDef (preDef : PreDefinition
         if u.hasMVar then
           let e' ← exposeLevelMVars e
           throwError "\
-            declaration '{preDef.declName}' contains universe level metavariables at the expression\
+            declaration `{preDef.declName}` contains universe level metavariables at the expression\
             {indentExpr e'}\n\
             in the declaration body{indentExpr <| ← exposeLevelMVars preDef.value}"
       let withExpr (e : Expr) (m : ReaderT Expr (MonadCacheT ExprStructEq Unit TermElabM) Unit) :=
@@ -333,7 +333,7 @@ def addPreDefinitions (preDefs : Array PreDefinition) : TermElabM Unit := withLC
             for preDef in preDefs do
               if !(← whnfD preDef.type).isForall then
                 if preDef.modifiers.isPartial then
-                  withRef preDef.ref <| throwError "invalid use of 'partial', '{preDef.declName}' is not a function{indentExpr preDef.type}"
+                  withRef preDef.ref <| throwError "invalid use of `partial`, `{preDef.declName}` is not a function{indentExpr preDef.type}"
                 else
                   -- `meta` should not imply `partial` in this case
                   isPartial := false

src/Lean/Elab/PreDefinition/PartialFixpoint/Eqns.lean

@@ -99,7 +99,7 @@ where
           trace[Elab.definition.partialFixpoint] "mkUnfoldEq rfl succeeded"
           instantiateMVars goal
         catch e =>
-          throwError "failed to generate unfold theorem for '{.ofConstName declName}':\n{e.toMessageData}"
+          throwError "failed to generate unfold theorem for `{.ofConstName declName}`:\n{e.toMessageData}"
       let type ← mkForallFVars xs type
       let type ← letToHave type
       let value ← mkLambdaFVars xs goal

src/Lean/Elab/PreDefinition/PartialFixpoint/Main.lean

@@ -91,17 +91,20 @@ def partialFixpoint (preDefs : Array PreDefinition) : TermElabM Unit := do
   -- ∀ x y, CCPO (r x y), but crucially constructed using `instCCPOPi`
   let insts ← preDefs.mapIdxM fun i preDef => withRef hints[i]!.ref do
     lambdaTelescope preDef.value fun xs _body => do
+      trace[Elab.definition.partialFixpoint] "preDef.value: {preDef.value}, xs: {xs}, _body: {_body}"
       let type ← instantiateForall preDef.type xs
       let inst ←
         match hints[i]!.fixpointType with
         | .coinductiveFixpoint =>
-          unless type.isProp do
-            throwError "`coinductive_fixpoint` can be only used to define predicates"
-          pure (mkConst ``ReverseImplicationOrder.instCompleteLattice)
+          forallTelescopeReducing type fun xs e => do
+            unless e.isProp do
+              throwError "`coinductive_fixpoint` can be only used to define predicates"
+            mkInstPiOfInstsForall xs (mkConst ``ReverseImplicationOrder.instCompleteLattice)
         | .inductiveFixpoint =>
-          unless type.isProp do
-            throwError "`inductive_fixpoint` can be only used to define predicates"
-          pure (mkConst ``ImplicationOrder.instCompleteLattice)
+          forallTelescopeReducing type fun xs e => do
+            unless e.isProp do
+              throwError "`inductive_fixpoint` can be only used to define predicates"
+            mkInstPiOfInstsForall xs (mkConst ``ImplicationOrder.instCompleteLattice)
         | .partialFixpoint => try
             synthInstance (← mkAppM ``CCPO #[type])
           catch _ =>
@@ -128,10 +131,7 @@ def partialFixpoint (preDefs : Array PreDefinition) : TermElabM Unit := do
     -- Or:     CompleteLattice (∀ x y, rᵢ x y)
     let insts' ← insts.mapM fun inst =>
       lambdaTelescope inst fun xs inst => do
-        let mut inst := inst
-        for x in xs.reverse do
-          inst ← mkInstPiOfInstForall x inst
-        pure inst
+        mkInstPiOfInstsForall xs inst
 
     -- Either: CCPO ((∀ x y, r₁ x y) ×' (∀ x y, r₂ x y))
     -- Or:     CompleteLattice ((∀ x y, r₁ x y) ×' (∀ x y, r₂ x y))

src/Lean/Elab/PreDefinition/Structural/Eqns.lean

@@ -74,7 +74,7 @@ where
             trace[Elab.definition.structural.eqns] "splitTarget? succeeded"
             mvarIds.forM go
           else
-            throwError "failed to generate equational theorem for '{.ofConstName declName}'\n{MessageData.ofGoal mvarId}"
+            throwError "failed to generate equational theorem for `{.ofConstName declName}`\n{MessageData.ofGoal mvarId}"
 
 def mkEqns (info : EqnInfo) : MetaM (Array Name) :=
   withOptions (tactic.hygienic.set · false) do

src/Lean/Elab/PreDefinition/WF/Main.lean

@@ -34,7 +34,7 @@ def wfRecursion (preDefs : Array PreDefinition) (termMeasure?s : Array (Option T
     let varNamess ← preDefs.mapIdxM fun i preDef => varyingVarNames fixedParamPerms i preDef
     for varNames in varNamess, preDef in preDefs do
       if varNames.isEmpty then
-        throwError "well-founded recursion cannot be used, '{preDef.declName}' does not take any (non-fixed) arguments"
+        throwError "well-founded recursion cannot be used, `{preDef.declName}` does not take any (non-fixed) arguments"
     let argsPacker := { varNamess }
     let preDefs' ← preDefs.mapM fun preDef => do
       return { preDef with value := (← unfoldIfArgIsConstOf (preDefs.map (·.declName)) preDef.value) }

src/Lean/Elab/PreDefinition/WF/Unfold.lean

@@ -197,7 +197,7 @@ def mkUnfoldProof (declName : Name) (mvarId : MVarId) : MetaM Unit := withTransp
   match (← simpTarget mvarId ctx (simprocs := simprocs)).1 with
   | none => return ()
   | some mvarId' =>
-    prependError m!"failed to finish proof for equational theorem for '{.ofConstName declName}'" do
+    prependError m!"failed to finish proof for equational theorem for `{.ofConstName declName}`" do
       mvarId'.refl
 
 public def mkUnfoldEq (preDef : PreDefinition) (unaryPreDefName : Name) (wfPreprocessProof : Simp.Result) : MetaM Unit := do
@@ -249,7 +249,7 @@ public def mkBinaryUnfoldEq (preDef : PreDefinition) (unaryPreDefName : Name) :
       let mvarId ← deltaLHS mvarId -- unfold the function
       let mvarIds ← mvarId.applyConst unaryEqName
       unless mvarIds.isEmpty do
-        throwError "Failed to apply '{unaryEqName}' to '{mvarId}'"
+        throwError "Failed to apply `{unaryEqName}` to `{mvarId}`"
 
       let value ← instantiateMVars main
       let type ← mkForallFVars xs type

src/Lean/Elab/Quotation.lean

@@ -181,7 +181,7 @@ private partial def quoteSyntax : Syntax → TermElabM Term
             | `sepBy    =>
               let sep := quote <| getSepFromSplice arg
               `(@TSepArray.elemsAndSeps $(quote ks) $sep $val)
-            | k         => throwErrorAt arg "invalid antiquotation suffix splice kind '{k}'"
+            | k         => throwErrorAt arg "invalid antiquotation suffix splice kind `{k}`"
         else if k == nullKind && isAntiquotSplice arg && !isEscapedAntiquot arg then
           let k := antiquotSpliceKind? arg
           let (arg, bindLets) ← floatOutAntiquotTerms arg |>.run pure
@@ -399,7 +399,7 @@ private partial def getHeadInfo (alt : Alt) : TermElabM HeadInfo :=
           | `optional => `(have $id := Option.map (@TSyntax.mk $(quote ks)) (Syntax.getOptional? __discr); $rhs)
           | `many     => `(have $id := @TSyntaxArray.mk $(quote ks) (Syntax.getArgs __discr); $rhs)
           | `sepBy    => `(have $id := @TSepArray.mk $(quote ks) $(quote <| getSepFromSplice quoted[0]) (Syntax.getArgs __discr); $rhs)
-          | k         => throwErrorAt quoted "invalid antiquotation suffix splice kind '{k}'"
+          | k         => throwErrorAt quoted "invalid antiquotation suffix splice kind `{k}`"
         | anti         => fun _   => throwErrorAt anti "unsupported antiquotation kind in pattern"
     else if quoted.getArgs.size == 1 && isAntiquotSplice quoted[0] then pure {
       check   := other pat,

src/Lean/Elab/Quotation/Precheck.lean

@@ -69,7 +69,7 @@ partial def precheck : Precheck := fun stx => do
   if let some stx' ← liftMacroM <| expandMacro? stx then
     precheck stx'
     return
-  throwErrorAt stx "no macro or `[quot_precheck]` instance for syntax kind '{stx.getKind}' found{indentD stx}
+  throwErrorAt stx "no macro or `[quot_precheck]` instance for syntax kind `{stx.getKind}` found{indentD stx}
 This means we cannot eagerly check your notation/quotation for unbound identifiers; you can use `set_option quotPrecheck false` to disable this check."
 where
   hasQuotedIdent

src/Lean/Elab/StructInst.lean

@@ -458,7 +458,7 @@ private partial def normalizeField (structName : Name) (fieldView : FieldView) :
       throwErrorAt ref m!"invalid field index, index must be greater than 0"
     let fieldNames := getStructureFields env structName
     if idx > fieldNames.size then
-      throwErrorAt ref m!"invalid field index, structure '{.ofConstName structName}' has only {fieldNames.size} fields"
+      throwErrorAt ref m!"invalid field index, structure `{.ofConstName structName}` has only {fieldNames.size} fields"
     normalizeField structName { fieldView with lhs := .fieldName ref fieldNames[idx - 1]! :: rest }
   | .fieldName ref name :: rest =>
     if !name.isAtomic then
@@ -474,7 +474,7 @@ private partial def normalizeField (structName : Name) (fieldView : FieldView) :
       else if (findField? env structName name).isSome then
         return fieldView
       else
-        throwErrorAt ref m!"'{name}' is not a field of structure '{.ofConstName structName}'"
+        throwErrorAt ref m!"`{name}` is not a field of structure `{.ofConstName structName}`"
   | _ => unreachable!
 
 private inductive ExpandedFieldVal
@@ -500,7 +500,7 @@ private instance : ToMessageData ExpandedFieldVal where
     | .nested fieldViews sources => m!"nested {MessageData.joinSep (sources.map (·.stx)).toList ", "} {MessageData.joinSep (fieldViews.map (indentD <| toMessageData ·)).toList "\n"}"
 
 private instance : ToMessageData ExpandedField where
-  toMessageData field := m!"field '{field.name}' is {field.val}"
+  toMessageData field := m!"field `{field.name}` is {field.val}"
 
 private abbrev ExpandedFields := NameMap ExpandedField
 
@@ -518,7 +518,7 @@ private def expandFields (structName : Name) (fieldViews : Array FieldView) (rec
       | .fieldName ref name :: rest =>
         if let some field := fields.find? name then
           if rest.isEmpty || !field.isNested then
-            throwErrorAt ref m!"field '{name}' has already been specified"
+            throwErrorAt ref m!"field `{name}` has already been specified"
           else
             -- There is a pre-existing nested field, and we are looking at a nested field. So, insert.
             let .nested views' sources := field.val | unreachable!
@@ -536,7 +536,7 @@ private def expandFields (structName : Name) (fieldViews : Array FieldView) (rec
         let fvarId ← mkFreshFVarId
         for parentField in getStructureFieldsFlattened (← getEnv) parentStructName false do
           if fields.contains parentField then
-            throwErrorAt ref m!"field '{name}' from structure '{.ofConstName parentStructName}' has already been specified"
+            throwErrorAt ref m!"field `{name}` from structure `{.ofConstName parentStructName}` has already been specified"
           else
             let val := ExpandedFieldVal.proj fvarId fieldView.val parentStructName name
             fields := fields.insert parentField { ref := ref, name := parentField, val }
@@ -700,7 +700,7 @@ private def normalizeExpr (e : Expr) (zetaDeltaImpl : Bool := true) : StructInst
   etaStructReduce' e
 
 private def addStructFieldAux (fieldName : Name) (e : Expr) : StructInstM Unit := do
-  trace[Elab.struct] "setting '{fieldName}' value to{indentExpr e}"
+  trace[Elab.struct] "setting `{fieldName}` value to{indentExpr e}"
   modify fun s => { s with
     type := s.type.bindingBody!.instantiateBetaRevRange 0 1 #[e]
     fields := s.fields.push e
@@ -738,7 +738,7 @@ private partial def getFieldDefaultValue? (fieldName : Name) : StructInstM (Name
     | return ({}, none)
   let fieldMap := (← get).fieldMap
   let some (fields, val) ← instantiateStructDefaultValueFn? defFn (← read).levels (← read).params (pure ∘ fieldMap.find?)
-    | logError m!"default value for field '{fieldName}' of structure '{.ofConstName (← read).structName}' could not be instantiated, ignoring"
+    | logError m!"default value for field `{fieldName}` of structure `{.ofConstName (← read).structName}` could not be instantiated, ignoring"
       return ({}, none)
   return (fields, val)
 
@@ -822,7 +822,7 @@ private def synthOptParamFields : StructInstM Unit := do
               cannot be assigned the default value{indentExpr selectedVal}"
         else
           assignErrors := assignErrors.push m!"\
-            default value for field '{selected.fieldName}' {← mkHasTypeButIsExpectedMsg selectedType fieldType}"
+            default value for field `{selected.fieldName}` {← mkHasTypeButIsExpectedMsg selectedType fieldType}"
       else
         if selected.required then
           -- Clear the value but preserve its pending status, for the "fields missing" error.
@@ -954,7 +954,7 @@ private def getParentStructType? (parentStructName : Name) : StructInstM (Option
     let projTy ← normalizeExpr projTy
     if projTy.containsFVar self.fvarId! then
       -- unsupported dependent type, parent depends on fields that haven't been visited yet.
-      trace[Elab.struct] "getParentStructType? '{parentStructName}', failed, computed type depends on {self}{indentExpr projTy}"
+      trace[Elab.struct] "getParentStructType? `{parentStructName}`, failed, computed type depends on {self}{indentExpr projTy}"
       return none
     return (projTy, path.getLast?)
 
@@ -980,7 +980,7 @@ private def mkProjStx (s : Syntax) (fieldName : Name) : Syntax :=
 
 private def processField (loop : StructInstM α) (field : ExpandedField) (fieldType : Expr) : StructInstM α := withRef field.ref do
   let fieldType := fieldType.consumeTypeAnnotations
-  trace[Elab.struct] "processing field '{field.name}' of type {fieldType}{indentD (toMessageData field)}"
+  trace[Elab.struct] "processing field `{field.name}` of type {fieldType}{indentD (toMessageData field)}"
   match field.val with
   | .term val => withRef val do
     trace[Elab.struct] "field.val is term {field.name}"
@@ -1010,7 +1010,7 @@ private def processField (loop : StructInstM α) (field : ExpandedField) (fieldT
         let e ← mkProjection (.fvar fvarId) field.name
         let eType ← inferType e
         unless ← isDefEq eType fieldType do
-          throwError m!"type of field '{field.name}' from structure '{.ofConstName parentStructName}' \
+          throwError m!"type of field `{field.name}` from structure `{.ofConstName parentStructName}` \
             {← mkHasTypeButIsExpectedMsg eType fieldType}"
         addStructFieldAux field.name e
       catch ex =>
@@ -1052,12 +1052,12 @@ Handle the case when no field is given.
 These fields can still be solved for by parent instance synthesis later.
 -/
 private def processNoField (loop : StructInstM α) (fieldName : Name) (binfo : BinderInfo) (fieldType : Expr) : StructInstM α := do
-  trace[Elab.struct] "processNoField '{fieldName}' of type {fieldType}"
+  trace[Elab.struct] "processNoField `{fieldName}` of type {fieldType}"
   if (← read).ellipsis && (← readThe Term.Context).inPattern then
     -- See the note in `ElabAppArgs.processExplicitArg`
     -- In ellipsis & pattern mode, do not use optParams or autoParams.
     let e ← addStructFieldMVar fieldName fieldType
-    registerCustomErrorIfMVar e (← read).view.ref m!"don't know how to synthesize placeholder for field '{fieldName}'"
+    registerCustomErrorIfMVar e (← read).view.ref m!"don't know how to synthesize placeholder for field `{fieldName}`"
     loop
   else
     let autoParam? := fieldType.getAutoParamTactic?
@@ -1095,10 +1095,10 @@ private partial def loop : StructInstM Expr := withViewRef do
   if let .forallE fieldName fieldType _ binfo := type then
     if let some fieldValue := (← get).fieldMap.find? fieldName then
       -- This is a field that was added by `addParentInstanceFields`
-      trace[Elab.struct] "field '{fieldName}' already exists, with type {fieldType}"
+      trace[Elab.struct] "field `{fieldName}` already exists, with type {fieldType}"
       let fieldValueType ← inferType fieldValue
       unless ← isDefEq fieldType fieldValueType do
-        throwError "field '{fieldName}' inferred from a parent class {← mkHasTypeButIsExpectedMsg fieldValueType fieldType}"
+        throwError "field `{fieldName}` inferred from a parent class {← mkHasTypeButIsExpectedMsg fieldValueType fieldType}"
       addStructFieldAux fieldName fieldValue
       loop
     else if let some field := (← read).fieldViews.find? fieldName then
@@ -1143,7 +1143,7 @@ private partial def addParentInstanceFields : StructInstM Unit := do
       -- This may fail if there is a complicated dependence. In that case, we put the problem on the deferred list.
       match ← getParentStructType? parentName with
       | none =>
-        trace[Elab.struct] "could not calculate type for parent '{.ofConstName parentName}'"
+        trace[Elab.struct] "could not calculate type for parent `{.ofConstName parentName}`"
         deferred := (parentName, parentFields) :: deferred
       | some (parentTy, _) =>
         match ← trySynthInstance parentTy with
@@ -1163,13 +1163,13 @@ private partial def addParentInstanceFields : StructInstM Unit := do
                 let projType ← inferType proj
                 let fieldType ← inferType fieldVal
                 unless ← isDefEq projType fieldType do
-                  throwError "parent field '{parentField}' {← mkHasTypeButIsExpectedMsg proj fieldType}"
+                  throwError "parent field `{parentField}` {← mkHasTypeButIsExpectedMsg proj fieldType}"
                 unless ← isDefEq proj fieldVal do
-                  throwError "parent field '{parentField}'{indentExpr proj}\nis not definitionally equal to overlapping field{indentExpr fieldVal}"
-                trace[Elab.struct] "checked field '{parentField}' from parent '{parentTy}' is definitionally equal"
+                  throwError "parent field `{parentField}`{indentExpr proj}\nis not definitionally equal to overlapping field{indentExpr fieldVal}"
+                trace[Elab.struct] "checked field `{parentField}` from parent `{parentTy}` is definitionally equal"
               | none =>
                 modify fun s => { s with fieldMap := s.fieldMap.insert parentField proj }
-                trace[Elab.struct] "added field '{parentField}' from parent '{parentTy}'"
+                trace[Elab.struct] "added field `{parentField}` from parent `{parentTy}`"
             -- All the fields have been added, update the list of remaining fields.
             remainingFields := remainingFields.filter (!parentFields.contains ·)
             -- Move the deferred list back the front of the work list
@@ -1195,7 +1195,7 @@ private def elabStructInstView (s : StructInstView) (structName : Name) (structT
   let env ← getEnv
   let ctorVal := getStructureCtor env structName
   if isInaccessiblePrivateName env ctorVal.name then
-    throwError "invalid \{...} notation, constructor for '{.ofConstName structName}' is marked as private"
+    throwError "invalid \{...} notation, constructor for `{.ofConstName structName}` is marked as private"
   let { ctorFn, ctorFnType, structType, levels, params } ← mkCtorHeader ctorVal structType?
   let (_, fields) ← expandFields structName s.fields (recover := (← read).errToSorry)
   let fields ← addSourceFields structName s.sources.explicit fields

src/Lean/Elab/Syntax.lean

@@ -81,7 +81,7 @@ def checkLeftRec (stx : Syntax) : ToParserDescrM Bool := do
   addCategoryInfo stx cat
   let prec? ← liftMacroM <| expandOptPrecedence stx[1]
   unless ctx.leftRec do
-    throwErrorAt stx[3] "invalid occurrence of '{cat}', parser algorithm does not allow this form of left recursion"
+    throwErrorAt stx[3] "invalid occurrence of `{cat}`, parser algorithm does not allow this form of left recursion"
   markAsTrailingParser (prec?.getD 0)
   return true
 
@@ -221,7 +221,7 @@ where
     | some (.alias _) =>
       ensureNoPrec stx
       processAlias ident #[]
-    | none => throwError "unknown parser declaration/category/alias '{id}'"
+    | none => throwError "unknown parser declaration/category/alias `{id}`"
 
   processSepBy (stx : Syntax) := do
     let p ← ensureUnaryOutput <$> withNestedParser do process stx[1]
@@ -358,7 +358,7 @@ private partial def isAtomLikeSyntax (stx : Syntax) : Bool :=
 def resolveSyntaxKind (k : Name) : CommandElabM Name := do
   checkSyntaxNodeKindAtNamespaces k (← getCurrNamespace)
   <|>
-  throwError "invalid syntax node kind '{k}'"
+  throwError "invalid syntax node kind `{k}`"
 
 def isLocalAttrKind (attrKind : Syntax) : Bool :=
   match attrKind with
@@ -381,7 +381,7 @@ def elabSyntax (stx : Syntax) : CommandElabM Name := do
     | throwUnsupportedSyntax
   let cat := catStx.getId.eraseMacroScopes
   unless (Parser.isParserCategory (← getEnv) cat) do
-    throwErrorAt catStx "unknown category '{cat}'"
+    throwErrorAt catStx "unknown category `{cat}`"
   liftTermElabM <| Term.addCategoryInfo catStx cat
   let syntaxParser := mkNullNode ps
   -- If the user did not provide an explicit precedence, we assign `maxPrec` to atom-like syntax and `leadPrec` otherwise.

src/Lean/Elab/Tactic/BVDecide/Frontend/BVCheck.lean

@@ -29,7 +29,7 @@ def getSrcDir : TermElabM System.FilePath := do
   let ctx ← readThe Lean.Core.Context
   let srcPath := System.FilePath.mk ctx.fileName
   let some srcDir := srcPath.parent
-    | throwError "cannot compute parent directory of '{srcPath}'"
+    | throwError "cannot compute parent directory of `{srcPath}`"
   return srcDir
 
 def mkContext (lratPath : System.FilePath) (cfg : BVDecideConfig) : TermElabM TacticContext := do

src/Lean/Elab/Tactic/Config.lean

@@ -59,7 +59,7 @@ private partial def expandField (structName : Name) (field : Name) : MetaM (Name
   | .str .anonymous fieldName => expandFieldName structName (Name.mkSimple fieldName)
   | .str field' fieldName =>
     let (field', projFn) ← expandField structName field'
-    let notStructure {α} : MetaM α := throwError "Field `{field'}` of structure '{.ofConstName structName}' is not a structure"
+    let notStructure {α} : MetaM α := throwError "Field `{field'}` of structure `{.ofConstName structName}` is not a structure"
     let .const structName' _ := (← getConstInfo projFn).type.getForallBody | notStructure
     unless isStructure (← getEnv) structName' do notStructure
     let (field'', projFn) ← expandFieldName structName' (Name.mkSimple fieldName)