doc-string

This PR refactors the `NoNatZeroDivisors` to make sure it will work
with the new `Semiring` support.

.github/workflows/ci.yml

@@ -421,6 +421,6 @@ jobs:
           GITHUB_TOKEN: ${{ secrets.RELEASE_INDEX_TOKEN }}
       - name: Update toolchain on mathlib4's nightly-testing branch
         run: |
-          gh workflow -R leanprover-community/mathlib4-nightly-testing run nightly_bump_toolchain.yml
+          gh workflow -R leanprover-community/mathlib4 run nightly_bump_toolchain.yml
         env:
           GITHUB_TOKEN: ${{ secrets.MATHLIB4_BOT }}

.github/workflows/pr-release.yml

@@ -167,7 +167,7 @@ jobs:
             echo "The merge base of this PR coincides with the nightly release"
 
             BATTERIES_REMOTE_TAGS="$(git ls-remote https://github.com/leanprover-community/batteries.git nightly-testing-"$MOST_RECENT_NIGHTLY")"
-            MATHLIB_REMOTE_TAGS="$(git ls-remote https://github.com/leanprover-community/mathlib4-nightly-testing.git nightly-testing-"$MOST_RECENT_NIGHTLY")"
+            MATHLIB_REMOTE_TAGS="$(git ls-remote https://github.com/leanprover-community/mathlib4.git nightly-testing-"$MOST_RECENT_NIGHTLY")"
 
             if [[ -n "$BATTERIES_REMOTE_TAGS" ]]; then
               echo "... and Batteries has a 'nightly-testing-$MOST_RECENT_NIGHTLY' tag."
@@ -355,7 +355,7 @@ jobs:
         if: steps.workflow-info.outputs.pullRequestNumber != '' && steps.ready.outputs.mathlib_ready == 'true'
         uses: actions/checkout@v4
         with:
-          repository: leanprover-community/mathlib4-nightly-testing
+          repository: leanprover-community/mathlib4
           token: ${{ secrets.MATHLIB4_BOT }}
           ref: nightly-testing
           fetch-depth: 0 # This ensures we check out all tags and branches.

doc/dev/index.md

@@ -85,6 +85,5 @@ such that changing files in `Init` doesn't force a full rebuild of `Lean`.
 You can test a Lean PR against Mathlib and Batteries by rebasing your PR
 on to `nightly-with-mathlib` branch. (It is fine to force push after rebasing.)
 CI will generate a branch of Mathlib and Batteries called `lean-pr-testing-NNNN`
-on the `leanprover-community/mathlib4-nightly-testing` fork of Mathlib.
-This branch uses the toolchain for your PR, and will report back to the Lean PR with results from Mathlib CI.
+that uses the toolchain for your PR, and will report back to the Lean PR with results from Mathlib CI.
 See https://leanprover-community.github.io/contribute/tags_and_branches.html for more details.

script/mathlib-bench

@@ -5,11 +5,8 @@ set -euo pipefail
 
 [ $# -eq 1 ] || (echo "usage: $0 <lean4 PR #>"; exit 1)
 
-echo "Warning: the speedcenter is probably not listening on mathlib4-nightly-testing yet."
-echo "If you're using this script, please contact @kim-em or @Kha to get this set up, and then remove this notice."
-
 LEAN_PR=$1
-PR_RESPONSE=$(gh api repos/leanprover-community/mathlib4-nightly-testing/pulls -X POST -f head=lean-pr-testing-$LEAN_PR -f base=nightly-testing -f title="leanprover/lean4#$LEAN_PR benchmarking" -f draft=true -f body="ignore me")
+PR_RESPONSE=$(gh api repos/leanprover-community/mathlib4/pulls -X POST -f head=lean-pr-testing-$LEAN_PR -f base=nightly-testing -f title="leanprover/lean4#$LEAN_PR benchmarking" -f draft=true -f body="ignore me")
 PR_NUMBER=$(echo "$PR_RESPONSE" | jq '.number')
-echo "opened https://github.com/leanprover-community/mathlib4-nightly-testing/pull/$PR_NUMBER"
-gh api repos/leanprover-community/mathlib4-nightly-testing/issues/$PR_NUMBER/comments -X POST -f body="!bench" > /dev/null
+echo "opened https://github.com/leanprover-community/mathlib4/pull/$PR_NUMBER"
+gh api repos/leanprover-community/mathlib4/issues/$PR_NUMBER/comments -X POST -f body="!bench" > /dev/null

src/Init/Data/BitVec/Bitblast.lean

@@ -1674,7 +1674,7 @@ private theorem neg_udiv_eq_intMin_iff_eq_intMin_eq_one_of_msb_eq_true
     obtain ⟨hx, hy⟩ := this
     simp only [beq_iff_eq] at hy
     subst hy
-    simp only [udiv_one, neg_eq_intMin] at h
+    simp only [udiv_one, zero_lt_succ, neg_eq_intMin] at h
     simp [h]
   · rintro ⟨hx, hy⟩
     subst hx hy
@@ -1701,9 +1701,10 @@ theorem msb_sdiv_eq_decide {x y : BitVec w} :
      := by
   rcases w; decide +revert
   case succ w =>
-    simp only [sdiv_eq, udiv_eq]
+    simp only [decide_true, ne_eq, decide_and, decide_not, Bool.true_and,
+      sdiv_eq, udiv_eq]
     rcases hxmsb : x.msb <;> rcases hymsb : y.msb
-    · simp [hxmsb, msb_udiv_eq_false_of, Bool.not_false, Bool.and_false, Bool.false_and,
+    · simp [hxmsb, hymsb, msb_udiv_eq_false_of, Bool.not_false, Bool.and_false, Bool.false_and,
         Bool.and_true, Bool.or_self, Bool.and_self]
     · simp only [hxmsb, hymsb, msb_neg, msb_udiv_eq_false_of, bne_false, Bool.not_false,
         Bool.and_self, ne_zero_of_msb_true, decide_false, Bool.and_true, Bool.true_and, Bool.not_true,
@@ -1715,7 +1716,7 @@ theorem msb_sdiv_eq_decide {x y : BitVec w} :
         obtain ⟨hcontra, _⟩ := this
         simp only [hcontra, true_eq_false] at hxmsb
       simp [this, hymsb, udiv_ne_zero_iff_ne_zero_and_le]
-    · simp only [Bool.not_true, Bool.and_self, Bool.false_and, Bool.not_false,
+    · simp only [hxmsb, hymsb, Bool.not_true, Bool.and_self, Bool.false_and, Bool.not_false,
         Bool.true_and, Bool.false_or, Bool.and_false, Bool.or_false]
       by_cases hx₁ : x = 0#(w + 1)
       · simp [hx₁, neg_zero, zero_udiv, msb_zero, le_zero_iff, Bool.and_not_self]
@@ -1724,12 +1725,12 @@ theorem msb_sdiv_eq_decide {x y : BitVec w} :
         · simp only [hy₁, decide_false, Bool.not_false, Bool.and_true]
           by_cases hxy₁ : (- x / y) = 0#(w + 1)
           · simp only [hxy₁, neg_zero, msb_zero, false_eq_decide_iff, BitVec.not_le,
-              BitVec.not_le]
+              decide_eq_true_eq, BitVec.not_le]
             simp only [udiv_eq_zero_iff_eq_zero_or_lt, hy₁, _root_.false_or] at hxy₁
             bv_omega
           · simp only [udiv_eq_zero_iff_eq_zero_or_lt, _root_.not_or, BitVec.not_lt,
               hy₁, not_false_eq_true, _root_.true_and] at hxy₁
-            simp only [decide_true, msb_neg, bne_iff_ne, ne_eq,
+            simp only [hxy₁, decide_true, msb_neg, bne_iff_ne, ne_eq,
               bool_to_prop,
               bne_iff_ne, ne_eq, udiv_eq_zero_iff_eq_zero_or_lt, hy₁, _root_.false_or,
               BitVec.not_lt, hxy₁, _root_.true_and, decide_not, not_eq_eq_eq_not, not_eq_not,

src/Init/Data/BitVec/Lemmas.lean

@@ -1880,14 +1880,14 @@ theorem toInt_shiftLeftZeroExtend {x : BitVec w} :
     (shiftLeftZeroExtend x n).toInt = x.toInt * 2 ^ n := by
   rw [shiftLeftZeroExtend_eq]
   rcases w with _|w
-  · simp [of_length_zero]
+  · simp [of_length_zero, shiftLeftZeroExtend_eq]
   · rcases n with _|n
-    · simp
+    · simp [shiftLeftZeroExtend_eq]
     · have := Nat.pow_pos (a := 2) (n := n + 1) (by omega)
       have : x.toNat <<< (n + 1) < 2 ^ (w + 1 + (n + 1)) := by
         rw [Nat.shiftLeft_eq, Nat.pow_add (a := 2) (m := w + 1) (n := n + 1), Nat.mul_lt_mul_right (by omega)]
         omega
-      simp only [toInt_shiftLeft, toNat_setWidth, Nat.lt_add_right_iff_pos,
+      simp only [shiftLeftZeroExtend_eq, toInt_shiftLeft, toNat_setWidth, Nat.lt_add_right_iff_pos,
         Nat.zero_lt_succ, toNat_mod_cancel_of_lt, Int.bmod_def]
       by_cases hmsb : x.msb
       · have hge := toNat_ge_of_msb_true hmsb
@@ -1902,7 +1902,7 @@ theorem toInt_shiftLeftZeroExtend {x : BitVec w} :
           show ¬2 * x.toNat < 2 ^ (w + 1) by simp [Nat.pow_add, Nat.mul_comm (2 ^ w) 2, hge]]
         norm_cast
         simp [Int.natCast_mul, Int.natCast_pow, Int.cast_ofNat_Int, Int.sub_mul,
-          show w + (n + 1) + 1 = (w + 1) + (n + 1) by omega, Nat.pow_add]
+          Int.sub_right_inj, show w + (n + 1) + 1 = (w + 1) + (n + 1) by omega, Nat.pow_add]
       · simp only [Bool.not_eq_true] at hmsb
         have hle := toNat_lt_of_msb_false (x := x) hmsb
         simp only [Nat.add_one_sub_one] at hle

src/Init/Data/Int/OfNat.lean

@@ -30,7 +30,6 @@ inductive Expr where
   | mul  (a b : Expr)
   | div  (a b : Expr)
   | mod  (a b : Expr)
-  | pow  (a : Expr) (k : Nat)
   deriving BEq
 
 @[expose]
@@ -41,7 +40,6 @@ def Expr.denote (ctx : Context) : Expr → Nat
   | .mul a b  => Nat.mul (denote ctx a) (denote ctx b)
   | .div a b  => Nat.div (denote ctx a) (denote ctx b)
   | .mod a b  => Nat.mod (denote ctx a) (denote ctx b)
-  | .pow a k  => Nat.pow (denote ctx a) k
 
 @[expose]
 def Expr.denoteAsInt (ctx : Context) : Expr → Int
@@ -51,7 +49,6 @@ def Expr.denoteAsInt (ctx : Context) : Expr → Int
   | .mul a b  => Int.mul (denoteAsInt ctx a) (denoteAsInt ctx b)
   | .div a b  => Int.ediv (denoteAsInt ctx a) (denoteAsInt ctx b)
   | .mod a b  => Int.emod (denoteAsInt ctx a) (denoteAsInt ctx b)
-  | .pow a k  => Int.pow (denoteAsInt ctx a) k
 
 theorem Expr.denoteAsInt_eq (ctx : Context) (e : Expr) : e.denoteAsInt ctx = e.denote ctx := by
   induction e <;> simp [denote, denoteAsInt, *] <;> rfl

src/Init/Data/Iterators/Lemmas/Consumers/Loop.lean

@@ -130,7 +130,7 @@ theorem Iter.forIn'_toList {α β : Type w} [Iterator α Id β]
   rw [forIn'_toList.aux this]
   rw [forIn'_eq_match_step]
   rw [List.forIn'_eq_foldlM] at *
-  simp only [map_eq_pure_bind, hs]
+  simp only [map_eq_pure_bind, List.foldlM_map, hs]
   cases step using PlausibleIterStep.casesOn
   · rename_i it' out h
     simp only [List.attach_cons, List.foldlM_cons, bind_pure_comp, map_bind]
@@ -180,7 +180,7 @@ theorem Iter.forIn_toList {α β : Type w} [Iterator α Id β]
     intro forInStep
     cases forInStep
     · induction it'.toList <;> simp [*]
-    · simp only [ForIn.forIn] at ihy
+    · simp only [ForIn.forIn, forIn', List.forIn'] at ihy
       simp [ihy h, forIn_eq_forIn_toIterM]
   · rename_i it' h
     simp only [bind_pure_comp]

src/Init/Data/Iterators/Lemmas/Consumers/Monadic/Collect.lean

@@ -63,7 +63,7 @@ theorem IterM.toArray_eq_match_step [Monad m] [LawfulMonad m] [Iterator α m β]
       | .done _ => return #[]) := by
   simp only [IterM.toArray, LawfulIteratorCollect.toArrayMapped_eq]
   rw [IterM.DefaultConsumers.toArrayMapped_eq_match_step]
-  simp [bind_pure_comp, pure_bind]
+  simp [bind_pure_comp, pure_bind, toArray]
 
 theorem IterM.toList_toArray [Monad m] [Iterator α m β] [Finite α m] [IteratorCollect α m m]
     {it : IterM (α := α) m β} :

src/Init/Data/Sum/Lemmas.lean

@@ -48,10 +48,10 @@ section get
   | inr _, _ => rfl
 
 @[simp, grind =] theorem getLeft?_eq_none_iff {x : α ⊕ β} : x.getLeft? = none ↔ x.isRight := by
-  cases x <;> simp only [getLeft?, isRight, reduceCtorEq]
+  cases x <;> simp only [getLeft?, isRight, eq_self_iff_true, reduceCtorEq]
 
 @[simp, grind =] theorem getRight?_eq_none_iff {x : α ⊕ β} : x.getRight? = none ↔ x.isLeft := by
-  cases x <;> simp only [getRight?, isLeft, reduceCtorEq]
+  cases x <;> simp only [getRight?, isLeft, eq_self_iff_true, reduceCtorEq]
 
 theorem eq_left_getLeft_of_isLeft : ∀ {x : α ⊕ β} (h : x.isLeft), x = inl (x.getLeft h)
   | inl _, _ => rfl

src/Init/Grind/Ordered/Field.lean

@@ -13,19 +13,18 @@ namespace Lean.Grind
 
 namespace Field.IsOrdered
 
-variable {R : Type u} [Field R] [LinearOrder R] [OrderedRing R]
+variable {R : Type u} [Field R] [LinearOrder R] [Ring.IsOrdered R]
 
-open OrderedAdd
-open OrderedRing
+open Ring.IsOrdered
 
 theorem pos_of_inv_pos {a : R} (h : 0 < a⁻¹) : 0 < a := by
   rcases LinearOrder.trichotomy 0 a with (h' | rfl | h')
   · exact h'
   · simpa [Field.inv_zero] using h
   · exfalso
-    have := OrderedRing.mul_neg_of_pos_of_neg h h'
+    have := Ring.IsOrdered.mul_neg_of_pos_of_neg h h'
     rw [inv_mul_cancel (Preorder.ne_of_lt h')] at this
-    exact OrderedRing.not_one_lt_zero this
+    exact Ring.IsOrdered.not_one_lt_zero this
 
 theorem inv_pos_iff {a : R} : 0 < a⁻¹ ↔ 0 < a := by
   constructor
@@ -37,7 +36,7 @@ theorem inv_pos_iff {a : R} : 0 < a⁻¹ ↔ 0 < a := by
 theorem inv_neg_iff {a : R} : a⁻¹ < 0 ↔ a < 0 := by
   have := inv_pos_iff (a := -a)
   rw [Field.inv_neg] at this
-  simpa [neg_pos_iff]
+  simpa [IntModule.IsOrdered.neg_pos_iff]
 
 theorem inv_nonneg_iff {a : R} : 0 ≤ a⁻¹ ↔ 0 ≤ a := by
   simp [PartialOrder.le_iff_lt_or_eq, inv_pos_iff, Field.zero_eq_inv_iff]
@@ -45,15 +44,15 @@ theorem inv_nonneg_iff {a : R} : 0 ≤ a⁻¹ ↔ 0 ≤ a := by
 theorem inv_nonpos_iff {a : R} : a⁻¹ ≤ 0 ↔ a ≤ 0 := by
   have := inv_nonneg_iff (a := -a)
   rw [Field.inv_neg] at this
-  simpa [neg_nonneg_iff] using this
+  simpa [IntModule.IsOrdered.neg_nonneg_iff] using this
 
 private theorem mul_le_of_le_mul_inv {a b c : R} (h : 0 < c) (h' : a ≤ b * c⁻¹) : a * c ≤ b := by
   simpa [Semiring.mul_assoc, Field.inv_mul_cancel (Preorder.ne_of_gt h), Semiring.mul_one] using
-    OrderedRing.mul_le_mul_of_nonneg_right h' (Preorder.le_of_lt h)
+    Ring.IsOrdered.mul_le_mul_of_nonneg_right h' (Preorder.le_of_lt h)
 
 private theorem le_mul_inv_of_mul_le {a b c : R} (h : 0 < b) (h' : a * b ≤ c) : a ≤ c * b⁻¹ := by
   simpa [Semiring.mul_assoc, Field.mul_inv_cancel (Preorder.ne_of_gt h), Semiring.mul_one] using
-    OrderedRing.mul_le_mul_of_nonneg_right h' (Preorder.le_of_lt (inv_pos_iff.mpr h))
+    Ring.IsOrdered.mul_le_mul_of_nonneg_right h' (Preorder.le_of_lt (inv_pos_iff.mpr h))
 
 theorem le_mul_inv_iff_mul_le (a b : R) {c : R} (h : 0 < c) : a ≤ b * c⁻¹ ↔ a * c ≤ b :=
   ⟨mul_le_of_le_mul_inv h, le_mul_inv_of_mul_le h⟩
@@ -64,11 +63,11 @@ private theorem mul_inv_le_iff_le_mul (a c : R) {b : R} (h : 0 < b) : a * b⁻¹
 
 private theorem mul_lt_of_lt_mul_inv {a b c : R} (h : 0 < c) (h' : a < b * c⁻¹) : a * c < b := by
   simpa [Semiring.mul_assoc, Field.inv_mul_cancel (Preorder.ne_of_gt h), Semiring.mul_one] using
-    OrderedRing.mul_lt_mul_of_pos_right h' h
+    Ring.IsOrdered.mul_lt_mul_of_pos_right h' h
 
 private theorem lt_mul_inv_of_mul_lt {a b c : R} (h : 0 < b) (h' : a * b < c) : a < c * b⁻¹ := by
   simpa [Semiring.mul_assoc, Field.mul_inv_cancel (Preorder.ne_of_gt h), Semiring.mul_one] using
-    OrderedRing.mul_lt_mul_of_pos_right h' (inv_pos_iff.mpr h)
+    Ring.IsOrdered.mul_lt_mul_of_pos_right h' (inv_pos_iff.mpr h)
 
 theorem lt_mul_inv_iff_mul_lt (a b : R) {c : R} (h : 0 < c) : a < b * c⁻¹ ↔ a * c < b :=
   ⟨mul_lt_of_lt_mul_inv h, lt_mul_inv_of_mul_lt h⟩
@@ -78,19 +77,19 @@ theorem mul_inv_lt_iff_lt_mul (a c : R) {b : R} (h : 0 < b) : a * b⁻¹ < c ↔
 
 private theorem le_mul_of_le_mul_inv {a b c : R} (h : c < 0) (h' : a ≤ b * c⁻¹) : b ≤ a * c := by
   simpa [Semiring.mul_assoc, Field.inv_mul_cancel (Preorder.ne_of_lt h), Semiring.mul_one] using
-    OrderedRing.mul_le_mul_of_nonpos_right h' (Preorder.le_of_lt h)
+    Ring.IsOrdered.mul_le_mul_of_nonpos_right h' (Preorder.le_of_lt h)
 
 private theorem mul_le_of_mul_inv_le {a b c : R} (h : b < 0) (h' : a * b⁻¹ ≤ c) : c * b ≤ a := by
   simpa [Semiring.mul_assoc, Field.inv_mul_cancel (Preorder.ne_of_lt h), Semiring.mul_one] using
-    OrderedRing.mul_le_mul_of_nonpos_right h' (Preorder.le_of_lt h)
+    Ring.IsOrdered.mul_le_mul_of_nonpos_right h' (Preorder.le_of_lt h)
 
 private theorem mul_inv_le_of_mul_le {a b c : R} (h : b < 0) (h' : a * b ≤ c) : c * b⁻¹ ≤ a := by
   simpa [Semiring.mul_assoc, Field.mul_inv_cancel (Preorder.ne_of_lt h), Semiring.mul_one] using
-    OrderedRing.mul_le_mul_of_nonpos_right h' (Preorder.le_of_lt (inv_neg_iff.mpr h))
+    Ring.IsOrdered.mul_le_mul_of_nonpos_right h' (Preorder.le_of_lt (inv_neg_iff.mpr h))
 
 private theorem le_mul_inv_of_le_mul {a b c : R} (h : c < 0) (h' : a ≤ b * c) : b ≤ a * c⁻¹ := by
   simpa [Semiring.mul_assoc, Field.mul_inv_cancel (Preorder.ne_of_lt h), Semiring.mul_one] using
-    OrderedRing.mul_le_mul_of_nonpos_right h' (Preorder.le_of_lt (inv_neg_iff.mpr h))
+    Ring.IsOrdered.mul_le_mul_of_nonpos_right h' (Preorder.le_of_lt (inv_neg_iff.mpr h))
 
 theorem le_mul_inv_iff_le_mul_of_neg (a b : R) {c : R} (h : c < 0) : a ≤ b * c⁻¹ ↔ b ≤ a * c :=
   ⟨le_mul_of_le_mul_inv h, le_mul_inv_of_le_mul h⟩
@@ -100,19 +99,19 @@ theorem mul_inv_le_iff_mul_le_of_neg (a c : R) {b : R} (h : b < 0) : a * b⁻¹
 
 private theorem lt_mul_of_lt_mul_inv {a b c : R} (h : c < 0) (h' : a < b * c⁻¹) : b < a * c := by
   simpa [Semiring.mul_assoc, Field.inv_mul_cancel (Preorder.ne_of_lt h), Semiring.mul_one] using
-    OrderedRing.mul_lt_mul_of_neg_right h' h
+    Ring.IsOrdered.mul_lt_mul_of_neg_right h' h
 
 private theorem mul_lt_of_mul_inv_lt {a b c : R} (h : b < 0) (h' : a * b⁻¹ < c) : c * b < a := by
   simpa [Semiring.mul_assoc, Field.inv_mul_cancel (Preorder.ne_of_lt h), Semiring.mul_one] using
-    OrderedRing.mul_lt_mul_of_neg_right h' h
+    Ring.IsOrdered.mul_lt_mul_of_neg_right h' h
 
 private theorem mul_inv_lt_of_mul_lt {a b c : R} (h : b < 0) (h' : a * b < c) : c * b⁻¹ < a := by
   simpa [Semiring.mul_assoc, Field.mul_inv_cancel (Preorder.ne_of_lt h), Semiring.mul_one] using
-    OrderedRing.mul_lt_mul_of_neg_right h' (inv_neg_iff.mpr h)
+    Ring.IsOrdered.mul_lt_mul_of_neg_right h' (inv_neg_iff.mpr h)
 
 private theorem lt_mul_inv_of_lt_mul {a b c : R} (h : c < 0) (h' : a < b * c) : b < a * c⁻¹ := by
   simpa [Semiring.mul_assoc, Field.mul_inv_cancel (Preorder.ne_of_lt h), Semiring.mul_one] using
-    OrderedRing.mul_lt_mul_of_neg_right h' (inv_neg_iff.mpr h)
+    Ring.IsOrdered.mul_lt_mul_of_neg_right h' (inv_neg_iff.mpr h)
 
 theorem lt_mul_inv_iff_lt_mul_of_neg (a b : R) {c : R} (h : c < 0) : a < b * c⁻¹ ↔ b < a * c :=
   ⟨lt_mul_of_lt_mul_inv h, lt_mul_inv_of_lt_mul h⟩

src/Init/Grind/Ordered/Int.lean

@@ -21,10 +21,13 @@ instance : Preorder Int where
   le_trans := Int.le_trans
   lt_iff_le_not_le := by omega
 
-instance : OrderedAdd Int where
-  add_le_left_iff := by omega
+instance : IntModule.IsOrdered Int where
+  neg_le_iff := by omega
+  add_le_left := by omega
+  hmul_pos_iff k a ha := ⟨fun h => Int.pos_of_mul_pos_left h ha, fun hk => Int.mul_pos hk ha⟩
+  hmul_nonneg hk ha := Int.mul_nonneg hk ha
 
-instance : OrderedRing Int where
+instance : Ring.IsOrdered Int where
   zero_lt_one := by omega
   mul_lt_mul_of_pos_left := Int.mul_lt_mul_of_pos_left
   mul_lt_mul_of_pos_right := Int.mul_lt_mul_of_pos_right

src/Init/Grind/Ordered/Linarith.lean

@@ -246,23 +246,23 @@ def Poly.leadCoeff (p : Poly) : Int :=
   | .add a _ _ => a
   | _ => 1
 
-open OrderedAdd
+open IntModule.IsOrdered
 
 /-!
 Helper theorems for conflict resolution during model construction.
 -/
 
-private theorem le_add_le {α} [IntModule α] [Preorder α] [OrderedAdd α] {a b : α}
+private theorem le_add_le {α} [IntModule α] [Preorder α] [IntModule.IsOrdered α] {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₂
 
-private theorem le_add_lt {α} [IntModule α] [Preorder α] [OrderedAdd α] {a b : α}
+private theorem le_add_lt {α} [IntModule α] [Preorder α] [IntModule.IsOrdered α] {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 α] [Preorder α] [OrderedAdd α] {a b : α}
+private theorem lt_add_lt {α} [IntModule α] [Preorder α] [IntModule.IsOrdered α] {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₂
@@ -275,11 +275,11 @@ 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 α] [Preorder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ p₃ : Poly)
+theorem le_le_combine {α} [IntModule α] [Preorder α] [IntModule.IsOrdered α] (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₁ := hmul_int_nonpos (coe_natAbs_nonneg p₂.leadCoeff) h₁
-  replace h₂ := hmul_int_nonpos (coe_natAbs_nonneg p₁.leadCoeff) h₂
+  replace h₁ := hmul_nonpos (coe_natAbs_nonneg p₂.leadCoeff) h₁
+  replace h₂ := hmul_nonpos (coe_natAbs_nonneg p₁.leadCoeff) h₂
   exact le_add_le h₁ h₂
 
 def le_lt_combine_cert (p₁ p₂ p₃ : Poly) : Bool :=
@@ -287,11 +287,11 @@ 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 α] [Preorder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ p₃ : Poly)
+theorem le_lt_combine {α} [IntModule α] [Preorder α] [IntModule.IsOrdered α] (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₁ := hmul_int_nonpos (coe_natAbs_nonneg p₂.leadCoeff) h₁
-  replace h₂ := hmul_int_neg_iff (↑p₁.leadCoeff.natAbs) h₂ |>.mpr hp
+  replace h₁ := hmul_nonpos (coe_natAbs_nonneg p₂.leadCoeff) h₁
+  replace h₂ := hmul_neg_iff (↑p₁.leadCoeff.natAbs) h₂ |>.mpr hp
   exact le_add_lt h₁ h₂
 
 def lt_lt_combine_cert (p₁ p₂ p₃ : Poly) : Bool :=
@@ -299,18 +299,18 @@ 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 α] [Preorder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ p₃ : Poly)
+theorem lt_lt_combine {α} [IntModule α] [Preorder α] [IntModule.IsOrdered α] (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₁ := hmul_int_neg_iff (↑p₂.leadCoeff.natAbs) h₁ |>.mpr hp₁
-  replace h₂ := hmul_int_neg_iff (↑p₁.leadCoeff.natAbs) h₂ |>.mpr hp₂
+  replace h₁ := hmul_neg_iff (↑p₂.leadCoeff.natAbs) h₁ |>.mpr hp₁
+  replace h₂ := hmul_neg_iff (↑p₁.leadCoeff.natAbs) h₂ |>.mpr hp₂
   exact lt_add_lt h₁ h₂
 
 def diseq_split_cert (p₁ p₂ : Poly) : Bool :=
   p₂ == p₁.mul (-1)
 
 -- We need `LinearOrder` to use `trichotomy`
-theorem diseq_split {α} [IntModule α] [LinearOrder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ : Poly)
+theorem diseq_split {α} [IntModule α] [LinearOrder α] [IntModule.IsOrdered α] (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
@@ -320,7 +320,7 @@ theorem diseq_split {α} [IntModule α] [LinearOrder α] [OrderedAdd α] (ctx :
     simp [h₁] at h
     rw [← neg_pos_iff, neg_hmul, neg_neg, one_hmul]; assumption
 
-theorem diseq_split_resolve {α} [IntModule α] [LinearOrder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ : Poly)
+theorem diseq_split_resolve {α} [IntModule α] [LinearOrder α] [IntModule.IsOrdered α] (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₃
@@ -336,7 +336,7 @@ 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 α] [Preorder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem le_of_eq {α} [IntModule α] [Preorder α] [IntModule.IsOrdered α] (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
@@ -349,21 +349,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 α] [Preorder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem le_norm {α} [IntModule α] [Preorder α] [IntModule.IsOrdered α] (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 α] [Preorder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem lt_norm {α} [IntModule α] [Preorder α] [IntModule.IsOrdered α] (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 α] [LinearOrder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem not_le_norm {α} [IntModule α] [LinearOrder α] [IntModule.IsOrdered α] (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₁
@@ -371,7 +371,7 @@ theorem not_le_norm {α} [IntModule α] [LinearOrder α] [OrderedAdd α] (ctx :
   simp [← sub_eq_add_neg, sub_self] at h₁
   assumption
 
-theorem not_lt_norm {α} [IntModule α] [LinearOrder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem not_lt_norm {α} [IntModule α] [LinearOrder α] [IntModule.IsOrdered α] (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₁
@@ -381,14 +381,14 @@ theorem not_lt_norm {α} [IntModule α] [LinearOrder α] [OrderedAdd α] (ctx :
 
 -- If the module does not have a linear order, we can still put the expressions in polynomial forms
 
-theorem not_le_norm' {α} [IntModule α] [Preorder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem not_le_norm' {α} [IntModule α] [Preorder α] [IntModule.IsOrdered α] (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 α] [Preorder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem not_lt_norm' {α} [IntModule α] [Preorder α] [IntModule.IsOrdered α] (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
@@ -401,7 +401,7 @@ Equality detection
 def eq_of_le_ge_cert (p₁ p₂ : Poly) : Bool :=
   p₂ == p₁.mul (-1)
 
-theorem eq_of_le_ge {α} [IntModule α] [PartialOrder α] [OrderedAdd α] (ctx : Context α) (p₁ : Poly) (p₂ : Poly)
+theorem eq_of_le_ge {α} [IntModule α] [PartialOrder α] [IntModule.IsOrdered α] (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
@@ -425,18 +425,18 @@ theorem lt_unsat {α} [IntModule α] [Preorder α] (ctx : Context α) : (Poly.ni
 def zero_lt_one_cert (p : Poly) : Bool :=
   p == .add (-1) 0 .nil
 
-theorem zero_lt_one {α} [Ring α] [Preorder α] [OrderedRing α] (ctx : Context α) (p : Poly)
+theorem zero_lt_one {α} [Ring α] [Preorder α] [Ring.IsOrdered α] (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_hmul]
-  rw [neg_lt_iff, neg_zero]; apply OrderedRing.zero_lt_one
+  rw [neg_lt_iff, neg_zero]; apply Ring.IsOrdered.zero_lt_one
 
 def zero_ne_one_cert (p : Poly) : Bool :=
   p == .add 1 0 .nil
 
-theorem zero_ne_one_of_ord_ring {α} [Ring α] [Preorder α] [OrderedRing α] (ctx : Context α) (p : Poly)
+theorem zero_ne_one_of_ord_ring {α} [Ring α] [Preorder α] [Ring.IsOrdered α] (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
+  intro h; have := Ring.IsOrdered.zero_lt_one (R := α); simp [h, Preorder.lt_irrefl] at this
 
 theorem zero_ne_one_of_field {α} [Field α] (ctx : Context α) (p : Poly)
     : zero_ne_one_cert p → (0 : Var).denote ctx = One.one → p.denote' ctx ≠ 0 := by
@@ -482,22 +482,22 @@ 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 α] [LinearOrder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ : Poly) (k : Nat)
+theorem le_coeff {α} [IntModule α] [LinearOrder α] [IntModule.IsOrdered α] (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
   intro h₁; apply Classical.byContradiction
   intro h₂; replace h₂ := LinearOrder.lt_of_not_le h₂
-  replace h₂ := hmul_int_pos_iff (↑k) h₂ |>.mpr this
+  replace h₂ := IsOrdered.hmul_pos_iff (↑k) h₂ |>.mpr this
   exact Preorder.lt_irrefl 0 (Preorder.lt_of_lt_of_le h₂ h₁)
 
-theorem lt_coeff {α} [IntModule α] [LinearOrder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ : Poly) (k : Nat)
+theorem lt_coeff {α} [IntModule α] [LinearOrder α] [IntModule.IsOrdered α] (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
   intro h₁; apply Classical.byContradiction
   intro h₂; replace h₂ := LinearOrder.le_of_not_lt h₂
-  replace h₂ := hmul_int_nonneg (Int.le_of_lt this) h₂
+  replace h₂ := IsOrdered.hmul_nonneg (Int.le_of_lt this) h₂
   exact Preorder.lt_irrefl 0 (Preorder.lt_of_le_of_lt h₂ h₁)
 
 theorem diseq_neg {α} [IntModule α] (ctx : Context α) (p p' : Poly) : p' == p.mul (-1) → p.denote' ctx ≠ 0 → p'.denote' ctx ≠ 0 := by
@@ -542,20 +542,20 @@ 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 α] [Preorder α] [OrderedAdd α] (ctx : Context α) (x : Var) (p₁ p₂ p₃ : Poly)
+theorem eq_le_subst {α} [IntModule α] [Preorder α] [IntModule.IsOrdered α] (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 hmul_int_nonpos h h₂
+  exact hmul_nonpos h h₂
 
 def eq_lt_subst_cert (x : Var) (p₁ p₂ p₃ : Poly) :=
   let a := p₁.coeff x
   let b := p₂.coeff x
   a > 0 && p₃ == (p₂.mul a |>.combine (p₁.mul (-b)))
 
-theorem eq_lt_subst {α} [IntModule α] [Preorder α] [OrderedAdd α] (ctx : Context α) (x : Var) (p₁ p₂ p₃ : Poly)
+theorem eq_lt_subst {α} [IntModule α] [Preorder α] [IntModule.IsOrdered α] (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 hmul_int_neg_iff (p₁.coeff x) h₂ |>.mpr h
+  exact IsOrdered.hmul_neg_iff (p₁.coeff x) h₂ |>.mpr h
 
 def eq_eq_subst_cert (x : Var) (p₁ p₂ p₃ : Poly) :=
   let a := p₁.coeff x

src/Init/Grind/Ordered/Module.lean

@@ -13,19 +13,35 @@ import Init.Grind.Ordered.Order
 namespace Lean.Grind
 
 /--
-Addition is compatible with a preorder if `a ≤ b ↔ a + c ≤ b + c`.
+A module over the natural numbers which is also equipped with a preorder is considered an
+ordered module if addition is compatible with the preorder.
 -/
-class OrderedAdd (M : Type u) [HAdd M M M] [Preorder M] where
+class NatModule.IsOrdered (M : Type u) [Preorder M] [NatModule M] where
   /-- `a + c ≤ b + c` iff `a ≤ b`. -/
   add_le_left_iff : ∀ {a b : M} (c : M), a ≤ b ↔ a + c ≤ b + c
 
-namespace OrderedAdd
+-- This class is actually redundant; it is available automatically when we have an
+-- `IntModule` satisfying `NatModule.IsOrdered`.
+-- Replace with a custom constructor?
+/--
+A module over the integers which is also equipped with a preorder is considered an
+ordered module if addition and negation are compatible with the preorder.
+-/
+class IntModule.IsOrdered (M : Type u) [Preorder M] [IntModule M] where
+  /-- `-a ≤ b` iff `-b ≤ a`. -/
+  neg_le_iff : ∀ a b : M, -a ≤ b ↔ -b ≤ a
+  /-- `a + c ≤ b + c` iff `a ≤ b`. -/
+  add_le_left : ∀ {a b : M}, a ≤ b → (c : M) → a + c ≤ b + c
+  /-- -/
+  hmul_pos_iff : ∀ (k : Int) {a : M}, 0 < a → (0 < k * a ↔ 0 < k)
+  /-- -/
+  hmul_nonneg : ∀ {k : Int} {a : M}, 0 ≤ k → 0 ≤ a → 0 ≤ k * a
 
-open NatModule
+namespace NatModule.IsOrdered
 
 section
 
-variable {M : Type u} [Preorder M] [NatModule M] [OrderedAdd M]
+variable {M : Type u} [Preorder M] [NatModule M] [NatModule.IsOrdered 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]
@@ -105,44 +121,51 @@ end
 
 section
 
-variable {M : Type u} [Preorder M] [IntModule M] [OrderedAdd M]
+variable {M : Type u} [Preorder M] [IntModule M] [NatModule.IsOrdered M]
 
 theorem neg_le_iff {a b : M} : -a ≤ b ↔ -b ≤ a := by
-  rw [OrderedAdd.add_le_left_iff a, IntModule.neg_add_cancel]
-  conv => rhs; rw [OrderedAdd.add_le_left_iff b, IntModule.neg_add_cancel]
+  rw [NatModule.IsOrdered.add_le_left_iff a, IntModule.neg_add_cancel]
+  conv => rhs; rw [NatModule.IsOrdered.add_le_left_iff b, IntModule.neg_add_cancel]
   rw [add_comm]
 
 end
+
+end NatModule.IsOrdered
+
+namespace IntModule.IsOrdered
+
 section
 
-variable {M : Type u} [Preorder M] [IntModule M] [OrderedAdd M]
+variable {M : Type u} [Preorder M] [IntModule M] [NatModule.IsOrdered M]
 
-theorem hmul_int_pos_iff (k : Int) {x : M} (h : 0 < x) : 0 < k * x ↔ 0 < k :=
-  match k with
-  | (k + 1 : Nat) => by
-    simpa [IntModule.hmul_zero, ← IntModule.hmul_nat] using hmul_lt_hmul_iff (k := k + 1) h
-  | (0 : Nat) => by simp [IntModule.zero_hmul]; exact Preorder.lt_irrefl 0
-  | -(k + 1 : Nat) => by
-    have : ¬ (k : Int) + 1 < 0 := by omega
-    simp [this]; clear this
-    rw [IntModule.neg_hmul]
-    rw [Preorder.lt_iff_le_not_le]
-    simp
-    intro h'
-    rw [OrderedAdd.neg_le_iff, IntModule.neg_zero]
-    simpa [IntModule.hmul_zero, ← IntModule.hmul_nat] using
-      hmul_le_hmul (k := k + 1) (Preorder.le_of_lt h)
-
-theorem hmul_int_nonneg {k : Int} {x : M} (h : 0 ≤ k) (hx : 0 ≤ x) : 0 ≤ k * x :=
-  match k, h with
-  | (k : Nat), _ => by
-    simpa [IntModule.hmul_nat] using OrderedAdd.hmul_nonneg hx
+open NatModule.IsOrdered in
+instance : IntModule.IsOrdered M where
+  neg_le_iff a b := NatModule.IsOrdered.neg_le_iff
+  add_le_left := NatModule.IsOrdered.add_le_left
+  hmul_pos_iff k x :=
+    match k with
+    | (k + 1 : Nat) => by
+      intro h
+      simpa [hmul_zero, ← hmul_nat] using hmul_lt_hmul_iff (k := k + 1) h
+    | (0 : Nat) => by simp [zero_hmul]; intro h; exact Preorder.lt_irrefl 0
+    | -(k + 1 : Nat) => by
+      intro h
+      have : ¬ (k : Int) + 1 < 0 := by omega
+      simp [this]; clear this
+      rw [neg_hmul]
+      rw [Preorder.lt_iff_le_not_le]
+      simp
+      intro h'
+      rw [NatModule.IsOrdered.neg_le_iff, neg_zero]
+      simpa [hmul_zero, ← hmul_nat] using hmul_le_hmul (k := k + 1) (Preorder.le_of_lt h)
+  hmul_nonneg {k a} h :=
+    match k, h with
+    | (k : Nat), _ => by
+      simpa [hmul_nat] using NatModule.IsOrdered.hmul_nonneg
 
 end
 
-variable {M : Type u} [Preorder M] [IntModule M] [OrderedAdd M]
-
-open IntModule
+variable {M : Type u} [Preorder M] [IntModule M] [IntModule.IsOrdered M]
 
 theorem le_neg_iff {a b : M} : a ≤ -b ↔ b ≤ -a := by
   conv => lhs; rw [← neg_neg a]
@@ -162,33 +185,89 @@ theorem neg_nonneg_iff {a : M} : 0 ≤ -a ↔ a ≤ 0 := by
 theorem neg_pos_iff {a : M} : 0 < -a ↔ a < 0 := by
   rw [lt_neg_iff, neg_zero]
 
+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 ⊢
+  constructor
+  · exact add_le_left h.1 _
+  · intro w
+    apply h.2
+    replace w := add_le_left w (-c)
+    rw [add_assoc, add_assoc, add_neg_cancel, add_zero, add_zero] at w
+    exact w
+
+theorem add_le_right (a : M) {b c : M} (h : b ≤ c) : a + b ≤ a + c := by
+  rw [add_comm a b, add_comm a c]
+  exact add_le_left h a
+
+theorem add_lt_right (a : M) {b c : M} (h : b < c) : a + b < a + c := by
+  rw [add_comm a b, add_comm a c]
+  exact add_lt_left h a
+
+theorem add_le_left_iff {a b : M} (c : M) : a ≤ b ↔ a + c ≤ b + c := by
+  constructor
+  · intro w
+    exact add_le_left w c
+  · intro w
+    have := add_le_left w (-c)
+    rwa [add_assoc, add_neg_cancel, add_zero, add_assoc, add_neg_cancel, add_zero] at this
+
+theorem add_le_right_iff {a b : M} (c : M) : a ≤ b ↔ c + a ≤ c + b := by
+  constructor
+  · intro w
+    exact add_le_right c w
+  · intro w
+    have := add_le_right (-c) w
+    rwa [← add_assoc, neg_add_cancel, zero_add, ← add_assoc, neg_add_cancel, zero_add] at this
+
+theorem add_lt_left_iff {a b : M} (c : M) : a < b ↔ a + c < b + c := by
+  constructor
+  · intro w
+    exact add_lt_left w c
+  · intro w
+    have := add_lt_left w (-c)
+    rwa [add_assoc, add_neg_cancel, add_zero, add_assoc, add_neg_cancel, add_zero] at this
+
+theorem add_lt_right_iff {a b : M} (c : M) : a < b ↔ c + a < c + b := by
+  constructor
+  · intro w
+    exact add_lt_right c w
+  · intro w
+    have := add_lt_right (-c) w
+    rwa [← add_assoc, neg_add_cancel, zero_add, ← add_assoc, neg_add_cancel, zero_add] at this
+
 theorem sub_nonneg_iff {a b : M} : 0 ≤ a - b ↔ b ≤ a := by
-  rw [add_le_left_iff b, IntModule.zero_add, sub_add_cancel]
+  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, IntModule.zero_add, sub_add_cancel]
+  rw [add_lt_left_iff b, zero_add, sub_add_cancel]
 
-theorem hmul_int_neg_iff (k : Int) {a : M} (h : a < 0) : k * a < 0 ↔ 0 < k := by
-  simpa [IntModule.hmul_neg, neg_pos_iff] using hmul_int_pos_iff k (neg_pos_iff.mpr h)
+theorem hmul_neg_iff (k : Int) {a : M} (h : a < 0) : k * a < 0 ↔ 0 < k := by
+  simpa [IntModule.hmul_neg, neg_pos_iff] using hmul_pos_iff k (neg_pos_iff.mpr h)
 
-theorem hmul_int_nonpos {k : Int} {a : M} (hk : 0 ≤ k) (ha : a ≤ 0) : k * a ≤ 0 := by
-  simpa [IntModule.hmul_neg, neg_nonneg_iff] using hmul_int_nonneg hk (neg_nonneg_iff.mpr ha)
+theorem hmul_nonpos {k : Int} {a : M} (hk : 0 ≤ k) (ha : a ≤ 0) : k * a ≤ 0 := by
+  simpa [IntModule.hmul_neg, neg_nonneg_iff] using hmul_nonneg hk (neg_nonneg_iff.mpr ha)
 
-theorem hmul_int_le_hmul_int {a b : M} {k : Int} (hk : 0 ≤ k) (h : a ≤ b) : k * a ≤ k * b := by
-  simpa [hmul_sub, sub_nonneg_iff] using hmul_int_nonneg hk (sub_nonneg_iff.mpr h)
+theorem hmul_le_hmul {a b : M} {k : Int} (hk : 0 ≤ k) (h : a ≤ b) : k * a ≤ k * b := by
+  simpa [hmul_sub, sub_nonneg_iff] using hmul_nonneg hk (sub_nonneg_iff.mpr h)
 
-theorem hmul_int_lt_hmul_int_iff (k : Int) {a b : M} (h : a < b) : k * a < k * b ↔ 0 < k := by
-  simpa [hmul_sub, sub_pos_iff] using hmul_int_pos_iff k (sub_pos_iff.mpr h)
+theorem hmul_lt_hmul_iff (k : Int) {a b : M} (h : a < b) : k * a < k * b ↔ 0 < k := by
+  simpa [hmul_sub, sub_pos_iff] using hmul_pos_iff k (sub_pos_iff.mpr h)
 
-theorem hmul_int_le_hmul_int_of_le_of_le_of_nonneg_of_nonneg
+theorem hmul_le_hmul_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) := hmul_int_nonneg w (sub_nonneg_iff.mpr h)
+  · have : 0 ≤ k₁ * (y - x) := hmul_nonneg w (sub_nonneg_iff.mpr h)
     rwa [IntModule.hmul_sub, sub_nonneg_iff] at this
-  · have : 0 ≤ (k₂ - k₁) * y := hmul_int_nonneg (Int.sub_nonneg.mpr hk) (Preorder.le_trans w' h)
+  · have : 0 ≤ (k₂ - k₁) * y := hmul_nonneg (Int.sub_nonneg.mpr hk) (Preorder.le_trans w' h)
     rwa [IntModule.sub_hmul, sub_nonneg_iff] at this
 
-end OrderedAdd
+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)
+
+instance : NatModule.IsOrdered M where
+  add_le_left_iff := add_le_left_iff
+
+end IntModule.IsOrdered
 
 end Lean.Grind

src/Init/Grind/Ordered/Ring.lean

@@ -15,7 +15,7 @@ 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) [Ring R] [Preorder R] extends OrderedAdd R where
+class Ring.IsOrdered (R : Type u) [Ring R] [Preorder R] extends NatModule.IsOrdered 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
@@ -25,17 +25,17 @@ class OrderedRing (R : Type u) [Ring R] [Preorder R] extends OrderedAdd R where
   by a positive element `0 < c` to obtain `a * c < b * c`. -/
   mul_lt_mul_of_pos_right : ∀ {a b c : R}, a < b → 0 < c → a * c < b * c
 
-namespace OrderedRing
+namespace Ring.IsOrdered
 
 variable {R : Type u} [Ring R]
 
 section Preorder
 
-variable [Preorder R] [OrderedRing R]
+variable [Preorder R] [Ring.IsOrdered R]
 
 theorem neg_one_lt_zero : (-1 : R) < 0 := by
   have h := zero_lt_one (R := R)
-  have := OrderedAdd.add_lt_left h (-1)
+  have := NatModule.IsOrdered.add_lt_left h (-1)
   rw [Semiring.zero_add, Ring.add_neg_cancel] at this
   assumption
 
@@ -43,14 +43,14 @@ theorem ofNat_nonneg (x : Nat) : (OfNat.ofNat x : R) ≥ 0 := by
   induction x
   next => simp [OfNat.ofNat, Zero.zero]; apply Preorder.le_refl
   next n ih =>
-    have := OrderedRing.zero_lt_one (R := R)
+    have := Ring.IsOrdered.zero_lt_one (R := R)
     rw [Semiring.ofNat_succ]
-    replace ih := OrderedAdd.add_le_left ih 1
+    replace ih := NatModule.IsOrdered.add_le_left ih 1
     rw [Semiring.zero_add] at ih
     have := Preorder.lt_of_lt_of_le this ih
     exact Preorder.le_of_lt this
 
-instance [Ring α] [Preorder α] [OrderedRing α] : IsCharP α 0 := IsCharP.mk' _ _ <| by
+instance [Ring α] [Preorder α] [Ring.IsOrdered α] : IsCharP α 0 := IsCharP.mk' _ _ <| by
   intro x
   simp only [Nat.mod_zero]; constructor
   next =>
@@ -63,9 +63,9 @@ instance [Ring α] [Preorder α] [OrderedRing α] : IsCharP α 0 := IsCharP.mk'
       rw [Ring.sub_eq_add_neg, Semiring.add_assoc, Ring.add_neg_cancel,
           Ring.sub_eq_add_neg, Semiring.zero_add, Semiring.add_zero] at h
       have h₁ : (OfNat.ofNat x : α) < 0 := by
-        have := OrderedRing.neg_one_lt_zero (R := α)
+        have := Ring.IsOrdered.neg_one_lt_zero (R := α)
         rw [h]; assumption
-      have h₂ := OrderedRing.ofNat_nonneg (R := α) x
+      have h₂ := Ring.IsOrdered.ofNat_nonneg (R := α) x
       have : (0 : α) < 0 := Preorder.lt_of_le_of_lt h₂ h₁
       simp
       exact (Preorder.lt_irrefl 0) this
@@ -75,7 +75,7 @@ end Preorder
 
 section PartialOrder
 
-variable [PartialOrder R] [OrderedRing R]
+variable [PartialOrder R] [Ring.IsOrdered R]
 
 theorem zero_le_one : (0 : R) ≤ 1 := Preorder.le_of_lt zero_lt_one
 
@@ -104,59 +104,57 @@ theorem mul_le_mul_of_nonneg_right {a b c : R} (h : a ≤ b) (h' : 0 ≤ c) : a
     | inr h => subst h; exact Preorder.le_refl (a * c)
   | inr h' => subst h'; simp [Semiring.mul_zero, Preorder.le_refl]
 
-open OrderedAdd
-
 theorem mul_le_mul_of_nonpos_left {a b c : R} (h : a ≤ b) (h' : c ≤ 0) : c * b ≤ c * a := by
-  have := mul_le_mul_of_nonneg_left h (neg_nonneg_iff.mpr h')
-  rwa [Ring.neg_mul, Ring.neg_mul, neg_le_iff, IntModule.neg_neg] at this
+  have := mul_le_mul_of_nonneg_left h (IntModule.IsOrdered.neg_nonneg_iff.mpr h')
+  rwa [Ring.neg_mul, Ring.neg_mul, IntModule.IsOrdered.neg_le_iff, IntModule.neg_neg] at this
 
 theorem mul_le_mul_of_nonpos_right {a b c : R} (h : a ≤ b) (h' : c ≤ 0) : b * c ≤ a * c := by
-  have := mul_le_mul_of_nonneg_right h (neg_nonneg_iff.mpr h')
-  rwa [Ring.mul_neg, Ring.mul_neg, neg_le_iff, IntModule.neg_neg] at this
+  have := mul_le_mul_of_nonneg_right h (IntModule.IsOrdered.neg_nonneg_iff.mpr h')
+  rwa [Ring.mul_neg, Ring.mul_neg, IntModule.IsOrdered.neg_le_iff, IntModule.neg_neg] at this
 
 theorem mul_lt_mul_of_neg_left {a b c : R} (h : a < b) (h' : c < 0) : c * b < c * a := by
-  have := mul_lt_mul_of_pos_left h (neg_pos_iff.mpr h')
-  rwa [Ring.neg_mul, Ring.neg_mul, neg_lt_iff, IntModule.neg_neg] at this
+  have := mul_lt_mul_of_pos_left h (IntModule.IsOrdered.neg_pos_iff.mpr h')
+  rwa [Ring.neg_mul, Ring.neg_mul, IntModule.IsOrdered.neg_lt_iff, IntModule.neg_neg] at this
 
 theorem mul_lt_mul_of_neg_right {a b c : R} (h : a < b) (h' : c < 0) : b * c < a * c := by
-  have := mul_lt_mul_of_pos_right h (neg_pos_iff.mpr h')
-  rwa [Ring.mul_neg, Ring.mul_neg, neg_lt_iff, IntModule.neg_neg] at this
+  have := mul_lt_mul_of_pos_right h (IntModule.IsOrdered.neg_pos_iff.mpr h')
+  rwa [Ring.mul_neg, Ring.mul_neg, IntModule.IsOrdered.neg_lt_iff, IntModule.neg_neg] at this
 
 theorem mul_nonneg {a b : R} (h₁ : 0 ≤ a) (h₂ : 0 ≤ b) : 0 ≤ a * b := by
   simpa [Semiring.zero_mul] using mul_le_mul_of_nonneg_right h₁ h₂
 
 theorem mul_nonneg_of_nonpos_of_nonpos {a b : R} (h₁ : a ≤ 0) (h₂ : b ≤ 0) : 0 ≤ a * b := by
-  have := mul_nonneg (neg_nonneg_iff.mpr h₁) (neg_nonneg_iff.mpr h₂)
+  have := mul_nonneg (IntModule.IsOrdered.neg_nonneg_iff.mpr h₁) (IntModule.IsOrdered.neg_nonneg_iff.mpr h₂)
   simpa [Ring.neg_mul, Ring.mul_neg, Ring.neg_neg] using this
 
 theorem mul_nonpos_of_nonneg_of_nonpos {a b : R} (h₁ : 0 ≤ a) (h₂ : b ≤ 0) : a * b ≤ 0 := by
-  rw [← neg_nonneg_iff, ← Ring.mul_neg]
-  apply mul_nonneg h₁ (neg_nonneg_iff.mpr h₂)
+  rw [← IntModule.IsOrdered.neg_nonneg_iff, ← Ring.mul_neg]
+  apply mul_nonneg h₁ (IntModule.IsOrdered.neg_nonneg_iff.mpr h₂)
 
 theorem mul_nonpos_of_nonpos_of_nonneg {a b : R} (h₁ : a ≤ 0) (h₂ : 0 ≤ b) : a * b ≤ 0 := by
-  rw [← neg_nonneg_iff, ← Ring.neg_mul]
-  apply mul_nonneg (neg_nonneg_iff.mpr h₁) h₂
+  rw [← IntModule.IsOrdered.neg_nonneg_iff, ← Ring.neg_mul]
+  apply mul_nonneg (IntModule.IsOrdered.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₂)
+  have := mul_pos (IntModule.IsOrdered.neg_pos_iff.mpr h₁) (IntModule.IsOrdered.neg_pos_iff.mpr h₂)
   simpa [Ring.neg_mul, Ring.mul_neg, Ring.neg_neg] using this
 
 theorem mul_neg_of_pos_of_neg {a b : R} (h₁ : 0 < a) (h₂ : b < 0) : a * b < 0 := by
-  rw [← neg_pos_iff, ← Ring.mul_neg]
-  apply mul_pos h₁ (neg_pos_iff.mpr h₂)
+  rw [← IntModule.IsOrdered.neg_pos_iff, ← Ring.mul_neg]
+  apply mul_pos h₁ (IntModule.IsOrdered.neg_pos_iff.mpr h₂)
 
 theorem mul_neg_of_neg_of_pos {a b : R} (h₁ : a < 0) (h₂ : 0 < b) : a * b < 0 := by
-  rw [← neg_pos_iff, ← Ring.neg_mul]
-  apply mul_pos (neg_pos_iff.mpr h₁) h₂
+  rw [← IntModule.IsOrdered.neg_pos_iff, ← Ring.neg_mul]
+  apply mul_pos (IntModule.IsOrdered.neg_pos_iff.mpr h₁) h₂
 
 end PartialOrder
 
 section LinearOrder
 
-variable [LinearOrder R] [OrderedRing R]
+variable [LinearOrder R] [Ring.IsOrdered 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)
@@ -205,6 +203,6 @@ theorem sq_pos {a : R} (h : a ≠ 0) : 0 < a^2 := by
 
 end LinearOrder
 
-end OrderedRing
+end Ring.IsOrdered
 
 end Lean.Grind

src/Init/Grind/Ring/Basic.lean

@@ -531,7 +531,7 @@ theorem no_int_zero_divisors {α : Type u} [IntModule α] [NoNatZeroDivisors α]
     : k ≠ 0 → k * a = 0 → a = 0 := by
   match k with
   | (k : Nat) =>
-    simp only [ne_eq, Int.natCast_eq_zero]
+    simp [intCast_natCast]
     intro h₁ h₂
     replace h₁ : k ≠ 0 := by intro h; simp [h] at h₁
     rw [IntModule.hmul_nat] at h₂

src/Init/Grind/Ring/Envelope.lean

@@ -242,7 +242,7 @@ def ofSemiring : Ring (Q α) := {
   intCast_neg, ofNat_succ
 }
 
-attribute [instance] ofSemiring
+attribute [local instance] ofSemiring
 
 @[local simp] def toQ (a : α) : Q α :=
   Q.mk (a, 0)
@@ -298,44 +298,6 @@ theorem toQ_inj [AddRightCancel α] {a b : α} : toQ a = toQ b → a = b := by
   obtain ⟨k, h₁⟩ := h₁
   exact AddRightCancel.add_right_cancel a b k h₁
 
-instance [Semiring α] [AddRightCancel α] [NoNatZeroDivisors α] : NoNatZeroDivisors (OfSemiring.Q α) where
-  no_nat_zero_divisors := by
-    intro k a b h₁ h₂
-    replace h₂ : mul (natCast k) a = mul (natCast k) b := h₂
-    induction a using Quot.ind
-    induction b using Quot.ind
-    next a b =>
-    rcases a with ⟨a₁, a₂⟩
-    rcases b with ⟨b₁, b₂⟩
-    simp [mul] at h₂
-    replace h₂ := Q.exact h₂
-    simp [r] at h₂
-    rcases h₂ with ⟨k', h₂⟩
-    replace h₂ := AddRightCancel.add_right_cancel _ _ _ h₂
-    simp [← Semiring.left_distrib] at h₂
-    replace h₂ := NoNatZeroDivisors.no_nat_zero_divisors k (a₁ + b₂) (a₂ + b₁) h₁ h₂
-    apply Quot.sound; simp [r]; exists 0; simp [h₂]
-
-instance {p} [Semiring α] [AddRightCancel α] [IsCharP α p] : IsCharP (OfSemiring.Q α) p where
-  ofNat_ext_iff := by
-    intro x y
-    constructor
-    next =>
-      intro h
-      replace h : natCast x = natCast y := h; simp at h
-      replace h := Q.exact h; simp [r] at h
-      rcases h with ⟨k, h⟩
-      replace h : OfNat.ofNat (α := α) x = OfNat.ofNat y := by
-        replace h := AddRightCancel.add_right_cancel _ _ _ h
-        simp [Semiring.ofNat_eq_natCast, h]
-      have := IsCharP.ofNat_ext_iff p |>.mp h
-      simp at this; assumption
-    next =>
-      intro h
-      have := IsCharP.ofNat_ext_iff (α := α) p |>.mpr h
-      apply Quot.sound
-      exists 0; simp [← Semiring.ofNat_eq_natCast, this]
-
 end OfSemiring
 end Lean.Grind.Ring
 
@@ -370,8 +332,6 @@ def ofCommSemiring : CommRing (OfSemiring.Q α) :=
   { OfSemiring.ofSemiring with
     mul_comm := mul_comm }
 
-attribute [instance] ofCommSemiring
-
 end OfCommSemiring
 
 end Lean.Grind.CommRing

src/Init/Grind/Ring/Poly.lean

@@ -1178,23 +1178,23 @@ theorem diseq_norm {α} [CommRing α] (ctx : Context α) (lhs rhs : Expr) (p : P
   simp [core_cert, Poly.denoteAsIntModule_eq_denote]; intro _ h; subst p; simp [Expr.denote_toPoly, Expr.denote]
   intro h; rw [sub_eq_zero_iff] at h; contradiction
 
-open OrderedAdd
+open IntModule.IsOrdered
 
-theorem le_norm {α} [CommRing α] [Preorder α] [OrderedRing α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem le_norm {α} [CommRing α] [Preorder α] [Ring.IsOrdered α] (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 α] [Preorder α] [OrderedRing α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem lt_norm {α} [CommRing α] [Preorder α] [Ring.IsOrdered α] (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 α] [LinearOrder α] [OrderedRing α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem not_le_norm {α} [CommRing α] [LinearOrder α] [Ring.IsOrdered α] (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₁
@@ -1202,7 +1202,7 @@ theorem not_le_norm {α} [CommRing α] [LinearOrder α] [OrderedRing α] (ctx :
   simp [← sub_eq_add_neg, sub_self] at h₁
   assumption
 
-theorem not_lt_norm {α} [CommRing α] [LinearOrder α] [OrderedRing α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem not_lt_norm {α} [CommRing α] [LinearOrder α] [Ring.IsOrdered α] (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₁
@@ -1210,14 +1210,14 @@ theorem not_lt_norm {α} [CommRing α] [LinearOrder α] [OrderedRing α] (ctx :
   simp [← sub_eq_add_neg, sub_self] at h₁
   assumption
 
-theorem not_le_norm' {α} [CommRing α] [Preorder α] [OrderedRing α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem not_le_norm' {α} [CommRing α] [Preorder α] [Ring.IsOrdered α] (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 := 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 α] [Preorder α] [OrderedRing α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem not_lt_norm' {α} [CommRing α] [Preorder α] [Ring.IsOrdered α] (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 := add_lt_right (rhs.denote ctx) h

src/Init/GrindInstances/Nat.lean

@@ -7,7 +7,6 @@ module
 prelude
 
 import Init.Grind.Module.Basic
-import Init.Grind.Ring.Basic
 
 namespace Lean.Grind
 

src/Init/GrindInstances/Ring.lean

@@ -6,7 +6,6 @@ Authors: Kim Morrison
 module
 
 prelude
-import Init.GrindInstances.Ring.Nat
 import Init.GrindInstances.Ring.Int
 import Init.GrindInstances.Ring.UInt
 import Init.GrindInstances.Ring.SInt

src/Init/GrindInstances/Ring/BitVec.lean

@@ -32,7 +32,7 @@ instance : CommRing (BitVec w) where
   intCast_neg _ := BitVec.ofInt_neg
 
 instance : IsCharP (BitVec w) (2 ^ w) := IsCharP.mk' _ _
-  (ofNat_eq_zero_iff := fun x => by simp [BitVec.toNat_eq])
+  (ofNat_eq_zero_iff := fun x => by simp [BitVec.ofInt, BitVec.toNat_eq])
 
 -- Verify we can derive the instances showing how `toInt` interacts with operations:
 example : ToInt.Add (BitVec w) (some 0) (some (2^w)) := inferInstance

src/Init/GrindInstances/Ring/Nat.lean

@@ -1,36 +0,0 @@
-/-
-Copyright (c) 2025 Lean FRO, LLC. or its affiliates. All Rights Reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Kim Morrison
--/
-module
-
-prelude
-import Init.Grind.Ring.Basic
-import Init.Data.Int.Lemmas
-
-namespace Lean.Grind
-
-instance : CommSemiring Nat where
-  add_assoc := Nat.add_assoc
-  add_comm := Nat.add_comm
-  add_zero := Nat.add_zero
-  mul_assoc := Nat.mul_assoc
-  mul_comm := Nat.mul_comm
-  mul_one := Nat.mul_one
-  one_mul := Nat.one_mul
-  left_distrib := Nat.mul_add
-  right_distrib := Nat.add_mul
-  zero_mul := Nat.zero_mul
-  mul_zero := Nat.mul_zero
-  pow_zero _ := by rfl
-  pow_succ _ _ := by rfl
-  ofNat_succ _ := by rfl
-
-instance : IsCharP Nat 0 where
-  ofNat_ext_iff {x y} := by simp [OfNat.ofNat]
-
-instance : NoNatZeroDivisors Nat where
-  no_nat_zero_divisors _ _ _ h₁ h₂ := (Nat.mul_right_inj h₁).mp h₂
-
-end Lean.Grind

src/Init/NotationExtra.lean

@@ -313,6 +313,23 @@ macro_rules
     `($mods:declModifiers class $id $params* $[: $ty:term]? extends $[$parents:term],*
       attribute [instance] $ctor)
 
+macro_rules
+  | `(haveI $hy:hygieneInfo $bs* $[: $ty]? := $val; $body) =>
+    `(haveI $(HygieneInfo.mkIdent hy `this (canonical := true)) $bs* $[: $ty]? := $val; $body)
+  | `(haveI _ $bs* := $val; $body) => `(haveI x $bs* : _ := $val; $body)
+  | `(haveI _ $bs* : $ty := $val; $body) => `(haveI x $bs* : $ty := $val; $body)
+  | `(haveI $x:ident $bs* := $val; $body) => `(haveI $x $bs* : _ := $val; $body)
+  | `(haveI $_:ident $_* : $_ := $_; $_) => Lean.Macro.throwUnsupported -- handled by elab
+
+macro_rules
+  | `(letI $hy:hygieneInfo $bs* $[: $ty]? := $val; $body) =>
+    `(letI $(HygieneInfo.mkIdent hy `this (canonical := true)) $bs* $[: $ty]? := $val; $body)
+  | `(letI _ $bs* := $val; $body) => `(letI x $bs* : _ := $val; $body)
+  | `(letI _ $bs* : $ty := $val; $body) => `(letI x $bs* : $ty := $val; $body)
+  | `(letI $x:ident $bs* := $val; $body) => `(letI $x $bs* : _ := $val; $body)
+  | `(letI $_:ident $_* : $_ := $_; $_) => Lean.Macro.throwUnsupported -- handled by elab
+
+
 namespace Lean
 syntax cdotTk := patternIgnore("· " <|> ". ")
 /-- `· tac` focuses on the main goal and tries to solve it using `tac`, or else fails. -/

src/Init/System/IO.lean

@@ -940,7 +940,7 @@ encountered.
 The underlying file is not automatically closed upon encountering an EOF, and subsequent reads from
 the handle may block and/or return data.
 -/
-def Handle.readBinToEnd (h : Handle) : IO ByteArray := do
+partial def Handle.readBinToEnd (h : Handle) : IO ByteArray := do
   h.readBinToEndInto .empty
 
 /--
@@ -957,14 +957,12 @@ def Handle.readToEnd (h : Handle) : IO String := do
   | none => throw <| .userError s!"Tried to read from handle containing non UTF-8 data."
 
 /--
-Reads the entire remaining contents of the file handle as a UTF-8-encoded array of lines.
+Returns the contents of a UTF-8-encoded text file as an array of lines.
 
 Newline markers are not included in the lines.
-
-The underlying file is not automatically closed, and subsequent reads from the handle may block
-and/or return data.
 -/
-partial def Handle.lines (h : Handle) : IO (Array String) := do
+partial def lines (fname : FilePath) : IO (Array String) := do
+  let h ← Handle.mk fname Mode.read
   let rec read (lines : Array String) := do
     let line ← h.getLine
     if line.length == 0 then
@@ -977,15 +975,6 @@ partial def Handle.lines (h : Handle) : IO (Array String) := do
       pure <| lines.push line
   read #[]
 
-/--
-Returns the contents of a UTF-8-encoded text file as an array of lines.
-
-Newline markers are not included in the lines.
--/
-def lines (fname : FilePath) : IO (Array String) := do
-  let h ← Handle.mk fname Mode.read
-  h.lines
-
 /--
 Write the provided bytes to a binary file at the specified path.
 -/
@@ -1677,66 +1666,6 @@ def ofBuffer (r : Ref Buffer) : Stream where
     { b with data := data.copySlice 0 b.data b.pos data.size false, pos := b.pos + data.size }
   isTty   := pure false
 
-/--
-Reads the entire remaining contents of the stream until an end-of-file marker (EOF) is
-encountered.
-
-The underlying stream is not automatically closed upon encountering an EOF, and subsequent reads from
-the stream may block and/or return data.
--/
-partial def readBinToEndInto (s : Stream) (buf : ByteArray) : IO ByteArray := do
-  let rec loop (acc : ByteArray) : IO ByteArray := do
-    let buf ← s.read 1024
-    if buf.isEmpty then
-      return acc
-    else
-      loop (acc ++ buf)
-  loop buf
-
-/--
-Reads the entire remaining contents of the stream until an end-of-file marker (EOF) is
-encountered.
-
-The underlying stream is not automatically closed upon encountering an EOF, and subsequent reads from
-the stream may block and/or return data.
--/
-def readBinToEnd (s : Stream) : IO ByteArray := do
-  s.readBinToEndInto .empty
-
-/--
-Reads the entire remaining contents of the stream as a UTF-8-encoded string. An exception is
-thrown if the contents are not valid UTF-8.
-
-The underlying stream is not automatically closed, and subsequent reads from the stream may block
-and/or return data.
--/
-def readToEnd (s : Stream) : IO String := do
-  let data ← s.readBinToEnd
-  match String.fromUTF8? data with
-  | some s => return s
-  | none => throw <| .userError s!"Tried to read from stream containing non UTF-8 data."
-  
-/--
-Reads the entire remaining contents of the stream as a UTF-8-encoded array of lines.
-
-Newline markers are not included in the lines.
-
-The underlying stream is not automatically closed, and subsequent reads from the stream may block
-and/or return data.
--/
-partial def lines (s : Stream) : IO (Array String) := do
-  let rec read (lines : Array String) := do
-    let line ← s.getLine
-    if line.length == 0 then
-      pure lines
-    else if line.back == '\n' then
-      let line := line.dropRight 1
-      let line := if line.back == '\r' then line.dropRight 1 else line
-      read <| lines.push line
-    else
-      pure <| lines.push line
-  read #[]
-
 end Stream
 
 /--

src/Init/Tactics.lean

@@ -818,16 +818,16 @@ The `have` tactic is for adding hypotheses to the local context of the main goal
   For example, given `h : p ∧ q ∧ r`, `have ⟨h₁, h₂, h₃⟩ := h` produces the
   hypotheses `h₁ : p`, `h₂ : q`, and `h₃ : r`.
 -/
-syntax "have " letDecl : tactic
+syntax "have " haveDecl : tactic
 macro_rules
   -- special case: when given a nested `by` block, move it outside of the `refine` to enable
   -- incrementality
-  | `(tactic| have%$haveTk $id:letId $bs* : $type := by%$byTk $tacs*) => do
+  | `(tactic| have%$haveTk $id:haveId $bs* : $type := by%$byTk $tacs*) => do
     /-
     We want to create the syntax
     ```
     focus
-      refine no_implicit_lambda% (have $id:letId $bs* : $type := ?body; ?_)
+      refine no_implicit_lambda% (have $id:haveId $bs* : $type := ?body; ?_)
       case body => $tacs*
     ```
     However, we need to be very careful with the syntax infos involved:
@@ -846,9 +846,9 @@ macro_rules
     let tac ← `(tacticSeq| $tac:tactic)
     let tac ← Lean.withRef byTk `(tactic| case body => $(.mk tac):tacticSeq)
     Lean.withRef haveTk `(tactic| focus
-      refine no_implicit_lambda% (have $id:letId $bs* : $type := ?body; ?_)
+      refine no_implicit_lambda% (have $id:haveId $bs* : $type := ?body; ?_)
       $tac)
-  | `(tactic| have $d:letDecl) => `(tactic| refine_lift have $d:letDecl; ?_)
+  | `(tactic| have $d:haveDecl) => `(tactic| refine_lift have $d:haveDecl; ?_)
 
 /--
 Given a main goal `ctx ⊢ t`, `suffices h : t' from e` replaces the main goal with `ctx ⊢ t'`,
@@ -879,7 +879,7 @@ macro_rules
 /-- Similar to `refine_lift`, but using `refine'` -/
 macro "refine_lift' " e:term : tactic => `(tactic| focus (refine' no_implicit_lambda% $e; rotate_right))
 /-- Similar to `have`, but using `refine'` -/
-macro "have' " d:letDecl : tactic => `(tactic| refine_lift' have $d:letDecl; ?_)
+macro "have' " d:haveDecl : tactic => `(tactic| refine_lift' have $d:haveDecl; ?_)
 set_option linter.missingDocs false in -- OK, because `tactic_alt` causes inheritance of docs
 macro (priority := high) "have'" x:ident " := " p:term : tactic => `(tactic| have' $x:ident : _ := $p)
 attribute [tactic_alt tacticHave'_] «tacticHave'_:=_»
@@ -1255,7 +1255,7 @@ h : β
 
 This can be used to simulate the `specialize` and `apply at` tactics of Coq.
 -/
-syntax (name := replace) "replace" letDecl : tactic
+syntax (name := replace) "replace" haveDecl : tactic
 
 /-- `and_intros` applies `And.intro` until it does not make progress. -/
 syntax "and_intros" : tactic
@@ -1271,10 +1271,10 @@ syntax (name := substEqs) "subst_eqs" : tactic
 syntax (name := runTac) "run_tac " doSeq : tactic
 
 /-- `haveI` behaves like `have`, but inlines the value instead of producing a `let_fun` term. -/
-macro "haveI" d:letDecl : tactic => `(tactic| refine_lift haveI $d:letDecl; ?_)
+macro "haveI" d:haveDecl : tactic => `(tactic| refine_lift haveI $d:haveDecl; ?_)
 
 /-- `letI` behaves like `let`, but inlines the value instead of producing a `let_fun` term. -/
-macro "letI" d:letDecl : tactic => `(tactic| refine_lift letI $d:letDecl; ?_)
+macro "letI" d:haveDecl : tactic => `(tactic| refine_lift letI $d:haveDecl; ?_)
 
 /--
 Configuration for the `decide` tactic family.
@@ -1790,6 +1790,307 @@ macro (name := bvNormalizeMacro) (priority:=low) "bv_normalize" optConfig : tact
   Macro.throwError "to use `bv_normalize`, please include `import Std.Tactic.BVDecide`"
 
 
+/--
+`massumption` is like `assumption`, but operating on a stateful `Std.Do.SPred` goal.
+```lean
+example (P Q : SPred σs) : Q ⊢ₛ P → Q := by
+  mintro _ _
+  massumption
+```
+-/
+macro (name := massumptionMacro) (priority:=low) "massumption" : tactic =>
+  Macro.throwError "to use `massumption`, please include `import Std.Tactic.Do`"
+
+
+/--
+`mclear` is like `clear`, but operating on a stateful `Std.Do.SPred` goal.
+```lean
+example (P Q : SPred σs) : P ⊢ₛ Q → Q := by
+  mintro HP
+  mintro HQ
+  mclear HP
+  mexact HQ
+```
+-/
+macro (name := mclearMacro) (priority:=low) "mclear" : tactic =>
+  Macro.throwError "to use `mclear`, please include `import Std.Tactic.Do`"
+
+
+/--
+`mconstructor` is like `constructor`, but operating on a stateful `Std.Do.SPred` goal.
+```lean
+example (Q : SPred σs) : Q ⊢ₛ Q ∧ Q := by
+  mintro HQ
+  mconstructor <;> mexact HQ
+```
+-/
+macro (name := mconstructorMacro) (priority:=low) "mconstructor" : tactic =>
+  Macro.throwError "to use `mconstructor`, please include `import Std.Tactic.Do`"
+
+
+/--
+`mexact` is like `exact`, but operating on a stateful `Std.Do.SPred` goal.
+```lean
+example (Q : SPred σs) : Q ⊢ₛ Q := by
+  mstart
+  mintro HQ
+  mexact HQ
+```
+-/
+macro (name := mexactMacro) (priority:=low) "mexact" : tactic =>
+  Macro.throwError "to use `mexact`, please include `import Std.Tactic.Do`"
+
+
+/--
+`mexfalso` is like `exfalso`, but operating on a stateful `Std.Do.SPred` goal.
+```lean
+example (P : SPred σs) : ⌜False⌝ ⊢ₛ P := by
+  mintro HP
+  mexfalso
+  mexact HP
+```
+-/
+macro (name := mexfalsoMacro) (priority:=low) "mexfalso" : tactic =>
+  Macro.throwError "to use `mexfalso`, please include `import Std.Tactic.Do`"
+
+
+/--
+`mexists` is like `exists`, but operating on a stateful `Std.Do.SPred` goal.
+```lean
+example (ψ : Nat → SPred σs) : ψ 42 ⊢ₛ ∃ x, ψ x := by
+  mintro H
+  mexists 42
+```
+-/
+macro (name := mexistsMacro) (priority:=low) "mexists" : tactic =>
+  Macro.throwError "to use `mexists`, please include `import Std.Tactic.Do`"
+
+
+/--
+`mframe` infers which hypotheses from the stateful context can be moved into the pure context.
+This is useful because pure hypotheses "survive" the next application of modus ponens
+(`Std.Do.SPred.mp`) and transitivity (`Std.Do.SPred.entails.trans`).
+
+It is used as part of the `mspec` tactic.
+
+```lean
+example (P Q : SPred σs) : ⊢ₛ ⌜p⌝ ∧ Q ∧ ⌜q⌝ ∧ ⌜r⌝ ∧ P ∧ ⌜s⌝ ∧ ⌜t⌝ → Q := by
+  mintro _
+  mframe
+  /- `h : p ∧ q ∧ r ∧ s ∧ t` in the pure context -/
+  mcases h with hP
+  mexact h
+```
+-/
+macro (name := mframeMacro) (priority:=low) "mframe" : tactic =>
+  Macro.throwError "to use `mframe`, please include `import Std.Tactic.Do`"
+
+
+/--
+`mhave` is like `have`, but operating on a stateful `Std.Do.SPred` goal.
+```lean
+example (P Q : SPred σs) : P ⊢ₛ (P → Q) → Q := by
+  mintro HP HPQ
+  mhave HQ : Q := by mspecialize HPQ HP; mexact HPQ
+  mexact HQ
+```
+-/
+macro (name := mhaveMacro) (priority:=low) "mhave" : tactic =>
+  Macro.throwError "to use `mhave`, please include `import Std.Tactic.Do`"
+
+
+/--
+`mreplace` is like `replace`, but operating on a stateful `Std.Do.SPred` goal.
+```lean
+example (P Q : SPred σs) : P ⊢ₛ (P → Q) → Q := by
+  mintro HP HPQ
+  mreplace HPQ : Q := by mspecialize HPQ HP; mexact HPQ
+  mexact HPQ
+```
+-/
+macro (name := mreplaceMacro) (priority:=low) "mreplace" : tactic =>
+  Macro.throwError "to use `mreplace`, please include `import Std.Tactic.Do`"
+
+
+/--
+`mleft` is like `left`, but operating on a stateful `Std.Do.SPred` goal.
+```lean
+example (P Q : SPred σs) : P ⊢ₛ P ∨ Q := by
+  mintro HP
+  mleft
+  mexact HP
+```
+-/
+macro (name := mleftMacro) (priority:=low) "mleft" : tactic =>
+  Macro.throwError "to use `mleft`, please include `import Std.Tactic.Do`"
+
+
+/--
+`mright` is like `right`, but operating on a stateful `Std.Do.SPred` goal.
+```lean
+example (P Q : SPred σs) : P ⊢ₛ Q ∨ P := by
+  mintro HP
+  mright
+  mexact HP
+```
+-/
+macro (name := mrightMacro) (priority:=low) "mright" : tactic =>
+  Macro.throwError "to use `mright`, please include `import Std.Tactic.Do`"
+
+
+/--
+`mpure` moves a pure hypothesis from the stateful context into the pure context.
+```lean
+example (Q : SPred σs) (ψ : φ → ⊢ₛ Q): ⌜φ⌝ ⊢ₛ Q := by
+  mintro Hφ
+  mpure Hφ
+  mexact (ψ Hφ)
+```
+-/
+macro (name := mpureMacro) (priority:=low) "mpure" : tactic =>
+  Macro.throwError "to use `mpure`, please include `import Std.Tactic.Do`"
+
+
+/--
+`mpure_intro` operates on a stateful `Std.Do.SPred` goal of the form `P ⊢ₛ ⌜φ⌝`.
+It leaves the stateful proof mode (thereby discarding `P`), leaving the regular goal `φ`.
+```lean
+theorem simple : ⊢ₛ (⌜True⌝ : SPred σs) := by
+  mpure_intro
+  exact True.intro
+```
+-/
+macro (name := mpureIntroMacro) (priority:=low) "mpure_intro" : tactic =>
+  Macro.throwError "to use `mpure_intro`, please include `import Std.Tactic.Do`"
+
+
+/--
+`mrevert` is like `revert`, but operating on a stateful `Std.Do.SPred` goal.
+```lean
+example (P Q R : SPred σs) : P ∧ Q ∧ R ⊢ₛ P → R := by
+  mintro ⟨HP, HQ, HR⟩
+  mrevert HR
+  mrevert HP
+  mintro HP'
+  mintro HR'
+  mexact HR'
+```
+-/
+macro (name := mrevertMacro) (priority:=low) "mrevert" : tactic =>
+  Macro.throwError "to use `mrevert`, please include `import Std.Tactic.Do`"
+
+
+/--
+`mspecialize` is like `specialize`, but operating on a stateful `Std.Do.SPred` goal.
+It specializes a hypothesis from the stateful context with hypotheses from either the pure
+or stateful context or pure terms.
+```lean
+example (P Q : SPred σs) : P ⊢ₛ (P → Q) → Q := by
+  mintro HP HPQ
+  mspecialize HPQ HP
+  mexact HPQ
+
+example (y : Nat) (P Q : SPred σs) (Ψ : Nat → SPred σs) (hP : ⊢ₛ P) : ⊢ₛ Q → (∀ x, P → Q → Ψ x) → Ψ (y + 1) := by
+  mintro HQ HΨ
+  mspecialize HΨ (y + 1) hP HQ
+  mexact HΨ
+```
+-/
+macro (name := mspecializeMacro) (priority:=low) "mspecialize" : tactic =>
+  Macro.throwError "to use `mspecialize`, please include `import Std.Tactic.Do`"
+
+
+/--
+`mspecialize_pure` is like `mspecialize`, but it specializes a hypothesis from the
+*pure* context with hypotheses from either the pure or stateful context or pure terms.
+```lean
+example (y : Nat) (P Q : SPred σs) (Ψ : Nat → SPred σs) (hP : ⊢ₛ P) (hΨ : ∀ x, ⊢ₛ P → Q → Ψ x) : ⊢ₛ Q → Ψ (y + 1) := by
+  mintro HQ
+  mspecialize_pure (hΨ (y + 1)) hP HQ => HΨ
+  mexact HΨ
+```
+-/
+macro (name := mspecializePureMacro) (priority:=low) "mspecialize_pure" : tactic =>
+  Macro.throwError "to use `mspecialize_pure`, please include `import Std.Tactic.Do`"
+
+
+/--
+Start the stateful proof mode of `Std.Do.SPred`.
+This will transform a stateful goal of the form `H ⊢ₛ T` into `⊢ₛ H → T`
+upon which `mintro` can be used to re-introduce `H` and give it a name.
+It is often more convenient to use `mintro` directly, which will
+try `mstart` automatically if necessary.
+-/
+macro (name := mstartMacro) (priority:=low) "mstart" : tactic =>
+  Macro.throwError "to use `mstart`, please include `import Std.Tactic.Do`"
+
+
+/--
+Stops the stateful proof mode of `Std.Do.SPred`.
+This will simply forget all the names given to stateful hypotheses and pretty-print
+a bit differently.
+-/
+macro (name := mstopMacro) (priority:=low) "mstop" : tactic =>
+  Macro.throwError "to use `mstop`, please include `import Std.Tactic.Do`"
+
+
+/--
+Like `rcases`, but operating on stateful `Std.Do.SPred` goals.
+Example: Given a goal `h : (P ∧ (Q ∨ R) ∧ (Q → R)) ⊢ₛ R`,
+`mcases h with ⟨-, ⟨hq | hr⟩, hqr⟩` will yield two goals:
+`(hq : Q, hqr : Q → R) ⊢ₛ R` and `(hr : R) ⊢ₛ R`.
+
+That is, `mcases h with pat` has the following semantics, based on `pat`:
+* `pat=□h'` renames `h` to `h'` in the stateful context, regardless of whether `h` is pure
+* `pat=⌜h'⌝` introduces `h' : φ`  to the pure local context if `h : ⌜φ⌝`
+  (c.f. `Lean.Elab.Tactic.Do.ProofMode.IsPure`)
+* `pat=h'` is like `pat=⌜h'⌝` if `h` is pure
+  (c.f. `Lean.Elab.Tactic.Do.ProofMode.IsPure`), otherwise it is like `pat=□h'`.
+* `pat=_` renames `h` to an inaccessible name
+* `pat=-` discards `h`
+* `⟨pat₁, pat₂⟩` matches on conjunctions and existential quantifiers and recurses via
+  `pat₁` and `pat₂`.
+* `⟨pat₁ | pat₂⟩` matches on disjunctions, matching the left alternative via `pat₁` and the right
+  alternative via `pat₂`.
+-/
+macro (name := mcasesMacro) (priority:=low) "mcases" : tactic =>
+  Macro.throwError "to use `mcases`, please include `import Std.Tactic.Do`"
+
+
+/--
+Like `refine`, but operating on stateful `Std.Do.SPred` goals.
+```lean
+example (P Q R : SPred σs) : (P ∧ Q ∧ R) ⊢ₛ P ∧ R := by
+  mintro ⟨HP, HQ, HR⟩
+  mrefine ⟨HP, HR⟩
+
+example (ψ : Nat → SPred σs) : ψ 42 ⊢ₛ ∃ x, ψ x := by
+  mintro H
+  mrefine ⟨⌜42⌝, H⟩
+```
+-/
+macro (name := mrefineMacro) (priority:=low) "mrefine" : tactic =>
+  Macro.throwError "to use `mrefine`, please include `import Std.Tactic.Do`"
+
+
+/--
+Like `intro`, but introducing stateful hypotheses into the stateful context of the `Std.Do.SPred`
+proof mode.
+That is, given a stateful goal `(hᵢ : Hᵢ)* ⊢ₛ P → T`, `mintro h` transforms
+into `(hᵢ : Hᵢ)*, (h : P) ⊢ₛ T`.
+
+Furthermore, `mintro ∀s` is like `intro s`, but preserves the stateful goal.
+That is, `mintro ∀s` brings the topmost state variable `s:σ` in scope and transforms
+`(hᵢ : Hᵢ)* ⊢ₛ T` (where the entailment is in `Std.Do.SPred (σ::σs)`) into
+`(hᵢ : Hᵢ s)* ⊢ₛ T s` (where the entailment is in `Std.Do.SPred σs`).
+
+Beyond that, `mintro` supports the full syntax of `mcases` patterns
+(`mintro pat = (mintro h; mcases h with pat`), and can perform multiple
+introductions in sequence.
+-/
+macro (name := mintroMacro) (priority:=low) "mintro" : tactic =>
+  Macro.throwError "to use `mintro`, please include `import Std.Tactic.Do`"
+
 end Tactic
 
 namespace Attr

src/Lean/Compiler/LCNF/CompilerM.lean

@@ -19,6 +19,8 @@ inductive Phase where
   | base
   /-- In this phase polymorphism has been eliminated. -/
   | mono
+  /-- In this phase impure stuff such as RC or efficient BaseIO transformations happen. -/
+  | impure
   deriving Inhabited
 
 /--

src/Lean/Compiler/LCNF/OtherDecl.lean

@@ -16,5 +16,6 @@ def getOtherDeclType (declName : Name) (us : List Level := []) : CompilerM Expr
   match (← getPhase) with
   | .base => getOtherDeclBaseType declName us
   | .mono => getOtherDeclMonoType declName
+  | _ => unreachable! -- TODO
 
 end Lean.Compiler.LCNF

src/Lean/Compiler/LCNF/PassManager.lean

@@ -14,6 +14,7 @@ namespace Lean.Compiler.LCNF
 def Phase.toNat : Phase → Nat
   | .base => 0
   | .mono => 1
+  | .impure => 2
 
 instance : LT Phase where
   lt l r := l.toNat < r.toNat
@@ -89,6 +90,7 @@ instance : ToString Phase where
   toString
     | .base => "base"
     | .mono => "mono"
+    | .impure => "impure"
 
 namespace Pass
 

src/Lean/Compiler/LCNF/PhaseExt.lean

@@ -76,11 +76,13 @@ def Decl.save (decl : Decl) : CompilerM Unit := do
   match (← getPhase) with
   | .base => decl.saveBase
   | .mono => decl.saveMono
+  | _ => unreachable!
 
 def getDeclAt? (declName : Name) (phase : Phase) : CoreM (Option Decl) :=
   match phase with
   | .base => getBaseDecl? declName
   | .mono => getMonoDecl? declName
+  | _  => return none -- TODO
 
 def getDecl? (declName : Name) : CompilerM (Option Decl) := do
   getDeclAt? declName (← getPhase)
@@ -89,6 +91,7 @@ def getExt (phase : Phase) : DeclExt :=
   match phase with
   | .base => baseExt
   | .mono => monoExt
+  | _ => unreachable!
 
 def forEachDecl (f : Decl → CoreM Unit) (phase := Phase.base) : CoreM Unit := do
   let ext := getExt phase

src/Lean/Compiler/LCNF/ToMono.lean

@@ -247,37 +247,6 @@ partial def casesStringToMono (c : Cases) (_ : c.typeName == ``String) : ToMonoM
   let k ← k.toMono
   return .let decl k
 
-/-- Eliminate `cases` for `Thunk. -/
-partial def casesThunkToMono (c : Cases) (_ : c.typeName == ``Thunk) : ToMonoM Code := do
-  assert! c.alts.size == 1
-  let .alt _ ps k := c.alts[0]! | unreachable!
-  eraseParams ps
-  let p := ps[0]!
-  let letValue := .const ``Thunk.get [] #[.erased, .fvar c.discr]
-  let letDecl ← mkLetDecl (← mkFreshBinderName `_x) anyExpr letValue
-  let paramType := .const `PUnit []
-  let decl := {
-    fvarId := p.fvarId
-    binderName := p.binderName
-    type := (← mkArrow paramType anyExpr)
-    params := #[← mkAuxParam paramType]
-    value := .let letDecl (.return letDecl.fvarId)
-  }
-  modifyLCtx fun lctx => lctx.addFunDecl decl
-  let k ← k.toMono
-  return .fun decl k
-
-/-- Eliminate `cases` for `Task. -/
-partial def casesTaskToMono (c : Cases) (_ : c.typeName == ``Task) : ToMonoM Code := do
-  assert! c.alts.size == 1
-  let .alt _ ps k := c.alts[0]! | unreachable!
-  eraseParams ps
-  let p := ps[0]!
-  let decl := { fvarId := p.fvarId, binderName := p.binderName, type := anyExpr, value := .const ``Task.get [] #[.erased, .fvar c.discr] }
-  modifyLCtx fun lctx => lctx.addLetDecl decl
-  let k ← k.toMono
-  return .let decl k
-
 /-- Eliminate `cases` for trivial structure. See `hasTrivialStructure?` -/
 partial def trivialStructToMono (info : TrivialStructureInfo) (c : Cases) : ToMonoM Code := do
   assert! c.alts.size == 1
@@ -325,10 +294,6 @@ partial def Code.toMono (code : Code) : ToMonoM Code := do
       casesFloatArrayToMono c h
     else if h : c.typeName == ``String then
       casesStringToMono c h
-    else if h : c.typeName == ``Thunk then
-      casesThunkToMono c h
-    else if h : c.typeName == ``Task then
-      casesTaskToMono c h
     else if let some info ← hasTrivialStructure? c.typeName then
       trivialStructToMono info c
     else

src/Lean/Elab/Binders.lean

@@ -687,56 +687,13 @@ open Lean.Elab.Term.Quotation in
       mkLambdaFVars xs e
   | _ => throwUnsupportedSyntax
 
-/--
-Configuration for `let` elaboration.
--/
-structure LetConfig where
-  /-- Elaborate as a nondependent `let` (a `have`). -/
-  nondep : Bool := false
-  /-- Eliminate the `let` if it is unused by the body. -/
-  usedOnly : Bool := false
-  /-- Zeta reduces (inlines) the `let`. -/
-  zeta : Bool := false
-  /-- Postpone elaboration of the value until after the body is elaborated. -/
-  postponeValue : Bool := false
-  /-- For `let x := v; b`, adds `eq : x = v` to the context. -/
-  eq? : Option Ident := none
-
-def LetConfig.setFrom (config : LetConfig) (key : Syntax) (val : Bool) : LetConfig :=
-  if key.isOfKind ``Parser.Term.letOptNondep then
-    { config with nondep := val }
-  else if key.isOfKind ``Parser.Term.letOptUsedOnly then
-    { config with usedOnly := val }
-  else if key.isOfKind ``Parser.Term.letOptZeta then
-    { config with zeta := val }
-  else if key.isOfKind ``Parser.Term.letOptPostponeValue then
-    { config with postponeValue := val }
-  else
-    config
-
-/--
-Interprets a `Parser.Term.letConfig`.
--/
-def mkLetConfig (letConfig : Syntax) (initConfig : LetConfig) : TermElabM LetConfig := do
-  let mut config := initConfig
-  unless letConfig.isOfKind ``Parser.Term.letConfig do
-    return config
-  for item in letConfig[0].getArgs do
-    match item with
-    | `(letPosOpt| +$opt:letOpts) => config := config.setFrom opt.raw[0] true
-    | `(letNegOpt| -$opt:letOpts) => config := config.setFrom opt.raw[0] false
-    | `(letOptEq| (eq := $n:ident)) => config := { config with eq? := n }
-    | `(letOptEq| (eq := $b)) => config := { config with eq? := mkIdentFrom b (canonical := true) (← mkFreshBinderNameForTactic `h) }
-    | _ => pure ()
-  return config
-
 /-- If `useLetExpr` is true, then a kernel let-expression `let x : type := val; body` is created.
    Otherwise, we create a term of the form `letFun val (fun (x : type) => body)`
 
    The default elaboration order is `binders`, `typeStx`, `valStx`, and `body`.
    If `elabBodyFirst == true`, then we use the order `binders`, `typeStx`, `body`, and `valStx`. -/
 def elabLetDeclAux (id : Syntax) (binders : Array Syntax) (typeStx : Syntax) (valStx : Syntax) (body : Syntax)
-    (expectedType? : Option Expr) (config : LetConfig) : TermElabM Expr := do
+    (expectedType? : Option Expr) (useLetExpr : Bool) (elabBodyFirst : Bool) (usedLetOnly : Bool) : TermElabM Expr := do
   let (type, val, binders) ← elabBindersEx binders fun xs => do
     let (binders, fvars) := xs.unzip
     /-
@@ -762,10 +719,10 @@ def elabLetDeclAux (id : Syntax) (binders : Array Syntax) (typeStx : Syntax) (va
     Recall that TC resolution does **not** produce synthetic opaque metavariables.
     -/
     let type ← withSynthesize (postpone := .partial) <| elabType typeStx
-    let letMsg := if config.nondep then "have" else "let"
+    let letMsg := if useLetExpr then "let" else "have"
     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
+    if elabBodyFirst then
       let type ← mkForallFVars fvars type
       let val  ← mkFreshExprMVar type
       pure (type, val, binders)
@@ -785,34 +742,19 @@ def elabLetDeclAux (id : Syntax) (binders : Array Syntax) (typeStx : Syntax) (va
       pure (type, val, binders)
   let kind := kindOfBinderName id.getId
   trace[Elab.let.decl] "{id.getId} : {type} := {val}"
-  let result ←
-    withLetDecl id.getId (kind := kind) type val (nondep := config.nondep) fun x => do
-      let elabBody : TermElabM Expr :=
-        elabTermEnsuringType body expectedType? >>= instantiateMVars
+  let result ← if useLetExpr then
+    withLetDecl id.getId (kind := kind) type val fun x => do
       addLocalVarInfo id x
-      match config.eq? with
-      | none =>
-        let body ← elabBody
-        if config.zeta then
-          pure <| (← body.abstractM #[x]).instantiate1 val
-        else
-          mkLetFVars #[x] body (usedLetOnly := config.usedOnly) (generalizeNondepLet := false)
-      | some h =>
-        let hTy ← mkEq x val
-        withLetDecl h.getId hTy (← mkEqRefl x) (nondep := true) fun h' => do
-          addLocalVarInfo h h'
-          let body ← elabBody
-          if config.zeta then
-            pure <| (← body.abstractM #[x, h']).instantiateRev #[val, ← mkEqRefl val]
-          else if config.nondep then
-            -- TODO(kmill): Think more about how to encode this case.
-            -- Currently we produce `(fun (x : α) (h : x = val) => b) val rfl`.
-            -- N.B. the nondep lets become lambdas here.
-            let f ← mkLambdaFVars #[x, h'] body
-            return mkApp2 f val (← mkEqRefl val)
-          else
-            mkLetFVars #[x, h'] body (usedLetOnly := config.usedOnly) (generalizeNondepLet := false)
-  if config.postponeValue then
+      let body ← elabTermEnsuringType body expectedType?
+      let body ← instantiateMVars body
+      mkLetFVars #[x] body (usedLetOnly := usedLetOnly)
+  else
+    withLocalDecl id.getId (kind := kind) .default type fun x => do
+      addLocalVarInfo id x
+      let body ← elabTermEnsuringType body expectedType?
+      let body ← instantiateMVars body
+      mkLetFun x val body
+  if elabBodyFirst then
     forallBoundedTelescope type binders.size fun xs type => do
       -- the original `fvars` from above are gone, so add back info manually
       for b in binders, x in xs do
@@ -830,19 +772,8 @@ structure LetIdDeclView where
   value   : Syntax
 
 def mkLetIdDeclView (letIdDecl : Syntax) : LetIdDeclView :=
-  /-
-  def letId := leading_parser binderIdent <|> hygieneInfo
-  def letIdBinder := binderIdent <|> bracketedBinder
-  def letIdLhs := letId >> many letIdBinder >> optType
-  def letIdDecl := leading_parser letIdLhs >> " := " >> termParser
-  -/
-  let letId := letIdDecl[0]
-  let id :=
-    if letId[0].isOfKind hygieneInfoKind then
-      HygieneInfo.mkIdent letId[0] `this (canonical := true)
-    else
-      -- Assumed to be binderIdent
-      letId[0]
+  -- `letIdDecl` is of the form `binderIdent >> many bracketedBinder >> optType >> " := " >> termParser
+  let id      := letIdDecl[0]
   let binders := letIdDecl[1].getArgs
   let optType := letIdDecl[2]
   let type    := expandOptType id optType
@@ -855,73 +786,52 @@ def expandLetEqnsDecl (letDecl : Syntax) (useExplicit := true) : MacroM Syntax :
   let val ← expandMatchAltsIntoMatch ref matchAlts (useExplicit := useExplicit)
   return mkNode `Lean.Parser.Term.letIdDecl #[letDecl[0], letDecl[1], letDecl[2], mkAtomFrom ref " := ", val]
 
-def elabLetDeclCore (stx : Syntax) (expectedType? : Option Expr) (initConfig : LetConfig) : TermElabM Expr := do
-  let (config, declIdx) ← if stx[1].isOfKind ``Parser.Term.letConfig then
-    pure (← mkLetConfig stx[1] initConfig, 2)
-  else
-    pure (initConfig, 1)
-  let letDecl   := stx[declIdx][0]
-  let body      := stx[declIdx + 2]
+def elabLetDeclCore (stx : Syntax) (expectedType? : Option Expr) (useLetExpr : Bool) (elabBodyFirst : Bool) (usedLetOnly : Bool) : TermElabM Expr := do
+  let letDecl := stx[1][0]
+  let body    := stx[3]
   if letDecl.getKind == ``Lean.Parser.Term.letIdDecl then
     let { id, binders, type, value } := mkLetIdDeclView letDecl
     let id ← if id.isIdent then pure id else mkFreshIdent id (canonical := true)
-    elabLetDeclAux id binders type value body expectedType? config
+    elabLetDeclAux id binders type value body expectedType? useLetExpr elabBodyFirst usedLetOnly
   else if letDecl.getKind == ``Lean.Parser.Term.letPatDecl then
     -- node `Lean.Parser.Term.letPatDecl  $ try (termParser >> pushNone >> optType >> " := ") >> termParser
+    if elabBodyFirst then
+      throwError "'let_delayed' with patterns is not allowed"
     let pat     := letDecl[0]
     let optType := letDecl[2]
     let val     := letDecl[4]
     if pat.getKind == ``Parser.Term.hole then
-      -- `let _ := ...` should be treated as a `letIdDecl`
+      -- `let _ := ...` should not be treated as a `letIdDecl`
       let id   ← mkFreshIdent pat (canonical := true)
       let type := expandOptType id optType
-      elabLetDeclAux id #[] type val body expectedType? config
+      elabLetDeclAux id #[] type val body expectedType? useLetExpr elabBodyFirst usedLetOnly
     else
-      if config.postponeValue then
-        throwError "`+deferValue` with patterns is not allowed"
-      if config.usedOnly then
-        throwError "`+usedOnly` with patterns is not allowed"
-      if config.zeta then
-        throwError "`+zeta` with patterns is not allowed"
-      -- We are currently ignore `config.nondep` when patterns are used.
-      let val ← if optType.isNone then
-        `($val:term)
+      -- We are currently treating `let_fun` and `let` the same way when patterns are used.
+      let stxNew ← if optType.isNone then
+        `(match $val:term with | $pat => $body)
       else
         let type := optType[0][1]
-        `(($val:term : $type))
-      let stxNew ← if let some h := config.eq? then
-        `(match $h:ident : $val:term with | $pat => $body)
-      else
-        `(match $val:term with | $pat => $body)
+        `(match ($val:term : $type) with | $pat => $body)
       withMacroExpansion stx stxNew <| elabTerm stxNew expectedType?
   else if letDecl.getKind == ``Lean.Parser.Term.letEqnsDecl then
     let letDeclIdNew ← liftMacroM <| expandLetEqnsDecl letDecl
-    let declNew := stx[declIdx].setArg 0 letDeclIdNew
-    let stxNew  := stx.setArg declIdx declNew
+    let declNew := stx[1].setArg 0 letDeclIdNew
+    let stxNew  := stx.setArg 1 declNew
     withMacroExpansion stx stxNew <| elabTerm stxNew expectedType?
   else
     throwUnsupportedSyntax
 
 @[builtin_term_elab «let»] def elabLetDecl : TermElab :=
-  fun stx expectedType? => elabLetDeclCore stx expectedType? {}
-
-@[builtin_term_elab «have»] def elabHaveDecl : TermElab :=
-  fun stx expectedType? => elabLetDeclCore stx expectedType? { nondep := true }
+  fun stx expectedType? => elabLetDeclCore stx expectedType? (useLetExpr := true) (elabBodyFirst := false) (usedLetOnly := false)
 
 @[builtin_term_elab «let_fun»] def elabLetFunDecl : TermElab :=
-  fun stx expectedType? => elabLetDeclCore stx expectedType? { nondep := true }
+  fun stx expectedType? => elabLetDeclCore stx expectedType? (useLetExpr := false) (elabBodyFirst := false) (usedLetOnly := false)
 
 @[builtin_term_elab «let_delayed»] def elabLetDelayedDecl : TermElab :=
-  fun stx expectedType? => elabLetDeclCore stx expectedType? { postponeValue := true }
+  fun stx expectedType? => elabLetDeclCore stx expectedType? (useLetExpr := true) (elabBodyFirst := true) (usedLetOnly := false)
 
 @[builtin_term_elab «let_tmp»] def elabLetTmpDecl : TermElab :=
-  fun stx expectedType? => elabLetDeclCore stx expectedType? { usedOnly := true }
-
-@[builtin_term_elab «letI»] def elabLetIDecl : TermElab :=
-  fun stx expectedType? => elabLetDeclCore stx expectedType? { zeta := true }
-
-@[builtin_term_elab «haveI»] def elabHaveIDecl : TermElab :=
-  fun stx expectedType? => elabLetDeclCore stx expectedType? { zeta := true, nondep := true }
+  fun stx expectedType? => elabLetDeclCore stx expectedType? (useLetExpr := true) (elabBodyFirst := false) (usedLetOnly := true)
 
 builtin_initialize
   registerTraceClass `Elab.let

src/Lean/Elab/BuiltinNotation.lean

@@ -117,19 +117,32 @@ open Meta
     ```
     -/
     let thisId := mkIdentFrom stx `this
-    let valNew ← `(have $thisId:ident : $(← exprToSyntax type) := $val; $thisId)
+    let valNew ← `(let_fun $thisId : $(← exprToSyntax type) := $val; $thisId)
     elabTerm valNew expectedType?
   | _ => throwUnsupportedSyntax
 
+@[builtin_macro Lean.Parser.Term.have] def expandHave : Macro := fun stx =>
+  match stx with
+  | `(have $hy:hygieneInfo $bs* $[: $type]? := $val; $body) =>
+    `(have $(HygieneInfo.mkIdent hy `this (canonical := true)) $bs* $[: $type]? := $val; $body)
+  | `(have $hy:hygieneInfo $bs* $[: $type]? $alts; $body)   =>
+    `(have $(HygieneInfo.mkIdent hy `this (canonical := true)) $bs* $[: $type]? $alts; $body)
+  | `(have $x:ident $bs* $[: $type]? := $val; $body) => `(let_fun $x $bs* $[: $type]? := $val; $body)
+  | `(have $x:ident $bs* $[: $type]? $alts; $body)   => `(let_fun $x $bs* $[: $type]? $alts; $body)
+  | `(have _%$x     $bs* $[: $type]? := $val; $body) => `(let_fun _%$x $bs* $[: $type]? := $val; $body)
+  | `(have _%$x     $bs* $[: $type]? $alts; $body)   => `(let_fun _%$x $bs* $[: $type]? $alts; $body)
+  | `(have $pattern:term $[: $type]? := $val; $body) => `(let_fun $pattern:term $[: $type]? := $val; $body)
+  | _                                                => Macro.throwUnsupported
+
 @[builtin_macro Lean.Parser.Term.suffices] def expandSuffices : Macro
-  | `(suffices%$tk $x:ident      : $type from $val; $body)   => `(have%$tk $x:ident : $type := $body; $val)
+  | `(suffices%$tk $x:ident      : $type from $val; $body)   => `(have%$tk $x : $type := $body; $val)
   | `(suffices%$tk _%$x          : $type from $val; $body)   => `(have%$tk _%$x : $type := $body; $val)
   | `(suffices%$tk $hy:hygieneInfo $type from $val; $body)   => `(have%$tk $hy:hygieneInfo : $type := $body; $val)
   | `(suffices%$tk $x:ident      : $type $b:byTactic'; $body) =>
     -- Pass on `SourceInfo` of `b` to `have`. This is necessary to display the goal state in the
     -- trailing whitespace of `by` and sound since `byTactic` and `byTactic'` are identical.
     let b := ⟨b.raw.setKind `Lean.Parser.Term.byTactic⟩
-    `(have%$tk $x:ident : $type := $body; $b:byTactic)
+    `(have%$tk $x : $type := $body; $b:byTactic)
   | `(suffices%$tk _%$x          : $type $b:byTactic'; $body) =>
     let b := ⟨b.raw.setKind `Lean.Parser.Term.byTactic⟩
     `(have%$tk _%$x : $type := $body; $b:byTactic)
@@ -531,4 +544,28 @@ def elabUnsafe : TermElab := fun stx expectedType? =>
       (← `(do $cmds)))
   | _ => throwUnsupportedSyntax
 
+@[builtin_term_elab Lean.Parser.Term.haveI] def elabHaveI : TermElab := fun stx expectedType? => do
+  match stx with
+  | `(haveI $x:ident $bs* : $ty := $val; $body) =>
+    withExpectedType expectedType? fun expectedType => do
+      let (ty, val) ← elabBinders bs fun bs => do
+        let ty ← elabType ty
+        let val ← elabTermEnsuringType val ty
+        pure (← mkForallFVars bs ty, ← mkLambdaFVars bs val)
+      withLocalDeclD x.getId ty fun x => do
+        return (← (← elabTerm body expectedType).abstractM #[x]).instantiate #[val]
+  | _ => throwUnsupportedSyntax
+
+@[builtin_term_elab Lean.Parser.Term.letI] def elabLetI : TermElab := fun stx expectedType? => do
+  match stx with
+  | `(letI $x:ident $bs* : $ty := $val; $body) =>
+    withExpectedType expectedType? fun expectedType => do
+      let (ty, val) ← elabBinders bs fun bs => do
+        let ty ← elabType ty
+        let val ← elabTermEnsuringType val ty
+        pure (← mkForallFVars bs ty, ← mkLambdaFVars bs val)
+      withLetDecl x.getId ty val fun x => do
+        return (← (← elabTerm body expectedType).abstractM #[x]).instantiate #[val]
+  | _ => throwUnsupportedSyntax
+
 end Lean.Elab.Term

src/Lean/Elab/Do.lean

@@ -648,22 +648,12 @@ def concat (terminal : CodeBlock) (kRef : Syntax) (y? : Option Var) (k : CodeBlo
   let terminal ← liftMacroM <| convertTerminalActionIntoJmp terminal.code jp xs
   return { code  := attachJP jpDecl terminal, uvars := k.uvars }
 
-def getLetIdVars (letId : Syntax) : Array Var :=
-  assert! letId.isOfKind ``Parser.Term.letId
-  -- def letId := leading_parser binderIdent <|> hygieneInfo
-  if letId[0].isIdent then
-    #[letId[0]]
-  else if letId[0].isOfKind hygieneInfoKind then
-    #[HygieneInfo.mkIdent letId[0] `this (canonical := true)]
+def getLetIdDeclVars (letIdDecl : Syntax) : Array Var :=
+  if letIdDecl[0].isIdent then
+    #[letIdDecl[0]]
   else
     #[]
 
-def getLetIdDeclVars (letIdDecl : Syntax) : Array Var :=
-  assert! letIdDecl.isOfKind ``Parser.Term.letIdDecl
-  -- def letIdLhs : Parser := letId >> many (ppSpace >> letIdBinder) >> optType
-  -- def letIdDecl := leading_parser letIdLhs >> " := " >> termParser
-  getLetIdVars letIdDecl[0]
-
 -- support both regular and syntax match
 def getPatternVarsEx (pattern : Syntax) : TermElabM (Array Var) :=
   getPatternVars pattern <|>
@@ -674,18 +664,16 @@ def getPatternsVarsEx (patterns : Array Syntax) : TermElabM (Array Var) :=
   Quotation.getPatternsVars patterns
 
 def getLetPatDeclVars (letPatDecl : Syntax) : TermElabM (Array Var) := do
-  -- def letPatDecl := leading_parser termParser >> pushNone >> optType >> " := " >> termParser
   let pattern := letPatDecl[0]
   getPatternVarsEx pattern
 
 def getLetEqnsDeclVars (letEqnsDecl : Syntax) : Array Var :=
-  assert! letEqnsDecl.isOfKind ``Parser.Term.letEqnsDecl
-  -- def letIdLhs : Parser := letId >> many (ppSpace >> letIdBinder) >> optType
-  -- def letEqnsDecl := leading_parser letIdLhs >> matchAlts
-  getLetIdVars letEqnsDecl[0]
+  if letEqnsDecl[0].isIdent then
+    #[letEqnsDecl[0]]
+  else
+    #[]
 
 def getLetDeclVars (letDecl : Syntax) : TermElabM (Array Var) := do
-  -- def letDecl := leading_parser letIdDecl <|> letPatDecl <|> letEqnsDecl
   let arg := letDecl[0]
   if arg.getKind == ``Parser.Term.letIdDecl then
     return getLetIdDeclVars arg
@@ -700,9 +688,15 @@ def getDoLetVars (doLet : Syntax) : TermElabM (Array Var) :=
   -- leading_parser "let " >> optional "mut " >> letDecl
   getLetDeclVars doLet[2]
 
-def getDoHaveVars (doHave : Syntax) : TermElabM (Array Var) :=
-  -- leading_parser "have" >> letDecl
-  getLetDeclVars doHave[1]
+def getDoHaveVars : Syntax → TermElabM (Array Var)
+  -- NOTE: `hygieneInfo` case should come first as `id` will match anything else
+  | `(doElem| have $info:hygieneInfo $_params* $[$_:typeSpec]? := $_val)
+  | `(doElem| have $info:hygieneInfo $_params* $[$_:typeSpec]? $_eqns:matchAlts) =>
+    return #[HygieneInfo.mkIdent info `this]
+  | `(doElem| have $id $_params* $[$_:typeSpec]? := $_val)
+  | `(doElem| have $id $_params* $[$_:typeSpec]? $_eqns:matchAlts) => return #[id]
+  | `(doElem| have $pat:letPatDecl) => getLetPatDeclVars pat
+  | _ => throwError "unexpected kind of have declaration"
 
 def getDoLetRecVars (doLetRec : Syntax) : TermElabM (Array Var) := do
   -- letRecDecls is an array of `(group (optional attributes >> letDecl))`
@@ -1073,7 +1067,7 @@ def declToTerm (decl : Syntax) (k : Syntax) : M Syntax := withRef decl <| withFr
     else
       Macro.throwErrorAt decl "unexpected kind of `do` declaration"
   else if kind == ``Parser.Term.doHave then
-    -- The `have` term is of the form  `"have " >> letDecl >> optSemicolon termParser`
+    -- The `have` term is of the form  `"have " >> haveDecl >> optSemicolon termParser`
     let args := decl.getArgs
     let args := args ++ #[mkNullNode /- optional ';' -/, k]
     return mkNode `Lean.Parser.Term.«have» args

src/Lean/Elab/GuardMsgs.lean

@@ -189,7 +189,7 @@ def MessageOrdering.apply (mode : MessageOrdering) (msgs : List String) : List S
       -- Failed. Put all the messages back on the message log and add an error
       modify fun st => { st with messages := initMsgs ++ msgs }
       let feedback :=
-        if guard_msgs.diff.get (← getOptions) then
+        if (← getOptions).getBool `guard_msgs.diff false then
           let diff := Diff.diff (expected.split (· == '\n')).toArray (res.split (· == '\n')).toArray
           Diff.linesToString diff
         else res

src/Lean/Elab/LetRec.lean

@@ -41,7 +41,7 @@ private def mkLetRecDeclView (letRec : Syntax) : TermElabM LetRecView := do
     if decl.isOfKind `Lean.Parser.Term.letPatDecl then
       throwErrorAt decl "patterns are not allowed in 'let rec' expressions"
     else if decl.isOfKind ``Lean.Parser.Term.letIdDecl || decl.isOfKind ``Lean.Parser.Term.letEqnsDecl then
-      let declId := decl[0][0]
+      let declId := decl[0]
       unless declId.isIdent do
         throwErrorAt declId "'let rec' expressions must be named"
       let shortDeclName := declId.getId

src/Lean/Elab/Match.lean

@@ -19,7 +19,7 @@ open Meta
 open Lean.Parser.Term
 
 private def expandSimpleMatch (stx : Syntax) (discr : Term) (lhsVar : Ident) (rhs : Term) (expectedType? : Option Expr) : TermElabM Expr := do
-  let newStx ← `(let $lhsVar:ident := $discr; $rhs)
+  let newStx ← `(let $lhsVar := $discr; $rhs)
   withMacroExpansion stx newStx <| elabTerm newStx expectedType?
 
 private def mkUserNameFor (e : Expr) : TermElabM Name := do
@@ -670,7 +670,7 @@ where
     match p with
     | .forallE n d b bi  => withLocalDecl n bi (← go d) fun x => do mkForallFVars #[x] (← go (b.instantiate1 x))
     | .lam n d b bi      => withLocalDecl n bi (← go d) fun x => do mkLambdaFVars #[x] (← go (b.instantiate1 x))
-    | .letE n t v b nondep => mapLetDecl n (← go t) (← go v) (nondep := nondep) fun x => go (b.instantiate1 x)
+    | .letE n t v b ..  => withLetDecl n (← go t) (← go v) fun x => do mkLetFVars #[x] (← go (b.instantiate1 x))
     | .app f a          => return mkApp (← go f) (← go a)
     | .proj _ _ b       => return p.updateProj! (← go b)
     | .mdata k b        =>

src/Lean/Elab/MutualDef.lean

@@ -869,11 +869,10 @@ private partial def mkClosureForAux (toProcess : Array FVarId) : StateRefT Closu
     | .cdecl _ _ userName type bi k =>
       let toProcess ← pushLocalDecl toProcess fvarId userName type bi k
       mkClosureForAux toProcess
-    | .ldecl _ _ userName type val nondep k =>
+    | .ldecl _ _ userName type val _ k =>
       let zetaDeltaFVarIds ← getZetaDeltaFVarIds
-      -- Note: If `nondep` is true then `zetaDeltaFVarIds.contains fvarId` must be false.
-      if nondep || !zetaDeltaFVarIds.contains fvarId then
-        /- Nondependent let-decl. See comment at src/Lean/Meta/Closure.lean -/
+      if !zetaDeltaFVarIds.contains fvarId then
+        /- Non-dependent let-decl. See comment at src/Lean/Meta/Closure.lean -/
         let toProcess ← pushLocalDecl toProcess fvarId userName type .default k
         mkClosureForAux toProcess
       else

src/Lean/Elab/PreDefinition/Main.lean

@@ -93,7 +93,7 @@ private partial def ensureNoUnassignedLevelMVarsAtPreDef (preDef : PreDefinition
           checkCache { val := e : ExprStructEq } fun _ => do
             match e with
             | .forallE n d b c | .lam n d b c => withExpr e do visit d; withLocalDecl n c d fun x => visit (b.instantiate1 x)
-            | .letE n t v b nondep => withExpr e do visit t; visit v; withLetDecl n t v (nondep := nondep) fun x => visit (b.instantiate1 x)
+            | .letE n t v b _ => withExpr e do visit t; visit v; withLetDecl n t v fun x => visit (b.instantiate1 x)
             | .mdata _ b     => withExpr e do visit b
             | .proj _ _ b    => withExpr e do visit b
             | .sort u        => visitLevel u (← read)

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

@@ -133,9 +133,9 @@ private partial def replaceRecApps (recArgInfos : Array RecArgInfo) (positions :
     | Expr.forallE n d b c =>
       withLocalDecl n c (← loop below d) fun x => do
         mkForallFVars #[x] (← loop below (b.instantiate1 x))
-    | Expr.letE n type val body nondep =>
-      mapLetDecl n (← loop below type) (← loop below val) (nondep := nondep) (usedLetOnly := false) fun x => do
-        loop below (body.instantiate1 x)
+    | Expr.letE n type val body _ =>
+      withLetDecl n (← loop below type) (← loop below val) fun x => do
+        mkLetFVars #[x] (← loop below (body.instantiate1 x)) (usedLetOnly := false)
     | Expr.mdata d b =>
       if let some stx := getRecAppSyntax? e then
         withRef stx <| loop below b

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

@@ -50,9 +50,9 @@ private partial def replaceIndPredRecApps (recArgInfo : RecArgInfo) (funType : E
     | Expr.forallE n d b c =>
       withLocalDecl n c (← loop d) fun x => do
         mkForallFVars #[x] (← loop (b.instantiate1 x))
-    | Expr.letE n type val body nondep =>
-      mapLetDecl n (← loop type) (← loop val) (nondep := nondep) fun x => do
-        loop (body.instantiate1 x)
+    | Expr.letE n type val body _ =>
+      withLetDecl n (← loop type) (← loop val) fun x => do
+        mkLetFVars #[x] (← loop (body.instantiate1 x))
     | Expr.mdata d b => do
       if let some stx := getRecAppSyntax? e then
         withRef stx <| loop b

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

@@ -32,9 +32,8 @@ where
     match e with
     | Expr.lam ..     => lambdaTelescope e fun xs b => do mkLambdaFVars xs (← visit b)
     | Expr.forallE .. => forallTelescope e fun xs b => do mkForallFVars xs (← visit b)
-    | Expr.letE n type val body nondep =>
-      mapLetDecl n type (← visit val) (nondep := nondep) fun x => do
-        visit (body.instantiate1 x)
+    | Expr.letE n type val body _ =>
+      withLetDecl n type (← visit val) fun x => do mkLetFVars #[x] (← visit (body.instantiate1 x))
     | Expr.mdata d b     => return mkMData d (← visit b)
     | Expr.proj n i s    => return mkProj n i (← visit s)
     | Expr.app .. =>

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

@@ -84,9 +84,9 @@ where
     | Expr.forallE n d b c =>
       withLocalDecl n c (← loop F d) fun x => do
         mkForallFVars #[x] (← loop F (b.instantiate1 x))
-    | Expr.letE n type val body nondep =>
-      mapLetDecl n (← loop F type) (← loop F val) (nondep := nondep) (usedLetOnly := false) fun x => do
-        loop F (body.instantiate1 x)
+    | Expr.letE n type val body _ =>
+      withLetDecl n (← loop F type) (← loop F val) fun x => do
+        mkLetFVars #[x] (← loop F (body.instantiate1 x)) (usedLetOnly := false)
     | Expr.mdata d b =>
       if let some stx := getRecAppSyntax? e then
         withRef stx <| loop F b

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

@@ -241,10 +241,10 @@ where
       loop param d
       withLocalDecl n c d fun x => do
         loop param (b.instantiate1 x)
-    | Expr.letE n type val body nondep =>
+    | Expr.letE n type val body _ =>
       loop param type
       loop param val
-      withLetDecl n type val (nondep := nondep) fun x => do
+      withLetDecl n type val fun x => do
         loop param (body.instantiate1 x)
     | Expr.mdata _d b =>
       if let some stx := getRecAppSyntax? e then

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

@@ -110,68 +110,14 @@ builtin_dsimproc paramMatcher (_) := fun e => do
   let matcherApp' := { matcherApp with discrs := discrs', alts := alts' }
   return .continue <| matcherApp'.toExpr
 
-private def anyLetValueIsWfParam (e : Expr) : Bool :=
-  match e with
-  | .letE _ _ v b _ => (isWfParam? v).isSome || anyLetValueIsWfParam b
-  | _               => false
-
-private def numLetsWithValueNotIsWfParam (e : Expr) (acc := 0) : Nat :=
-  match e with
-  | .letE _ _ v b _ => if (isWfParam? v).isSome then acc else numLetsWithValueNotIsWfParam b (acc + 1)
-  | _               => acc
-
-private partial def processParamLet (e : Expr) : MetaM Expr := do
-  if let .letE _ t v b _ := e then
-    if let some v' := isWfParam? v then
-      if ← Meta.isProp t then
-        processParamLet <| e.updateLetE! t v' b
-      else
-        let u ← getLevel t
-        let b' := b.instantiate1 <| mkApp2 (.const ``wfParam [u]) t (.bvar 0)
-        processParamLet <| e.updateLetE! t v' b'
-    else
-      let num := numLetsWithValueNotIsWfParam e
-      assert! num > 0
-      letBoundedTelescope e num fun xs b => do
-        let b' ← processParamLet b
-        mkLetFVars (usedLetOnly := false) (generalizeNondepLet := false) xs b'
-  else
-    return e
-
-/--
-`let x : T := (wfParam e); body[x] ==> let x : T := e; body[wfParam y]` if `T` is not a proposition,
-otherwise `... ==> let x : T := e; body[x]`. (Applies to `have`s too.)
-
-Note: simprocs are provided the head of a let telescope, but not intermediate lets.
--/
+/-- `let x := (wfParam e); body[x] ==> let x := e; body[wfParam y] -/
 builtin_dsimproc paramLet (_) := fun e => do
-  unless e.isLet || anyLetValueIsWfParam e do return .continue
-  return .continue (← processParamLet e)
-
-/--
-Transforms non-Prop `have`s to `let`s, so that the values can be used in GuessLex and decreasing-by proofs.
-These `have`s may have been introdued by `simp`, which converts `let`s to `have`s.
--/
-private def nonPropHaveToLet (e : Expr) : MetaM Expr := do
-  Meta.transform e (pre := fun e => do
-    if (← Meta.isProof e) then
-      return .done e
-    else if e.isLet then
-      -- Recall that `Meta.transform` processes entire let telescopes,
-      -- so we need to handle the telescope all at once.
-      let lctx ← getLCtx
-      let e' ← letTelescope e fun xs b => do
-        let lctx' ← xs.foldlM (init := lctx) fun lctx' x => do
-          let decl ← x.fvarId!.getDecl
-          -- Clear the flag if it's not a prop.
-          let decl' := decl.setNondep <| ← pure decl.isNondep <&&> Meta.isProp decl.type
-          pure <| lctx'.addDecl decl'
-        withLCtx' lctx' do
-          mkLetFVars (usedLetOnly := false) (generalizeNondepLet := false) xs b
-      return .continue e'
-    else
-      return .continue
-  )
+  unless e.isLet do return .continue
+  let some v := isWfParam? e.letValue! | return .continue
+  let u ← getLevel e.letType!
+  let body' := e.letBody!.instantiate1 <|
+    mkApp2 (.const ``wfParam [u]) e.letType! (.bvar 0)
+  return .continue <| e.updateLetE! e.letType! v body'
 
 def preprocess (e : Expr) : MetaM Simp.Result := do
   unless wf.preprocess.get (← getOptions) do
@@ -195,13 +141,9 @@ def preprocess (e : Expr) : MetaM Simp.Result := do
           if h : as.size ≥ 2 then
             return .continue (mkAppN as[1] as[2:])
         return .continue
-
-    -- Transform `have`s to `let`s for non-propositions.
-    let e'' ← nonPropHaveToLet e''
-
     let result := { result with expr := e'' }
 
-    trace[Elab.definition.wf] "Attach-introduction:{indentExpr e'}\nto{indentExpr result.expr}"
+    trace[Elab.definition.wf] "Attach-introduction:{indentExpr e'}\nto{indentExpr result.expr}\ncleaned up as{indentExpr e''}"
     result.addLambdas xs
 
 end Lean.Elab.WF

src/Lean/Elab/Tactic.lean

@@ -52,3 +52,4 @@ import Lean.Elab.Tactic.ExposeNames
 import Lean.Elab.Tactic.SimpArith
 import Lean.Elab.Tactic.Show
 import Lean.Elab.Tactic.Lets
+import Lean.Elab.Tactic.Do

src/Lean/Elab/Tactic/BuiltinTactic.lean

@@ -606,11 +606,11 @@ where
 
 @[builtin_tactic replace] def evalReplace : Tactic := fun stx => do
   match stx with
-  | `(tactic| replace $decl:letDecl) =>
+  | `(tactic| replace $decl:haveDecl) =>
     withMainContext do
-      let vars ← Elab.Term.Do.getLetDeclVars decl
+      let vars ← Elab.Term.Do.getDoHaveVars (← `(doElem| have $decl:haveDecl))
       let origLCtx ← getLCtx
-      evalTactic $ ← `(tactic| have $decl:letDecl)
+      evalTactic $ ← `(tactic| have $decl:haveDecl)
       let mut toClear := #[]
       for fv in vars do
         if let some ldecl := origLCtx.findFromUserName? fv.getId then

src/Lean/Elab/Tactic/Do.lean

@@ -0,0 +1,7 @@
+/-
+Copyright (c) 2025 Lean FRO LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sebastian Graf
+-/
+prelude
+import Lean.Elab.Tactic.Do.ProofMode

src/Lean/Elab/Tactic/Do/ProofMode.lean

@@ -0,0 +1,23 @@
+/-
+Copyright (c) 2025 Lean FRO LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sebastian Graf
+-/
+prelude
+import Lean.Elab.Tactic.Do.ProofMode.MGoal
+import Lean.Elab.Tactic.Do.ProofMode.Display
+import Lean.Elab.Tactic.Do.ProofMode.Basic
+import Lean.Elab.Tactic.Do.ProofMode.Clear
+import Lean.Elab.Tactic.Do.ProofMode.Intro
+import Lean.Elab.Tactic.Do.ProofMode.Revert
+import Lean.Elab.Tactic.Do.ProofMode.Exact
+import Lean.Elab.Tactic.Do.ProofMode.Assumption
+import Lean.Elab.Tactic.Do.ProofMode.Pure
+import Lean.Elab.Tactic.Do.ProofMode.Frame
+import Lean.Elab.Tactic.Do.ProofMode.LeftRight
+import Lean.Elab.Tactic.Do.ProofMode.Constructor
+import Lean.Elab.Tactic.Do.ProofMode.Specialize
+import Lean.Elab.Tactic.Do.ProofMode.Cases
+import Lean.Elab.Tactic.Do.ProofMode.Exfalso
+import Lean.Elab.Tactic.Do.ProofMode.Have
+import Lean.Elab.Tactic.Do.ProofMode.Refine

src/Lean/Elab/Tactic/Do/ProofMode/Assumption.lean

@@ -0,0 +1,52 @@
+/-
+Copyright (c) 2025 Lean FRO LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sebastian Graf
+-/
+prelude
+import Std.Tactic.Do.Syntax
+import Lean.Elab.Tactic.Do.ProofMode.Basic
+import Lean.Elab.Tactic.Do.ProofMode.Exact
+import Lean.Elab.Tactic.Do.ProofMode.Focus
+
+namespace Lean.Elab.Tactic.Do.ProofMode
+open Std.Do
+open Lean Elab Tactic Meta
+
+theorem Assumption.assumption_l {σs : List Type} {P Q R : SPred σs} (h : P ⊢ₛ R) : P ∧ Q ⊢ₛ R :=
+  SPred.and_elim_l.trans h
+theorem Assumption.assumption_r {σs : List Type} {P Q R : SPred σs} (h : Q ⊢ₛ R) : P ∧ Q ⊢ₛ R :=
+  SPred.and_elim_r.trans h
+
+partial def MGoal.assumption (goal : MGoal) : OptionT MetaM Expr := do
+  if let some _ := parseEmptyHyp? goal.hyps then
+    failure
+  if let some hyp := parseHyp? goal.hyps then
+    guard (← isDefEq hyp.p goal.target)
+    return mkApp2 (mkConst ``SPred.entails.refl) goal.σs hyp.p
+  if let some (σs, lhs, rhs) := parseAnd? goal.hyps then
+    -- NB: Need to prefer rhs over lhs, like the goal view (Lean.Elab.Tactic.Do.ProofMode.Display).
+    mkApp5 (mkConst ``Assumption.assumption_r) σs lhs rhs goal.target <$> assumption { goal with hyps := rhs }
+    <|>
+    mkApp5 (mkConst ``Assumption.assumption_l) σs lhs rhs goal.target <$> assumption { goal with hyps := lhs }
+  else
+    panic! s!"assumption: hypothesis without proper metadata: {goal.hyps}"
+
+def MGoal.assumptionPure (goal : MGoal) : OptionT MetaM Expr := do
+  let φ := mkApp2 (mkConst ``SPred.tautological) goal.σs goal.target
+  let fvarId ← OptionT.mk (findLocalDeclWithType? φ)
+  let inst ← synthInstance? (mkApp3 (mkConst ``PropAsSPredTautology) φ goal.σs goal.target)
+  return mkApp6 (mkConst ``Exact.from_tautology) φ goal.σs goal.hyps goal.target inst (.fvar fvarId)
+
+@[builtin_tactic Lean.Parser.Tactic.massumption]
+def elabMAssumption : Tactic | _ => do
+  let mvar ← getMainGoal
+  mvar.withContext do
+  let g ← instantiateMVars <| ← mvar.getType
+  let some goal := parseMGoal? g | throwError "not in proof mode"
+
+  let some proof ← liftMetaM <|
+    goal.assumption <|> goal.assumptionPure
+    | throwError "hypothesis not found"
+  mvar.assign proof
+  replaceMainGoal []

src/Lean/Elab/Tactic/Do/ProofMode/Basic.lean

@@ -0,0 +1,60 @@
+/-
+Copyright (c) 2022 Lars König. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Lars König, Mario Carneiro, Sebastian Graf
+-/
+prelude
+import Lean.Meta
+import Std.Tactic.Do.Syntax
+import Lean.Elab.Tactic.Do.ProofMode.MGoal
+
+namespace Lean.Elab.Tactic.Do.ProofMode
+open Std.Do
+open Lean Elab.Tactic Meta
+
+structure MStartResult where
+  goal : MGoal
+  proof? : Option Expr := none
+
+def mStart (goal : Expr) : MetaM MStartResult := do
+  -- check if already in proof mode
+  if let some mgoal := parseMGoal? goal then
+    return { goal := mgoal }
+
+  let listType := mkApp (mkConst ``List [.succ .zero]) (mkSort (.succ .zero))
+  let σs ← mkFreshExprMVar listType
+  let P ← mkFreshExprMVar (mkApp (mkConst ``SPred) σs)
+  let inst ← synthInstance (mkApp3 (mkConst ``PropAsSPredTautology) goal σs P)
+  let prf := mkApp4 (mkConst ``ProofMode.start_entails) σs P goal inst
+  let goal : MGoal := { σs,  hyps := emptyHyp σs, target := ← instantiateMVars P }
+  return { goal, proof? := some prf }
+
+def mStartMVar (mvar : MVarId) : MetaM (MVarId × MGoal) := mvar.withContext do
+  let goal ← instantiateMVars <| ← mvar.getType
+  unless ← isProp goal do
+    throwError "type mismatch\n{← mkHasTypeButIsExpectedMsg (← inferType goal) (mkSort .zero)}"
+
+  let result ← mStart goal
+  if let some proof := result.proof? then
+    let subgoal ←
+      mkFreshExprSyntheticOpaqueMVar result.goal.toExpr (← mvar.getTag)
+    mvar.assign (mkApp proof subgoal)
+    return (subgoal.mvarId!, result.goal)
+  else
+    return (mvar, result.goal)
+
+@[builtin_tactic Lean.Parser.Tactic.mstart]
+def elabMStart : Tactic | _ => do
+  let (mvar, _) ← mStartMVar (← getMainGoal)
+  replaceMainGoal [mvar]
+
+@[builtin_tactic Lean.Parser.Tactic.mstop]
+def elabMStop : Tactic | _ => do
+  -- parse goal
+  let mvar ← getMainGoal
+  mvar.withContext do
+  let goal ← instantiateMVars <| ← mvar.getType
+
+  -- check if already in proof mode
+  let some mgoal := parseMGoal? goal | throwError "not in proof mode"
+  mvar.setType mgoal.strip

src/Lean/Elab/Tactic/Do/ProofMode/Cases.lean

@@ -0,0 +1,233 @@
+/-
+Copyright (c) 2022 Lars König. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Lars König, Mario Carneiro, Sebastian Graf
+-/
+prelude
+import Std.Tactic.Do.Syntax
+import Lean.Elab.Tactic.Do.ProofMode.Focus
+import Lean.Elab.Tactic.Do.ProofMode.Basic
+import Lean.Elab.Tactic.Do.ProofMode.Pure
+import Lean.Elab.Tactic.Do.ProofMode.Intro
+
+namespace Lean.Elab.Tactic.Do.ProofMode
+open Std.Do Lean.Parser.Tactic
+open Lean Elab Tactic Meta
+
+initialize registerTraceClass `Meta.Tactic.Do.cases
+
+theorem SCases.add_goal {σs} {P Q H T : SPred σs} (hand : Q ∧ H ⊣⊢ₛ P) (hgoal : P ⊢ₛ T) : Q ∧ H ⊢ₛ T :=
+  hand.mp.trans hgoal
+
+theorem SCases.clear {σs} {Q H T : SPred σs} (hgoal : Q ∧ ⌜True⌝ ⊢ₛ T) : Q ∧ H ⊢ₛ T :=
+  (SPred.and_mono_r SPred.true_intro).trans hgoal
+
+theorem SCases.pure {σs} {Q T : SPred σs} (hgoal : Q ∧ ⌜True⌝ ⊢ₛ T) : Q ⊢ₛ T :=
+  (SPred.and_intro .rfl SPred.true_intro).trans hgoal
+
+theorem SCases.and_1 {σs} {Q H₁' H₂' H₁₂' T : SPred σs} (hand : H₁' ∧ H₂' ⊣⊢ₛ H₁₂') (hgoal : Q ∧ H₁₂' ⊢ₛ T) : (Q ∧ H₁') ∧ H₂' ⊢ₛ T :=
+  ((SPred.and_congr_r hand.symm).trans SPred.and_assoc.symm).mpr.trans hgoal
+
+theorem SCases.and_2 {σs} {Q H₁' H₂ T : SPred σs} (hgoal : (Q ∧ H₁') ∧ H₂ ⊢ₛ T) : (Q ∧ H₂) ∧ H₁' ⊢ₛ T :=
+  SPred.and_right_comm.mp.trans hgoal
+
+theorem SCases.and_3 {σs} {Q H₁ H₂ H T : SPred σs} (hand : H ⊣⊢ₛ H₁ ∧ H₂) (hgoal : (Q ∧ H₂) ∧ H₁ ⊢ₛ T) : Q ∧ H ⊢ₛ T :=
+  (SPred.and_congr_r hand).mp.trans (SPred.and_assoc.mpr.trans (SPred.and_right_comm.mp.trans hgoal))
+
+theorem SCases.exists {σs : List Type} {Q : SPred σs} {ψ : α → SPred σs} {T : SPred σs}
+  (h : ∀ a, Q ∧ ψ a ⊢ₛ T) : Q ∧ (∃ a, ψ a) ⊢ₛ T :=
+    SPred.imp_elim' (SPred.exists_elim fun a => SPred.imp_intro (SPred.entails.trans SPred.and_symm (h a)))
+
+class IsAnd {σs : List Type} (P : SPred σs) (Q₁ Q₂ : outParam (SPred σs)) where to_and : P ⊣⊢ₛ Q₁ ∧ Q₂
+instance (σs) (Q₁ Q₂ : SPred σs) : IsAnd (σs:=σs) spred(Q₁ ∧ Q₂) Q₁ Q₂ where to_and := .rfl
+instance (σs) : IsAnd (σs:=σs) ⌜p ∧ q⌝ ⌜p⌝ ⌜q⌝ where to_and := SPred.pure_and.symm
+instance (σs) (P Q₁ Q₂ : σ → SPred σs) [base : ∀ s, IsAnd (P s) (Q₁ s) (Q₂ s)] : IsAnd (σs:=σ::σs) P Q₁ Q₂ where to_and := fun s => (base s).to_and
+
+-- Given σs and H, produces H₁, H₂ and a proof that H₁ ∧ H₂ ⊣⊢ₛ H.
+def synthIsAnd (σs H : Expr) : OptionT MetaM (Expr × Expr × Expr) := do
+  if let some (_σs, H₁, H₂) := parseAnd? H.consumeMData then
+    return (H₁, H₂, mkApp2 (mkConst ``SPred.bientails.refl) σs H)
+  try
+    let H₁ ← mkFreshExprMVar (mkApp (mkConst ``SPred) σs)
+    let H₂ ← mkFreshExprMVar (mkApp (mkConst ``SPred) σs)
+    let inst ← synthInstance (mkApp4 (mkConst ``IsAnd) σs H H₁ H₂)
+    return (H₁, H₂, mkApp5 (mkConst ``IsAnd.to_and) σs H H₁ H₂ inst)
+  catch _ => failure
+
+-- Produce a proof for Q ∧ H ⊢ₛ T by opening a new goal P ⊢ₛ T, where P ⊣⊢ₛ Q ∧ H.
+def mCasesAddGoal (goals : IO.Ref (Array MVarId)) (σs : Expr) (T : Expr) (Q : Expr) (H : Expr) : MetaM (Unit × MGoal × Expr) := do
+  let (P, hand) := mkAnd σs Q H
+  -- hand : Q ∧ H ⊣⊢ₛ P
+  -- Need to produce a proof that P ⊢ₛ T and return res
+  let goal : MGoal := { σs := σs, hyps := P, target := T }
+  let m ← mkFreshExprSyntheticOpaqueMVar goal.toExpr
+  goals.modify (·.push m.mvarId!)
+  let prf := mkApp7 (mkConst ``SCases.add_goal) σs P Q H T hand m
+  let goal := { goal with hyps := mkAnd! σs Q H }
+  return ((), goal, prf)
+
+private def getQH (goal : MGoal) : MetaM (Expr × Expr) := do
+  let some (_, Q, H) := parseAnd? goal.hyps | throwError m!"Internal error: Hypotheses not a conjunction {goal.hyps}"
+  return (Q, H)
+
+-- Pretty much like sPureCore, but for existential quantifiers.
+-- This function receives the hypothesis H=(∃ (x : α), ψ x) to destruct.
+-- It will provide a proof for Q ∧ H ⊢ₛ T
+-- if `k` produces a proof for Q ∧ ψ n ⊢ₛ T that may range over `name : α`.
+-- It calls `k` with name.
+def mCasesExists (H : Expr) (name : TSyntax ``binderIdent)
+  (k : Expr /-name:α-/ → MetaM (α × MGoal × Expr)) : MetaM (α × MGoal × Expr) := do
+  let some (α, σs, ψ) := H.consumeMData.app3? ``SPred.exists | throwError "Not an existential quantifier {H}"
+  let (name, ref) ← getFreshHypName name
+  withLocalDeclD name α fun x => do
+    addLocalVarInfo ref (← getLCtx) x α
+    let (r, goal, prf /- : goal.toExpr -/) ← k x
+    let (Q, _) ← getQH goal
+    let u ← getLevel α
+    let prf := mkApp6 (mkConst ``SCases.exists [u]) α σs Q ψ goal.target (← mkLambdaFVars #[x] prf)
+    let goal := { goal with hyps := mkAnd! σs Q H }
+    return (r, goal, prf)
+
+-- goal is P ⊢ₛ T
+-- The caller focuses on hypothesis H, P ⊣⊢ₛ Q ∧ H.
+-- scasesCore on H, pat and k builds H ⊢ₛ H' according to pat, then calls k with H'
+-- k knows context Q and builds goal Q ∧ H' ⊢ₛ T and a proof of the goal.
+-- (k should not also apply H ⊢ₛ H' or unfocus because that does not work with spureCore which needs the see `P'` and not `Q ∧ _`.)
+-- then scasesCore builds a proof for Q ∧ H ⊢ₛ T from P' ⊢ₛ T:
+--   Q ∧ H ⊢ₛ Q ∧ H' ⊢ₛ P' ⊢ₛ T
+-- and finally the caller builds the proof for
+--   P ⊢ₛ Q ∧ H ⊢ₛ T
+-- by unfocussing.
+partial def mCasesCore (σs : Expr) (H : Expr) (pat : MCasesPat) (k : Expr → MetaM (α × MGoal × Expr)): MetaM (α × MGoal × Expr) :=
+  match pat with
+  | .clear => do
+    let H' := emptyHyp σs -- H' = ⌜True⌝
+    let (a, goal, prf) ← k H'
+    let (Q, _H) ← getQH goal
+    -- prf : Q ∧ ⌜True⌝ ⊢ₛ T
+    -- Then Q ∧ H ⊢ₛ Q ∧ ⌜True⌝ ⊢ₛ T
+    let prf := mkApp5 (mkConst ``SCases.clear) σs Q H goal.target prf
+    let goal := { goal with hyps := mkAnd! σs Q H }
+    return (a, goal, prf)
+  | .stateful name => do
+    let (name, ref) ← getFreshHypName name
+    let uniq ← mkFreshId
+    let hyp := Hyp.mk name uniq H.consumeMData
+    addHypInfo ref σs hyp (isBinder := true)
+    k hyp.toExpr
+  | .pure name => do
+    mPureCore σs H name fun _ _hφ => do
+      -- This case is very similar to the clear case, but we need to
+      -- return Q ⊢ₛ T, not Q ∧ H ⊢ₛ T.
+      let H' := emptyHyp σs -- H' = ⌜True⌝
+      let (a, goal, prf) ← k H'
+      let (Q, _H) ← getQH goal
+      -- prf : Q ∧ ⌜True⌝ ⊢ₛ T
+      -- Then Q ⊢ₛ Q ∧ ⌜True⌝ ⊢ₛ T
+      let prf := mkApp4 (mkConst ``SCases.pure) σs Q goal.target prf
+      let goal := { goal with hyps := Q }
+      return (a, goal, prf)
+    -- Now prf : Q ∧ H ⊢ₛ T (where H is ⌜φ⌝). Exactly what is needed.
+  | .one name => do
+    try
+      -- First try to see if H can be introduced as a pure hypothesis
+      let φ ← mkFreshExprMVar (mkSort .zero)
+      let _ ← synthInstance (mkApp3 (mkConst ``IsPure) σs H φ)
+      mCasesCore σs H (.pure name) k
+    catch _ =>
+      -- Otherwise introduce it as a stateful hypothesis.
+      mCasesCore σs H (.stateful name) k
+  | .tuple [] => mCasesCore σs H .clear k
+  | .tuple [p] => mCasesCore σs H p k
+  | .tuple (p :: ps) => do
+    if let some (H₁, H₂, hand) ← synthIsAnd σs H then
+      -- goal is Q ∧ H ⊢ₛ T, where `hand : H ⊣⊢ₛ H₁ ∧ H₂`. Plan:
+      -- 1. Recurse on H₁ and H₂.
+      -- 2. The inner callback sees H₁' and H₂' and calls k on H₁₂', where H₁₂' = mkAnd H₁' H₂'
+      -- 3. The inner callback receives P' ⊢ₛ T, where (P' ⊣⊢ₛ Q ∧ H₁₂').
+      -- 4. The inner callback returns (Q ∧ H₁') ∧ H₂' ⊢ₛ T
+      -- 5. The outer callback receives (Q ∧ H₁') ∧ H₂ ⊢ₛ T
+      -- 6. The outer callback reassociates and returns (Q ∧ H₂) ∧ H₁' ⊢ₛ T
+      -- 7. The top-level receives (Q ∧ H₂) ∧ H₁ ⊢ₛ T
+      -- 8. Reassociate to Q ∧ (H₁ ∧ H₂) ⊢ₛ T, rebuild Q ∧ H ⊢ₛ T and return it.
+      let ((a, Q), goal, prf) ← mCasesCore σs H₁ p fun H₁' => do
+        let ((a, Q), goal, prf) ← mCasesCore σs H₂ (.tuple ps) fun H₂' => do
+          let (H₁₂', hand') := mkAnd σs H₁' H₂'
+          let (a, goal, prf) ← k H₁₂' -- (2)
+          -- (3) prf : Q ∧ H₁₂' ⊢ₛ T
+          -- (4) refocus to (Q ∧ H₁') ∧ H₂'
+          let (Q, _H) ← getQH goal
+          let T := goal.target
+          let prf := mkApp8 (mkConst ``SCases.and_1) σs Q H₁' H₂' H₁₂' T hand' prf
+          -- check prf
+          let QH₁' := mkAnd! σs Q H₁'
+          let goal := { goal with hyps := mkAnd! σs QH₁' H₂' }
+          return ((a, Q), goal, prf)
+        -- (5) prf : (Q ∧ H₁') ∧ H₂ ⊢ₛ T
+        -- (6) refocus to prf : (Q ∧ H₂) ∧ H₁' ⊢ₛ T
+        let prf := mkApp6 (mkConst ``SCases.and_2) σs Q H₁' H₂ goal.target prf
+        let QH₂ := mkAnd! σs Q H₂
+        let goal := { goal with hyps := mkAnd! σs QH₂ H₁' }
+        return ((a, Q), goal, prf)
+      -- (7) prf : (Q ∧ H₂) ∧ H₁ ⊢ₛ T
+      -- (8) rearrange to Q ∧ H ⊢ₛ T
+      let prf := mkApp8 (mkConst ``SCases.and_3) σs Q H₁ H₂ H goal.target hand prf
+      let goal := { goal with hyps := mkAnd! σs Q H }
+      return (a, goal, prf)
+    else if let some (_α, σs, ψ) := H.consumeMData.app3? ``SPred.exists then
+      let .one n := p
+        | throwError "cannot further destruct a term after moving it to the Lean context"
+      -- goal is Q ∧ (∃ x, ψ x) ⊢ₛ T. The plan is pretty similar to sPureCore:
+      -- 1. Recurse on ψ n where (n : α) is named according to the head pattern p.
+      -- 2. Receive a proof for Q ∧ ψ n ⊢ₛ T.
+      -- 3. Build a proof for Q ∧ (∃ x, ψ x) ⊢ₛ T from it (in sCasesExists).
+      mCasesExists H n fun x => mCasesCore σs (ψ.betaRev #[x]) (.alts ps) k
+    else throwError "Neither a conjunction nor an existential quantifier {H}"
+  | .alts [] => throwUnsupportedSyntax
+  | .alts [p] => mCasesCore σs H p k
+  | .alts (p :: ps) => do
+    let some (σs, H₁, H₂) := H.consumeMData.app3? ``SPred.or | throwError "Not a disjunction {H}"
+    -- goal is Q ∧ (H₁ ∨ H₂) ⊢ₛ T. Plan:
+    -- 1. Recurse on H₁ and H₂ with the same k.
+    -- 2. Receive proofs for Q ∧ H₁ ⊢ₛ T and Q ∧ H₂ ⊢ₛ T.
+    -- 3. Build a proof for Q ∧ (H₁ ∨ H₂) ⊢ₛ T from them.
+    let (_a, goal₁,  prf₁) ← mCasesCore σs H₁ p k
+    let (a,  _goal₂, prf₂) ← mCasesCore σs H₂ (.alts ps) k
+    let (Q, _H₁) ← getQH goal₁
+    let goal := { goal₁ with hyps := mkAnd! σs Q (mkApp3 (mkConst ``SPred.or) σs H₁ H₂) }
+    let prf := mkApp7 (mkConst ``SPred.and_or_elim_r) σs Q H₁ H₂ goal.target prf₁ prf₂
+    return (a, goal, prf)
+
+private theorem assembled_proof {σs} {P P' Q H H' T : SPred σs}
+  (hfocus : P ⊣⊢ₛ Q ∧ H) (hcases : H ⊢ₛ H') (hand : Q ∧ H' ⊣⊢ₛ P') (hprf₃ : P' ⊢ₛ T) : P ⊢ₛ T :=
+  hfocus.mp.trans ((SPred.and_mono_r hcases).trans (hand.mp.trans hprf₃))
+
+private theorem blah2 {σs} {P Q H R : SPred σs}
+  (h₁ : P ⊣⊢ₛ Q ∧ H) (h₂ : Q ∧ H ⊢ₛ R) : P ⊢ₛ R :=
+  h₁.mp.trans h₂
+
+private theorem blah3 {σs} {P Q H T : SPred σs}
+  (hand : Q ∧ H ⊣⊢ₛ P) (hgoal : P ⊢ₛ T) : Q ∧ H ⊢ₛ T :=
+  hand.mp.trans hgoal
+
+@[builtin_tactic Lean.Parser.Tactic.mcases]
+def elabMCases : Tactic
+  | `(tactic| mcases $hyp:ident with $pat:mcasesPat) => do
+  let pat ← liftMacroM <| MCasesPat.parse pat
+  let (mvar, goal) ← mStartMVar (← getMainGoal)
+  mvar.withContext do
+
+  let focus ← goal.focusHypWithInfo hyp
+  -- goal : P ⊢ₛ T,
+  -- hfocus : P ⊣⊢ₛ Q ∧ H
+  let Q := focus.restHyps
+  let H := focus.focusHyp
+  let goals ← IO.mkRef #[]
+  let (_, _new_goal, prf) ← mCasesCore goal.σs H pat (mCasesAddGoal goals goal.σs goal.target Q)
+
+  -- Now prf : Q ∧ H ⊢ₛ T. Prepend hfocus.mp, done.
+  let prf := focus.rewriteHyps goal prf
+  -- check prf
+  mvar.assign prf
+  replaceMainGoal (← goals.get).toList
+  | _ => throwUnsupportedSyntax

src/Lean/Elab/Tactic/Do/ProofMode/Clear.lean

@@ -0,0 +1,32 @@
+/-
+Copyright (c) 2022 Lars König. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Lars König, Mario Carneiro, Sebastian Graf
+-/
+prelude
+import Std.Tactic.Do.Syntax
+import Lean.Elab.Tactic.Do.ProofMode.MGoal
+import Lean.Elab.Tactic.Do.ProofMode.Focus
+
+namespace Lean.Elab.Tactic.Do.ProofMode
+open Std.Do
+open Lean Elab Tactic Meta
+
+theorem Clear.clear {σs : List Type} {P P' A Q : SPred σs}
+    (hfocus : P ⊣⊢ₛ P' ∧ A) (h : P' ⊢ₛ Q) : P ⊢ₛ Q :=
+    hfocus.mp.trans <| (SPred.and_mono_l h).trans SPred.and_elim_l
+
+@[builtin_tactic Lean.Parser.Tactic.mclear]
+def elabMClear : Tactic
+  | `(tactic| mclear $hyp:ident) => do
+  let mvar ← getMainGoal
+  mvar.withContext do
+  let g ← instantiateMVars <| ← mvar.getType
+  let some goal := parseMGoal? g | throwError "not in proof mode"
+  let res ← goal.focusHypWithInfo hyp
+  let m ← mkFreshExprSyntheticOpaqueMVar (res.restGoal goal).toExpr
+
+  mvar.assign (mkApp7 (mkConst ``Clear.clear) goal.σs goal.hyps
+    res.restHyps res.focusHyp goal.target res.proof m)
+  replaceMainGoal [m.mvarId!]
+  | _ => throwUnsupportedSyntax

src/Lean/Elab/Tactic/Do/ProofMode/Constructor.lean

@@ -0,0 +1,30 @@
+/-
+Copyright (c) 2022 Lars König. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Lars König, Mario Carneiro, Sebastian Graf
+-/
+prelude
+import Std.Tactic.Do.Syntax
+import Lean.Elab.Tactic.Do.ProofMode.MGoal
+
+namespace Lean.Elab.Tactic.Do.ProofMode
+open Std.Do
+open Lean Elab Tactic Meta
+
+def mConstructorCore (mvar : MVarId) : MetaM (MVarId × MVarId) := do
+  let g ← instantiateMVars <| ← mvar.getType
+  let some goal := parseMGoal? g | throwError "not in proof mode"
+
+  let mkApp3 (.const ``SPred.and []) σs L R := goal.target | throwError "target is not SPred.and"
+
+  let leftGoal ← mkFreshExprSyntheticOpaqueMVar {goal with target := L}.toExpr
+  let rightGoal ← mkFreshExprSyntheticOpaqueMVar {goal with target := R}.toExpr
+  mvar.assign (mkApp6 (mkConst ``SPred.and_intro) σs goal.hyps L R leftGoal rightGoal)
+  return (leftGoal.mvarId!, rightGoal.mvarId!)
+
+@[builtin_tactic Lean.Parser.Tactic.mconstructor]
+def elabMConstructor : Tactic | _ => do
+  let mvar ← getMainGoal
+  mvar.withContext do
+  let (leftGoal, rightGoal) ← mConstructorCore mvar
+  replaceMainGoal [leftGoal, rightGoal]

src/Lean/Elab/Tactic/Do/ProofMode/Display.lean

@@ -0,0 +1,55 @@
+/-
+Copyright (c) 2022 Lars König. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Lars König, Mario Carneiro, Sebastian Graf
+-/
+prelude
+import Lean.Elab.Tactic.Do.ProofMode.MGoal
+
+namespace Lean.Elab.Tactic.Do.ProofMode
+open Std.Do
+open Lean Expr Meta PrettyPrinter Delaborator SubExpr
+
+syntax mgoalHyp := ident " : " term
+
+syntax mgoalStx := ppDedent(ppLine mgoalHyp)* ppDedent(ppLine "⊢ₛ " term)
+
+@[app_delab MGoalEntails]
+partial def delabMGoal : Delab := do
+  let expr ← instantiateMVars <| ← getExpr
+
+  -- extract environment
+  let some goal := parseMGoal? expr | failure
+
+  -- delaborate
+  let (_, hyps) ← withAppFn ∘ withAppArg <| delabHypotheses goal.σs ({}, #[])
+  let target ← SPred.Notation.unpack (← withAppArg <| delab)
+
+  -- build syntax
+  return ⟨← `(mgoalStx| $hyps.reverse* ⊢ₛ $target:term)⟩
+where
+  delabHypotheses (σs : Expr)
+      (acc : NameMap Nat × Array (TSyntax ``mgoalHyp)) :
+      DelabM (NameMap Nat × Array (TSyntax ``mgoalHyp)) := do
+    let hyps ← getExpr
+    if let some _ := parseEmptyHyp? hyps then
+      return acc
+    if let some hyp := parseHyp? hyps then
+      let mut (map, lines) := acc
+      let (idx, name') :=
+        if let some idx := map.find? hyp.name then
+          (idx + 1, hyp.name.appendAfter <| if idx == 0 then "✝" else "✝" ++ idx.toSuperscriptString)
+        else
+          (0, hyp.name)
+      let name' := mkIdent name'
+      let stx ← `(mgoalHyp| $name' : $(← SPred.Notation.unpack (← withMDataExpr <| delab)))
+      return (map.insert hyp.name idx, lines.push stx)
+    if (parseAnd? hyps).isSome then
+      let acc_rhs ← withAppArg <| delabHypotheses σs acc
+      let acc_lhs ← withAppFn ∘ withAppArg <| delabHypotheses σs acc_rhs
+      return acc_lhs
+    else
+      failure
+
+@[app_delab HypMarker]
+def delabHypMarker : Delab := do SPred.Notation.unpack (← withAppArg delab)

src/Lean/Elab/Tactic/Do/ProofMode/Exact.lean

@@ -0,0 +1,50 @@
+/-
+Copyright (c) 2022 Lars König. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Lars König, Mario Carneiro, Sebastian Graf
+-/
+prelude
+import Std.Tactic.Do.Syntax
+import Lean.Elab.Tactic.Do.ProofMode.Basic
+import Lean.Elab.Tactic.Do.ProofMode.Focus
+
+namespace Lean.Elab.Tactic.Do.ProofMode
+open Std.Do
+open Lean Elab Tactic Meta
+
+theorem Exact.assumption {σs : List Type} {P P' A : SPred σs}
+  (h : P ⊣⊢ₛ P' ∧ A) : P ⊢ₛ A := h.mp.trans SPred.and_elim_r
+
+theorem Exact.from_tautology {σs : List Type} {P T : SPred σs} [PropAsSPredTautology φ T] (h : φ) : P ⊢ₛ T :=
+  SPred.true_intro.trans (PropAsSPredTautology.iff.mp h)
+
+def _root_.Lean.Elab.Tactic.Do.ProofMode.MGoal.exact (goal : MGoal) (hyp : Syntax) : OptionT MetaM Expr := do
+  if goal.findHyp? hyp.getId |>.isNone then failure
+  let focusRes ← goal.focusHypWithInfo ⟨hyp⟩
+  OptionT.mk do
+  let proof := mkApp5 (mkConst ``Exact.assumption) goal.σs goal.hyps focusRes.restHyps goal.target focusRes.proof
+  unless ← isDefEq focusRes.focusHyp goal.target do
+    throwError "mexact tactic failed, hypothesis {hyp} is not definitionally equal to {goal.target}"
+  return proof
+
+def _root_.Lean.Elab.Tactic.Do.ProofMode.MGoal.exactPure (goal : MGoal) (hyp : Syntax) : TacticM Expr := do
+  let φ ← mkFreshExprMVar (mkSort .zero)
+  let h ← elabTermEnsuringType hyp φ
+  let P ← mkFreshExprMVar (mkApp (mkConst ``SPred) goal.σs)
+  let some inst ← synthInstance? (mkApp3 (mkConst ``PropAsSPredTautology) φ goal.σs P)
+    | throwError "mexact tactic failed, {hyp} is not an SPred tautology"
+  return mkApp6 (mkConst ``Exact.from_tautology) φ goal.σs goal.hyps goal.target inst h
+
+@[builtin_tactic Lean.Parser.Tactic.mexact]
+def elabMExact : Tactic
+  | `(tactic| mexact $hyp:term) => do
+    let mvar ← getMainGoal
+    mvar.withContext do
+      let g ← instantiateMVars <| ← mvar.getType
+      let some goal := parseMGoal? g | throwError "not in proof mode"
+      if let some prf ← liftMetaM (goal.exact hyp) then
+    mvar.assign prf
+      else
+        mvar.assign (← goal.exactPure hyp)
+      replaceMainGoal []
+  | _ => throwUnsupportedSyntax

src/Lean/Elab/Tactic/Do/ProofMode/Exfalso.lean

@@ -0,0 +1,31 @@
+/-
+Copyright (c) 2022 Lars König. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Lars König, Mario Carneiro, Sebastian Graf
+-/
+prelude
+import Std.Tactic.Do.Syntax
+import Lean.Elab.Tactic.Do.ProofMode.MGoal
+import Lean.Elab.Tactic.Do.ProofMode.Basic
+
+namespace Lean.Elab.Tactic.Do.ProofMode
+open Std.Do
+open Lean Elab Tactic Meta
+
+
+-- set_option pp.all true in
+-- #check ⌜False⌝
+private def falseProp (σs : Expr) : Expr := -- ⌜False⌝ standing in for an empty conjunction of hypotheses
+  mkApp3 (mkConst ``SVal.curry) (.sort .zero) σs <| mkLambda `escape .default (mkApp (mkConst ``SVal.StateTuple) σs) (mkConst ``False)
+
+@[builtin_tactic Lean.Parser.Tactic.mexfalso]
+def elabMExfalso : Tactic | _ => do
+  let mvar ← getMainGoal
+  mvar.withContext do
+  let g ← instantiateMVars <| ← mvar.getType
+  let some goal := parseMGoal? g | throwError "not in proof mode"
+  let newGoal := { goal with target := falseProp goal.σs }
+  let m ← mkFreshExprSyntheticOpaqueMVar newGoal.toExpr
+  let prf := mkApp4 (mkConst ``SPred.exfalso) goal.σs goal.hyps goal.target m
+  mvar.assign prf
+  replaceMainGoal [m.mvarId!]

src/Lean/Elab/Tactic/Do/ProofMode/Focus.lean

@@ -0,0 +1,80 @@
+/-
+Copyright (c) 2022 Lars König. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Lars König, Mario Carneiro, Sebastian Graf
+-/
+prelude
+import Lean.Elab.Tactic.Do.ProofMode.MGoal
+import Lean.Meta
+
+namespace Lean.Elab.Tactic.Do.ProofMode
+open Std.Do ProofMode
+open Lean Elab.Tactic Meta
+
+/-- The result of focussing the context of a goal `goal : MGoal` on a particular hypothesis.
+The focussed hypothesis is returned as `focusHyp : Expr`, along with the
+residual `restHyps : Expr` and a `proof : Expr` for the property
+`goal.hyps ⊣⊢ₛ restHyps ∧ focusHyp`. -/
+structure FocusResult where
+  focusHyp : Expr
+  restHyps : Expr
+  proof : Expr
+  deriving Inhabited
+
+theorem focus_this {σs : List Type} {P : SPred σs} : P ⊣⊢ₛ ⌜True⌝ ∧ P :=
+  SPred.true_and.symm
+
+theorem focus_l {σs : List Type} {P P' Q C R : SPred σs} (h₁ : P ⊣⊢ₛ P' ∧ R) (h₂ : P' ∧ Q ⊣⊢ₛ C) :
+    P ∧ Q ⊣⊢ₛ C ∧ R :=
+  (SPred.and_congr_l h₁).trans (SPred.and_right_comm.trans (SPred.and_congr_l h₂))
+
+theorem focus_r {σs : List Type} {P Q Q' C R : SPred σs} (h₁ : Q ⊣⊢ₛ Q' ∧ R) (h₂ : P ∧ Q' ⊣⊢ₛ C) :
+    P ∧ Q ⊣⊢ₛ C ∧ R :=
+  (SPred.and_congr_r h₁).trans (SPred.and_assoc.symm.trans (SPred.and_congr_l h₂))
+
+partial def focusHyp (σs : Expr) (e : Expr) (name : Name) : Option FocusResult := do
+  if let some hyp := parseHyp? e then
+    if hyp.name = name then
+      return ⟨e, emptyHyp σs, mkApp2 (mkConst ``focus_this) σs e⟩
+    else
+      none
+  else if let some (σs, lhs, rhs) := parseAnd? e then
+    try
+      -- NB: Need to prefer rhs over lhs, like the goal view (Lean.Elab.Tactic.Do.ProofMode.Display).
+      let ⟨focus, rhs', h₁⟩ ← focusHyp σs rhs name
+      let ⟨C, h₂⟩ := mkAnd σs lhs rhs'
+      return ⟨focus, C, mkApp8 (mkConst ``focus_r) σs lhs rhs rhs' C focus h₁ h₂⟩
+    catch _ =>
+      let ⟨focus, lhs', h₁⟩ ← focusHyp σs lhs name
+      let ⟨C, h₂⟩ := mkAnd σs lhs' rhs
+      return ⟨focus, C, mkApp8 (mkConst ``focus_l) σs lhs lhs' rhs C focus h₁ h₂⟩
+  else if let some _ := parseEmptyHyp? e then
+    none
+  else
+    panic! s!"focusHyp: hypothesis without proper metadata: {e}"
+
+def MGoal.focusHyp (goal : MGoal) (name : Name) : Option FocusResult :=
+  Lean.Elab.Tactic.Do.ProofMode.focusHyp goal.σs goal.hyps name
+
+def FocusResult.refl (σs : Expr) (restHyps : Expr) (focusHyp : Expr) : FocusResult :=
+  let proof := mkApp2 (mkConst ``SPred.bientails.refl) σs (mkAnd! σs restHyps focusHyp)
+  { restHyps, focusHyp, proof }
+
+def FocusResult.restGoal (res : FocusResult) (goal : MGoal) : MGoal :=
+  { goal with hyps := res.restHyps }
+
+def FocusResult.recombineGoal (res : FocusResult) (goal : MGoal) : MGoal :=
+  { goal with hyps := mkAnd! goal.σs res.restHyps res.focusHyp }
+
+theorem FocusResult.rewrite_hyps {σs} {P Q R : SPred σs} (hrw : P ⊣⊢ₛ Q) (hgoal : Q ⊢ₛ R) : P ⊢ₛ R :=
+  hrw.mp.trans hgoal
+
+/-- Turn a proof for `(res.recombineGoal goal).toExpr` into one for `goal.toExpr`. -/
+def FocusResult.rewriteHyps (res : FocusResult) (goal : MGoal) : Expr → Expr :=
+  mkApp6 (mkConst ``rewrite_hyps) goal.σs goal.hyps (mkAnd! goal.σs res.restHyps res.focusHyp) goal.target res.proof
+
+def MGoal.focusHypWithInfo (goal : MGoal) (name : Ident) : MetaM FocusResult := do
+  let some res := goal.focusHyp name.getId | throwError "unknown hypothesis '{name}'"
+  let some hyp := parseHyp? res.focusHyp | throwError "impossible; res.focusHyp not a hypothesis"
+  addHypInfo name goal.σs hyp
+  pure res

src/Lean/Elab/Tactic/Do/ProofMode/Frame.lean

@@ -0,0 +1,129 @@
+/-
+Copyright (c) 2025 Lars König. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sebastian Graf
+-/
+prelude
+import Std.Tactic.Do.Syntax
+import Lean.Elab.Tactic.Do.ProofMode.MGoal
+import Lean.Elab.Tactic.Do.ProofMode.Focus
+
+namespace Lean.Elab.Tactic.Do.ProofMode
+open Std.Do
+open Lean Elab Tactic Meta
+
+class SimpAnd {σs : List Type} (P Q : SPred σs) (PQ : outParam (SPred σs)) : Prop where
+  simp_and : P ∧ Q ⊣⊢ₛ PQ
+
+instance (σs) (P Q : SPred σs) : SimpAnd P Q (spred(P ∧ Q)) where simp_and := .rfl
+instance (σs) (P : SPred σs) : SimpAnd P ⌜True⌝ P where simp_and := SPred.and_true
+instance (σs) (P : SPred σs) : SimpAnd ⌜True⌝ P P where simp_and := SPred.true_and
+
+class HasFrame {σs : List Type} (P : SPred σs) (P' : outParam (SPred σs)) (φ : outParam Prop) : Prop where
+  reassoc : P ⊣⊢ₛ P' ∧ ⌜φ⌝
+instance (σs) : HasFrame (σs:=σs) ⌜φ⌝ ⌜True⌝ φ where reassoc := SPred.true_and.symm
+instance (σs) (P P' Q QP : SPred σs) [HasFrame P Q φ] [SimpAnd Q P' QP]: HasFrame (σs:=σs) spred(P ∧ P') QP φ where
+  reassoc := ((SPred.and_congr_l HasFrame.reassoc).trans SPred.and_right_comm).trans (SPred.and_congr_l SimpAnd.simp_and)
+instance (σs) (P P' Q' PQ : SPred σs) [HasFrame P' Q' φ] [SimpAnd P Q' PQ]: HasFrame (σs:=σs) spred(P ∧ P') PQ φ where
+  reassoc := ((SPred.and_congr_r HasFrame.reassoc).trans SPred.and_assoc.symm).trans (SPred.and_congr_l SimpAnd.simp_and)
+instance (σs) (P : SPred σs) : HasFrame (σs:=σs) spred(⌜φ⌝ ∧ P) P φ where reassoc := SPred.and_comm
+instance (σs) (P : SPred σs) : HasFrame (σs:=σs) spred(P ∧ ⌜φ⌝) P φ where reassoc := .rfl
+instance (σs) (P P' Q Q' QQ : SPred σs) [HasFrame P Q φ] [HasFrame P' Q' ψ] [SimpAnd Q Q' QQ]: HasFrame (σs:=σs) spred(P ∧ P') QQ (φ ∧ ψ) where
+  reassoc := (SPred.and_congr HasFrame.reassoc HasFrame.reassoc).trans
+             <| SPred.and_assoc.trans
+             <| (SPred.and_congr_r
+                  <| SPred.and_assoc.symm.trans
+                  <| (SPred.and_congr_l SPred.and_comm).trans
+                  <| SPred.and_assoc.trans
+                  <| SPred.and_congr_r SPred.pure_and).trans
+             <| SPred.and_assoc.symm.trans
+             <| SPred.and_congr_l SimpAnd.simp_and
+instance (σs) (P Q : SPred σs) [HasFrame P Q ψ] : HasFrame (σs:=σs) spred(⌜φ⌝ ∧ P) Q (φ ∧ ψ) where
+  reassoc := SPred.and_comm.trans
+             <| (SPred.and_congr_l HasFrame.reassoc).trans
+             <| SPred.and_right_comm.trans
+             <| SPred.and_assoc.trans
+             <| SPred.and_congr_r SPred.pure_and
+instance (σs) (P Q : SPred σs) [HasFrame P Q ψ] : HasFrame (σs:=σs) spred(P ∧ ⌜φ⌝) Q (ψ ∧ φ) where
+  reassoc := (SPred.and_congr_l HasFrame.reassoc).trans
+             <| SPred.and_right_comm.trans
+             <| SPred.and_assoc.trans
+             <| SPred.and_congr_r (SPred.and_comm.trans SPred.pure_and)
+-- The following instance comes last so that it gets the highest priority.
+-- It's the most efficient and best solution if valid
+instance {P : Prop} : HasFrame (σs:=[]) P ⌜True⌝ P where reassoc := SPred.true_and.symm
+
+-- #synth ∀ {w x P Q y z}, HasFrame spred(⌜w = 2⌝ ∧ ⌜x = 3⌝ ∧ P ∧ ⌜y = 4⌝ ∧ Q ∧ ⌜z=6⌝) _ _
+
+theorem Frame.frame {σs : List Type} {P Q T : SPred σs} {φ : Prop} [HasFrame P Q φ]
+  (h : φ → Q ⊢ₛ T) : P ⊢ₛ T := by
+    apply SPred.pure_elim
+    · exact HasFrame.reassoc.mp.trans SPred.and_elim_r
+    · intro hp
+      exact HasFrame.reassoc.mp.trans (SPred.and_elim_l' (h hp))
+
+/-- If `P'` is a conjunction of unnamed hypotheses that are a subset of the named hypotheses of `P`,
+transfer the names of the hypotheses of `P` to the hypotheses of `P'`. -/
+partial def transferHypNames (P P' : Expr) : MetaM Expr := (·.snd) <$> label (collectHyps P) P'
+  where
+    collectHyps (P : Expr) (acc : List Hyp := []) : List Hyp :=
+      if let some hyp := parseHyp? P then
+        hyp :: acc
+      else if let some (_, L, R) := parseAnd? P then
+        collectHyps L (collectHyps R acc)
+      else
+        acc
+
+    label (Ps : List Hyp) (P' : Expr) : MetaM (List Hyp × Expr) := do
+      let P' ← instantiateMVarsIfMVarApp P'
+      if let some _ := parseEmptyHyp? P' then
+        return (Ps, P')
+      if let some (σs, L, R) := parseAnd? P' then
+        let (Ps, L') ← label Ps L
+        let (Ps, R') ← label Ps R
+        return (Ps, mkAnd! σs L' R')
+      else
+        let mut Ps' := Ps
+        repeat
+          -- If we cannot find the hyp, it might be in a nested conjunction.
+          -- Just pick a default name for it.
+          let uniq ← mkFreshId
+          let P :: Ps'' := Ps' | return (Ps, { name := `h, uniq, p := P' : Hyp }.toExpr)
+          Ps' := Ps''
+          if ← isDefEq P.p P' then
+            return (Ps, { P with p := P' }.toExpr)
+        unreachable!
+
+def mFrameCore [Monad m] [MonadControlT MetaM m] [MonadLiftT MetaM m]
+  (goal : MGoal) (kFail : m (α × Expr)) (kSuccess : Expr /-φ:Prop-/ → Expr /-h:φ-/ → MGoal → m (α × Expr)) : m (α × Expr) := do
+  let P := goal.hyps
+  let φ ← mkFreshExprMVar (mkSort .zero)
+  let P' ← mkFreshExprMVar (mkApp (mkConst ``SPred) goal.σs)
+  if let some inst ← synthInstance? (mkApp4 (mkConst ``HasFrame) goal.σs P P' φ) then
+    if ← isDefEq (mkConst ``True) φ then return (← kFail)
+    -- copy the name of P to P' if it is a named hypothesis
+    let P' ← transferHypNames P P'
+    let goal := { goal with hyps := P' }
+    withLocalDeclD `h φ fun hφ => do
+      let (a, prf) ← kSuccess φ hφ goal
+      let prf ← mkLambdaFVars #[hφ] prf
+      let prf := mkApp7 (mkConst ``Frame.frame) goal.σs P P' goal.target φ inst prf
+      return (a, prf)
+  else
+    kFail
+
+def mTryFrame [Monad m] [MonadControlT MetaM m] [MonadLiftT MetaM m]
+  (goal : MGoal) (k : MGoal → m (α × Expr)) : m (α × Expr) :=
+  mFrameCore goal (k goal) (fun _ _ goal => k goal)
+
+@[builtin_tactic Lean.Parser.Tactic.mframe]
+def elabMFrame : Tactic | _ => do
+  let mvar ← getMainGoal
+  mvar.withContext do
+  let g ← instantiateMVars <| ← mvar.getType
+  let some goal := parseMGoal? g | throwError "not in proof mode"
+  let (m, prf) ← mFrameCore goal (fun _ => throwError "Could not infer frame") fun _ _ goal => do
+    let m ← mkFreshExprSyntheticOpaqueMVar goal.toExpr
+    return (m, m)
+  mvar.assign prf
+  replaceMainGoal [m.mvarId!]

src/Lean/Elab/Tactic/Do/ProofMode/Have.lean

@@ -0,0 +1,96 @@
+/-
+Copyright (c) 2025 Lean FRO LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sebastian Graf
+-/
+prelude
+import Std.Tactic.Do.Syntax
+import Lean.Elab.Tactic.Do.ProofMode.Cases
+import Lean.Elab.Tactic.Do.ProofMode.Specialize
+
+namespace Lean.Elab.Tactic.Do.ProofMode
+open Std.Do
+open Lean Elab Tactic Meta
+
+def Have.dup {σs : List Type} {P Q H T : SPred σs} (hfoc : P ⊣⊢ₛ Q ∧ H) (hgoal : P ∧ H ⊢ₛ T) : P ⊢ₛ T :=
+  (SPred.and_intro .rfl (hfoc.mp.trans SPred.and_elim_r)).trans hgoal
+
+def Have.have {σs : List Type} {P H PH T : SPred σs} (hand : P ∧ H ⊣⊢ₛ PH) (hhave : P ⊢ₛ H) (hgoal : PH ⊢ₛ T) : P ⊢ₛ T :=
+  (SPred.and_intro .rfl hhave).trans (hand.mp.trans hgoal)
+
+def Have.replace {σs : List Type} {P H H' PH PH' T : SPred σs} (hfoc : PH ⊣⊢ₛ P ∧ H ) (hand : P ∧ H' ⊣⊢ₛ PH') (hhave : PH ⊢ₛ H') (hgoal : PH' ⊢ₛ T) : PH ⊢ₛ T :=
+  (SPred.and_intro (hfoc.mp.trans SPred.and_elim_l) hhave).trans (hand.mp.trans hgoal)
+
+@[builtin_tactic Lean.Parser.Tactic.mdup]
+def elabMDup : Tactic
+  | `(tactic| mdup $h:ident => $h₂:ident) => do
+  let (mvar, goal) ← ensureMGoal
+  mvar.withContext do
+  let some res := goal.focusHyp h.raw.getId | throwError m!"Hypothesis {h} not found"
+  let P := goal.hyps
+  let Q := res.restHyps
+  let H := res.focusHyp
+  let uniq ← mkFreshId
+  let hyp := Hyp.mk h₂.raw.getId uniq H.consumeMData
+  addHypInfo h goal.σs hyp (isBinder := true)
+  let H' := hyp.toExpr
+  let T := goal.target
+  let newGoal := { goal with hyps := mkAnd! goal.σs P H' }
+  let m ← mkFreshExprSyntheticOpaqueMVar newGoal.toExpr
+  mvar.assign (mkApp7 (mkConst ``Have.dup) goal.σs P Q H T res.proof m)
+  replaceMainGoal [m.mvarId!]
+  | _ => throwUnsupportedSyntax
+
+@[builtin_tactic Lean.Parser.Tactic.mhave]
+def elabMHave : Tactic
+  | `(tactic| mhave $h $[: $ty?]? := $rhs) => do
+  let (mvar, goal) ← ensureMGoal
+  mvar.withContext do
+  -- build goal `P ⊢ₛ T` from `P ⊢ₛ H` and residual goal `P ∧ H ⊢ₛ T`
+  let P := goal.hyps
+  let spred := mkApp (mkConst ``SPred) goal.σs
+  let H ← match ty? with
+    | some ty => elabTerm ty spred
+    | _       => mkFreshExprMVar spred
+  let uniq ← mkFreshId
+  let hyp := Hyp.mk h.raw.getId uniq H
+  addHypInfo h goal.σs hyp (isBinder := true)
+  let H := hyp.toExpr
+  let T := goal.target
+  let (PH, hand) := mkAnd goal.σs P H
+  let haveGoal := { goal with target := H }
+  let hhave ← elabTermEnsuringType rhs haveGoal.toExpr
+  let newGoal := { goal with hyps := PH }
+  let m ← mkFreshExprSyntheticOpaqueMVar newGoal.toExpr
+  mvar.assign (mkApp8 (mkConst ``Have.have) goal.σs P H PH T hand hhave m)
+  replaceMainGoal [m.mvarId!]
+  | _ => throwUnsupportedSyntax
+
+@[builtin_tactic Lean.Parser.Tactic.mreplace]
+def elabMReplace : Tactic
+  | `(tactic| mreplace $h $[: $ty?]? := $rhs) => do
+  let (mvar, goal) ← ensureMGoal
+  mvar.withContext do
+  -- build goal `P ⊢ₛ T` from `P ⊢ₛ H` and residual goal `P ∧ H ⊢ₛ T`
+  let PH := goal.hyps
+  let some res := goal.focusHyp h.raw.getId | throwError m!"Hypothesis {h} not found"
+  let P := res.restHyps
+  let H := res.focusHyp
+  let spred := mkApp (mkConst ``SPred) goal.σs
+  let H' ← match ty? with
+    | some ty => elabTerm ty spred
+    | _       => mkFreshExprMVar spred
+  let uniq ← mkFreshId
+  let hyp := Hyp.mk h.raw.getId uniq H'
+  addHypInfo h goal.σs hyp (isBinder := true)
+  let H' := hyp.toExpr
+  let haveGoal := { goal with target := H' }
+  let hhave ← elabTermEnsuringType rhs haveGoal.toExpr
+  let T := goal.target
+  let (PH', hand) := mkAnd goal.σs P H'
+  let newGoal := { goal with hyps := PH' }
+  let m ← mkFreshExprSyntheticOpaqueMVar newGoal.toExpr
+  let prf := mkApp (mkApp10 (mkConst ``Have.replace) goal.σs P H H' PH PH' T res.proof hand hhave) m
+  mvar.assign prf
+  replaceMainGoal [m.mvarId!]
+  | _ => throwUnsupportedSyntax

src/Lean/Elab/Tactic/Do/ProofMode/Intro.lean

@@ -0,0 +1,90 @@
+/-
+Copyright (c) 2022 Lars König. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Lars König, Mario Carneiro, Sebastian Graf
+-/
+prelude
+import Std.Tactic.Do.Syntax
+import Lean.Elab.Tactic.Do.ProofMode.Basic
+import Lean.Elab.Tactic.Do.ProofMode.Display
+
+namespace Lean.Elab.Tactic.Do.ProofMode
+open Std.Do
+open Lean Elab Tactic Meta
+
+theorem Intro.intro {σs : List Type} {P Q H T : SPred σs} (hand : Q ∧ H ⊣⊢ₛ P) (h : P ⊢ₛ T) : Q ⊢ₛ H → T :=
+  SPred.imp_intro (hand.mp.trans h)
+
+partial def mIntro [Monad m] [MonadControlT MetaM m] (goal : MGoal) (ident : TSyntax ``binderIdent) (k : MGoal → m (α × Expr)) : m (α × Expr) :=
+  controlAt MetaM fun map => do
+  let some (σs, H, T) := goal.target.app3? ``SPred.imp | throwError "Target not an implication {goal.target}"
+  let (name, ref) ← getFreshHypName ident
+  let uniq ← mkFreshId
+  let hyp := Hyp.mk name uniq H
+  addHypInfo ref σs hyp (isBinder := true)
+  let Q := goal.hyps
+  let H := hyp.toExpr
+  let (P, hand) := mkAnd goal.σs goal.hyps H
+  map do
+    let (a, prf) ← k { goal with hyps := P, target := T }
+    let prf := mkApp7 (mkConst ``Intro.intro) σs P Q H T hand prf
+    return (a, prf)
+
+-- This is regular MVar.intro, but it takes care not to leave the proof mode by preserving metadata
+partial def mIntroForall [Monad m] [MonadControlT MetaM m] [MonadLiftT MetaM m] (goal : MGoal) (ident : TSyntax ``binderIdent) (k : MGoal → m (α × Expr)) : m (α × Expr) :=
+  controlAt MetaM fun map => do
+  let some (_type, σ, σs') := (← whnf goal.σs).app3? ``List.cons | liftMetaM <| throwError "Ambient state list not a cons {goal.σs}"
+  let name ← match ident with
+  | `(binderIdent| $name:ident) => pure name.getId
+  | `(binderIdent| $_) => liftMetaM <| mkFreshUserName `s
+  withLocalDeclD name σ fun s => do
+    addLocalVarInfo ident (← getLCtx) s σ (isBinder := true)
+    let H := betaRevPreservingHypNames σs' goal.hyps #[s]
+    let T := goal.target.betaRev #[s]
+    map do
+      let (a, prf) ← k { σs:=σs', hyps:=H, target:=T }
+      let prf ← mkLambdaFVars #[s] prf
+      return (a, mkApp5 (mkConst ``SPred.entails_cons_intro) σ σs' goal.hyps goal.target prf)
+
+def mIntroForallN [Monad m] [MonadControlT MetaM m] [MonadLiftT MetaM m] (goal : MGoal) (n : Nat) (k : MGoal → m (α × Expr)) : m (α × Expr) :=
+  match n with
+  | 0 => k goal
+  | n+1 => do mIntroForall goal (← liftM (m := MetaM) `(binderIdent| _)) fun g =>
+              mIntroForallN g n k
+
+macro_rules
+  | `(tactic| mintro $pat₁ $pat₂ $pats:mintroPat*) => `(tactic| mintro $pat₁; mintro $pat₂ $pats*)
+  | `(tactic| mintro $pat:mintroPat) => do
+    match pat with
+    | `(mintroPat| $_:binderIdent) => Macro.throwUnsupported -- handled by an elaborator below
+    | `(mintroPat| ∀$_:binderIdent) => Macro.throwUnsupported -- handled by an elaborator below
+    | `(mintroPat| $pat:mcasesPat) => `(tactic| mintro h; mcases h with $pat)
+    | _ => Macro.throwUnsupported -- presently unreachable
+
+@[builtin_tactic Lean.Parser.Tactic.mintro]
+def elabMIntro : Tactic
+  | `(tactic| mintro $ident:binderIdent) => do
+
+  let (mvar, goal) ← mStartMVar (← getMainGoal)
+  mvar.withContext do
+
+  let goals ← IO.mkRef []
+  mvar.assign (← Prod.snd <$> mIntro goal ident fun newGoal => do
+    let m ← mkFreshExprSyntheticOpaqueMVar newGoal.toExpr
+    goals.modify (m.mvarId! :: ·)
+    return ((), m))
+  replaceMainGoal (← goals.get)
+
+  | `(tactic| mintro ∀$ident:binderIdent) => do
+
+  let (mvar, goal) ← mStartMVar (← getMainGoal)
+  mvar.withContext do
+
+  let goals ← IO.mkRef []
+  mvar.assign (← Prod.snd <$> mIntroForall goal ident fun newGoal => do
+    let m ← mkFreshExprSyntheticOpaqueMVar newGoal.toExpr
+    goals.modify (m.mvarId! :: ·)
+    return ((), m))
+  replaceMainGoal (← goals.get)
+
+  | _ => throwUnsupportedSyntax

src/Lean/Elab/Tactic/Do/ProofMode/LeftRight.lean

@@ -0,0 +1,38 @@
+/-
+Copyright (c) 2022 Lars König. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Lars König, Mario Carneiro, Sebastian Graf
+-/
+prelude
+import Std.Tactic.Do.Syntax
+import Lean.Elab.Tactic.Do.ProofMode.MGoal
+
+namespace Lean.Elab.Tactic.Do.ProofMode
+open Std.Do
+open Lean Elab Tactic Meta
+
+def mLeftRightCore (right : Bool) (mvar : MVarId) : MetaM MVarId := do
+  let g ← instantiateMVars <| ← mvar.getType
+  let some goal := parseMGoal? g | throwError "not in proof mode"
+
+  let mkApp3 (.const ``SPred.or []) σs L R := goal.target | throwError "target is not SPred.or"
+
+  let (thm, keep) := if right then (``SPred.or_intro_r', R) else (``SPred.or_intro_l', L)
+
+  let newGoal ← mkFreshExprSyntheticOpaqueMVar {goal with target := keep}.toExpr
+  mvar.assign (mkApp5 (mkConst thm) σs goal.hyps L R newGoal)
+  return newGoal.mvarId!
+
+@[builtin_tactic Lean.Parser.Tactic.mleft]
+def elabMLeft : Tactic | _ => do
+  let mvar ← getMainGoal
+  mvar.withContext do
+  let newGoal ← mLeftRightCore (right := false) mvar
+  replaceMainGoal [newGoal]
+
+@[builtin_tactic Lean.Parser.Tactic.mright]
+def elabMRight : Tactic | _ => do
+  let mvar ← getMainGoal
+  mvar.withContext do
+  let newGoal ← mLeftRightCore (right := true) mvar
+  replaceMainGoal [newGoal]

src/Lean/Elab/Tactic/Do/ProofMode/MGoal.lean

@@ -0,0 +1,192 @@
+/-
+Copyright (c) 2022 Lars König. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Lars König, Mario Carneiro, Sebastian Graf
+-/
+prelude
+import Std.Do.SPred.DerivedLaws
+
+import Lean.Meta
+open Lean Elab Meta
+
+namespace Std.Do
+
+/-- Tautology in `SPred` as a definition. -/
+abbrev SPred.tautological {σs : List Type} (Q : SPred σs) : Prop := ⊢ₛ Q
+
+class PropAsSPredTautology (φ : Prop) {σs : outParam (List Type)} (P : outParam (SPred σs)) : Prop where
+  iff : φ ↔ ⊢ₛ P
+
+instance : PropAsSPredTautology (σs := []) φ φ where
+  iff := true_imp_iff.symm
+
+instance : PropAsSPredTautology (P ⊢ₛ Q) spred(P → Q) where
+  iff := (SPred.entails_true_intro P Q).symm
+
+instance : PropAsSPredTautology (⊢ₛ P) P where
+  iff := Iff.rfl
+
+end Std.Do
+
+namespace Lean.Elab.Tactic.Do.ProofMode
+open Std.Do
+
+theorem start_entails {φ : Prop} [PropAsSPredTautology φ P] : (⊢ₛ P) → φ :=
+  PropAsSPredTautology.iff.mpr
+
+theorem elim_entails {φ : Prop} [PropAsSPredTautology φ P] : φ → (⊢ₛ P) :=
+  PropAsSPredTautology.iff.mp
+
+@[match_pattern] def nameAnnotation := `name
+@[match_pattern] def uniqAnnotation := `uniq
+
+structure Hyp where
+  name : Name
+  uniq : Name -- for display purposes only
+  p : Expr
+
+def parseHyp? : Expr → Option Hyp
+  | .mdata ⟨[(nameAnnotation, .ofName name), (uniqAnnotation, .ofName uniq)]⟩ p =>
+    some ⟨name, uniq, p⟩ -- NB: mdatas are transparent to SubExpr; hence no pos.push
+  | _ => none
+
+def Hyp.toExpr (hyp : Hyp) : Expr :=
+  .mdata ⟨[(nameAnnotation, .ofName hyp.name), (uniqAnnotation, .ofName hyp.uniq)]⟩ hyp.p
+
+/-- An elaborator to create a new named hypothesis for an `MGoal` context. -/
+elab "mk_hyp " name:ident " := " e:term : term <= ty? => do
+  let e ← Lean.Elab.Term.elabTerm e ty?
+  let uniq ← mkFreshId
+  return (Hyp.mk name.getId uniq e).toExpr
+
+-- set_option pp.all true in
+-- #check ⌜True⌝
+def emptyHyp (σs : Expr) : Expr := -- ⌜True⌝ standing in for an empty conjunction of hypotheses
+  mkApp3 (mkConst ``SVal.curry) (.sort .zero) σs <| mkLambda `escape .default (mkApp (mkConst ``SVal.StateTuple) σs) (mkConst ``True)
+def parseEmptyHyp? : Expr → Option Expr
+  | mkApp3 (.const ``SVal.curry _) (.sort .zero) σs (.lam _ _ (.const ``True _) _) => some σs
+  | _ => none
+
+def pushLeftConjunct (pos : SubExpr.Pos) : SubExpr.Pos :=
+  pos.pushNaryArg 3 1
+
+def pushRightConjunct (pos : SubExpr.Pos) : SubExpr.Pos :=
+  pos.pushNaryArg 3 2
+
+/-- Combine two hypotheses into a conjunction.
+Precondition: Neither `lhs` nor `rhs` is empty (`parseEmptyHyp?`). -/
+def mkAnd! (σs lhs rhs : Expr) : Expr :=
+  mkApp3 (mkConst ``SPred.and) σs lhs rhs
+
+/-- Smart constructor that cancels away empty hypotheses,
+along with a proof that `lhs ∧ rhs ⊣⊢ₛ result`. -/
+def mkAnd (σs lhs rhs : Expr) : Expr × Expr :=
+  if let some _ := parseEmptyHyp? lhs then
+    (rhs, mkApp2 (mkConst ``SPred.true_and) σs rhs)
+  else if let some _ := parseEmptyHyp? rhs then
+    (lhs, mkApp2 (mkConst ``SPred.and_true) σs lhs)
+  else
+    let result := mkAnd! σs lhs rhs
+    (result, mkApp2 (mkConst ``SPred.bientails.refl) σs result)
+
+def σs.mkType : Expr := mkApp (mkConst ``List [.succ .zero]) (mkSort (.succ .zero))
+def σs.mkNil : Expr := mkApp (mkConst ``List.nil [.succ .zero]) (mkSort (.succ .zero))
+
+def parseAnd? (e : Expr) : Option (Expr × Expr × Expr) :=
+  e.app3? ``SPred.and <|> (σs.mkNil, ·) <$> e.app2? ``And
+
+structure MGoal where
+  σs : Expr -- Q(List Type)
+  hyps : Expr -- A conjunction of hypotheses in `SPred σs`, each carrying a name and uniq as metadata (`parseHyp?`)
+  target : Expr -- Q(SPred $σs)
+  deriving Inhabited
+
+/-- This is the same as `SPred.entails`.
+This constant is used to detect `SPred` proof mode goals. -/
+abbrev MGoalEntails := @SPred.entails
+
+def parseMGoal? (expr : Expr) : Option MGoal := do
+  let some (σs, hyps, target) := expr.consumeMData.app3? ``MGoalEntails | none
+  some { σs, hyps, target }
+
+open Tactic in
+def ensureMGoal : TacticM (MVarId × MGoal) := do
+  let mvar ← getMainGoal
+  let goal ← instantiateMVars <| (← mvar.getType)
+  if let some goal := parseMGoal? goal then
+    return (mvar, goal)
+  else
+    throwError "Not in proof mode"
+
+def MGoal.strip (goal : MGoal) : Expr := -- omits the .mdata wrapper
+  mkApp3 (mkConst ``SPred.entails) goal.σs goal.hyps goal.target
+
+/-- Roundtrips with `parseMGoal?`. -/
+def MGoal.toExpr (goal : MGoal) : Expr :=
+  mkApp3 (mkConst ``MGoalEntails) goal.σs goal.hyps goal.target
+
+partial def MGoal.findHyp? (goal : MGoal) (name : Name) : Option (SubExpr.Pos × Hyp) := go goal.hyps SubExpr.Pos.root
+  where
+    go (e : Expr) (p : SubExpr.Pos) : Option (SubExpr.Pos × Hyp) := do
+      if let some hyp := parseHyp? e then
+        if hyp.name = name then
+          return (p, hyp)
+        else
+          none
+      else if let some (_, lhs, rhs) := parseAnd? e then
+        -- NB: Need to prefer rhs over lhs, like the goal view (Lean.Elab.Tactic.Do.ProofMode.Display).
+        go rhs (pushLeftConjunct p) <|> go lhs (pushRightConjunct p)
+      else if let some _ := parseEmptyHyp? e then
+        none
+      else
+        panic! "MGoal.findHyp?: hypothesis without proper metadata: {e}"
+
+def MGoal.checkProof (goal : MGoal) (prf : Expr) (suppressWarning : Bool := false) : MetaM Unit := do
+  check prf
+  let prf_type ← inferType prf
+  unless ← isDefEq goal.toExpr prf_type do
+    throwError "MGoal.checkProof: the proof and its supposed type did not match.\ngoal:  {goal.toExpr}\nproof: {prf_type}"
+  unless suppressWarning do
+    logWarning m!"stray MGoal.checkProof {prf_type} {goal.toExpr}"
+
+def getFreshHypName : TSyntax ``binderIdent → CoreM (Name × Syntax)
+  | `(binderIdent| $name:ident) => pure (name.getId, name)
+  | stx => return (← mkFreshUserName `h, stx)
+
+partial def betaRevPreservingHypNames (σs' e : Expr) (args : Array Expr) : Expr :=
+  if let some _σs := parseEmptyHyp? e then
+    emptyHyp σs'
+  else if let some hyp := parseHyp? e then
+    { hyp with p := hyp.p.betaRev args }.toExpr
+  else if let some (_σs, lhs, rhs) := parseAnd? e then
+    -- _σs = σ :: σs'
+    mkAnd! σs' (betaRevPreservingHypNames σs' lhs args) (betaRevPreservingHypNames σs' rhs args)
+  else
+    e.betaRev args
+
+def betaPreservingHypNames (σs' e : Expr) (args : Array Expr) : Expr :=
+  betaRevPreservingHypNames σs' e args.reverse
+
+def dropStateList (σs : Expr) (n : Nat) : MetaM Expr := do
+  let mut σs := σs
+  for _ in [:n] do
+    let some (_type, _σ, σs') := (← whnfR σs).app3? ``List.cons | throwError "Ambient state list not a cons {σs}"
+    σs := σs'
+  return σs
+
+/-- This is only used for display purposes, so that we can render context variables that appear
+to have type `A : PROP` even though `PROP` is not a type. -/
+def HypMarker {σs : List Type} (_A : SPred σs) : Prop := True
+
+def addLocalVarInfo (stx : Syntax) (lctx : LocalContext)
+    (expr : Expr) (expectedType? : Option Expr) (isBinder := false) : MetaM Unit := do
+  Elab.withInfoContext' (pure ())
+    (fun _ =>
+      return .inl <| .ofTermInfo
+        { elaborator := .anonymous, lctx, expr, stx, expectedType?, isBinder })
+    (return .ofPartialTermInfo { elaborator := .anonymous, lctx, stx, expectedType? })
+
+def addHypInfo (stx : Syntax) (σs : Expr) (hyp : Hyp) (isBinder := false) : MetaM Unit := do
+  let lctx ← getLCtx
+  let ty := mkApp2 (mkConst ``HypMarker) σs hyp.p
+  addLocalVarInfo stx (lctx.mkLocalDecl ⟨hyp.uniq⟩ hyp.name ty) (.fvar ⟨hyp.uniq⟩) ty isBinder

src/Lean/Elab/Tactic/Do/ProofMode/Pure.lean

@@ -0,0 +1,71 @@
+/-
+Copyright (c) 2022 Lars König. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Lars König, Mario Carneiro, Sebastian Graf
+-/
+prelude
+import Std.Tactic.Do.Syntax
+import Lean.Elab.Tactic.Do.ProofMode.MGoal
+import Lean.Elab.Tactic.Do.ProofMode.Focus
+
+namespace Lean.Elab.Tactic.Do.ProofMode
+open Std.Do
+open Lean Elab Tactic Meta
+
+class IsPure {σs : List Type} (P : SPred σs) (φ : outParam Prop) where to_pure : P ⊣⊢ₛ ⌜φ⌝
+instance (σs) : IsPure (σs:=σs) ⌜φ⌝ φ where to_pure := .rfl
+instance (σs) : IsPure (σs:=σs) spred(⌜φ⌝ → ⌜ψ⌝) (φ → ψ) where to_pure := SPred.pure_imp
+instance (σs) : IsPure (σs:=σs) spred(⌜φ⌝ ∧ ⌜ψ⌝) (φ ∧ ψ) where to_pure := SPred.pure_and
+instance (σs) : IsPure (σs:=σs) spred(⌜φ⌝ ∨ ⌜ψ⌝) (φ ∨ ψ) where to_pure := SPred.pure_or
+instance (σs) (P : α → Prop) : IsPure (σs:=σs) spred(∃ x, ⌜P x⌝) (∃ x, P x) where to_pure := SPred.pure_exists
+instance (σs) (P : α → Prop) : IsPure (σs:=σs) spred(∀ x, ⌜P x⌝) (∀ x, P x) where to_pure := SPred.pure_forall
+instance (σs) (P : SPred (σ::σs)) [inst : IsPure P φ] : IsPure (σs:=σs) spred(P s) φ where to_pure := (iff_of_eq SPred.bientails_cons).mp inst.to_pure s
+instance (P : Prop) : IsPure (σs:=[]) P P where to_pure := Iff.rfl
+
+theorem Pure.thm {σs : List Type} {P Q T : SPred σs} {φ : Prop} [IsPure Q φ]
+  (h : φ → P ⊢ₛ T) : P ∧ Q ⊢ₛ T := by
+    apply SPred.pure_elim
+    · exact SPred.and_elim_r.trans IsPure.to_pure.mp
+    · intro hp
+      exact SPred.and_elim_l.trans (h hp)
+
+-- NB: We do not use MVarId.intro because that would mean we require all callers to supply an MVarId.
+-- This function only knows about the hypothesis H=⌜φ⌝ to destruct.
+-- It will provide a proof for Q ∧ H ⊢ₛ T
+-- if `k` produces a proof for Q ⊢ₛ T that may range over a pure proof h : φ.
+-- It calls `k` with the φ in H = ⌜φ⌝ and a proof `h : φ` thereof.
+def mPureCore (σs : Expr) (hyp : Expr) (name : TSyntax ``binderIdent)
+  (k : Expr /-φ:Prop-/ → Expr /-h:φ-/ → MetaM (α × MGoal × Expr)) : MetaM (α × MGoal × Expr) := do
+  let φ ← mkFreshExprMVar (mkSort .zero)
+  let inst ← synthInstance (mkApp3 (mkConst ``IsPure) σs hyp φ)
+  let (name, ref) ← getFreshHypName name
+  withLocalDeclD name φ fun h => do
+    addLocalVarInfo ref (← getLCtx) h φ
+    let (a, goal, prf /- : goal.toExpr -/) ← k φ h
+    let prf ← mkLambdaFVars #[h] prf
+    let prf := mkApp7 (mkConst ``Pure.thm) σs goal.hyps hyp goal.target φ inst prf
+    let goal := { goal with hyps := mkAnd! σs goal.hyps hyp }
+    return (a, goal, prf)
+
+@[builtin_tactic Lean.Parser.Tactic.mpure]
+def elabMPure : Tactic
+  | `(tactic| mpure $hyp) => do
+  let mvar ← getMainGoal
+  mvar.withContext do
+  let g ← instantiateMVars <| ← mvar.getType
+  let some goal := parseMGoal? g | throwError "not in proof mode"
+  let res ← goal.focusHypWithInfo hyp
+  let (m, _new_goal, prf) ← mPureCore goal.σs res.focusHyp (← `(binderIdent| $hyp:ident)) fun _ _ => do
+    let goal := res.restGoal goal
+    let m ← mkFreshExprSyntheticOpaqueMVar goal.toExpr
+    return (m, goal, m)
+  let prf := res.rewriteHyps goal prf
+  mvar.assign prf
+  replaceMainGoal [m.mvarId!]
+  | _ => throwUnsupportedSyntax
+
+/-- A generalization of `SPred.pure_intro` exploiting `IsPure`. -/
+private theorem Pure.intro {σs : List Type} {P Q : SPred σs} {φ : Prop} [IsPure Q φ] (hp : φ) : P ⊢ₛ Q :=
+  (SPred.pure_intro hp).trans IsPure.to_pure.mpr
+
+macro "mpure_intro" : tactic => `(tactic| apply Pure.intro)

src/Lean/Elab/Tactic/Do/ProofMode/Refine.lean

@@ -0,0 +1,78 @@
+/-
+Copyright (c) 2022 Lars König. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Lars König, Mario Carneiro, Sebastian Graf
+-/
+prelude
+import Std.Tactic.Do.Syntax
+import Lean.Elab.Tactic.Do.ProofMode.Focus
+import Lean.Elab.Tactic.Do.ProofMode.Assumption
+import Lean.Elab.Tactic.Do.ProofMode.Exact
+
+namespace Lean.Elab.Tactic.Do.ProofMode
+open Std.Do Lean.Parser.Tactic
+open Lean Elab Tactic Meta
+
+def patAsTerm (pat : MRefinePat) (expected : Option Expr := none) : OptionT TacticM Expr := do
+  match pat with
+  | .pure t => elabTerm t expected
+  | .one name =>
+    if let `(binderIdent| $name:ident) := name then
+      elabTerm (← `($name)) expected
+    else failure
+  | _ => failure
+
+partial def mRefineCore (goal : MGoal) (pat : MRefinePat) (k : MGoal → TSyntax ``binderIdent → TacticM Expr) : TacticM Expr := do
+  match pat with
+  | .stateful name => liftMetaM do
+    match name with
+    | `(binderIdent| $name:ident) => do
+      let some prf ← goal.exact name | throwError "unknown hypothesis '{repr name}'"
+      return prf
+    | _ => do
+      let some prf ← goal.assumption | throwError "could not solve {goal.target} by assumption"
+      return prf
+  | .pure t => do
+    goal.exactPure t
+  | .one name =>
+      if let `(binderIdent| $_:ident) := name then
+        mRefineCore goal (.pure ⟨name.raw⟩) k <|> mRefineCore goal (.stateful name) k
+      else
+        mRefineCore goal (.stateful name) k
+  | .hole name => k goal name
+  | .tuple [] => throwUnsupportedSyntax
+  | .tuple [p] => mRefineCore goal p k
+  | .tuple (p::ps) => do
+    let T ← whnfR goal.target
+    if let some (σs, T₁, T₂) := parseAnd? T.consumeMData then
+      let prf₁ ← mRefineCore { goal with target := T₁ } p k
+      let prf₂ ← mRefineCore { goal with target := T₂ } (.tuple ps) k
+      return mkApp6 (mkConst ``SPred.and_intro) σs goal.hyps T₁ T₂ prf₁ prf₂
+    else if let some (α, σs, ψ) := T.app3? ``SPred.exists then
+      let some witness ← patAsTerm p (some α) | throwError "pattern does not elaborate to a term to instantiate ψ"
+      let prf ← mRefineCore { goal with target := ψ.betaRev #[witness] } (.tuple ps) k
+      let u ← getLevel α
+      return mkApp6 (mkConst ``SPred.exists_intro' [u]) α σs goal.hyps ψ witness prf
+    else throwError "Neither a conjunction nor an existential quantifier {goal.target}"
+
+@[builtin_tactic Lean.Parser.Tactic.mrefine]
+def elabMRefine : Tactic
+  | `(tactic| mrefine $pat:mrefinePat) => do
+  let pat ← liftMacroM <| MRefinePat.parse pat
+  let (mvar, goal) ← mStartMVar (← getMainGoal)
+  mvar.withContext do
+
+  let goals ← IO.mkRef #[]
+  let prf ← mRefineCore goal pat fun goal name => do
+    let m ← mkFreshExprSyntheticOpaqueMVar goal.toExpr name.raw.getId
+    goals.modify (·.push m.mvarId!)
+    return m
+  mvar.assign prf
+  replaceMainGoal (← goals.get).toList
+  | _ => throwUnsupportedSyntax
+
+macro_rules
+  | `(tactic| mexists $args,*) => do
+  let pats ← args.getElems.mapM fun t => `(mrefinePat| ⌜$t⌝)
+  let pat ← pats.foldrM (fun pat acc => `(mrefinePat| ⟨$pat, $acc⟩)) (← `(mrefinePat| ?_))
+  `(tactic| (mrefine $pat; try massumption))

src/Lean/Elab/Tactic/Do/ProofMode/Revert.lean

@@ -0,0 +1,40 @@
+/-
+Copyright (c) 2022 Lars König. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Lars König, Mario Carneiro, Sebastian Graf
+-/
+prelude
+import Std.Tactic.Do.Syntax
+import Lean.Elab.Tactic.Do.ProofMode.Focus
+import Lean.Elab.Tactic.Do.ProofMode.Basic
+
+namespace Lean.Elab.Tactic.Do.ProofMode
+open Std.Do
+open Lean Elab Tactic Meta
+
+theorem Revert.revert {σs : List Type} {P Q H T : SPred σs} (hfoc : P ⊣⊢ₛ Q ∧ H) (h : Q ⊢ₛ H → T) : P ⊢ₛ T :=
+  hfoc.mp.trans (SPred.imp_elim h)
+
+partial def mRevertStep (goal : MGoal) (ref : TSyntax `ident) (k : MGoal → MetaM Expr) : MetaM Expr := do
+  let res ← goal.focusHypWithInfo ref
+  let P := goal.hyps
+  let Q := res.restHyps
+  let H := res.focusHyp
+  let T := goal.target
+  let prf ← k { goal with hyps := Q, target := mkApp3 (mkConst ``SPred.imp) goal.σs H T }
+  let prf := mkApp7 (mkConst ``Revert.revert) goal.σs P Q H T res.proof prf
+  return prf
+
+@[builtin_tactic Lean.Parser.Tactic.mrevert]
+def elabMRevert : Tactic
+  | `(tactic| mrevert $h) => do
+  let (mvar, goal) ← mStartMVar (← getMainGoal)
+  mvar.withContext do
+
+  let goals ← IO.mkRef []
+  mvar.assign (← mRevertStep goal h fun newGoal => do
+    let m ← mkFreshExprSyntheticOpaqueMVar newGoal.toExpr
+    goals.modify (m.mvarId! :: ·)
+    return m)
+  replaceMainGoal (← goals.get)
+  | _ => throwUnsupportedSyntax

src/Lean/Elab/Tactic/Do/ProofMode/Specialize.lean

@@ -0,0 +1,203 @@
+/-
+Copyright (c) 2022 Lars König. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Lars König, Mario Carneiro, Sebastian Graf
+-/
+prelude
+import Std.Tactic.Do.Syntax
+import Lean.Elab.Tactic.Do.ProofMode.MGoal
+import Lean.Elab.Tactic.Do.ProofMode.Focus
+import Lean.Elab.Tactic.Do.ProofMode.Basic
+import Lean.Elab.Tactic.Do.ProofMode.Pure
+
+namespace Lean.Elab.Tactic.Do.ProofMode
+open Std.Do
+open Lean Elab Tactic Meta
+
+initialize registerTraceClass `Meta.Tactic.Do.specialize
+
+theorem Specialize.imp_stateful {P P' Q R : SPred σs}
+  (hrefocus : P ∧ (Q → R) ⊣⊢ₛ P' ∧ Q) : P ∧ (Q → R) ⊢ₛ P ∧ R := by
+  calc spred(P ∧ (Q → R))
+    _ ⊢ₛ (P' ∧ Q) ∧ (Q → R) := SPred.and_intro hrefocus.mp SPred.and_elim_r
+    _ ⊢ₛ P' ∧ Q ∧ (Q → R) := SPred.and_assoc.mp
+    _ ⊢ₛ P' ∧ Q ∧ R := SPred.and_mono_r (SPred.and_intro SPred.and_elim_l SPred.imp_elim_r)
+    _ ⊢ₛ (P' ∧ Q) ∧ R := SPred.and_assoc.mpr
+    _ ⊢ₛ P ∧ R := SPred.and_mono_l (hrefocus.mpr.trans SPred.and_elim_l)
+
+theorem Specialize.imp_pure {P Q R : SPred σs} [PropAsSPredTautology φ Q]
+  (h : φ) : P ∧ (Q → R) ⊢ₛ P ∧ R := by
+  calc spred(P ∧ (Q → R))
+    _ ⊢ₛ P ∧ (Q ∧ (Q → R)) := SPred.and_mono_r (SPred.and_intro (SPred.true_intro.trans (PropAsSPredTautology.iff.mp h)) .rfl)
+    _ ⊢ₛ P ∧ R := SPred.and_mono_r (SPred.mp SPred.and_elim_r SPred.and_elim_l)
+
+theorem Specialize.forall {P : SPred σs} {ψ : α → SPred σs}
+  (a : α) : P ∧ (∀ x, ψ x) ⊢ₛ P ∧ ψ a := SPred.and_mono_r (SPred.forall_elim a)
+
+theorem Specialize.pure_start {φ : Prop} {H P T : SPred σs} [PropAsSPredTautology φ H] (hpure : φ) (hgoal : P ∧ H ⊢ₛ T) : P ⊢ₛ T :=
+  (SPred.and_intro .rfl (SPred.true_intro.trans (PropAsSPredTautology.iff.mp hpure))).trans hgoal
+
+theorem Specialize.pure_taut {σs} {φ} {P : SPred σs} [IsPure P φ] (h : φ) : ⊢ₛ P :=
+  (SPred.pure_intro h).trans IsPure.to_pure.mpr
+
+def mSpecializeImpStateful (σs : Expr) (P : Expr) (QR : Expr) (arg : TSyntax `term) : OptionT TacticM (Expr × Expr) := do
+  guard (arg.raw.isIdent)
+  let some argRes := focusHyp σs (mkAnd! σs P QR) arg.raw.getId | failure
+  let some hyp := parseHyp? argRes.focusHyp | failure
+  addHypInfo arg σs hyp
+  OptionT.mk do -- no OptionT failure after this point
+  -- The goal is P ∧ (Q → R)
+  -- argRes.proof : P ∧ (Q → R) ⊣⊢ₛ P' ∧ Q
+  -- we want to return (R, (proof : P ∧ (Q → R) ⊢ₛ P ∧ R))
+  let some specHyp := parseHyp? QR | panic! "Precondition of specializeImpStateful violated"
+  let P' := argRes.restHyps
+  let Q := argRes.focusHyp
+  let hrefocus := argRes.proof -- P ∧ (Q → R) ⊣⊢ₛ P' ∧ Q
+  let mkApp3 (.const ``SPred.imp []) σs Q' R := specHyp.p | throwError "Expected implication {QR}"
+  let proof := mkApp6 (mkConst ``Specialize.imp_stateful) σs P P' Q R hrefocus
+  -- check proof
+  trace[Meta.Tactic.Do.specialize] "Statefully specialize {specHyp.p} with {Q}. New Goal: {mkAnd! σs P R}"
+  unless ← isDefEq Q Q' do
+    throwError "failed to specialize {specHyp.p} with {Q}"
+
+  return ({ specHyp with p := R }.toExpr, proof)
+
+def mSpecializeImpPure (_σs : Expr) (P : Expr) (QR : Expr) (arg : TSyntax `term) : OptionT TacticM (Expr × Expr) := do
+  let some specHyp := parseHyp? QR | panic! "Precondition of specializeImpPure violated"
+  let mkApp3 (.const ``SPred.imp []) σs Q R := specHyp.p | failure
+  let mut φ ← mkFreshExprMVar (mkSort .zero)
+  let mut (hφ, mvarIds) ← try
+    elabTermWithHoles arg.raw φ `specialize (allowNaturalHoles := true)
+    catch _ => failure
+  -- We might have hφ : φ and Q = ⌜φ⌝. In this case, convert hφ to a proof of ⊢ₛ ⌜φ⌝,
+  -- so that we can infer an instance of `PropAsSPredTautology`.
+  -- NB: PropAsSPredTautology φ ⌜φ⌝ is unfortunately impossible because ⊢ₛ ⌜φ⌝ does not imply φ.
+  -- Hence this additional (lossy) conversion.
+  if let some inst ← synthInstance? (mkApp3 (mkConst ``IsPure) σs Q φ) then
+    hφ := mkApp5 (mkConst ``Specialize.pure_taut) σs φ Q inst hφ
+    φ := mkApp2 (mkConst ``SPred.tautological) σs Q
+
+  let some inst ← synthInstance? (mkApp3 (mkConst ``PropAsSPredTautology) φ σs Q)
+    | failure
+
+  OptionT.mk do -- no OptionT failure after this point
+  -- The goal is P ∧ (Q → R)
+  -- we want to return (R, (proof : P ∧ (Q → R) ⊢ₛ P ∧ R))
+  pushGoals mvarIds
+  let proof := mkApp7 (mkConst ``Specialize.imp_pure) σs φ P Q R inst hφ
+  -- check proof
+  trace[Meta.Tactic.Do.specialize] "Purely specialize {specHyp.p} with {Q}. New Goal: {mkAnd! σs P R}"
+  -- logInfo m!"proof: {← inferType proof}"
+  return ({ specHyp with p := R }.toExpr, proof)
+
+def mSpecializeForall (_σs : Expr) (P : Expr) (Ψ : Expr) (arg : TSyntax `term) : OptionT TacticM (Expr × Expr) := do
+  let some specHyp := parseHyp? Ψ | panic! "Precondition of specializeForall violated"
+  let mkApp3 (.const ``SPred.forall [u]) α σs αR := specHyp.p | failure
+  let (a, mvarIds) ← try
+    elabTermWithHoles arg.raw α `specialize (allowNaturalHoles := true)
+    catch _ => failure
+  OptionT.mk do -- no OptionT failure after this point
+  pushGoals mvarIds
+  let proof := mkApp5 (mkConst ``Specialize.forall [u]) σs α P αR a
+  let R := αR.beta #[a]
+  -- check proof
+  trace[Meta.Tactic.Do.specialize] "Instantiate {specHyp.p} with {a}. New Goal: {mkAnd! σs P R}"
+  return ({ specHyp with p := R }.toExpr, proof)
+
+theorem focus {P P' Q R : SPred σs} (hfocus : P ⊣⊢ₛ P' ∧ Q) (hnew : P' ∧ Q ⊢ₛ R) : P ⊢ₛ R :=
+  hfocus.mp.trans hnew
+
+@[builtin_tactic Lean.Parser.Tactic.mspecialize]
+def elabMSpecialize : Tactic
+  | `(tactic| mspecialize $hyp $args*) => do
+  let (mvar, goal) ← mStartMVar (← getMainGoal)
+  mvar.withContext do
+
+  -- Want to prove goal P ⊢ T, where hyp occurs in P.
+  -- So we
+  -- 1. focus on hyp (referred to as H):  P ⊣⊢ₛ P' ∧ H. Prove P' ∧ H ⊢ₛ T
+  -- 2. Produce a (transitive chain of) proofs
+  --      P' ∧ H ⊢ P' ∧ H₁ ⊢ₛ P' ∧ H₂ ⊢ₛ ...
+  --    One for each arg; end up with goal P' ∧ H' ⊢ₛ T
+  -- 3. Recombine with mkAnd (NB: P' might be empty), compose with P' ∧ H' ⊣⊢ₛ mkAnd P' H'.
+  -- 4. Make a new MVar for goal `mkAnd P' H' ⊢ T` and assign the transitive chain.
+  let some specFocus := goal.focusHyp hyp.getId | throwError "unknown identifier '{hyp}'"
+  let σs := goal.σs
+  let P := specFocus.restHyps
+  let mut H := specFocus.focusHyp
+  let some hyp' := parseHyp? H | panic! "Invariant of specialize violated"
+  addHypInfo hyp σs hyp'
+  -- invariant: proof (_ : { goal with hyps := mkAnd! σs P H }.toExpr) fills the mvar
+  let mut proof : Expr → Expr :=
+    mkApp7 (mkConst ``focus) σs goal.hyps P H goal.target specFocus.proof
+
+  for arg in args do
+    let res? ← OptionT.run
+      (mSpecializeImpStateful σs P H arg
+        <|> mSpecializeImpPure σs P H arg
+        <|> mSpecializeForall σs P H arg)
+    match res? with
+    | some (H', H2H') =>
+      -- logInfo m!"H: {H}, proof: {← inferType H2H'}"
+      proof := fun hgoal => proof (mkApp6 (mkConst ``SPred.entails.trans) σs (mkAnd! σs P H) (mkAnd! σs P H') goal.target H2H' hgoal)
+      H := H'
+    | none =>
+      throwError "Could not specialize {H} with {arg}"
+
+  let newMVar ← mkFreshExprSyntheticOpaqueMVar { goal with hyps := mkAnd! σs P H }.toExpr
+  mvar.assign (proof newMVar)
+  replaceMainGoal [newMVar.mvarId!]
+
+  | _ => throwUnsupportedSyntax
+
+@[builtin_tactic Lean.Parser.Tactic.mspecializePure]
+def elabMspecializePure : Tactic
+  | `(tactic| mspecialize_pure $head $args* => $hyp) => do
+  -- "mspecialize_pure" >> term >> many (ppSpace >> checkColGt "irrelevant" >> termParser (eval_prec max)) >> "as" >> ident
+  let (mvar, goal) ← mStartMVar (← getMainGoal)
+  mvar.withContext do
+
+  -- Want to prove goal P ⊢ₛ T. `head` is a pure proof of type `φ` that turns into `⊢ₛ H` via `start_entails`.
+  -- So we
+  -- 1. Introduce `head` via `PropAsEntails` as stateful hypothesis named `hyp`, P ∧ (hyp : H) ⊢ₛ T
+  -- 2. (from here on it's the same as `mspecialize`.)
+  --    Produce a (transitive chain of) proofs
+  --      P ∧ H ⊢ P ∧ H₁ ⊢ₛ P ∧ H₂ ⊢ₛ ...
+  --    One for each arg; end up with goal P ∧ H' ⊢ₛ T
+  -- 3. Recombine with mkAnd (NB: P' might be empty), compose with P' ∧ H' ⊣⊢ₛ mkAnd P' H'.
+  -- 4. Make a new MVar for goal `mkAnd P' H' ⊢ T` and assign the transitive chain.
+  let σs := goal.σs
+  let P := goal.hyps
+  let T := goal.target
+  let hφ ← elabTerm head none
+  let φ ← inferType hφ
+  let H ← mkFreshExprMVar (mkApp (mkConst ``SPred) σs)
+  let inst ← synthInstance (mkApp3 (mkConst ``PropAsSPredTautology) φ σs H)
+  let uniq ← mkFreshId
+  let mut H := (Hyp.mk hyp.getId uniq (← instantiateMVars H)).toExpr
+
+  let goal : MGoal := { goal with hyps := mkAnd! σs P H }
+  -- invariant: proof (_ : { goal with hyps := mkAnd! σs P H }.toExpr) fills the mvar
+  let mut proof : Expr → Expr :=
+    mkApp8 (mkConst ``Specialize.pure_start) σs φ H P T inst hφ
+
+  for arg in args do
+    let res? ← OptionT.run
+      (mSpecializeImpStateful σs P H ⟨arg⟩
+        <|> mSpecializeImpPure σs P H ⟨arg⟩
+        <|> mSpecializeForall σs P H ⟨arg⟩)
+    match res? with
+    | some (H', H2H') =>
+      -- logInfo m!"H: {H}, proof: {← inferType H2H'}"
+      proof := fun hgoal => proof (mkApp6 (mkConst ``SPred.entails.trans) σs (mkAnd! σs P H) (mkAnd! σs P H') goal.target H2H' hgoal)
+      H := H'
+    | none =>
+      throwError "Could not specialize {H} with {arg}"
+
+  let some hyp' := parseHyp? H | panic! "Invariant of specialize_pure violated"
+  addHypInfo hyp σs hyp'
+
+  let newMVar ← mkFreshExprSyntheticOpaqueMVar { goal with hyps := mkAnd! σs P H }.toExpr
+  mvar.assign (proof newMVar)
+  replaceMainGoal [newMVar.mvarId!]
+  | _ => throwUnsupportedSyntax

src/Lean/Elab/Tactic/Monotonicity.lean

@@ -134,7 +134,7 @@ def solveMonoStep (failK : ∀ {α}, Expr → Array Name → MetaM α := @defaul
       return [goal'.mvarId!]
 
     -- Handle let
-    if let .letE n t v b nondep := e then
+    if let .letE n t v b _nonDep := e then
       if t.hasLooseBVars || v.hasLooseBVars then
         -- We cannot float the let to the context, so just zeta-reduce.
         let b' := f.updateLambdaE! f.bindingDomain! (b.instantiate1 v)
@@ -143,10 +143,10 @@ def solveMonoStep (failK : ∀ {α}, Expr → Array Name → MetaM α := @defaul
         return [goal'.mvarId!]
       else
         -- No recursive call in t or v, so float out
-        let goal' ← withLetDecl n t v (nondep := nondep) fun x => do
+        let goal' ← withLetDecl n t v fun x => do
           let b' := f.updateLambdaE! f.bindingDomain! (b.instantiate1 x)
           let goal' ← mkFreshExprSyntheticOpaqueMVar (mkApp type.appFn! b')
-          goal.assign (← mkLetFVars (generalizeNondepLet := false) #[x] goal')
+          goal.assign (← mkLetFVars #[x] goal')
           pure goal'
         return [goal'.mvarId!]
 

src/Lean/Elab/Tactic/NormCast.lean

@@ -266,7 +266,7 @@ def evalConvNormCast : Tactic :=
 
 @[builtin_tactic pushCast]
 def evalPushCast : Tactic := fun stx => do
-  let { ctx, simprocs, dischargeWrapper, .. } ← withMainContext do
+  let { ctx, simprocs, dischargeWrapper } ← withMainContext do
     mkSimpContext (simpTheorems := pushCastExt.getTheorems) stx (eraseLocal := false)
   let ctx := ctx.setFailIfUnchanged false
   dischargeWrapper.with fun discharge? =>

src/Lean/Elab/Tactic/RCases.lean

@@ -27,12 +27,11 @@ instance : Coe (TSyntax ``rcasesPatMed) (TSyntax ``rcasesPatLo) where
 instance : Coe (TSyntax `rcasesPat) (TSyntax `rintroPat) where
   coe stx := Unhygienic.run `(rintroPat| $stx:rcasesPat)
 
--- These frequently cause bootstrapping issues. Commented out for now, using `List/-Σ-/` and `List/-Π-/` instead.
--- /-- A list, with a disjunctive meaning (like a list of inductive constructors, or subgoals) -/
--- local notation "ListΣ" => List
+/-- A list, with a disjunctive meaning (like a list of inductive constructors, or subgoals) -/
+local notation "ListΣ" => List
 
--- /-- A list, with a conjunctive meaning (like a list of constructor arguments, or hypotheses) -/
--- local notation "ListΠ" => List
+/-- A list, with a conjunctive meaning (like a list of constructor arguments, or hypotheses) -/
+local notation "ListΠ" => List
 
 /--
 An `rcases` pattern can be one of the following, in a nested combination:
@@ -66,9 +65,9 @@ inductive RCasesPatt : Type
   /-- A type ascription like `pat : ty` (parentheses are optional) -/
   | typed (ref : Syntax) : RCasesPatt → Term → RCasesPatt
   /-- A tuple constructor like `⟨p1, p2, p3⟩` -/
-  | tuple (ref : Syntax) : List/-Π-/ RCasesPatt → RCasesPatt
+  | tuple (ref : Syntax) : ListΠ RCasesPatt → RCasesPatt
   /-- An alternation / variant pattern `p1 | p2 | p3` -/
-  | alts (ref : Syntax) : List/-Σ-/ RCasesPatt → RCasesPatt
+  | alts (ref : Syntax) : ListΣ RCasesPatt → RCasesPatt
   deriving Repr
 
 namespace RCasesPatt
@@ -98,7 +97,7 @@ def ref : RCasesPatt → Syntax
 /--
 Interpret an rcases pattern as a tuple, where `p` becomes `⟨p⟩` if `p` is not already a tuple.
 -/
-def asTuple : RCasesPatt → Bool × List/-Π-/ RCasesPatt
+def asTuple : RCasesPatt → Bool × ListΠ RCasesPatt
   | paren _ p    => p.asTuple
   | explicit _ p => (true, p.asTuple.2)
   | tuple _ ps   => (false, ps)
@@ -108,7 +107,7 @@ def asTuple : RCasesPatt → Bool × List/-Π-/ RCasesPatt
 Interpret an rcases pattern as an alternation, where non-alternations are treated as one
 alternative.
 -/
-def asAlts : RCasesPatt → List/-Σ-/ RCasesPatt
+def asAlts : RCasesPatt → ListΣ RCasesPatt
   | paren _ p => p.asAlts
   | alts _ ps => ps
   | p         => [p]
@@ -119,7 +118,7 @@ def typed? (ref : Syntax) : RCasesPatt → Option Term → RCasesPatt
   | p, some ty => typed ref p ty
 
 /-- Convert a list of patterns to a tuple pattern, but mapping `[p]` to `p` instead of `⟨p⟩`. -/
-def tuple' : List/-Π-/ RCasesPatt → RCasesPatt
+def tuple' : ListΠ RCasesPatt → RCasesPatt
   | [p] => p
   | ps  => tuple (ps.head?.map (·.ref) |>.getD .missing) ps
 
@@ -127,7 +126,7 @@ def tuple' : List/-Π-/ RCasesPatt → RCasesPatt
 Convert a list of patterns to an alternation pattern, but mapping `[p]` to `p` instead of
 a unary alternation `|p`.
 -/
-def alts' (ref : Syntax) : List/-Σ-/ RCasesPatt → RCasesPatt
+def alts' (ref : Syntax) : ListΣ RCasesPatt → RCasesPatt
   | [p] => p
   | ps  => alts ref ps
 
@@ -140,7 +139,7 @@ becomes `⟨a, b, c, d⟩` instead of `⟨a, b, ⟨c, d⟩⟩`.
 We must be careful to turn `[a, ⟨⟩]` into `⟨a, ⟨⟩⟩` instead of `⟨a⟩` (which will not perform the
 nested match).
 -/
-def tuple₁Core : List/-Π-/ RCasesPatt → List/-Π-/ RCasesPatt
+def tuple₁Core : ListΠ RCasesPatt → ListΠ RCasesPatt
   | []         => []
   | [tuple ref []] => [tuple ref []]
   | [tuple _ ps] => ps
@@ -151,7 +150,7 @@ This function is used for producing rcases patterns based on a case tree. This i
 `tuple₁Core` but it produces a pattern instead of a tuple pattern list, converting `[n]` to `n`
 instead of `⟨n⟩` and `[]` to `_`, and otherwise just converting `[a, b, c]` to `⟨a, b, c⟩`.
 -/
-def tuple₁ : List/-Π-/ RCasesPatt → RCasesPatt
+def tuple₁ : ListΠ RCasesPatt → RCasesPatt
   | []      => default
   | [one ref n] => one ref n
   | ps      => tuple ps.head!.ref $ tuple₁Core ps
@@ -163,7 +162,7 @@ produce a list of alternatives with the same effect. This function calls `tuple
 individual alternatives, and handles merging `[a, b, c | d]` to `a | b | c | d` instead of
 `a | b | (c | d)`.
 -/
-def alts₁Core : List/-Σ-/ (List/-Π-/ RCasesPatt) → List/-Σ-/ RCasesPatt
+def alts₁Core : ListΣ (ListΠ RCasesPatt) → ListΣ RCasesPatt
   | []          => []
   | [[alts _ ps]] => ps
   | p :: ps     => tuple₁ p :: alts₁Core ps
@@ -175,7 +174,7 @@ specially translate the empty alternation to `⟨⟩`, and translate `|(a | b)`
 don't have any syntax for unary alternation). Otherwise we can use the regular merging of
 alternations at the last argument so that `a | b | (c | d)` becomes `a | b | c | d`.
 -/
-def alts₁ (ref : Syntax) : List/-Σ-/ (List/-Π-/ RCasesPatt) → RCasesPatt
+def alts₁ (ref : Syntax) : ListΣ (ListΠ RCasesPatt) → RCasesPatt
   | [[]]        => tuple .missing []
   | [[alts ref ps]] => tuple ref ps
   | ps          => alts' ref $ alts₁Core ps
@@ -205,7 +204,7 @@ constructor. The `name` is the name which will be used in the top-level `cases`
 tactics.
 -/
 def processConstructor (ref : Syntax) (info : Array ParamInfo)
-    (explicit : Bool) (idx : Nat) (ps : List/-Π-/ RCasesPatt) : List/-Π-/ Name × List/-Π-/ RCasesPatt :=
+    (explicit : Bool) (idx : Nat) (ps : ListΠ RCasesPatt) : ListΠ Name × ListΠ RCasesPatt :=
   if _ : idx < info.size then
     if !explicit && info[idx].binderInfo != .default then
       let (ns, tl) := processConstructor ref info explicit (idx+1) ps
@@ -228,7 +227,7 @@ and the list of `(constructor name, patterns)` for each constructor, where `patt
 (conjunctive) list of patterns to apply to each constructor argument.
 -/
 def processConstructors (ref : Syntax) (params : Nat) (altVarNames : Array AltVarNames := #[]) :
-    List/-Σ-/ Name → List/-Σ-/ RCasesPatt → MetaM (Array AltVarNames × List/-Σ-/ (Name × List/-Π-/ RCasesPatt))
+    ListΣ Name → ListΣ RCasesPatt → MetaM (Array AltVarNames × ListΣ (Name × ListΠ RCasesPatt))
   | [], _ => pure (altVarNames, [])
   | c :: cs, ps => do
     let info := (← getFunInfo (← mkConstWithLevelParams c)).paramInfo
@@ -355,7 +354,7 @@ partial def rcasesCore (g : MVarId) (fs : FVarSubst) (clears : Array FVarId) (e
       let rec
       /-- Runs `rcasesContinue` on the first pattern in `r` with a matching `ctorName`.
       The unprocessed patterns (subsequent to the matching pattern) are returned. -/
-      align : List/-Π-/ (Name × List/-Π-/ RCasesPatt) → TermElabM (List/-Π-/ (Name × List/-Π-/ RCasesPatt) × α)
+      align : ListΠ (Name × ListΠ RCasesPatt) → TermElabM (ListΠ (Name × ListΠ RCasesPatt) × α)
       | [] => pure ([], a)
       | (tgt, ps) :: as => do
         if tgt == ctorName then
@@ -373,7 +372,7 @@ earlier arguments. For example `⟨a | b, ⟨c, d⟩⟩` performs the `⟨c, d
 `a` branch and once on `b`.
 -/
 partial def rcasesContinue (g : MVarId) (fs : FVarSubst) (clears : Array FVarId) (a : α)
-  (pats : List/-Π-/ (RCasesPatt × Expr)) (cont : MVarId → FVarSubst → Array FVarId → α → TermElabM α) :
+  (pats : ListΠ (RCasesPatt × Expr)) (cont : MVarId → FVarSubst → Array FVarId → α → TermElabM α) :
   TermElabM α :=
   match pats with
   | []  => cont g fs clears a

src/Lean/Elab/Tactic/Simp.lean

@@ -6,7 +6,6 @@ Authors: Leonardo de Moura
 prelude
 import Lean.Meta.Tactic.Simp
 import Lean.Meta.Tactic.Replace
-import Lean.Meta.Hint
 import Lean.Elab.BuiltinNotation
 import Lean.Elab.Tactic.Basic
 import Lean.Elab.Tactic.ElabTerm
@@ -92,6 +91,56 @@ def elabSimpConfig (optConfig : Syntax) (kind : SimpKind) : TacticM Meta.Simp.Co
   | .simpAll => return (← elabSimpConfigCtxCore optConfig).toConfig
   | .dsimp   => return { (← elabDSimpConfigCore optConfig) with }
 
+private def addDeclToUnfoldOrTheorem (config : Meta.ConfigWithKey) (thms : SimpTheorems) (id : Origin) (e : Expr) (post : Bool) (inv : Bool) (kind : SimpKind) : MetaM SimpTheorems := do
+  if e.isConst then
+    let declName := e.constName!
+    let info ← getConstVal declName
+    if (← isProp info.type) then
+      thms.addConst declName (post := post) (inv := inv)
+    else
+      if inv then
+        throwError "invalid '←' modifier, '{declName}' is a declaration name to be unfolded"
+      if kind == .dsimp then
+        return thms.addDeclToUnfoldCore declName
+      else
+        thms.addDeclToUnfold declName
+  else if e.isFVar then
+    let fvarId := e.fvarId!
+    let decl ← fvarId.getDecl
+    if (← isProp decl.type) then
+      thms.add id #[] e (post := post) (inv := inv) (config := config)
+    else if !decl.isLet then
+      throwError "invalid argument, variable is not a proposition or let-declaration"
+    else if inv then
+      throwError "invalid '←' modifier, '{e}' is a let-declaration name to be unfolded"
+    else
+      return thms.addLetDeclToUnfold fvarId
+  else
+    thms.add id #[] e (post := post) (inv := inv) (config := config)
+
+private def addSimpTheorem (config : Meta.ConfigWithKey) (thms : SimpTheorems) (id : Origin) (stx : Syntax) (post : Bool) (inv : Bool) : TermElabM SimpTheorems := do
+  let thm? ← Term.withoutModifyingElabMetaStateWithInfo <| withRef stx do
+    let e ← Term.elabTerm stx none
+    Term.synthesizeSyntheticMVars (postpone := .no) (ignoreStuckTC := true)
+    let e ← instantiateMVars e
+    if e.hasSyntheticSorry then
+      return none
+    let e := e.eta
+    if e.hasMVar then
+      let r ← abstractMVars e
+      return some (r.paramNames, r.expr)
+    else
+      return some (#[], e)
+  if let some (levelParams, proof) := thm? then
+    thms.add id levelParams proof (post := post) (inv := inv) (config := config)
+  else
+    return thms
+
+structure ElabSimpArgsResult where
+  ctx      : Simp.Context
+  simprocs : Simp.SimprocsArray
+  starArg  : Bool := false
+
 inductive ResolveSimpIdResult where
   | none
   | expr (e : Expr)
@@ -105,8 +154,104 @@ inductive ResolveSimpIdResult where
   -/
   | ext  (ext₁? : Option SimpExtension) (ext₂? : Option Simp.SimprocExtension) (h : ext₁?.isSome || ext₂?.isSome)
 
-private def resolveSimpIdTheorem? (simpArgTerm : Term) : TermElabM ResolveSimpIdResult := do
-    let resolveExt (n : Name) : TermElabM ResolveSimpIdResult := do
+/--
+  Elaborate extra simp theorems provided to `simp`. `stx` is of the form `"[" simpTheorem,* "]"`
+  If `eraseLocal == true`, then we consider local declarations when resolving names for erased theorems (`- id`),
+  this option only makes sense for `simp_all` or `*` is used.
+  When `recover := true`, try to recover from errors as much as possible so that users keep seeing
+  the current goal.
+-/
+def elabSimpArgs (stx : Syntax) (ctx : Simp.Context) (simprocs : Simp.SimprocsArray) (eraseLocal : Bool) (kind : SimpKind) : TacticM ElabSimpArgsResult := do
+  if stx.isNone then
+    return { ctx, simprocs }
+  else
+    /-
+    syntax simpPre := "↓"
+    syntax simpPost := "↑"
+    syntax simpLemma := (simpPre <|> simpPost)? "← "? term
+
+    syntax simpErase := "-" ident
+    -/
+    let go := withMainContext do
+      let zetaDeltaSet ← toZetaDeltaSet stx ctx
+      withTrackingZetaDeltaSet zetaDeltaSet do
+        let mut thmsArray := ctx.simpTheorems
+        let mut thms      := thmsArray[0]!
+        let mut simprocs  := simprocs
+        let mut starArg   := false
+        for arg in stx[1].getSepArgs do
+          try -- like withLogging, but compatible with do-notation
+            if arg.getKind == ``Lean.Parser.Tactic.simpErase then
+              let fvar? ← if eraseLocal || starArg then Term.isLocalIdent? arg[1] else pure none
+              if let some fvar := fvar? then
+                -- We use `eraseCore` because the simp theorem for the hypothesis was not added yet
+                thms := thms.eraseCore (.fvar fvar.fvarId!)
+              else
+                let id := arg[1]
+                if let .ok declName ← observing (realizeGlobalConstNoOverloadWithInfo id) then
+                  if (← Simp.isSimproc declName) then
+                    simprocs := simprocs.erase declName
+                  else if ctx.config.autoUnfold then
+                    thms := thms.eraseCore (.decl declName)
+                  else
+                    thms ← withRef id <| thms.erase (.decl declName)
+                else
+                  -- If `id` could not be resolved, we should check whether it is a builtin simproc.
+                  -- before returning error.
+                  let name := id.getId.eraseMacroScopes
+                  if (← Simp.isBuiltinSimproc name) then
+                    simprocs := simprocs.erase name
+                  else
+                    throwUnknownConstantAt id name
+            else if arg.getKind == ``Lean.Parser.Tactic.simpLemma then
+              let post :=
+                if arg[0].isNone then
+                  true
+                else
+                  arg[0][0].getKind == ``Parser.Tactic.simpPost
+              let inv  := !arg[1].isNone
+              let term := arg[2]
+              match (← resolveSimpIdTheorem? term) with
+              | .expr e  =>
+                let name ← mkFreshId
+                thms ← addDeclToUnfoldOrTheorem ctx.indexConfig thms (.stx name arg) e post inv kind
+              | .simproc declName =>
+                simprocs ← simprocs.add declName post
+              | .ext (some ext₁) (some ext₂) _ =>
+                thmsArray := thmsArray.push (← ext₁.getTheorems)
+                simprocs  := simprocs.push (← ext₂.getSimprocs)
+              | .ext (some ext₁) none _ =>
+                thmsArray := thmsArray.push (← ext₁.getTheorems)
+              | .ext none (some ext₂) _ =>
+                simprocs  := simprocs.push (← ext₂.getSimprocs)
+              | .none    =>
+                let name ← mkFreshId
+                thms ← addSimpTheorem ctx.indexConfig thms (.stx name arg) term post inv
+            else if arg.getKind == ``Lean.Parser.Tactic.simpStar then
+              starArg := true
+            else
+              throwUnsupportedSyntax
+          catch ex =>
+            if (← read).recover then
+              logException ex
+            else
+              throw ex
+        let ctx := ctx.setZetaDeltaSet zetaDeltaSet (← getZetaDeltaFVarIds)
+        return { ctx := ctx.setSimpTheorems (thmsArray.set! 0 thms), simprocs, starArg }
+    -- If recovery is disabled, then we want simp argument elaboration failures to be exceptions.
+    -- This affects `addSimpTheorem`.
+    if (← read).recover then
+      go
+    else
+      Term.withoutErrToSorry go
+where
+  isSimproc? (e : Expr) : MetaM (Option Name) := do
+    let .const declName _ := e | return none
+    unless (← Simp.isSimproc declName) do return none
+    return some declName
+
+  resolveSimpIdTheorem? (simpArgTerm : Term) : TacticM ResolveSimpIdResult := do
+    let resolveExt (n : Name) : TacticM ResolveSimpIdResult := do
       let ext₁? ← getSimpExtension? n
       let ext₂? ← Simp.getSimprocExtension? n
       if h : ext₁?.isSome || ext₂?.isSome then
@@ -134,234 +279,7 @@ private def resolveSimpIdTheorem? (simpArgTerm : Term) : TermElabM ResolveSimpId
         return .expr e
       else
         return .none
-where
-  isSimproc? (e : Expr) : MetaM (Option Name) := do
-    let .const declName _ := e | return none
-    unless (← Simp.isSimproc declName) do return none
-    return some declName
 
-
-/--
-The result of elaborating a single `simp` argument
--/
-inductive ElabSimpArgResult where
-  | addEntries (entries : Array SimpEntry)
-  | addSimproc («simproc» : Name) (post : Bool)
-  | addLetToUnfold (fvarId : FVarId)
-  | ext  (ext₁? : Option SimpExtension) (ext₂? : Option Simp.SimprocExtension) (h : ext₁?.isSome || ext₂?.isSome)
-  | erase (toErase : Origin)
-  | eraseSimproc (toErase : Name)
-  | star
-  | none -- used for example when elaboration fails
-
-private def elabDeclToUnfoldOrTheorem (config : Meta.ConfigWithKey) (id : Origin)
-    (e : Expr) (post : Bool) (inv : Bool) (kind : SimpKind) : MetaM ElabSimpArgResult := do
-  if e.isConst then
-    let declName := e.constName!
-    let info ← getConstVal declName
-    if (← isProp info.type) then
-      let thms ← mkSimpTheoremFromConst declName (post := post) (inv := inv)
-      return .addEntries <| thms.map (SimpEntry.thm ·)
-    else
-      if inv then
-        throwError "invalid '←' modifier, '{declName}' is a declaration name to be unfolded"
-      if kind == .dsimp then
-        return .addEntries #[.toUnfold declName]
-      else
-        .addEntries <$> mkSimpEntryOfDeclToUnfold declName
-  else if e.isFVar then
-    let fvarId := e.fvarId!
-    let decl ← fvarId.getDecl
-    if (← isProp decl.type) then
-      let thms ← mkSimpTheoremFromExpr id #[] e (post := post) (inv := inv) (config := config)
-      return .addEntries <| thms.map (SimpEntry.thm ·)
-    else if !decl.isLet then
-      throwError "invalid argument, variable is not a proposition or let-declaration"
-    else if inv then
-      throwError "invalid '←' modifier, '{e}' is a let-declaration name to be unfolded"
-    else
-      return .addLetToUnfold fvarId
-  else
-    let thms ← mkSimpTheoremFromExpr id #[] e (post := post) (inv := inv) (config := config)
-    return .addEntries <| thms.map (SimpEntry.thm ·)
-
-private def elabSimpTheorem (config : Meta.ConfigWithKey) (id : Origin) (stx : Syntax)
-    (post : Bool) (inv : Bool) : TermElabM ElabSimpArgResult := do
-  let thm? ← Term.withoutModifyingElabMetaStateWithInfo <| withRef stx do
-    let e ← Term.elabTerm stx .none
-    Term.synthesizeSyntheticMVars (postpone := .no) (ignoreStuckTC := true)
-    let e ← instantiateMVars e
-    if e.hasSyntheticSorry then
-      return .none
-    let e := e.eta
-    if e.hasMVar then
-      let r ← abstractMVars e
-      return some (r.paramNames, r.expr)
-    else
-      return some (#[], e)
-  if let some (levelParams, proof) := thm? then
-    let thms ← mkSimpTheoremFromExpr id levelParams proof (post := post) (inv := inv) (config := config)
-    return .addEntries <| thms.map (SimpEntry.thm ·)
-  else
-    return .none
-
-private def elabSimpArg (indexConfig : Meta.ConfigWithKey) (eraseLocal : Bool) (kind : SimpKind)
-    (arg : Syntax) : TacticM ElabSimpArgResult := withRef arg do
-  try
-    /-
-    syntax simpPre := "↓"
-    syntax simpPost := "↑"
-    syntax simpLemma := (simpPre <|> simpPost)? "← "? term
-
-    syntax simpErase := "-" ident
-    -/
-    if arg.getKind == ``Lean.Parser.Tactic.simpErase then
-      let fvar? ← if eraseLocal then Term.isLocalIdent? arg[1] else pure none
-      if let some fvar := fvar? then
-        -- We use `eraseCore` because the simp theorem for the hypothesis was not added yet
-        return .erase (.fvar fvar.fvarId!)
-      else
-        let id := arg[1]
-        if let .ok declName ← observing (realizeGlobalConstNoOverloadWithInfo id) then
-          if (← Simp.isSimproc declName) then
-            return .eraseSimproc declName
-          else
-            return .erase (.decl declName)
-        else
-          -- If `id` could not be resolved, we should check whether it is a builtin simproc.
-          -- before returning error.
-          let name := id.getId.eraseMacroScopes
-          if (← Simp.isBuiltinSimproc name) then
-            return .eraseSimproc name
-          else
-            throwUnknownConstantAt id name
-    else if arg.getKind == ``Lean.Parser.Tactic.simpLemma then
-      let post :=
-        if arg[0].isNone then
-          true
-        else
-          arg[0][0].getKind == ``Parser.Tactic.simpPost
-      let inv  := !arg[1].isNone
-      let term := arg[2]
-      match (← resolveSimpIdTheorem? term) with
-      | .expr e  =>
-        let name ← mkFreshId
-        elabDeclToUnfoldOrTheorem indexConfig (.stx name arg) e post inv kind
-      | .simproc declName =>
-        return .addSimproc declName post
-      | .ext ext₁? ext₂? h =>
-        return .ext ext₁? ext₂? h
-      | .none    =>
-        let name ← mkFreshId
-        elabSimpTheorem indexConfig (.stx name arg) term post inv
-    else if arg.getKind == ``Lean.Parser.Tactic.simpStar then
-      return .star
-    else
-      throwUnsupportedSyntax
-  catch ex =>
-    if (← read).recover then
-      logException ex
-      return .none
-    else
-      throw ex
-
-/--
-The result of elaborating a full array of simp arguments and applying them to the simp context.
--/
-structure ElabSimpArgsResult where
-  ctx      : Simp.Context
-  simprocs : Simp.SimprocsArray
-  /-- The elaborated simp arguments with syntax -/
-  simpArgs : Array (Syntax × ElabSimpArgResult)
-
-/-- Implements the effect of the `*` attribute. -/
-private def applyStarArg (ctx : Simp.Context) : MetaM Simp.Context := do
-  let mut simpTheorems := ctx.simpTheorems
-  /-
-  When using `zetaDelta := false`, we do not expand let-declarations when using `[*]`.
-  Users must explicitly include it in the list.
-  -/
-  let hs ← getPropHyps
-  for h in hs do
-    unless simpTheorems.isErased (.fvar h) do
-      simpTheorems ← simpTheorems.addTheorem (.fvar h) (← h.getDecl).toExpr (config := ctx.indexConfig)
-  return ctx.setSimpTheorems simpTheorems
-
-/--
-  Elaborate extra simp theorems provided to `simp`. `stx` is of the form `"[" simpTheorem,* "]"`
-  If `eraseLocal == true`, then we consider local declarations when resolving names for erased theorems (`- id`),
-  this option only makes sense for `simp_all` or `*` is used.
-  When `recover := true`, try to recover from errors as much as possible so that users keep seeing
-  the current goal.
--/
-def elabSimpArgs (stx : Syntax) (ctx : Simp.Context) (simprocs : Simp.SimprocsArray) (eraseLocal : Bool)
-    (kind : SimpKind) (ignoreStarArg := false) : TacticM ElabSimpArgsResult := do
-  if stx.isNone then
-    return { ctx, simprocs, simpArgs := #[] }
-  else
-    /-
-    syntax simpPre := "↓"
-    syntax simpPost := "↑"
-    syntax simpLemma := (simpPre <|> simpPost)? "← "? term
-
-    syntax simpErase := "-" ident
-    -/
-    let go := withMainContext do
-      let zetaDeltaSet ← toZetaDeltaSet stx ctx
-      withTrackingZetaDeltaSet zetaDeltaSet do
-        let mut starArg := false -- only after * we can erase local declarations
-        let mut args : Array (Syntax × ElabSimpArgResult) := #[]
-        for argStx in stx[1].getSepArgs do
-          let arg ← elabSimpArg ctx.indexConfig (eraseLocal || starArg) kind argStx
-          starArg := !ignoreStarArg && (starArg || arg matches .star)
-          args := args.push (argStx, arg)
-
-        let mut thmsArray := ctx.simpTheorems
-        let mut thms      := thmsArray[0]!
-        let mut simprocs  := simprocs
-        for (ref, arg) in args do
-          match arg with
-          | .addEntries entries =>
-            for entry in entries do
-              thms := thms.uneraseSimpEntry entry
-              thms := thms.addSimpEntry entry
-          | .addLetToUnfold fvarId =>
-            thms := thms.addLetDeclToUnfold fvarId
-          | .addSimproc declName post =>
-            simprocs ← simprocs.add declName post
-          | .erase origin =>
-            -- `thms.erase` checks if the erasure is effective.
-            -- We do not want this check for local hypotheses (they are added later based on `starArg`)
-            if origin matches .fvar _ then
-              thms := thms.eraseCore origin
-            -- Nor for decls to unfold when we do auto unfolding
-            else if ctx.config.autoUnfold then
-              thms := thms.eraseCore origin
-            else
-              thms ← withRef ref <| thms.erase origin
-          | .eraseSimproc name =>
-            simprocs := simprocs.erase name
-          | .ext simpExt? simprocExt? _ =>
-            if let some simpExt := simpExt? then
-              thmsArray := thmsArray.push (← simpExt.getTheorems)
-            if let some simprocExt := simprocExt? then
-              simprocs := simprocs.push (← simprocExt.getSimprocs)
-          | .star => pure ()
-          | .none => pure ()
-
-        let mut ctx := ctx.setZetaDeltaSet zetaDeltaSet (← getZetaDeltaFVarIds)
-        ctx := ctx.setSimpTheorems (thmsArray.set! 0 thms)
-        if !ignoreStarArg && starArg then
-          ctx ← applyStarArg ctx
-
-        return { ctx, simprocs, simpArgs := args}
-    -- If recovery is disabled, then we want simp argument elaboration failures to be exceptions.
-    -- This affects `addSimpTheorem`.
-    if (← read).recover then
-      go
-    else
-      Term.withoutErrToSorry go
-where
   /-- If `zetaDelta := false`, create a `FVarId` set with all local let declarations in the `simp` argument list. -/
   toZetaDeltaSet (stx : Syntax) (ctx : Simp.Context) : TacticM FVarIdSet := do
     if ctx.config.zetaDelta then return {}
@@ -401,8 +319,6 @@ structure MkSimpContextResult where
   ctx              : Simp.Context
   simprocs         : Simp.SimprocsArray
   dischargeWrapper : Simp.DischargeWrapper
-  /-- The elaborated simp arguments with syntax -/
-  simpArgs         : Array (Syntax × ElabSimpArgResult) := #[]
 
 /--
    Create the `Simp.Context` for the `simp`, `dsimp`, and `simp_all` tactics.
@@ -435,8 +351,23 @@ def mkSimpContext (stx : Syntax) (eraseLocal : Bool) (kind := SimpKind.simp)
      (config := (← elabSimpConfig stx[1] (kind := kind)))
      (simpTheorems := #[simpTheorems])
      congrTheorems
-  let r ← elabSimpArgs stx[4] (eraseLocal := eraseLocal) (kind := kind) (simprocs := #[simprocs]) (ignoreStarArg := ignoreStarArg) ctx
-  return { r with dischargeWrapper }
+  let r ← elabSimpArgs stx[4] (eraseLocal := eraseLocal) (kind := kind) (simprocs := #[simprocs]) ctx
+  if !r.starArg || ignoreStarArg then
+    return { r with dischargeWrapper }
+  else
+    let ctx := r.ctx
+    let simprocs := r.simprocs
+    let mut simpTheorems := ctx.simpTheorems
+    /-
+    When using `zetaDelta := false`, we do not expand let-declarations when using `[*]`.
+    Users must explicitly include it in the list.
+    -/
+    let hs ← getPropHyps
+    for h in hs do
+      unless simpTheorems.isErased (.fvar h) do
+        simpTheorems ← simpTheorems.addTheorem (.fvar h) (← h.getDecl).toExpr (config := ctx.indexConfig)
+    let ctx := ctx.setSimpTheorems simpTheorems
+    return { ctx, simprocs, dischargeWrapper }
 
 register_builtin_option tactic.simp.trace : Bool := {
   defValue := false
@@ -505,79 +436,6 @@ def mkSimpOnly (stx : Syntax) (usedSimps : Simp.UsedSimps) : MetaM Syntax := do
 def traceSimpCall (stx : Syntax) (usedSimps : Simp.UsedSimps) : MetaM Unit := do
   logInfoAt stx[0] m!"Try this: {← mkSimpOnly stx usedSimps}"
 
-
-register_builtin_option linter.unusedSimpArgs : Bool := {
-  defValue := true,
-  descr := "enable the linter that warns when explicit `simp` arguments are unused.\n\
-    \n\
-    The linter suggests removing the unused arguments. This hint may not be correct in the case \
-    that `simp [← thm]` is given, when `thm` has the `@[simp]` attribute, and it is relevant that \
-    `thm` it disabled (which is a side-effect of specifying `← thm`). In that case, replace \
-    it with `simp [- thm]`.\n\
-    \n\
-    When one `simp` invocation is run multiple times (e.g. `all_goals simp [thm]`), it warns \
-    about simp arguments that are unused in all invocations. For this reason, the linter \
-    does not warn about uses of `simp` inside a macro, as there it is usually not possible to see \
-    all invocations."
-}
-
-structure UnusedSimpArgsInfo where
-  mask : Array Bool
-deriving TypeName
-
-def pushUnusedSimpArgsInfo [Monad m] [MonadInfoTree m] (simpStx : Syntax) (mask : Array Bool) : m Unit := do
-  pushInfoLeaf <| .ofCustomInfo {
-    stx := simpStx
-    value := .mk { mask := mask : UnusedSimpArgsInfo } }
-
-/--
-Checks the simp arguments for unused ones, and stores a bitmask of unused ones in the info tree,
-to be picked up by the linter.
-(This indirection is necessary because the same `simp` syntax may be executed multiple times,
-and different simp arguments may be used in each step.)
--/
-def warnUnusedSimpArgs (simpArgs : Array (Syntax × ElabSimpArgResult)) (usedSimps : Simp.UsedSimps) : MetaM Unit := do
-  if simpArgs.isEmpty then return
-  let mut mask : Array Bool := #[]
-  for h : i in [:simpArgs.size] do
-    let (ref, arg) := simpArgs[i]
-    let used ←
-      match arg with
-      | .addEntries entries =>
-        entries.anyM fun
-          | .thm thm => return usedSimps.contains (← usedThmIdOfSimpTheorem thm)
-          | .toUnfold declName => return usedSimps.contains (.decl declName)
-          | .toUnfoldThms _declName thms => return thms.any (usedSimps.contains <| .decl ·)
-      | .addSimproc declName post =>
-        pure <| usedSimps.contains (.decl declName post)
-      | .addLetToUnfold fvarId =>
-        pure <| usedSimps.contains (.fvar fvarId)
-      | .erase _
-      | .eraseSimproc _
-      | .ext _ _ _
-      | .star
-      | .none
-      => pure true -- not supported yet
-    mask := mask.push used
-  pushUnusedSimpArgsInfo (← getRef) mask
-where
-  /--
-  For equational theorems, usedTheorems record the declaration name. So if the user
-  specified `foo.eq_1`, we get `foo` in `usedTheores`, but we still want to mark
-  `foo.eq_1` as used.
-  (cf. `recordSimpTheorem`)
-  This may lead to unused, explicitly given `foo.eq_1` to not be warned about. Ok for now,
-  eventually `recordSimpTheorem` could record the actual theorem, and the logic for
-  treating `foo.eq_1` as `foo` be moved to `SimpTrace.lean`
-  -/
-  usedThmIdOfSimpTheorem (thm : SimpTheorem) : MetaM Origin := do
-    let thmId := thm.origin
-    if let .decl declName post false := thmId then
-      if let some declName ← isEqnThm? declName then
-        return (Origin.decl declName post false)
-    return thmId
-
-
 /--
 `simpLocation ctx discharge? varIdToLemmaId loc`
 runs the simplifier at locations specified by `loc`,
@@ -619,27 +477,21 @@ def withSimpDiagnostics (x : TacticM Simp.Diagnostics) : TacticM Unit := do
   (location)?
 -/
 @[builtin_tactic Lean.Parser.Tactic.simp] def evalSimp : Tactic := fun stx => withMainContext do withSimpDiagnostics do
-  let { ctx, simprocs, dischargeWrapper, simpArgs } ← mkSimpContext stx (eraseLocal := false)
+  let { ctx, simprocs, dischargeWrapper } ← mkSimpContext stx (eraseLocal := false)
   let stats ← dischargeWrapper.with fun discharge? =>
     simpLocation ctx simprocs discharge? (expandOptLocation stx[5])
   if tactic.simp.trace.get (← getOptions) then
     traceSimpCall stx stats.usedTheorems
-  else if linter.unusedSimpArgs.get (← getOptions) then
-    withRef stx do
-      warnUnusedSimpArgs simpArgs stats.usedTheorems
   return stats.diag
 
 @[builtin_tactic Lean.Parser.Tactic.simpAll] def evalSimpAll : Tactic := fun stx => withMainContext do withSimpDiagnostics do
-  let { ctx, simprocs, dischargeWrapper := _, simpArgs } ← mkSimpContext stx (eraseLocal := true) (kind := .simpAll) (ignoreStarArg := true)
+  let { ctx, simprocs, .. } ← mkSimpContext stx (eraseLocal := true) (kind := .simpAll) (ignoreStarArg := true)
   let (result?, stats) ← simpAll (← getMainGoal) ctx (simprocs := simprocs)
   match result? with
   | none => replaceMainGoal []
   | some mvarId => replaceMainGoal [mvarId]
   if tactic.simp.trace.get (← getOptions) then
     traceSimpCall stx stats.usedTheorems
-  else if linter.unusedSimpArgs.get (← getOptions) then
-    withRef stx do
-      warnUnusedSimpArgs simpArgs stats.usedTheorems
   return stats.diag
 
 def dsimpLocation (ctx : Simp.Context) (simprocs : Simp.SimprocsArray) (loc : Location) : TacticM Unit := do

src/Lean/Elab/Tactic/SimpTrace.lean

@@ -30,7 +30,7 @@ def mkSimpCallStx (stx : Syntax) (usedSimps : UsedSimps) : MetaM (TSyntax `tacti
       `(tactic| simp!%$tk $cfg:optConfig $(discharger)? $[only%$o]? $[[$args,*]]? $(loc)?)
     else
       `(tactic| simp%$tk $cfg:optConfig $[$discharger]? $[only%$o]? $[[$args,*]]? $(loc)?)
-    let { ctx, simprocs, dischargeWrapper, ..} ← mkSimpContext stx (eraseLocal := false)
+    let { ctx, simprocs, dischargeWrapper } ← mkSimpContext stx (eraseLocal := false)
     let ctx := if bang.isSome then ctx.setAutoUnfold else ctx
     let stats ← dischargeWrapper.with fun discharge? =>
       simpLocation ctx (simprocs := simprocs) discharge? <|

src/Lean/Elab/Tactic/Simpa.lean

@@ -34,7 +34,7 @@ deriving instance Repr for UseImplicitLambdaResult
   | `(tactic| simpa%$tk $[?%$squeeze]? $[!%$unfold]? $cfg:optConfig $(disch)? $[only%$only]?
         $[[$args,*]]? $[using $usingArg]?) => Elab.Tactic.focus do withSimpDiagnostics do
     let stx ← `(tactic| simp $cfg:optConfig $(disch)? $[only%$only]? $[[$args,*]]?)
-    let { ctx, simprocs, dischargeWrapper, .. } ←
+    let { ctx, simprocs, dischargeWrapper } ←
       withMainContext <| mkSimpContext stx (eraseLocal := false)
     let ctx := if unfold.isSome then ctx.setAutoUnfold else ctx
     -- TODO: have `simpa` fail if it doesn't use `simp`.

src/Lean/Expr.lean

@@ -2280,9 +2280,6 @@ private def intDivFn : Expr :=
 private def intModFn : Expr :=
   mkApp4 (mkConst ``HMod.hMod [0, 0, 0]) Int.mkType Int.mkType Int.mkType Int.mkInstHMod
 
-private def intPowNatFn : Expr :=
-  mkApp4 (mkConst ``HPow.hPow [0, 0, 0]) Int.mkType Nat.mkType Int.mkType Int.mkInstHPow
-
 private def intNatCastFn : Expr :=
   mkApp2 (mkConst ``NatCast.natCast [0]) Int.mkType Int.mkInstNatCast
 
@@ -2314,10 +2311,6 @@ def mkIntMod (a b : Expr) : Expr :=
 def mkIntNatCast (a : Expr) : Expr :=
   mkApp intNatCastFn a
 
-/-- Given `a b : Int`, returns `a ^ b` -/
-def mkIntPowNat (a b : Expr) : Expr :=
-  mkApp2 intPowNatFn a b
-
 private def intLEPred : Expr :=
   mkApp2 (mkConst ``LE.le [0]) Int.mkType Int.mkInstLE
 

src/Lean/Linter.lean

@@ -13,4 +13,3 @@ import Lean.Linter.MissingDocs
 import Lean.Linter.Omit
 import Lean.Linter.List
 import Lean.Linter.Sets
-import Lean.Linter.UnusedSimpArgs

src/Lean/Linter/UnusedSimpArgs.lean

@@ -1,65 +0,0 @@
-/-
-Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Joachim Breitner
--/
-prelude
-import Lean.Elab.Command
-import Lean.Elab.Tactic.Simp
-import Lean.Linter.Util
-
-namespace Lean.Linter
-
-open Lean Elab Command
-open Lean.Linter (logLint)
-
-private def warnUnused (stx : Syntax) (i : Nat) : CoreM Unit := do
-  let stx : TSyntax `tactic := ⟨stx⟩
-  let simpArgs := Tactic.getSimpParams stx
-  unless i < simpArgs.size do
-    throwError "Index {i} out of bounds for simp arguments of {stx}"
-  let argStx := simpArgs[i]!
-  let msg := m!"This simp argument is unused:{indentD argStx}"
-  let mut otherArgs : Array Syntax := #[]
-  for h : j in [:simpArgs.size] do if j != i then
-    otherArgs := otherArgs.push simpArgs[j]
-  let stx' := Tactic.setSimpParams stx otherArgs
-  let suggestion : Meta.Hint.Suggestion := stx'
-  let suggestion := { suggestion with span? := stx }
-  let hint ← MessageData.hint "Omit it from the simp argument list." #[ suggestion ]
-  logLint Tactic.linter.unusedSimpArgs argStx (msg ++ hint)
-
-def unusedSimpArgs : Linter where
-  run cmdStx := do
-    if !Tactic.linter.unusedSimpArgs.get (← getOptions) then return
-    let some cmdStxRange := cmdStx.getRange?  | return
-
-    let infoTrees := (← get).infoState.trees.toArray
-    let masksMap : IO.Ref (Std.HashMap String.Range (Syntax × Array Bool)) ← IO.mkRef {}
-
-    for tree in infoTrees do
-      tree.visitM' (postNode := fun ci info _ => do
-        match info with
-        | .ofCustomInfo ci =>
-          if let some {mask} := ci.value.get? Tactic.UnusedSimpArgsInfo then
-            -- Only look at info with a range. This also happens to prevent the linter from
-            -- reporting about unused simp arguments inside macro, which we do not want to do
-            -- (we likely cannot see all uses of the macro, so the warning would be incomplete)
-            let some range := info.range? | return
-            let maskAcc ←
-              if let some (_, maskAcc) := (← masksMap.get)[range]? then
-                unless mask.size = maskAcc.size do
-                  throwErrorAt info.stx "Simp argument mask size mismatch}: {maskAcc.size} vs. {mask.size}"
-                pure <| Array.zipWith (· || ·) mask maskAcc
-              else
-                pure mask
-            masksMap.modify fun m => m.insert range (ci.stx, maskAcc)
-        | _ => pure ())
-
-    -- Sort the outputs by position
-    for (_range, tacticStx, mask) in (← masksMap.get).toArray.qsort (·.1.start < ·.1.start) do
-      for i in [:mask.size] do
-        unless mask[i]! do
-          liftCoreM <| warnUnused tacticStx i
-
-builtin_initialize addLinter unusedSimpArgs

src/Lean/LocalContext.lean

@@ -48,36 +48,10 @@ See `LocalDecl.index`, `LocalDecl.fvarId`, `LocalDecl.userName`, `LocalDecl.type
 arguments common to both constructors.
 -/
 inductive LocalDecl where
-  /-- A local variable without any value.
-  `Lean.LocalContext.mkBinding` creates lambdas or foralls from `cdecl`s. -/
+  /-- A local variable. -/
   | cdecl (index : Nat) (fvarId : FVarId) (userName : Name) (type : Expr) (bi : BinderInfo) (kind : LocalDeclKind)
-  /-- A let-bound free variable, with a value `value : Expr`.
-  If `nondep := false`, then the variable is definitionally equal to its value.
-  If `nondep := true`, then the variable has an opaque value; we call these "have-bound free variables."
-  `Lean.LocalContext.mkBinding` creates let/have expressions from `ldecl`s.
-
-  **Important:** The `nondep := true` case is subtle; it is not merely an opaque `ldecl`!
-  - In most contexts, nondependent `ldecl`s should be treated like `cdecl`s.
-    For example, suppose we have a tactic goal `x : α := v (nondep) ⊢ b`.
-    It would be incorrect for `revert x` to produce the goal `⊢ have x : α := v; b`,
-    since this would be saying "to prove `b` without knowledge of the value of `x`, it suffices to
-    prove `have x : α := v; b` for this particular value of `x`."
-    Instead, `revert x` *must* produce the goal `⊢ ∀ x : α, b`.
-    Furthermore, given a goal `⊢ have x : α := v; b`, the `intro x` tactic should yield a *dependent* `ldecl`,
-    since users expect to be able to make use of the value of `x`,
-    plus, as discussed, if `intro` yielded a nondep `ldecl` then `intro x; revert x` would convert the goal into a forall, not a `have`.
-  - Also: `value` might not be type correct. Metaprograms may decide to pretend that all `nondep := true`
-    `ldecl`s are `cdecl`s (for example, when reverting variables). As a consequence, nondep `ldecl`s may
-    have type-incorrect values. This design decision allows metaprograms to not have to think about nondep `ldecl`s,
-    so long as `LocalDecl` values are consumed through `LocalDecl.isLet` and `LocalDecl.value?` with `(allowNondep := false)`.
-    **Rule:** never use `(generalizeNondepLet := false)` in `mkBinding`-family functions within a local context you do not own.
-    See `LocalDecl.setNondep` for some additional discussion.
-  - Where then do nondep ldecls come from? Common functions are `Meta.mapLetDecl`, `Meta.withLetDecl`, and `Meta.letTelescope`.
-    The `have` term syntax makes use of a nondep ldecl as well.
-
-  Therefore, `nondep := true` should be used with consideration.
-  Its primary use is in metaprograms that enter `let`/`have` telescopes and wish to reconstruct them. -/
-  | ldecl (index : Nat) (fvarId : FVarId) (userName : Name) (type : Expr) (value : Expr) (nondep : Bool) (kind : LocalDeclKind)
+  /-- A let-bound free variable, with a `value : Expr`. -/
+  | ldecl (index : Nat) (fvarId : FVarId) (userName : Name) (type : Expr) (value : Expr) (nonDep : Bool) (kind : LocalDeclKind)
   deriving Inhabited
 
 @[export lean_mk_local_decl]
@@ -92,15 +66,9 @@ def LocalDecl.binderInfoEx : LocalDecl → BinderInfo
   | _                   => BinderInfo.default
 namespace LocalDecl
 
-/--
-Returns true if this is an `ldecl` with a visible value.
-
-If `allowNondep` is true then includes `ldecl`s with `nondep := true`, whose values are normally hidden.
--/
-def isLet : LocalDecl → (allowNondep : Bool := false) → Bool
-  | cdecl .., _ => false
-  | ldecl (nondep := false) .., _ => true
-  | ldecl (nondep := true) .., allowNondep => allowNondep
+def isLet : LocalDecl → Bool
+  | cdecl .. => false
+  | ldecl .. => true
 
 /-- The position of the decl in the local context. -/
 def index : LocalDecl → Nat
@@ -147,81 +115,22 @@ Is the local declaration an implementation-detail hypothesis
 def isImplementationDetail (d : LocalDecl) : Bool :=
   d.kind != .default
 
-/--
-Returns the value of the `ldecl` if it has a visible value.
+def value? : LocalDecl → Option Expr
+  | cdecl ..              => none
+  | ldecl (value := v) .. => some v
 
-If `allowNondep` is true, then allows nondependent `ldecl`s, whose values are normally hidden.
--/
-def value? : LocalDecl → (allowNondep : Bool := false) → Option Expr
-  | ldecl (nondep := false) (value := v) .., _    => some v
-  | ldecl (nondep := true)  (value := v) .., true => some v
-  | _,                                       _    => none
+def value : LocalDecl → Expr
+  | cdecl ..              => panic! "let declaration expected"
+  | ldecl (value := v) .. => v
 
-/--
-Returns the value of the `ldecl` if it has a visible value.
+def hasValue : LocalDecl → Bool
+  | cdecl .. => false
+  | ldecl .. => true
 
-If `allowNondep` is true, then allows nondependent `ldecl`s, whose values are normally hidden.
--/
-def value : LocalDecl → (allowNondep : Bool := false) → Expr
-  | cdecl ..,                                _     => panic! "let declaration expected"
-  | ldecl (nondep := false) (value := v) .., _     => v
-  | ldecl (nondep := true)  (value := v) .., true  => v
-  | ldecl (nondep := true) ..,               false => panic! "dependent let declaration expected"
-
-/--
-Returns `true` if `LocalDecl.value?` is not `none`.
--/
-def hasValue : LocalDecl → (allowNondep : Bool := false) → Bool
-  | cdecl ..,                    _           => false
-  | ldecl (nondep := nondep) .., allowNondep => !nondep || allowNondep
-
-/-- Sets the value of an `ldecl`, otherwise returns `cdecl`s unchanged. -/
 def setValue : LocalDecl → Expr → LocalDecl
   | ldecl idx id n t _ nd k, v => ldecl idx id n t v nd k
   | d, _                       => d
 
-/--
-Sets the `nondep` flag of an `ldecl`, otherwise returns `cdecl`s unchanged.
-
-This is a low-level function, and it is the responsibility of the caller to ensure that
-transitions of `nondep` are valid.
-
-Rules:
-- If the declaration is not under the caller's control, then setting `nondep := false` must not be done.
-  General nondependent `ldecl`s should be treated like `cdecl`s.
-  See also the docstring for `LocalDecl.ldecl` about the `value` not necessarily being type correct.
-- Setting `nondep := true` is usually fine.
-  - Caution: be sure any relevant caches are cleared so that the value associated to this `FVarId` does not leak.
-  - Caution: be sure that metavariables dependent on this declaration created before and after the transition are not mixed,
-    since unification does not check "`nondep`-compatibility" of local contexts when assigning metavariables.
-
-For example, setting `nondep := false` is fine from within a telescope combinator, to update the local context
-right before calling `mkLetFVars`:
-```lean
-let lctx ← getLCtx
-letTelescope e fun xs b => do
-  let lctx' ← xs.foldlM (init := lctx) fun lctx' x => do
-    let decl ← x.fvarId!.getDecl
-    -- Clear the flag if it's not a prop.
-    let decl' := decl.setNondep <| ← pure decl.isNondep <&&> Meta.isProp decl.type
-    pure <| lctx'.addDecl decl'
-  withLCtx' lctx' do
-    mkLetFVars (usedLetOnly := false) (generalizeNondepLet := false) xs b
-```
-1. The declarations for `xs` are in the control of this metaprogram.
-2. `mkLetFVars` does make use of `MetaM` caches.
-3. Even if `e` has metavariables, these do not include `xs` in their contexts,
-   so the change of the `nondep` flag does not cause any issues in the `abstractM` system used by `mkLetFVars`.
--/
-def setNondep : LocalDecl → Bool → LocalDecl
-  | ldecl idx id n t v _ k, nd => ldecl idx id n t v nd k
-  | d, _                       => d
-
-/-- Returns `true` if this is an `ldecl` with `nondep := true`. -/
-def isNondep : LocalDecl → Bool
-  | ldecl (nondep := nondep) .. => nondep
-  | _                           => false
-
 def setUserName : LocalDecl → Name → LocalDecl
   | cdecl index id _ type bi k,     userName => cdecl index id userName type bi k
   | ldecl index id _ type val nd k, userName => ldecl index id userName type val nd k
@@ -243,8 +152,8 @@ Set the kind of a `LocalDecl`.
 def setKind : LocalDecl → LocalDeclKind → LocalDecl
   | cdecl index fvarId userName type bi _, kind =>
       cdecl index fvarId userName type bi kind
-  | ldecl index fvarId userName type value nondep _, kind =>
-      ldecl index fvarId userName type value nondep kind
+  | ldecl index fvarId userName type value nonDep _, kind =>
+      ldecl index fvarId userName type value nonDep kind
 
 end LocalDecl
 
@@ -273,7 +182,7 @@ def empty : LocalContext := {}
 def isEmpty (lctx : LocalContext) : Bool :=
   lctx.fvarIdToDecl.isEmpty
 
-/-- Low level API for creating local declarations (`LocalDecl.cdecl`).
+/-- Low level API for creating local declarations.
 It is used to implement actions in the monads `Elab` and `Tactic`.
 It should not be used directly since the argument `(fvarId : FVarId)` is
 assumed to be unique. You can create a unique fvarId with `mkFreshFVarId`. -/
@@ -290,16 +199,16 @@ private def mkLocalDeclExported (lctx : LocalContext) (fvarId : FVarId) (userNam
   mkLocalDecl lctx fvarId userName type bi
 
 /-- Low level API for let declarations. Do not use directly.-/
-def mkLetDecl (lctx : LocalContext) (fvarId : FVarId) (userName : Name) (type : Expr) (value : Expr) (nondep := false) (kind : LocalDeclKind := default) : LocalContext :=
+def mkLetDecl (lctx : LocalContext) (fvarId : FVarId) (userName : Name) (type : Expr) (value : Expr) (nonDep := false) (kind : LocalDeclKind := default) : LocalContext :=
   match lctx with
   | { fvarIdToDecl := map, decls := decls, auxDeclToFullName } =>
     let idx  := decls.size
-    let decl := LocalDecl.ldecl idx fvarId userName type value nondep kind
+    let decl := LocalDecl.ldecl idx fvarId userName type value nonDep kind
     { fvarIdToDecl := map.insert fvarId decl, decls := decls.push decl, auxDeclToFullName }
 
 @[export lean_local_ctx_mk_let_decl]
-private def mkLetDeclExported (lctx : LocalContext) (fvarId : FVarId) (userName : Name) (type : Expr) (value : Expr) (nondep : Bool) : LocalContext :=
-  mkLetDecl lctx fvarId userName type value nondep
+private def mkLetDeclExported (lctx : LocalContext) (fvarId : FVarId) (userName : Name) (type : Expr) (value : Expr) (nonDep : Bool) : LocalContext :=
+  mkLetDecl lctx fvarId userName type value nonDep
 
 /-- Low level API for auxiliary declarations. Do not use directly. -/
 def mkAuxDecl (lctx : LocalContext) (fvarId : FVarId) (userName : Name) (type : Expr) (fullName : Name) : LocalContext :=
@@ -522,39 +431,35 @@ partial def isSubPrefixOfAux (a₁ a₂ : PArray (Option LocalDecl)) (exceptFVar
 def isSubPrefixOf (lctx₁ lctx₂ : LocalContext) (exceptFVars : Array Expr := #[]) : Bool :=
   isSubPrefixOfAux lctx₁.decls lctx₂.decls exceptFVars 0 0
 
-@[inline] def mkBinding (isLambda : Bool) (lctx : LocalContext) (xs : Array Expr) (b : Expr) (generalizeNondepLet := false) : Expr :=
+@[inline] def mkBinding (isLambda : Bool) (lctx : LocalContext) (xs : Array Expr) (b : Expr) : Expr :=
   let b := b.abstract xs
   xs.size.foldRev (init := b) fun i _ b =>
     let x := xs[i]
-    let handleCDecl (n : Name) (ty : Expr) (bi : BinderInfo) : Expr :=
+    match lctx.findFVar? x with
+    | some (.cdecl _ _ n ty bi _)  =>
       let ty := ty.abstractRange i xs;
       if isLambda then
         Lean.mkLambda n bi ty b
       else
         Lean.mkForall n bi ty b
-    match lctx.findFVar? x with
-    | some (.cdecl _ _ n ty bi _)  =>
-      handleCDecl n ty bi
-    | some (.ldecl _ _ n ty val nondep _) =>
-      if nondep && generalizeNondepLet then
-        handleCDecl n ty .default
-      else if b.hasLooseBVar 0 then
+    | some (.ldecl _ _ n ty val nonDep _) =>
+      if b.hasLooseBVar 0 then
         let ty  := ty.abstractRange i xs
         let val := val.abstractRange i xs
-        mkLet n ty val b nondep
+        mkLet n ty val b nonDep
       else
         b.lowerLooseBVars 1 1
     | none => panic! "unknown free variable"
 
 /-- Creates the expression `fun x₁ .. xₙ => b` for free variables `xs = #[x₁, .., xₙ]`,
 suitably abstracting `b` and the types for each of the `xᵢ`. -/
-def mkLambda (lctx : LocalContext) (xs : Array Expr) (b : Expr) (generalizeNondepLet := false) : Expr :=
-  mkBinding true lctx xs b generalizeNondepLet
+def mkLambda (lctx : LocalContext) (xs : Array Expr) (b : Expr) : Expr :=
+  mkBinding true lctx xs b
 
 /-- Creates the expression `(x₁:α₁) → .. → (xₙ:αₙ) → b` for free variables `xs = #[x₁, .., xₙ]`,
 suitably abstracting `b` and the types for each of the `xᵢ`, `αᵢ`. -/
-def mkForall (lctx : LocalContext) (xs : Array Expr) (b : Expr) (generalizeNondepLet := false) : Expr :=
-  mkBinding false lctx xs b generalizeNondepLet
+def mkForall (lctx : LocalContext) (xs : Array Expr) (b : Expr) : Expr :=
+  mkBinding false lctx xs b
 
 @[inline] def anyM [Monad m] (lctx : LocalContext) (p : LocalDecl → m Bool) : m Bool :=
   lctx.decls.anyM fun d => match d with
@@ -634,7 +539,7 @@ def LocalDecl.replaceFVarId (fvarId : FVarId) (e : Expr) (d : LocalDecl) : Local
   if d.fvarId == fvarId then d
   else match d with
     | .cdecl idx id n type bi k => .cdecl idx id n (type.replaceFVarId fvarId e) bi k
-    | .ldecl idx id n type val nondep k => .ldecl idx id n (type.replaceFVarId fvarId e) (val.replaceFVarId fvarId e) nondep k
+    | .ldecl idx id n type val nonDep k => .ldecl idx id n (type.replaceFVarId fvarId e) (val.replaceFVarId fvarId e) nonDep k
 
 def LocalContext.replaceFVarId (fvarId : FVarId) (e : Expr) (lctx : LocalContext) : LocalContext :=
   let lctx := lctx.erase fvarId

src/Lean/Meta/AbstractNestedProofs.lean

@@ -60,7 +60,7 @@ partial def visit (e : Expr) : M Expr := do
         let localDecl ← xFVarId.getDecl
         let type      ← visit localDecl.type
         let localDecl := localDecl.setType type
-        let localDecl ← match localDecl.value? (allowNondep := true) with
+        let localDecl ← match localDecl.value? with
            | some value => let value ← visit value; pure <| localDecl.setValue value
            | none       => pure localDecl
         lctx := lctx.modifyLocalDecl xFVarId fun _ => localDecl
@@ -70,8 +70,8 @@ partial def visit (e : Expr) : M Expr := do
         /- Ensure proofs nested in type are also abstracted -/
         abstractProof e (← read).cache visit
       else match e with
-        | .lam ..
-        | .letE ..     => lambdaLetTelescope e fun xs b => visitBinders xs do mkLambdaFVars xs (← visit b) (usedLetOnly := false) (generalizeNondepLet := false)
+        | .lam ..      => lambdaLetTelescope e fun xs b => visitBinders xs do mkLambdaFVars xs (← visit b) (usedLetOnly := false)
+        | .letE ..     => lambdaLetTelescope e fun xs b => visitBinders xs do mkLambdaFVars xs (← visit b) (usedLetOnly := false)
         | .forallE ..  => forallTelescope e fun xs b => visitBinders xs do mkForallFVars xs (← visit b)
         | .mdata _ b   => return e.updateMData! (← visit b)
         | .proj _ _ b  => return e.updateProj! (← visit b)

src/Lean/Meta/Basic.lean

@@ -445,8 +445,8 @@ structure Context where
   When `trackZetaDelta = true`, we track all free variables that have been zetaDelta-expanded.
   That is, suppose the local context contains
   the declaration `x : t := v`, and we reduce `x` to `v`, then we insert `x` into `State.zetaDeltaFVarIds`.
-  We use `trackZetaDelta` to discover which let-declarations `let x := v; e` can be represented as `have x := v; e`.
-  When we find these declarations we set their `nondep` flag with `true`.
+  We use `trackZetaDelta` to discover which let-declarations `let x := v; e` can be represented as `(fun x => e) v`.
+  When we find these declarations we set their `nonDep` flag with `true`.
   To find these let-declarations in a given term `s`, we
   1- Reset `State.zetaDeltaFVarIds`
   2- Set `trackZetaDelta := true`
@@ -978,27 +978,17 @@ def _root_.Lean.FVarId.getType (fvarId : FVarId) : MetaM Expr :=
 def _root_.Lean.FVarId.getBinderInfo (fvarId : FVarId) : MetaM BinderInfo :=
   return (← fvarId.getDecl).binderInfo
 
-/--
-Returns `some value` if the given free let-variable has a visible local definition in the current local context
-(using `Lean.LocalDecl.value?`), and `none` otherwise.
-
-Setting `allowNondep := true` allows access of the normally hidden value of a nondependent let declaration.
--/
-def _root_.Lean.FVarId.getValue? (fvarId : FVarId) (allowNondep : Bool := false) : MetaM (Option Expr) :=
-  return (← fvarId.getDecl).value? allowNondep
+/-- Return `some value` if the given free variable is a let-declaration, and `none` otherwise. -/
+def _root_.Lean.FVarId.getValue? (fvarId : FVarId) : MetaM (Option Expr) :=
+  return (← fvarId.getDecl).value?
 
 /-- Return the user-facing name for the given free variable. -/
 def _root_.Lean.FVarId.getUserName (fvarId : FVarId) : MetaM Name :=
   return (← fvarId.getDecl).userName
 
-/--
-Returns `true` if the free variable is a let-variable with a visible local definition in the current local context
-(using `Lean.LocalDecl.isLet`).
-
-Setting `allowNondep := true` includes nondependent let declarations, whose values are normally hidden.
--/
-def _root_.Lean.FVarId.isLetVar (fvarId : FVarId) (allowNondep : Bool := false) : MetaM Bool :=
-  return (← fvarId.getDecl).isLet allowNondep
+/-- Return `true` is the free variable is a let-variable. -/
+def _root_.Lean.FVarId.isLetVar (fvarId : FVarId) : MetaM Bool :=
+  return (← fvarId.getDecl).isLet
 
 /-- Get the local declaration associated to the given `Expr` in the current local
 context. Fails if the given expression is not a fvar or if no such declaration exists. -/
@@ -1064,30 +1054,26 @@ def _root_.Lean.Expr.abstractM (e : Expr) (xs : Array Expr) : MetaM Expr :=
 /--
 Collect forward dependencies for the free variables in `toRevert`.
 Recall that when reverting free variables `xs`, we must also revert their forward dependencies.
-
-When `generalizeNondepLet := true` (the default), then the values of nondependent lets are not considered
-when computing forward dependencies.
 -/
-def collectForwardDeps (toRevert : Array Expr) (preserveOrder : Bool) (generalizeNondepLet := true) : MetaM (Array Expr) := do
-  liftMkBindingM <| MetavarContext.collectForwardDeps toRevert preserveOrder generalizeNondepLet
+def collectForwardDeps (toRevert : Array Expr) (preserveOrder : Bool) : MetaM (Array Expr) := do
+  liftMkBindingM <| MetavarContext.collectForwardDeps toRevert preserveOrder
 
 /-- Takes an array `xs` of free variables or metavariables and a term `e` that may contain those variables, and abstracts and binds them as universal quantifiers.
 
 - if `usedOnly = true` then only variables that the expression body depends on will appear.
 - if `usedLetOnly = true` same as `usedOnly` except for let-bound variables. (That is, local constants which have been assigned a value.)
-- if `generalizeNondepLet = true` then nondependent `ldecl`s become foralls too.
  -/
-def mkForallFVars (xs : Array Expr) (e : Expr) (usedOnly : Bool := false) (usedLetOnly : Bool := true) (generalizeNondepLet := true) (binderInfoForMVars := BinderInfo.implicit) : MetaM Expr :=
-  if xs.isEmpty then return e else liftMkBindingM <| MetavarContext.mkForall xs e usedOnly usedLetOnly generalizeNondepLet binderInfoForMVars
+def mkForallFVars (xs : Array Expr) (e : Expr) (usedOnly : Bool := false) (usedLetOnly : Bool := true) (binderInfoForMVars := BinderInfo.implicit) : MetaM Expr :=
+  if xs.isEmpty then return e else liftMkBindingM <| MetavarContext.mkForall xs e usedOnly usedLetOnly binderInfoForMVars
 
 /-- Takes an array `xs` of free variables and metavariables and a
 body term `e` and creates `fun ..xs => e`, suitably
 abstracting `e` and the types in `xs`. -/
-def mkLambdaFVars (xs : Array Expr) (e : Expr) (usedOnly : Bool := false) (usedLetOnly : Bool := true) (etaReduce : Bool := false) (generalizeNondepLet := true) (binderInfoForMVars := BinderInfo.implicit) : MetaM Expr :=
-  if xs.isEmpty then return e else liftMkBindingM <| MetavarContext.mkLambda xs e usedOnly usedLetOnly etaReduce generalizeNondepLet binderInfoForMVars
+def mkLambdaFVars (xs : Array Expr) (e : Expr) (usedOnly : Bool := false) (usedLetOnly : Bool := true) (etaReduce : Bool := false) (binderInfoForMVars := BinderInfo.implicit) : MetaM Expr :=
+  if xs.isEmpty then return e else liftMkBindingM <| MetavarContext.mkLambda xs e usedOnly usedLetOnly etaReduce binderInfoForMVars
 
-def mkLetFVars (xs : Array Expr) (e : Expr) (usedLetOnly := true) (generalizeNondepLet := true) (binderInfoForMVars := BinderInfo.implicit) : MetaM Expr :=
-  mkLambdaFVars xs e (usedLetOnly := usedLetOnly) (generalizeNondepLet := generalizeNondepLet) (binderInfoForMVars := binderInfoForMVars)
+def mkLetFVars (xs : Array Expr) (e : Expr) (usedLetOnly := true) (binderInfoForMVars := BinderInfo.implicit) : MetaM Expr :=
+  mkLambdaFVars xs e (usedLetOnly := usedLetOnly) (binderInfoForMVars := binderInfoForMVars)
 
 /-- `fun _ : Unit => a` -/
 def mkFunUnit (a : Expr) : MetaM Expr :=
@@ -1372,15 +1358,11 @@ mutual
 
 
     If `cleanupAnnotations` is `true`, we apply `Expr.cleanupAnnotations` to each type in the telescope.
-
-    If `whnfIfReducing` is true, then in the `reducing == true` case, `k` is given the whnf of the type.
-    This does not have any performance cost.
   -/
   private partial def forallTelescopeReducingAuxAux
       (reducing          : Bool) (maxFVars? : Option Nat)
       (type              : Expr)
-      (k                 : Array Expr → Expr → MetaM α)
-      (cleanupAnnotations : Bool) (whnfTypeIfReducing : Bool) : MetaM α := do
+      (k                 : Array Expr → Expr → MetaM α) (cleanupAnnotations : Bool) : MetaM α := do
     let rec process (lctx : LocalContext) (fvars : Array Expr) (j : Nat) (type : Expr) : MetaM α := do
       match type with
       | .forallE n d b bi =>
@@ -1405,47 +1387,43 @@ mutual
               let newType ← whnf type
               if newType.isForall then
                 process lctx fvars fvars.size newType
-              else if whnfTypeIfReducing then
-                k fvars newType
               else
                 k fvars type
             else
               k fvars type
     process (← getLCtx) #[] 0 type
 
-  private partial def forallTelescopeReducingAux (type : Expr) (maxFVars? : Option Nat) (k : Array Expr → Expr → MetaM α) (cleanupAnnotations : Bool) (whnfType : Bool) : MetaM α := do
+  private partial def forallTelescopeReducingAux (type : Expr) (maxFVars? : Option Nat) (k : Array Expr → Expr → MetaM α) (cleanupAnnotations : Bool) : MetaM α := do
     match maxFVars? with
-    | some 0 =>
-      if whnfType then
-        k #[] (← whnf type)
-      else
-        k #[] type
+    | some 0 => k #[] type
     | _ => do
       let newType ← whnf type
       if newType.isForall then
-        forallTelescopeReducingAuxAux true maxFVars? newType k cleanupAnnotations whnfType
-      else if whnfType then
-        k #[] newType
+        forallTelescopeReducingAuxAux true maxFVars? newType k cleanupAnnotations
       else
         k #[] type
 
 
-  /--
-  Helper method for `isClassExpensive?`. The type `type` is in WHNF.
-  -/
-  private partial def isClassApp? (type : Expr) : MetaM (Option Name) := do
+  -- Helper method for isClassExpensive?
+  private partial def isClassApp? (type : Expr) (instantiated := false) : MetaM (Option Name) := do
     match type.getAppFn with
     | .const c _ =>
       let env ← getEnv
       if isClass env c then
         return some c
       else
-        return none
+        -- Use whnf to make sure abbreviations are unfolded
+        match (← whnf type).getAppFn with
+        | .const c _ => if isClass env c then return some c else return none
+        | _ => return none
+    | .mvar .. =>
+      if instantiated then return none
+      isClassApp? (← instantiateMVars type) true
     | _ => return none
 
   private partial def isClassExpensive? (type : Expr) : MetaM (Option Name) :=
     withReducible do -- when testing whether a type is a type class, we only unfold reducible constants.
-      forallTelescopeReducingAux type none (cleanupAnnotations := false) (whnfType := true) fun _ type => isClassApp? type
+      forallTelescopeReducingAux type none (cleanupAnnotations := false) fun _ type => isClassApp? type
 
   private partial def isClassImp? (type : Expr) : MetaM (Option Name) := do
     match (← isClassQuick? type) with
@@ -1474,8 +1452,8 @@ private def withNewLocalInstancesImpAux (fvars : Array Expr) (j : Nat) : n α
 partial def withNewLocalInstances (fvars : Array Expr) (j : Nat) : n α → n α :=
   mapMetaM <| withNewLocalInstancesImpAux fvars j
 
-@[inline] private def forallTelescopeImp (type : Expr) (k : Array Expr → Expr → MetaM α) (cleanupAnnotations : Bool) (whnfType : Bool) : MetaM α := do
-  forallTelescopeReducingAuxAux (reducing := false) (maxFVars? := none) type k cleanupAnnotations whnfType
+@[inline] private def forallTelescopeImp (type : Expr) (k : Array Expr → Expr → MetaM α) (cleanupAnnotations : Bool) : MetaM α := do
+  forallTelescopeReducingAuxAux (reducing := false) (maxFVars? := none) type k cleanupAnnotations
 
 /--
   Given `type` of the form `forall xs, A`, execute `k xs A`.
@@ -1485,7 +1463,7 @@ partial def withNewLocalInstances (fvars : Array Expr) (j : Nat) : n α → n α
   If `cleanupAnnotations` is `true`, we apply `Expr.cleanupAnnotations` to each type in the telescope.
 -/
 def forallTelescope (type : Expr) (k : Array Expr → Expr → n α) (cleanupAnnotations := false) : n α :=
-  map2MetaM (fun k => forallTelescopeImp type k cleanupAnnotations (whnfType := false)) k
+  map2MetaM (fun k => forallTelescopeImp type k cleanupAnnotations) k
 
 /--
 Given a monadic function `f` that takes a type and a term of that type and produces a new term,
@@ -1504,77 +1482,64 @@ and then builds the lambda telescope term for the new term.
 def mapForallTelescope (f : Expr → MetaM Expr) (forallTerm : Expr) : MetaM Expr := do
   mapForallTelescope' (fun _ e => f e) forallTerm
 
-private def forallTelescopeReducingImp (type : Expr) (k : Array Expr → Expr → MetaM α) (cleanupAnnotations : Bool) (whnfType : Bool) : MetaM α :=
-  forallTelescopeReducingAux type (maxFVars? := none) k cleanupAnnotations (whnfType := whnfType)
+private def forallTelescopeReducingImp (type : Expr) (k : Array Expr → Expr → MetaM α) (cleanupAnnotations : Bool) : MetaM α :=
+  forallTelescopeReducingAux type (maxFVars? := none) k cleanupAnnotations
 
 /--
   Similar to `forallTelescope`, but given `type` of the form `forall xs, A`,
   it reduces `A` and continues building the telescope if it is a `forall`.
 
   If `cleanupAnnotations` is `true`, we apply `Expr.cleanupAnnotations` to each type in the telescope.
-
-  If `whnfType` is `true`, we give `k` the `whnf` of the resulting type. This is a free operation.
 -/
-def forallTelescopeReducing (type : Expr) (k : Array Expr → Expr → n α) (cleanupAnnotations := false) (whnfType := false) : n α :=
-  map2MetaM (fun k => forallTelescopeReducingImp type k cleanupAnnotations (whnfType := whnfType)) k
+def forallTelescopeReducing (type : Expr) (k : Array Expr → Expr → n α) (cleanupAnnotations := false) : n α :=
+  map2MetaM (fun k => forallTelescopeReducingImp type k cleanupAnnotations) k
 
-private def forallBoundedTelescopeImp (type : Expr) (maxFVars? : Option Nat) (k : Array Expr → Expr → MetaM α) (cleanupAnnotations : Bool) (whnfType : Bool) : MetaM α :=
-  forallTelescopeReducingAux type maxFVars? k cleanupAnnotations (whnfType := whnfType)
+private def forallBoundedTelescopeImp (type : Expr) (maxFVars? : Option Nat) (k : Array Expr → Expr → MetaM α) (cleanupAnnotations : Bool) : MetaM α :=
+  forallTelescopeReducingAux type maxFVars? k cleanupAnnotations
 
 /--
   Similar to `forallTelescopeReducing`, stops constructing the telescope when
   it reaches size `maxFVars`.
 
   If `cleanupAnnotations` is `true`, we apply `Expr.cleanupAnnotations` to each type in the telescope.
-
-  If `whnfType` is `true`, we give `k` the `whnf` of the resulting type.
-  This is a free operation unless `maxFVars? == some 0`, in which case it computes the `whnf`.
 -/
-def forallBoundedTelescope (type : Expr) (maxFVars? : Option Nat) (k : Array Expr → Expr → n α) (cleanupAnnotations := false) (whnfType := false) : n α :=
-  map2MetaM (fun k => forallBoundedTelescopeImp type maxFVars? k cleanupAnnotations (whnfType := whnfType)) k
+def forallBoundedTelescope (type : Expr) (maxFVars? : Option Nat) (k : Array Expr → Expr → n α) (cleanupAnnotations := false) : n α :=
+  map2MetaM (fun k => forallBoundedTelescopeImp type maxFVars? k cleanupAnnotations) k
 
-private partial def lambdaTelescopeImp (e : Expr) (consumeLambda : Bool) (consumeLet : Bool) (preserveNondepLet : Bool) (nondepLetOnly : Bool) (maxFVars? : Option Nat)
+private partial def lambdaTelescopeImp (e : Expr) (consumeLet : Bool) (maxFVars? : Option Nat)
     (k : Array Expr → Expr → MetaM α) (cleanupAnnotations := false) : MetaM α := do
-  process consumeLambda consumeLet (← getLCtx) #[] e
+  process consumeLet (← getLCtx) #[] e
 where
-  process (consumeLambda : Bool) (consumeLet : Bool) (lctx : LocalContext) (fvars : Array Expr) (e : Expr) : MetaM α := do
-    let finish (e : Expr) : MetaM α :=
-      let e := e.instantiateRevRange 0 fvars.size fvars
-      withReader (fun ctx => { ctx with lctx := lctx }) do
-        withNewLocalInstancesImp fvars 0 do
-          k fvars e
-    match fvarsSizeLtMaxFVars fvars maxFVars?, consumeLambda, consumeLet, e with
-    | true, true, _, .lam n d b bi =>
+  process (consumeLet : Bool) (lctx : LocalContext) (fvars : Array Expr) (e : Expr) : MetaM α := do
+    match fvarsSizeLtMaxFVars fvars maxFVars?, consumeLet, e with
+    | true, _, .lam n d b bi =>
       let d := d.instantiateRevRange 0 fvars.size fvars
       let d := if cleanupAnnotations then d.cleanupAnnotations else d
       let fvarId ← mkFreshFVarId
       let lctx := lctx.mkLocalDecl fvarId n d bi
       let fvar := mkFVar fvarId
-      process true consumeLet lctx (fvars.push fvar) b
-    | true, _, true, .letE n t v b nondep => do
-      if !nondep && nondepLetOnly then
-        finish e
-      else
-        let t := t.instantiateRevRange 0 fvars.size fvars
-        let t := if cleanupAnnotations then t.cleanupAnnotations else t
-        let v := v.instantiateRevRange 0 fvars.size fvars
-        let fvarId ← mkFreshFVarId
-        let lctx := lctx.mkLetDecl fvarId n t v (nondep && preserveNondepLet)
-        let fvar := mkFVar fvarId
-        process consumeLambda true lctx (fvars.push fvar) b
-    | _, _, _, e =>
-      finish e
+      process consumeLet lctx (fvars.push fvar) b
+    | true, true, .letE n t v b _ => do
+      let t := t.instantiateRevRange 0 fvars.size fvars
+      let t := if cleanupAnnotations then t.cleanupAnnotations else t
+      let v := v.instantiateRevRange 0 fvars.size fvars
+      let fvarId ← mkFreshFVarId
+      let lctx := lctx.mkLetDecl fvarId n t v
+      let fvar := mkFVar fvarId
+      process true lctx (fvars.push fvar) b
+    | _, _, e =>
+      let e := e.instantiateRevRange 0 fvars.size fvars
+      withReader (fun ctx => { ctx with lctx := lctx }) do
+        withNewLocalInstancesImp fvars 0 do
+          k fvars e
 
 /--
 Similar to `lambdaTelescope` but for lambda and let expressions.
 
-- If `cleanupAnnotations` is `true`, we apply `Expr.cleanupAnnotations` to each type in the telescope.
-- If `preserveNondep` is `false`, all `have`s are converted to `let`s.
-
-See also `mapLambdaLetTelescope` for entering and rebuilding the telescope.
+If `cleanupAnnotations` is `true`, we apply `Expr.cleanupAnnotations` to each type in the telescope.
 -/
-def lambdaLetTelescope (e : Expr) (k : Array Expr → Expr → n α) (cleanupAnnotations := false) (preserveNondepLet := true) : n α :=
-  map2MetaM (fun k => lambdaTelescopeImp e true true preserveNondepLet false .none k (cleanupAnnotations := cleanupAnnotations)) k
+def lambdaLetTelescope (e : Expr) (k : Array Expr → Expr → n α) (cleanupAnnotations := false) : n α :=
+  map2MetaM (fun k => lambdaTelescopeImp e true .none k (cleanupAnnotations := cleanupAnnotations)) k
 
 /--
   Given `e` of the form `fun ..xs => A`, execute `k xs A`.
@@ -1584,7 +1549,7 @@ def lambdaLetTelescope (e : Expr) (k : Array Expr → Expr → n α) (cleanupAnn
   If `cleanupAnnotations` is `true`, we apply `Expr.cleanupAnnotations` to each type in the telescope.
 -/
 def lambdaTelescope (e : Expr) (k : Array Expr → Expr → n α) (cleanupAnnotations := false) : n α :=
-  map2MetaM (fun k => lambdaTelescopeImp e true false true false none k (cleanupAnnotations := cleanupAnnotations)) k
+  map2MetaM (fun k => lambdaTelescopeImp e false none k (cleanupAnnotations := cleanupAnnotations)) k
 
 /--
   Given `e` of the form `fun ..xs ..ys => A`, execute `k xs (fun ..ys => A)` where
@@ -1595,42 +1560,7 @@ def lambdaTelescope (e : Expr) (k : Array Expr → Expr → n α) (cleanupAnnota
   If `cleanupAnnotations` is `true`, we apply `Expr.cleanupAnnotations` to each type in the telescope.
 -/
 def lambdaBoundedTelescope (e : Expr) (maxFVars : Nat) (k : Array Expr → Expr → n α) (cleanupAnnotations := false) : n α :=
-  map2MetaM (fun k => lambdaTelescopeImp e true false true false (.some maxFVars) k (cleanupAnnotations := cleanupAnnotations)) k
-
-/--
-Given `e` of the form `let x₁ := v₁; ...; let xₙ := vₙ; A`, executes `k xs A`,
-where `xs` is an array of free variables for the binders.
-The `let`s can also be `have`s.
-
-- If `cleanupAnnotations` is `true`, applies `Expr.cleanupAnnotations` to each type in the telescope.
-- If `preserveNondep` is `false`, all `have`s are converted to `let`s.
-- If `nondepLetOnly` is `true`, then only `have`s are consumed (it stops at the first dependent `let`).
-
-See also `mapLetTelescope` for entering and rebuilding the telescope.
--/
-def letTelescope (e : Expr) (k : Array Expr → Expr → n α) (cleanupAnnotations := false) (preserveNondepLet := true) (nondepLetOnly := false) : n α :=
-  map2MetaM (fun k => lambdaTelescopeImp e false true preserveNondepLet nondepLetOnly none k (cleanupAnnotations := cleanupAnnotations)) k
-
-/--
-Like `letTelescope`, but limits the number of `let`/`have`s consumed to `maxFVars?`.
-If `maxFVars?` is none, then this is the same as `letTelescope`.
--/
-def letBoundedTelescope (e : Expr) (maxFVars? : Option Nat) (k : Array Expr → Expr → n α) (cleanupAnnotations := false) (preserveNondepLet := true) (nondepLetOnly := false) : n α :=
-  map2MetaM (fun k => lambdaTelescopeImp e false true preserveNondepLet nondepLetOnly maxFVars? k (cleanupAnnotations := cleanupAnnotations)) k
-
-/--
-Evaluates `k` from within a `lambdaLetTelescope`, then uses `mkLetFVars` to rebuild the telescope.
--/
-def mapLambdaLetTelescope [MonadLiftT MetaM n] (e : Expr) (k : Array Expr → Expr → n Expr) (cleanupAnnotations := false) (preserveNondepLet := true) (usedLetOnly := true) : n Expr :=
-  lambdaLetTelescope e (cleanupAnnotations := cleanupAnnotations) (preserveNondepLet := preserveNondepLet) fun xs b => do
-    mkLambdaFVars (usedLetOnly := usedLetOnly) (generalizeNondepLet := false) xs (← k xs b)
-
-/--
-Evaluates `k` from within a `letTelescope`, then uses `mkLetFVars` to rebuild the telescope.
--/
-def mapLetTelescope [MonadLiftT MetaM n] (e : Expr) (k : Array Expr → Expr → n Expr) (cleanupAnnotations := false) (preserveNondepLet := true) (nondepLetOnly := false) (usedLetOnly := true) : n Expr :=
-  letTelescope e (cleanupAnnotations := cleanupAnnotations) (preserveNondepLet := preserveNondepLet) (nondepLetOnly := nondepLetOnly) fun xs b => do
-    mkLetFVars (usedLetOnly := usedLetOnly) (generalizeNondepLet := false) xs (← k xs b)
+  map2MetaM (fun k => lambdaTelescopeImp e false (.some maxFVars) k (cleanupAnnotations := cleanupAnnotations)) k
 
 /-- Return the parameter names for the given global declaration. -/
 def getParamNames (declName : Name) : MetaM (Array Name) := do
@@ -1811,10 +1741,10 @@ def withInstImplicitAsImplict (xs : Array Expr) (k : MetaM α) : MetaM α := do
       return none
   withNewBinderInfos newBinderInfos k
 
-private def withLetDeclImp (n : Name) (type : Expr) (val : Expr) (k : Expr → MetaM α) (nondep : Bool) (kind : LocalDeclKind) : MetaM α := do
+private def withLetDeclImp (n : Name) (type : Expr) (val : Expr) (k : Expr → MetaM α) (kind : LocalDeclKind) : MetaM α := do
   let fvarId ← mkFreshFVarId
   let ctx ← read
-  let lctx := ctx.lctx.mkLetDecl fvarId n type val nondep kind
+  let lctx := ctx.lctx.mkLetDecl fvarId n type val (nonDep := false) kind
   let fvar := mkFVar fvarId
   withReader (fun ctx => { ctx with lctx := lctx }) do
     withNewFVar fvar type k
@@ -1823,17 +1753,8 @@ private def withLetDeclImp (n : Name) (type : Expr) (val : Expr) (k : Expr → M
   Add the local declaration `<name> : <type> := <val>` to the local context and execute `k x`, where `x` is a new
   free variable corresponding to the `let`-declaration. After executing `k x`, the local context is restored.
 -/
-def withLetDecl (name : Name) (type : Expr) (val : Expr) (k : Expr → n α) (nondep : Bool := false) (kind : LocalDeclKind := .default) : n α :=
-  map1MetaM (fun k => withLetDeclImp name type val k nondep kind) k
-
-/--
-Runs `k x` with the local declaration `<name> : <type> := <val>` added to the local context, where `x` is the new free variable.
-Afterwards, the result is wrapped in the given `let`/`have` expression (according to the value of `nondep`).
-- If `usedLetOnly := true` (the default) then the the `let`/`have` is not created if the variable is unused.
--/
-def mapLetDecl [MonadLiftT MetaM n] (name : Name) (type : Expr) (val : Expr) (k : Expr → n Expr) (nondep : Bool := false) (kind : LocalDeclKind := .default) (usedLetOnly : Bool := true) : n Expr :=
-  withLetDecl name type val (nondep := nondep) (kind := kind) fun x => do
-    mkLetFVars (usedLetOnly := usedLetOnly) (generalizeNondepLet := false) #[x] (← k x)
+def withLetDecl (name : Name) (type : Expr) (val : Expr) (k : Expr → n α) (kind : LocalDeclKind := .default) : n α :=
+  map1MetaM (fun k => withLetDeclImp name type val k kind) k
 
 def withLocalInstancesImp (decls : List LocalDecl) (k : MetaM α) : MetaM α := do
   let mut localInsts := (← read).localInstances

src/Lean/Meta/Check.lean

@@ -183,11 +183,10 @@ where
 def throwLetTypeMismatchMessage {α} (fvarId : FVarId) : MetaM α := do
   let lctx ← getLCtx
   match lctx.find? fvarId with
-  | some (LocalDecl.ldecl _ _ _ t v nondep _) => do
+  | some (LocalDecl.ldecl _ _ _ t v _ _) => do
     let vType ← inferType v
     let (vType, t) ← addPPExplicitToExposeDiff vType t
-    let declKind := if nondep then "have" else "let"
-    throwError "invalid {declKind} declaration, term{indentExpr v}\nhas type{indentExpr vType}\nbut is expected to have type{indentExpr t}"
+    throwError "invalid let declaration, term{indentExpr v}\nhas type{indentExpr vType}\nbut is expected to have type{indentExpr t}"
   | _ => unreachable!
 
 /--

src/Lean/Meta/Closure.lean

@@ -286,10 +286,9 @@ partial def process : ClosureM Unit := do
       pushLocalDecl newFVarId userName type bi
       pushFVarArg (mkFVar fvarId)
       process
-    | .ldecl _ _ userName type val nondep _ =>
+    | .ldecl _ _ userName type val _ _ =>
       let zetaDeltaFVarIds ← getZetaDeltaFVarIds
-      -- Note: If `nondep` is true then `zetaDeltaFVarIds.contains fvarId` must be false.
-      if nondep || !zetaDeltaFVarIds.contains fvarId then
+      if !zetaDeltaFVarIds.contains fvarId then
         /- Non-dependent let-decl
 
             Recall that if `fvarId` is in `zetaDeltaFVarIds`, then we zetaDelta-expanded it
@@ -322,11 +321,11 @@ partial def process : ClosureM Unit := do
         Lean.mkLambda n bi ty b
       else
         Lean.mkForall n bi ty b
-    | .ldecl _ _ n ty val nondep _ =>
+    | .ldecl _ _ n ty val nonDep _ =>
       if b.hasLooseBVar 0 then
         let ty  := ty.abstractRange i xs
         let val := val.abstractRange i xs
-        mkLet n ty val b nondep
+        mkLet n ty val b nonDep
       else
         b.lowerLooseBVars 1 1
 

src/Lean/Meta/ExprDefEq.lean

@@ -426,7 +426,7 @@ private partial def mkLambdaFVarsWithLetDeps (xs : Array Expr) (v : Expr) : Meta
     mkLambdaFVars ys v (etaReduce := true)
 
 where
-  /-- Return true if there are let-declarations between `xs[0]` and `xs[xs.size-1]`.
+  /-- Return true if there are let-declarions between `xs[0]` and `xs[xs.size-1]`.
      We use it a quick-check to avoid the more expensive collection procedure. -/
   hasLetDeclsInBetween : MetaM Bool := do
     let check (lctx : LocalContext) : Bool := Id.run do
@@ -728,21 +728,7 @@ mutual
     else
       let lctx := ctxMeta.lctx
       match lctx.findFVar? fvar with
-      /-
-      Recall: if `nondep := true`, then the ldecl is locally a cdecl, so the `value` field is not relevant.
-      In the following example, switching the indicated `have` for a `let` causes the unification to fail,
-      since then `v` depends on a variable not in `?mvar`'s local context.
-      ```
-      example : Nat → Nat :=
-        let f : Nat → Nat := ?mvar
-        let x : Nat := 2
-        -- if this is a `let`, then `refine rfl` fails.
-        have v := x
-        have : ?mvar v = v := by refine rfl
-        f
-      ```
-      -/
-      | some (.ldecl (nondep := false) (value := v) ..) => check v
+      | some (.ldecl (value := v) ..) => check v
       | _ =>
         if ctx.fvars.contains fvar then pure fvar
         else
@@ -931,10 +917,7 @@ unsafe def checkImpl
     | .fvar fvarId ..  =>
       if mvarDecl.lctx.contains fvarId then
         return true
-      /-
-      Recall: if `nondep := true` then the ldecl is locally a cdecl. See comment in `CheckAssignment.checkFVar`.
-      -/
-      if let some (LocalDecl.ldecl (nondep := false) ..) := lctx.find? fvarId then
+      if let some (LocalDecl.ldecl ..) := lctx.find? fvarId then
         return false -- need expensive CheckAssignment.check
       if fvars.any fun x => x.fvarId! == fvarId then
         return true

src/Lean/Meta/ExprLens.lean

@@ -38,7 +38,7 @@ private def lensCoord (g : Expr → M Expr) (n : Nat) (e : Expr) : M Expr := do
   | 1, .forallE n y b c => withLocalDecl n c y fun x => do mkForallFVars #[x] <|← g <| b.instantiateRev #[x]
   | 0, .letE _ y a b _  => return e.updateLetE! (← g y) a b
   | 1, .letE _ y a b _  => return e.updateLetE! y (← g a) b
-  | 2, .letE n y a b nondep => mapLetDecl n y a (nondep := nondep) (usedLetOnly := false) fun x => g <| b.instantiate1 x
+  | 2, .letE n y a b _  => withLetDecl n y a fun x => do mkLetFVars #[x] <|← g <| b.instantiateRev #[x]
   | 0, .proj _ _ b      => e.updateProj! <$> g b
   | n, .mdata _ a       => e.updateMData! <$> lensCoord g n a
   | 3, _                => throwError "Lensing on types is not supported"

src/Lean/Meta/InferType.lean

@@ -121,7 +121,7 @@ private def inferProjType (structName : Name) (idx : Nat) (e : Expr) : MetaM Exp
       | .forallE _ d _ _ => return d.consumeTypeAnnotations
       | _                => failed ()
 
-def throwTypeExpected {α} (type : Expr) : MetaM α :=
+def throwTypeExcepted {α} (type : Expr) : MetaM α :=
   throwError "type expected{indentExpr type}"
 
 def getLevel (type : Expr) : MetaM Level := do
@@ -131,12 +131,12 @@ def getLevel (type : Expr) : MetaM Level := do
   | Expr.sort lvl     => return lvl
   | Expr.mvar mvarId  =>
     if (← mvarId.isReadOnlyOrSyntheticOpaque) then
-      throwTypeExpected type
+      throwTypeExcepted type
     else
       let lvl ← mkFreshLevelMVar
       mvarId.assign (mkSort lvl)
       return lvl
-  | _ => throwTypeExpected type
+  | _ => throwTypeExcepted type
 
 private def inferForallType (e : Expr) : MetaM Expr :=
   forallTelescope e fun xs e => do
@@ -151,7 +151,7 @@ private def inferForallType (e : Expr) : MetaM Expr :=
 private def inferLambdaType (e : Expr) : MetaM Expr :=
   lambdaLetTelescope e fun xs e => do
     let type ← inferType e
-    mkForallFVars (generalizeNondepLet := false) xs type
+    mkForallFVars xs type
 
 def throwUnknownMVar {α} (mvarId : MVarId) : MetaM α :=
   throwError "unknown metavariable '?{mvarId.name}'"

src/Lean/Meta/PPGoal.lean

@@ -102,8 +102,7 @@ def ppGoal (mvarId : MVarId) : MetaM Format := do
             return fmt ++ (Format.joinSep ids.reverse (format " ") ++ " :" ++ Format.nest indent (Format.line ++ typeFmt)).group
       let rec ppVars (varNames : List Name) (prevType? : Option Expr) (fmt : Format) (localDecl : LocalDecl) : MetaM (List Name × Option Expr × Format) := do
         match localDecl with
-        | .cdecl _ _ varName type ..
-        | .ldecl _ _ varName type (nondep := true) .. =>
+        | .cdecl _ _ varName type _ _ =>
           let varName := varName.simpMacroScopes
           let type ← instantiateMVars type
           if prevType? == none || prevType? == some type then
@@ -111,7 +110,7 @@ def ppGoal (mvarId : MVarId) : MetaM Format := do
           else do
             let fmt ← pushPending varNames prevType? fmt
             return ([varName], some type, fmt)
-        | .ldecl _ _ varName type val (nondep := false) .. => do
+        | .ldecl _ _ varName type val _ _ => do
           let varName := varName.simpMacroScopes
           let fmt ← pushPending varNames prevType? fmt
           let fmt  := addLine fmt

src/Lean/Meta/Tactic/FunInd.lean

@@ -379,13 +379,13 @@ partial def foldAndCollect (oldIH newIH : FVarId) (isRecCall : Expr → Option E
           let body' ← foldAndCollect oldIH newIH isRecCall (body.instantiate1 x)
           mkForallFVars #[x] body'
 
-    | .letE n t v b nondep =>
+    | .letE n t v b _ =>
       let t' ← foldAndCollect oldIH newIH isRecCall t
       let v' ← foldAndCollect oldIH newIH isRecCall v
-      withLetDecl n t' v' (nondep := nondep) fun x => do
-        M.localMapM (mkLetFVars (usedLetOnly := true) (generalizeNondepLet := false) #[x] ·) do
+      withLetDecl n t' v' fun x => do
+        M.localMapM (mkLetFVars (usedLetOnly := true) #[x] ·) do
           let b' ← foldAndCollect oldIH newIH isRecCall (b.instantiate1 x)
-          mkLetFVars (generalizeNondepLet := false) #[x] b'
+          mkLetFVars #[x] b'
 
     | .mdata m b =>
       pure <| .mdata m (← foldAndCollect oldIH newIH isRecCall b)
@@ -474,11 +474,6 @@ where
       for localDecl in (← getLCtx) do
         if localDecl.index > index && (!firstPass || localDecl.userName.hasMacroScopes) then
           if localDecl.isLet then
-            if ← Meta.isProp localDecl.type then
-              if let some mvarId' ← observing? <| mvarId.clearValue localDecl.fvarId then
-                return some mvarId'
-              else
-                continue
             if let some mvarId' ← observing? <| mvarId.clear localDecl.fvarId then
               return some mvarId'
           if let some mvarId' ← substVar? mvarId localDecl.fvarId then
@@ -913,10 +908,10 @@ partial def buildInductionBody (toErase toClear : Array FVarId) (goal : Expr)
   if let some (n, t, v, b) := e.letFun? then
     let t' ← foldAndCollect oldIH newIH isRecCall t
     let v' ← foldAndCollect oldIH newIH isRecCall v
-    return ← withLetDecl n t' v' fun x => M2.branch do
+    return ← withLocalDeclD n t' fun x => M2.branch do
       let b' ← withRewrittenMotiveArg goal (rwHaveWith x) fun goal' =>
         buildInductionBody toErase toClear goal' oldIH newIH isRecCall (b.instantiate1 x)
-      mkLetFVars #[x] b' (usedLetOnly := false)
+      mkLetFun x v' b'
 
   -- Special case for traversing the PProd’ed bodies in our encoding of structural mutual recursion
   if let .lam n t b bi := e then

src/Lean/Meta/Tactic/Grind/Arith/CommRing/DenoteExpr.lean

@@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Leonardo de Moura
 -/
 prelude
-import Init.Grind.Ring.OfSemiring
 import Lean.Meta.Tactic.Grind.Arith.CommRing.Util
 import Lean.Meta.Tactic.Grind.Arith.CommRing.Var
 import Lean.Meta.Tactic.Grind.Arith.CommRing.RingId
@@ -79,14 +78,4 @@ def PolyDerivation.denoteExpr (d : PolyDerivation) : M Expr := do
 def DiseqCnstr.denoteExpr (c : DiseqCnstr) : M Expr := do
   return mkNot (← mkEq (← c.d.denoteExpr) (← denoteNum 0))
 
-def _root_.Lean.Grind.Ring.OfSemiring.Expr.denoteAsRingExpr (e : SemiringExpr) : SemiringM Expr := do
-  shareCommon (← go e)
-where
-  go : SemiringExpr → SemiringM Expr
-  | .num k => denoteNum k
-  | .var x => return mkApp (← getSemiring).toQFn (← getSemiring).vars[x]!
-  | .add a b => return mkApp2 (← getRing).addFn (← go a) (← go b)
-  | .mul a b => return mkApp2 (← getRing).mulFn (← go a) (← go b)
-  | .pow a k => return mkApp2 (← getRing).powFn (← go a) (toExpr k)
-
 end Lean.Meta.Grind.Arith.CommRing

src/Lean/Meta/Tactic/Grind/Arith/CommRing/EqCnstr.lean

@@ -9,7 +9,6 @@ import Lean.Meta.Tactic.Grind.Arith.CommRing.RingId
 import Lean.Meta.Tactic.Grind.Arith.CommRing.Proof
 import Lean.Meta.Tactic.Grind.Arith.CommRing.DenoteExpr
 import Lean.Meta.Tactic.Grind.Arith.CommRing.Inv
-import Lean.Meta.Tactic.Grind.Arith.CommRing.Reify
 
 namespace Lean.Meta.Grind.Arith.CommRing
 /-- Returns `some ringId` if `a` and `b` are elements of the same ring. -/
@@ -19,13 +18,6 @@ private def inSameRing? (a b : Expr) : GoalM (Option Nat) := do
   unless ringId == ringId' do return none -- This can happen when we have heterogeneous equalities
   return ringId
 
-/-- Returns `some semiringId` if `a` and `b` are elements of the same semiring. -/
-private def inSameSemiring? (a b : Expr) : GoalM (Option Nat) := do
-  let some semiringId ← getTermSemiringId? a | return none
-  let some semiringId' ← getTermSemiringId? b | return none
-  unless semiringId == semiringId' do return none -- This can happen when we have heterogeneous equalities
-  return semiringId
-
 def mkEqCnstr (p : Poly) (h : EqCnstrProof) : RingM EqCnstr := do
   let id := (← getRing).nextId
   let sugar := p.degree
@@ -46,20 +38,6 @@ private def toRingExpr? (e : Expr) : RingM (Option RingExpr) := do
     reportIssue! "failed to convert to ring expression{indentExpr e}"
     return none
 
-/--
-Returns the semiring expression denoting the given Lean expression.
-Recall that we compute the semiring expressions during internalization.
--/
-private def toSemiringExpr? (e : Expr) : SemiringM (Option SemiringExpr) := do
-  let semiring ← getSemiring
-  if let some re := semiring.denote.find? { expr := e } then
-    return some re
-  else if let some x := semiring.varMap.find? { expr := e } then
-    return some (.var x)
-  else
-    reportIssue! "failed to convert to semiring expression{indentExpr e}"
-    return none
-
 /--
 Returns `some c`, where `c` is an equation from the basis whose leading monomial divides `m`.
 Remark: if the current ring does not satisfy the property
@@ -297,24 +275,13 @@ def addNewDiseq (c : DiseqCnstr) : RingM Unit := do
 @[export lean_process_ring_eq]
 def processNewEqImpl (a b : Expr) : GoalM Unit := do
   if isSameExpr a b then return () -- TODO: check why this is needed
-  if let some ringId ← inSameRing? a b then RingM.run ringId do
+  let some ringId ← inSameRing? a b | return ()
+  RingM.run ringId do
     trace_goal[grind.ring.assert] "{← mkEq a b}"
     let some ra ← toRingExpr? a | return ()
     let some rb ← toRingExpr? b | return ()
     let p ← (ra.sub rb).toPolyM
     addNewEq (← mkEqCnstr p (.core a b ra rb))
-  else if let some semiringId ← inSameSemiring? a b then SemiringM.run semiringId do
-    if (← getConfig).ringNull then return () -- TODO: remove after we add Nullstellensatz certificates for semiring adapter
-    trace_goal[grind.ring.assert] "{← mkEq a b}"
-    let some sa ← toSemiringExpr? a | return ()
-    let some sb ← toSemiringExpr? b | return ()
-    let lhs ← sa.denoteAsRingExpr
-    let rhs ← sb.denoteAsRingExpr
-    RingM.run (← getSemiring).ringId do
-      let some ra ← reify? lhs (skipVar := false) (gen := (← getGeneration a)) | return ()
-      let some rb ← reify? rhs (skipVar := false) (gen := (← getGeneration b)) | return ()
-      let p ← (ra.sub rb).toPolyM
-      addNewEq (← mkEqCnstr p (.coreS a b sa sb ra rb))
 
 private def pre (e : Expr) : GoalM Expr := do
   -- We must canonicalize because the instances generated by this module may not match
@@ -348,7 +315,8 @@ private def diseqZeroToEq (a b : Expr) : RingM Unit := do
 
 @[export lean_process_ring_diseq]
 def processNewDiseqImpl (a b : Expr) : GoalM Unit := do
-  if let some ringId ← inSameRing? a b then RingM.run ringId do
+  let some ringId ← inSameRing? a b | return ()
+  RingM.run ringId do
     trace_goal[grind.ring.assert] "{mkNot (← mkEq a b)}"
     let some ra ← toRingExpr? a | return ()
     let some rb ← toRingExpr? b | return ()
@@ -364,26 +332,7 @@ def processNewDiseqImpl (a b : Expr) : GoalM Unit := do
       lhs := a, rhs := b
       rlhs := ra, rrhs := rb
       d := .input p
-      ofSemiring? := none
     }
-  else if let some semiringId ← inSameSemiring? a b then SemiringM.run semiringId do
-    if (← getSemiring).addRightCancelInst?.isSome then
-    if (← getConfig).ringNull then return () -- TODO: remove after we add Nullstellensatz certificates for semiring adapter
-    trace_goal[grind.ring.assert] "{mkNot (← mkEq a b)}"
-    let some sa ← toSemiringExpr? a | return ()
-    let some sb ← toSemiringExpr? b | return ()
-    let lhs ← sa.denoteAsRingExpr
-    let rhs ← sb.denoteAsRingExpr
-    RingM.run (← getSemiring).ringId do
-      let some ra ← reify? lhs (skipVar := false) (gen := (← getGeneration a)) | return ()
-      let some rb ← reify? rhs (skipVar := false) (gen := (← getGeneration b)) | return ()
-      let p ← (ra.sub rb).toPolyM
-      addNewDiseq {
-        lhs := a, rhs := b
-        rlhs := ra, rrhs := rb
-        d := .input p
-        ofSemiring? := some (sa, sb)
-      }
 
 /--
 Returns `true` if the todo queue is not empty or the `recheck` flag is set to `true`
@@ -411,7 +360,6 @@ private def propagateEqs : RingM Unit := do
   This is a very simple procedure that does not use any indexing data-structure.
   We don't even cache the simplified polynomials.
   TODO: optimize
-  TODO: support for semiring
   -/
   let mut map : PropagateEqMap := {}
   for a in (← getRing).vars do

src/Lean/Meta/Tactic/Grind/Arith/CommRing/Internalize.lean

@@ -107,24 +107,19 @@ private def internalizeInv (e : Expr) : GoalM Bool := do
   | _ => return false
 
 def internalize (e : Expr) (parent? : Option Expr) : GoalM Unit := do
-  if !(← getConfig).ring then return ()
+  if !(← getConfig).ring && !(← getConfig).ringNull then return ()
   if isIntModuleVirtualParent parent? then
     -- `e` is an auxiliary term used to convert `CommRing` to `IntModule`
     return ()
   if (← internalizeInv e) then return ()
   let some type := getType? e | return ()
   if isForbiddenParent parent? then return ()
-  if let some ringId ← getRingId? type then RingM.run ringId do
+  let some ringId ← getRingId? type | return ()
+  RingM.run ringId do
     let some re ← reify? e | return ()
     trace_goal[grind.ring.internalize] "[{ringId}]: {e}"
     setTermRingId e
     markAsCommRingTerm e
     modifyRing fun s => { s with denote := s.denote.insert { expr := e } re }
-  else if let some semiringId ← getSemiringId? type then SemiringM.run semiringId do
-    let some re ← sreify? e | return ()
-    trace_goal[grind.ring.internalize] "semiring [{semiringId}]: {e}"
-    setTermSemiringId e
-    markAsCommRingTerm e
-    modifySemiring fun s => { s with denote := s.denote.insert { expr := e } re }
 
 end Lean.Meta.Grind.Arith.CommRing

src/Lean/Meta/Tactic/Grind/Arith/CommRing/Proof.lean

@@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Leonardo de Moura
 -/
 prelude
-import Init.Grind.Ring.OfSemiring
 import Lean.Meta.Tactic.Grind.Diseq
 import Lean.Meta.Tactic.Grind.Arith.ProofUtil
 import Lean.Meta.Tactic.Grind.Arith.CommRing.RingId
@@ -24,15 +23,6 @@ def toContextExpr : RingM Expr := do
   else
     RArray.toExpr ring.type id (RArray.leaf (mkApp ring.natCastFn (toExpr 0)))
 
-/-- Similar to `toContextExpr`, but for semirings. -/
-private def toSContextExpr (semiringId : Nat) : RingM Expr := do
-  SemiringM.run semiringId do
-    let semiring ← getSemiring
-    if h : 0 < semiring.vars.size then
-      RArray.toExpr semiring.type id (RArray.ofFn (semiring.vars[·]) h)
-    else
-      RArray.toExpr semiring.type id (RArray.leaf (mkApp semiring.natCastFn (toExpr 0)))
-
 def throwNoNatZeroDivisors : RingM α := do
   throwError "`grind` internal error, `NoNatZeroDivisors` instance is needed, but it is not available for{indentExpr (← getRing).type}"
 
@@ -161,8 +151,6 @@ partial def EqCnstr.toPreNullCert (c : EqCnstr) : ProofM PreNullCert := caching
     let h ← mkEqProof a b
     modify fun s => { s with hyps := s.hyps.push { h, lhs, rhs } }
     return PreNullCert.unit i (i+1)
-  | .coreS _a _b _sa _sb _ra _rb =>
-    throwError "NIY"
   | .superpose k₁ m₁ c₁ k₂ m₂ c₂ => (← c₁.toPreNullCert).combine k₁ m₁ k₂ m₂ (← c₂.toPreNullCert)
   | .simp k₁ c₁ k₂ m₂ c₂ => (← c₁.toPreNullCert).combine k₁ .unit k₂ m₂ (← c₂.toPreNullCert)
   | .mul k c => (← c.toPreNullCert).mul k
@@ -311,12 +299,9 @@ structure ProofM.State where
   polyMap     : Std.HashMap Poly Expr := {}
   monMap      : Std.HashMap Mon Expr := {}
   exprMap     : Std.HashMap RingExpr Expr := {}
-  sexprMap    : Std.HashMap SemiringExpr Expr := {}
 
 structure ProofM.Context where
-  ctx   : Expr
-  /-- Context for semiring variables if available -/
-  sctx? : Option Expr
+  ctx : Expr
 
 abbrev ProofM := ReaderT ProofM.Context (StateRefT ProofM.State RingM)
 
@@ -324,15 +309,6 @@ abbrev ProofM := ReaderT ProofM.Context (StateRefT ProofM.State RingM)
 private abbrev getContext : ProofM Expr := do
   return (← read).ctx
 
-/--
-Returns a Lean expression representing the semiring variable context
-used to construct `CommRing` proof steps.
--/
-private abbrev getSContext : ProofM Expr := do
-  let some sctx := (← read).sctx?
-    | throwError "`grind` internal error, semiring context is not available"
-  return sctx
-
 private abbrev caching (c : α) (k : ProofM Expr) : ProofM Expr := do
   let addr := unsafe (ptrAddrUnsafe c).toUInt64 >>> 2
   if let some h := (← get).cache[addr]? then
@@ -356,13 +332,6 @@ def mkExprDecl (e : RingExpr) : ProofM Expr := do
   modify fun s => { s with exprMap := s.exprMap.insert e x }
   return x
 
-def mkSExprDecl (e : SemiringExpr) : ProofM Expr := do
-  if let some x := (← get).sexprMap[e]? then
-    return x
-  let x := mkFVar (← mkFreshFVarId)
-  modify fun s => { s with sexprMap := s.sexprMap.insert e x }
-  return x
-
 def mkMonDecl (m : Mon) : ProofM Expr := do
   if let some x := (← get).monMap[m]? then
     return x
@@ -383,33 +352,12 @@ private def mkStepPrefix (declName declNameC : Name) : ProofM Expr := do
   else
     mkStepBasicPrefix declName
 
-private def getSemiringOf : RingM Semiring := do
-  let some semiringId := (← getRing).semiringId? | throwError "`grind` internal error, semiring is not available"
-  SemiringM.run semiringId do getSemiring
-
-private def mkSemiringPrefix (declName : Name) : ProofM Expr := do
-  let sctx ← getSContext
-  let semiring ← getSemiringOf
-  return mkApp3 (mkConst declName [semiring.u]) semiring.type semiring.semiringInst sctx
-
-private def mkSemiringAddRightCancelPrefix (declName : Name) : ProofM Expr := do
-  let sctx ← getSContext
-  let semiring ← getSemiringOf
-  let some addRightCancelInst := semiring.addRightCancelInst?
-    | throwError "`grind` internal error, `AddRightCancel` instance is not available"
-  return mkApp4 (mkConst declName [semiring.u]) semiring.type semiring.semiringInst addRightCancelInst sctx
-
 open Lean.Grind.CommRing in
 partial def _root_.Lean.Meta.Grind.Arith.CommRing.EqCnstr.toExprProof (c : EqCnstr) : ProofM Expr := caching c do
   match c.h with
   | .core a b lhs rhs =>
     let h ← mkStepPrefix ``Stepwise.core ``Stepwise.coreC
     return mkApp5 h (← mkExprDecl lhs) (← mkExprDecl rhs) (← mkPolyDecl c.p) reflBoolTrue (← mkEqProof a b)
-  | .coreS a b sa sb ra rb =>
-    let h' ← mkSemiringPrefix ``Grind.Ring.OfSemiring.of_eq
-    let h' := mkApp3 h' (← mkSExprDecl sa) (← mkSExprDecl sb) (← mkEqProof a b)
-    let h ← mkStepPrefix ``Stepwise.core ``Stepwise.coreC
-    return mkApp5 h (← mkExprDecl ra) (← mkExprDecl rb) (← mkPolyDecl c.p) reflBoolTrue h'
   | .superpose k₁ m₁ c₁ k₂ m₂ c₂ =>
     let h ← mkStepPrefix ``Stepwise.superpose ``Stepwise.superposeC
     return mkApp10 h
@@ -469,26 +417,16 @@ private def mkImpEqExprProof (lhs rhs : RingExpr) (d : PolyDerivation) : ProofM
     pure <| mkApp2 (← mkStepPrefix ``Stepwise.imp_keq ``Stepwise.imp_keqC) nzInst (toExpr k)
   return mkApp6 h (← mkExprDecl lhs) (← mkExprDecl rhs) (← mkPolyDecl p₀) (← mkPolyDecl d.p) reflBoolTrue h₁
 
-private abbrev withSemiringContext (k : Option Expr → RingM Expr) : RingM Expr := do
-  let some semiringId := (← getRing).semiringId? | k none
-  let sctx ← toSContextExpr semiringId
-  let semiring ← getSemiringOf
-  withLetDecl `sctx (mkApp (mkConst ``RArray [semiring.u]) semiring.type) sctx fun sctx =>
-  k (some sctx)
-
 private abbrev withProofContext (x : ProofM Expr) : RingM Expr := do
   let ring ← getRing
   withLetDecl `ctx (mkApp (mkConst ``RArray [ring.u]) ring.type) (← toContextExpr) fun ctx =>
-  withSemiringContext fun sctx? =>
-  go { ctx, sctx? } |>.run' {}
+  go { ctx } |>.run' {}
 where
   go : ProofM Expr := do
     let h ← x
     let h ← mkLetOfMap (← get).polyMap h `p (mkConst ``Grind.CommRing.Poly) toExpr
     let h ← mkLetOfMap (← get).monMap h `m (mkConst ``Grind.CommRing.Mon) toExpr
     let h ← mkLetOfMap (← get).exprMap h `e (mkConst ``Grind.CommRing.Expr) toExpr
-    let h ← mkLetOfMap (← get).sexprMap h `s (mkConst ``Grind.Ring.OfSemiring.Expr) toExpr
-    let h ← if let some sctx := (← read).sctx? then mkLetFVars #[sctx] h else pure h
     mkLetFVars #[(← getContext)] h
 
 open Lean.Grind.CommRing in
@@ -509,15 +447,9 @@ def setEqUnsat (c : EqCnstr) : RingM Unit := do
   closeGoal h
 
 def setDiseqUnsat (c : DiseqCnstr) : RingM Unit := do
-  let h ← withProofContext do
-    let heq ← mkImpEqExprProof c.rlhs c.rrhs c.d
-    let hne ← if let some (sa, sb) := c.ofSemiring? then
-      let h ← mkSemiringAddRightCancelPrefix ``Grind.Ring.OfSemiring.of_diseq
-      pure <| mkApp3 h (← mkSExprDecl sa) (← mkSExprDecl sb) (← mkDiseqProof c.lhs c.rhs)
-    else
-      mkDiseqProof c.lhs c.rhs
-    return mkApp hne heq
-  closeGoal h
+  let heq ← withProofContext do
+    mkImpEqExprProof c.rlhs c.rrhs c.d
+  closeGoal <| mkApp (← mkDiseqProof c.lhs c.rhs) heq
 
 def propagateEq (a b : Expr) (ra rb : RingExpr) (d : PolyDerivation) : RingM Unit := do
   let heq ← withProofContext do

src/Lean/Meta/Tactic/Grind/Arith/CommRing/Reify.lean

@@ -29,18 +29,13 @@ private def reportAppIssue (e : Expr) : GoalM Unit := do
   reportIssue! "comm ring term with unexpected instance{indentExpr e}"
 
 /--
-Converts a Lean expression `e` in the `CommRing` into a `CommRing.Expr` object.
+Converts a Lean expression `e` in the `CommRing` with id `ringId` into
+a `CommRing.Expr` object.
 
 If `skipVar` is `true`, then the result is `none` if `e` is not an interpreted `CommRing` term.
 We use `skipVar := false` when processing inequalities, and `skipVar := true` for equalities and disequalities
 -/
-partial def reify? (e : Expr) (skipVar := true) (gen : Nat := 0) : RingM (Option RingExpr) := do
-  let mkVar (e : Expr) : RingM Var := do
-    if (← alreadyInternalized e) then
-      mkVar e
-    else
-      internalize e gen
-      mkVar e
+partial def reify? (e : Expr) (skipVar := true) : RingM (Option RingExpr) := do
   let toVar (e : Expr) : RingM RingExpr := do
     return .var (← mkVar e)
   let asVar (e : Expr) : RingM RingExpr := do
@@ -112,59 +107,4 @@ partial def reify? (e : Expr) (skipVar := true) (gen : Nat := 0) : RingM (Option
     return some (.num k)
   | _ => toTopVar e
 
-private def reportSAppIssue (e : Expr) : GoalM Unit := do
-  reportIssue! "comm semiring term with unexpected instance{indentExpr e}"
-
-/--
-Similar to `reify?` but for `CommSemiring`
--/
-partial def sreify? (e : Expr) : SemiringM (Option SemiringExpr) := do
-  let toVar (e : Expr) : SemiringM SemiringExpr := do
-    return .var (← mkSVar e)
-  let asVar (e : Expr) : SemiringM SemiringExpr := do
-    reportSAppIssue e
-    return .var (← mkSVar e)
-  let rec go (e : Expr) : SemiringM SemiringExpr := do
-    match_expr e with
-    | HAdd.hAdd _ _ _ i a b =>
-      if isSameExpr (← getSemiring).addFn.appArg! i then return .add (← go a) (← go b) else asVar e
-    | HMul.hMul _ _ _ i a b =>
-      if isSameExpr (← getSemiring).mulFn.appArg! i then return .mul (← go a) (← go b) else asVar e
-    | HPow.hPow _ _ _ i a b =>
-      let some k ← getNatValue? b | toVar e
-      if isSameExpr (← getSemiring).powFn.appArg! i then return .pow (← go a) k else asVar e
-    | NatCast.natCast _ i a =>
-      if isSameExpr (← getSemiring).natCastFn.appArg! i then
-        let some k ← getNatValue? a | toVar e
-        return .num k
-      else
-        asVar e
-    | OfNat.ofNat _ n _ =>
-      let some k ← getNatValue? n | toVar e
-      return .num k
-    | _ => toVar e
-  let toTopVar (e : Expr) : SemiringM (Option SemiringExpr) := do
-    return some (← toVar e)
-  let asTopVar (e : Expr) : SemiringM (Option SemiringExpr) := do
-    reportSAppIssue e
-    toTopVar e
-  match_expr e with
-  | HAdd.hAdd _ _ _ i a b =>
-    if isSameExpr (← getSemiring).addFn.appArg! i then return some (.add (← go a) (← go b)) else asTopVar e
-  | HMul.hMul _ _ _ i a b =>
-    if isSameExpr (← getSemiring).mulFn.appArg! i then return some (.mul (← go a) (← go b)) else asTopVar e
-  | HPow.hPow _ _ _ i a b =>
-    let some k ← getNatValue? b | return none
-    if isSameExpr (← getSemiring).powFn.appArg! i then return some (.pow (← go a) k) else asTopVar e
-  | NatCast.natCast _ i a =>
-    if isSameExpr (← getSemiring).natCastFn.appArg! i then
-      let some k ← getNatValue? a | toTopVar e
-      return some (.num k)
-    else
-      asTopVar e
-  | OfNat.ofNat _ n _ =>
-    let some k ← getNatValue? n | asTopVar e
-    return some (.num k)
-  | _ => toTopVar e
-
 end  Lean.Meta.Grind.Arith.CommRing

src/Lean/Meta/Tactic/Grind/Arith/CommRing/RingId.lean

@@ -5,7 +5,6 @@ Authors: Leonardo de Moura
 -/
 prelude
 import Init.Grind.Ring.Field
-import Init.Grind.Ring.Envelope
 import Lean.Meta.Tactic.Grind.Simp
 import Lean.Meta.Tactic.Grind.Arith.CommRing.Util
 
@@ -147,51 +146,11 @@ where
     else
       pure none
     let one ← shareCommon <| (← canon <| denoteNumCore u type semiringInst negFn 1)
-    let semiringId? := none
     let id := (← get').rings.size
     let ring : Ring := {
-      id, semiringId?, type, u, semiringInst, ringInst, commSemiringInst,
-      commRingInst, charInst?, noZeroDivInst?, fieldInst?,
+      id, type, u, semiringInst, ringInst, commSemiringInst, commRingInst, charInst?, noZeroDivInst?, fieldInst?,
       addFn, mulFn, subFn, negFn, powFn, intCastFn, natCastFn, invFn?, one }
     modify' fun s => { s with rings := s.rings.push ring }
     return some id
 
-private def setSemiringId (ringId : Nat) (semiringId : Nat) : GoalM Unit := do
-  RingM.run ringId do modifyRing fun s => { s with semiringId? := some semiringId }
-
-def getSemiringId? (type : Expr) : GoalM (Option Nat) := do
-  if let some id? := (← get').stypeIdOf.find? { expr := type } then
-    return id?
-  else
-    let id? ← go?
-    modify' fun s => { s with stypeIdOf := s.stypeIdOf.insert { expr := type } id? }
-    return id?
-where
-  go? : GoalM (Option Nat) := do
-    let u ← getDecLevel type
-    let semiring := mkApp (mkConst ``Grind.Semiring [u]) type
-    let .some semiringInst ← trySynthInstance semiring | return none
-    let commSemiring := mkApp (mkConst ``Grind.CommSemiring [u]) type
-    let .some commSemiringInst ← trySynthInstance commSemiring | return none
-    let toQFn ← internalizeFn <| mkApp2 (mkConst ``Grind.Ring.OfSemiring.toQ [u]) type semiringInst
-    let addFn ← getAddFn type u
-    let mulFn ← getMulFn type u
-    let powFn ← getPowFn type u semiringInst
-    let natCastFn ← getNatCastFn type u semiringInst
-    let add := mkApp (mkConst ``Add [u]) type
-    let .some addInst ← trySynthInstance add | return none
-    let addRightCancel := mkApp2 (mkConst ``Grind.AddRightCancel [u]) type addInst
-    let addRightCancelInst? ← LOption.toOption <$> trySynthInstance addRightCancel
-    let q ← shareCommon (← canon (mkApp2 (mkConst ``Grind.Ring.OfSemiring.Q [u]) type semiringInst))
-    let some ringId ← getRingId? q
-      | throwError "`grind` unexpected failure, failure to initialize ring{indentExpr q}"
-    let id := (← get').semirings.size
-    let semiring : Semiring := {
-      id, type, ringId, u, semiringInst, commSemiringInst,
-      addFn, mulFn, powFn, natCastFn, toQFn, addRightCancelInst?
-    }
-    modify' fun s => { s with semirings := s.semirings.push semiring }
-    setSemiringId ringId id
-    return some id
-
 end Lean.Meta.Grind.Arith.CommRing

src/Lean/Meta/Tactic/Grind/Arith/CommRing/ToExpr.lean

@@ -5,7 +5,6 @@ Authors: Leonardo de Moura
 -/
 prelude
 import Init.Grind.Ring.Poly
-import Init.Grind.Ring.OfSemiring
 import Lean.ToExpr
 
 namespace Lean.Meta.Grind.Arith.CommRing
@@ -64,16 +63,4 @@ instance : ToExpr CommRing.NullCert where
   toExpr := ofNullCert
   toTypeExpr := mkConst ``CommRing.NullCert
 
-def ofSemiringExpr (e : Ring.OfSemiring.Expr) : Expr :=
-  match e with
-  | .num k => mkApp (mkConst ``Ring.OfSemiring.Expr.num) (toExpr k)
-  | .var x => mkApp (mkConst ``Ring.OfSemiring.Expr.var) (toExpr x)
-  | .add a b => mkApp2 (mkConst ``Ring.OfSemiring.Expr.add) (ofSemiringExpr a) (ofSemiringExpr b)
-  | .mul a b => mkApp2 (mkConst ``Ring.OfSemiring.Expr.mul) (ofSemiringExpr a) (ofSemiringExpr b)
-  | .pow a k => mkApp2 (mkConst ``Ring.OfSemiring.Expr.pow) (ofSemiringExpr a) (toExpr k)
-
-instance : ToExpr Ring.OfSemiring.Expr where
-  toExpr := ofSemiringExpr
-  toTypeExpr := mkConst ``Ring.OfSemiring.Expr
-
 end Lean.Meta.Grind.Arith.CommRing

src/Lean/Meta/Tactic/Grind/Arith/CommRing/Types.lean

@@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Leonardo de Moura
 -/
 prelude
-import Init.Grind.Ring.OfSemiring
 import Lean.Data.PersistentArray
 import Lean.Data.RBTree
 import Lean.Meta.Tactic.Grind.ExprPtr
@@ -14,9 +13,9 @@ import Lean.Meta.Tactic.Grind.Arith.CommRing.Poly
 namespace Lean.Meta.Grind.Arith.CommRing
 export Lean.Grind.CommRing (Var Power Mon Poly)
 abbrev RingExpr := Grind.CommRing.Expr
-abbrev SemiringExpr := Grind.Ring.OfSemiring.Expr
 
 mutual
+
 structure EqCnstr where
   p     : Poly
   h     : EqCnstrProof
@@ -25,11 +24,11 @@ structure EqCnstr where
 
 inductive EqCnstrProof where
   | core (a b : Expr) (ra rb : RingExpr)
-  | coreS (a b : Expr) (sa sb : SemiringExpr) (ra rb : RingExpr)
   | superpose (k₁ : Int) (m₁ : Mon) (c₁ : EqCnstr) (k₂ : Int) (m₂ : Mon) (c₂ : EqCnstr)
   | simp (k₁ : Int) (c₁ : EqCnstr) (k₂ : Int) (m₂ : Mon) (c₂ : EqCnstr)
   | mul (k : Int) (e : EqCnstr)
   | div (k : Int) (e : EqCnstr)
+
 end
 
 instance : Inhabited EqCnstrProof where
@@ -124,20 +123,10 @@ structure DiseqCnstr where
   rrhs : RingExpr
   /-- `lhs - rhs` simplification chain. If it becomes `0` we have an inconsistency. -/
   d : PolyDerivation
-  /--
-  If `lhs` and `rhs` are semiring expressions that have been adapted as ring ones.
-  The respective semiring reified expressions are stored here.
-  -/
-  ofSemiring? : Option (SemiringExpr × SemiringExpr)
 
 /-- State for each `CommRing` processed by this module. -/
 structure Ring where
   id             : Nat
-  /--
-  If this is a `OfSemiring.Q α` ring, this field contain the
-  `semiringId` for `α`.
-  -/
-  semiringId?    : Option Nat
   type           : Expr
   /-- Cached `getDecLevel type` -/
   u              : Level
@@ -198,39 +187,6 @@ structure Ring where
   invSet         : PHashSet Expr := {}
   deriving Inhabited
 
-/--
-State for each `CommSemiring` processed by this module.
-Recall that `CommSemiring` are processed using the envelop `OfCommSemiring.Q`
--/
-structure Semiring where
-  id             : Nat
-  /-- Id for `OfCommSemiring.Q` -/
-  ringId         : Nat
-  type           : Expr
-  /-- Cached `getDecLevel type` -/
-  u              : Level
-  /-- `Semiring` instance for `type` -/
-  semiringInst   : Expr
-  /-- `CommSemiring` instance for `type` -/
-  commSemiringInst   : Expr
-  /-- `AddRightCancel` instance for `type` if available. -/
-  addRightCancelInst? : Option Expr
-  toQFn          : Expr
-  addFn          : Expr
-  mulFn          : Expr
-  powFn          : Expr
-  natCastFn      : Expr
-  /-- Mapping from Lean expressions to their representations as `SemiringExpr` -/
-  denote         : PHashMap ExprPtr SemiringExpr := {}
-  /--
-  Mapping from variables to their denotations.
-  Remark each variable can be in only one ring.
-  -/
-  vars           : PArray Expr := {}
-  /-- Mapping from `Expr` to a variable representing it. -/
-  varMap         : PHashMap ExprPtr Var := {}
-  deriving Inhabited
-
 /-- State for all `CommRing` types detected by `grind`. -/
 structure State where
   /--
@@ -244,19 +200,6 @@ structure State where
   typeIdOf : PHashMap ExprPtr (Option Nat) := {}
   /- Mapping from expressions/terms to their ring ids. -/
   exprToRingId : PHashMap ExprPtr Nat := {}
-  /-- Commutative semirings. We support them using the envelope `OfCommRing.Q` -/
-  semirings : Array Semiring := {}
-  /--
-  Mapping from types to its "semiring id". We cache failures using `none`.
-  `stypeIdOf[type]` is `some id`, then `id < semirings.size`.
-  If a type is in this map, it is not in `typeIdOf`.
-  -/
-  stypeIdOf : PHashMap ExprPtr (Option Nat) := {}
-  /-
-  Mapping from expressions/terms to their semiring ids.
-  If an expression is in this map, it is not in `exprToRingId`.
-  -/
-  exprToSemiringId : PHashMap ExprPtr Nat := {}
   steps := 0
   deriving Inhabited
 

src/Lean/Meta/Tactic/Grind/Arith/CommRing/Util.lean

@@ -69,40 +69,6 @@ instance : MonadGetRing RingM where
   let ringId ← getRingId
   modify' fun s => { s with rings := s.rings.modify ringId f }
 
-structure SemiringM.Context where
-  semiringId : Nat
-
-abbrev SemiringM := ReaderT SemiringM.Context GoalM
-
-abbrev SemiringM.run (semiringId : Nat) (x : SemiringM α) : GoalM α :=
-  x { semiringId }
-
-abbrev getSemiringId : SemiringM Nat :=
-  return (← read).semiringId
-
-def getSemiring : SemiringM Semiring := do
-  let s ← get'
-  let semiringId ← getSemiringId
-  if h : semiringId < s.semirings.size then
-    return s.semirings[semiringId]
-  else
-    throwError "`grind` internal error, invalid semiringId"
-
-protected def SemiringM.getRing : SemiringM Ring := do
-  let s ← get'
-  let ringId := (← getSemiring).ringId
-  if h : ringId < s.rings.size then
-    return s.rings[ringId]
-  else
-    throwError "`grind` internal error, invalid ringId"
-
-instance : MonadGetRing SemiringM where
-  getRing := SemiringM.getRing
-
-@[inline] def modifySemiring (f : Semiring → Semiring) : SemiringM Unit := do
-  let semiringId ← getSemiringId
-  modify' fun s => { s with semirings := s.semirings.modify semiringId f }
-
 abbrev withCheckCoeffDvd (x : RingM α) : RingM α :=
   withReader (fun ctx => { ctx with checkCoeffDvd := true }) x
 
@@ -120,17 +86,6 @@ def setTermRingId (e : Expr) : RingM Unit := do
     return ()
   modify' fun s => { s with exprToRingId := s.exprToRingId.insert { expr := e } ringId }
 
-def getTermSemiringId? (e : Expr) : GoalM (Option Nat) := do
-  return (← get').exprToSemiringId.find? { expr := e }
-
-def setTermSemiringId (e : Expr) : SemiringM Unit := do
-  let semiringId ← getSemiringId
-  if let some semiringId' ← getTermSemiringId? e then
-    unless semiringId' == semiringId do
-      reportIssue! "expression in two different semirings{indentExpr e}"
-    return ()
-  modify' fun s => { s with exprToSemiringId := s.exprToSemiringId.insert { expr := e } semiringId }
-
 /-- Returns `some c` if the current ring has a nonzero characteristic `c`. -/
 def nonzeroChar? [Monad m] [MonadGetRing m] : m (Option Nat) := do
   if let some (_, c) := (← getRing).charInst? then

src/Lean/Meta/Tactic/Grind/Arith/CommRing/Var.lean

@@ -21,18 +21,4 @@ def mkVar (e : Expr) : RingM Var := do
   markAsCommRingTerm e
   return var
 
-/-- Similar to `mkVar` but for `Semiring`s -/
-def mkSVar (e : Expr) : SemiringM Var := do
-  let s ← getSemiring
-  if let some var := s.varMap.find? { expr := e } then
-    return var
-  let var : Var := s.vars.size
-  modifySemiring fun s => { s with
-    vars       := s.vars.push e
-    varMap     := s.varMap.insert { expr := e } var
-  }
-  setTermSemiringId e
-  markAsCommRingTerm e
-  return var
-
 end Lean.Meta.Grind.Arith.CommRing

src/Lean/Meta/Tactic/Grind/Arith/Cutsat.lean

@@ -17,7 +17,6 @@ import Lean.Meta.Tactic.Grind.Arith.Cutsat.EqCnstr
 import Lean.Meta.Tactic.Grind.Arith.Cutsat.SearchM
 import Lean.Meta.Tactic.Grind.Arith.Cutsat.Model
 import Lean.Meta.Tactic.Grind.Arith.Cutsat.MBTC
-import Lean.Meta.Tactic.Grind.Arith.Cutsat.Nat
 
 namespace Lean
 

src/Lean/Meta/Tactic/Grind/Arith/Cutsat/Nat.lean

@@ -22,7 +22,6 @@ protected def toExpr (e : Expr) : Lean.Expr :=
   | .mul a b  => mkApp2 (mkConst ``mul) (OfNat.toExpr a) (OfNat.toExpr b)
   | .div a b  => mkApp2 (mkConst ``div) (OfNat.toExpr a) (OfNat.toExpr b)
   | .mod a b  => mkApp2 (mkConst ``mod) (OfNat.toExpr a) (OfNat.toExpr b)
-  | .pow a k  => mkApp2 (mkConst ``pow) (OfNat.toExpr a) (mkNatLit k)
 
 instance : ToExpr OfNat.Expr where
   toExpr a := OfNat.toExpr a
@@ -44,7 +43,6 @@ where
     | .mul a b  => mkIntMul (go a) (go b)
     | .div a b  => mkIntDiv (go a) (go b)
     | .mod a b  => mkIntMod (go a) (go b)
-    | .pow a b  => mkIntPowNat (go a) (mkNatLit b)
 
 partial def toOfNatExpr (e : Lean.Expr) : GoalM Expr := do
   let mkVar (e : Lean.Expr) : GoalM Expr := do
@@ -68,10 +66,6 @@ partial def toOfNatExpr (e : Lean.Expr) : GoalM Expr := do
   | HMod.hMod _ _ _ i a b =>
     if (← isInstHModNat i) then return .mod (← toOfNatExpr a) (← toOfNatExpr b)
     else mkVar e
-  | HPow.hPow _ _ _ i a b =>
-    let some k ← getNatValue? b | mkVar e
-    if (← isInstHPowNat i) then return .pow (← toOfNatExpr a) k
-    else mkVar e
   | _ => mkVar e
 
 /--

src/Lean/Meta/Tactic/Grind/Arith/Linear/Proof.lean

@@ -143,21 +143,21 @@ private def mkIntModPreThmPrefix (declName : Name) : ProofM Expr := do
 
 /--
 Returns the prefix of a theorem with name `declName` where the first five arguments are
-`{α} [IntModule α] [Preorder α] [OrderedAdd α] (ctx : Context α)`
+`{α} [IntModule α] [Preorder α] [IntModule.IsOrdered α] (ctx : Context α)`
 This is the most common theorem prefix at `Linarith.lean`
 -/
 private def mkIntModPreOrdThmPrefix (declName : Name) : ProofM Expr := do
   let s ← getStruct
-  return mkApp5 (mkConst declName [s.u]) s.type s.intModuleInst (← getPreorderInst) (← getOrderedAddInst) (← getContext)
+  return mkApp5 (mkConst declName [s.u]) s.type s.intModuleInst (← getPreorderInst) (← getIsOrdInst) (← getContext)
 
 /--
 Returns the prefix of a theorem with name `declName` where the first five arguments are
-`{α} [IntModule α] [LinearOrder α] [OrderedAdd α] (ctx : Context α)`
+`{α} [IntModule α] [LinearOrder α] [IntModule.IsOrdered α] (ctx : Context α)`
 This is the most common theorem prefix at `Linarith.lean`
 -/
 private def mkIntModLinOrdThmPrefix (declName : Name) : ProofM Expr := do
   let s ← getStruct
-  return mkApp5 (mkConst declName [s.u]) s.type s.intModuleInst (← getLinearOrderInst) (← getOrderedAddInst) (← getContext)
+  return mkApp5 (mkConst declName [s.u]) s.type s.intModuleInst (← getLinearOrderInst) (← getIsOrdInst) (← getContext)
 
 /--
 Returns the prefix of a theorem with name `declName` where the first three arguments are
@@ -169,19 +169,19 @@ private def mkCommRingThmPrefix (declName : Name) : ProofM Expr := do
 
 /--
 Returns the prefix of a theorem with name `declName` where the first five arguments are
-`{α} [CommRing α] [Preorder α] [OrderedRing α] (rctx : Context α)`
+`{α} [CommRing α] [Preorder α] [Ring.IsOrdered α] (rctx : Context α)`
 -/
 private def mkCommRingPreOrdThmPrefix (declName : Name) : ProofM Expr := do
   let s ← getStruct
-  return mkApp5 (mkConst declName [s.u]) s.type (← getCommRingInst) (← getPreorderInst) (← getOrderedRingInst) (← getRingContext)
+  return mkApp5 (mkConst declName [s.u]) s.type (← getCommRingInst) (← getPreorderInst) (← getRingIsOrdInst) (← getRingContext)
 
 /--
 Returns the prefix of a theorem with name `declName` where the first five arguments are
-`{α} [CommRing α] [LinearOrder α] [OrderedRing α] (rctx : Context α)`
+`{α} [CommRing α] [LinearOrder α] [Ring.IsOrdered α] (rctx : Context α)`
 -/
 private def mkCommRingLinOrdThmPrefix (declName : Name) : ProofM Expr := do
   let s ← getStruct
-  return mkApp5 (mkConst declName [s.u]) s.type (← getCommRingInst) (← getLinearOrderInst) (← getOrderedRingInst) (← getRingContext)
+  return mkApp5 (mkConst declName [s.u]) s.type (← getCommRingInst) (← getLinearOrderInst) (← getRingIsOrdInst) (← getRingContext)
 
 mutual
 partial def IneqCnstr.toExprProof (c' : IneqCnstr) : ProofM Expr := caching c' do
@@ -213,7 +213,7 @@ partial def IneqCnstr.toExprProof (c' : IneqCnstr) : ProofM Expr := caching c' d
       (← c₁.toExprProof) (← c₂.toExprProof)
   | .oneGtZero =>
     let s ← getStruct
-    let h := mkApp5 (mkConst ``Grind.Linarith.zero_lt_one [s.u]) s.type (← getRingInst) (← getPreorderInst) (← getOrderedRingInst) (← getContext)
+    let h := mkApp5 (mkConst ``Grind.Linarith.zero_lt_one [s.u]) s.type (← getRingInst) (← getPreorderInst) (← getRingIsOrdInst) (← getContext)
     return mkApp3 h (← mkPolyDecl c'.p) reflBoolTrue (← mkEqRefl (← getOne))
   | .ofEq a b la lb =>
     let h ← mkIntModPreOrdThmPrefix ``Grind.Linarith.le_of_eq

src/Lean/Meta/Tactic/Grind/Arith/Linear/PropagateEq.lean

@@ -224,7 +224,7 @@ def processNewEqImpl (a b : Expr) : GoalM Unit := do
   if isSameExpr a b then return () -- TODO: check why this is needed
   let some structId ← inSameStruct? a b | return ()
   LinearM.run structId do
-    if (← isOrderedAdd) then
+    if (← isOrdered) then
       trace_goal[grind.linarith.assert] "{← mkEq a b}"
       if (← isCommRing) then
         processNewCommRingEq' a b

src/Lean/Meta/Tactic/Grind/Arith/Linear/StructId.lean

@@ -132,12 +132,12 @@ where
     ensureToFieldDefEq hmulInst intModuleInst ``Grind.IntModule.hmulInt
     ensureToFieldDefEq hmulNatInst intModuleInst ``Grind.IntModule.hmulNat
     let preorderInst? ← getInst? ``Grind.Preorder
-    let orderedAddInst? ← if let some preorderInst := preorderInst? then
-      let isOrderedType := mkApp3 (mkConst ``Grind.OrderedAdd [u]) type addInst preorderInst
+    let isOrdInst? ← if let some preorderInst := preorderInst? then
+      let isOrderedType := mkApp3 (mkConst ``Grind.IntModule.IsOrdered [u]) type preorderInst intModuleInst
       pure <| LOption.toOption (← trySynthInstance isOrderedType)
     else
       pure none
-    let preorderInst? := if orderedAddInst?.isNone then none else preorderInst?
+    let preorderInst? := if isOrdInst?.isNone then none else preorderInst?
     let partialInst? ← checkToFieldDefEq? preorderInst? (← getInst? ``Grind.PartialOrder) ``Grind.PartialOrder.toPreorder
     let linearInst? ← checkToFieldDefEq? partialInst? (← getInst? ``Grind.LinearOrder) ``Grind.LinearOrder.toPartialOrder
     let (leFn?, ltFn?) ← if let some preorderInst := preorderInst? then
@@ -172,15 +172,15 @@ where
       return some one
     let one? ← getOne?
     let commRingInst? ← getInst? ``Grind.CommRing
-    let getOrderedRingInst? : GoalM (Option Expr) := do
+    let getRingIsOrdInst? : GoalM (Option Expr) := do
       let some ringInst := ringInst? | return none
       let some preorderInst := preorderInst? | return none
-      let isOrdType := mkApp3 (mkConst ``Grind.OrderedRing [u]) type ringInst preorderInst
+      let isOrdType := mkApp3 (mkConst ``Grind.Ring.IsOrdered [u]) type ringInst preorderInst
       let .some inst ← trySynthInstance isOrdType
-        | reportIssue! "type has a `Preorder` and is a `Ring`, but is not an ordered ring, failed to synthesize{indentExpr isOrdType}"
+        | reportIssue! "type is an ordered `IntModule` and a `Ring`, but is not an ordered ring, failed to synthesize{indentExpr isOrdType}"
           return none
       return some inst
-    let orderedRingInst? ← getOrderedRingInst?
+    let ringIsOrdInst? ← getRingIsOrdInst?
     let charInst? ← if let some semiringInst := semiringInst? then getIsCharInst? u type semiringInst else pure none
     let getNoNatZeroDivInst? : GoalM (Option Expr) := do
       let hmulNat := mkApp3 (mkConst ``HMul [0, u, u]) Nat.mkType type type
@@ -190,14 +190,14 @@ where
     let noNatDivInst? ← getNoNatZeroDivInst?
     let id := (← get').structs.size
     let struct : Struct := {
-      id, type, u, intModuleInst, preorderInst?, orderedAddInst?, partialInst?, linearInst?, noNatDivInst?
+      id, type, u, intModuleInst, preorderInst?, isOrdInst?, partialInst?, linearInst?, noNatDivInst?
       leFn?, ltFn?, addFn, subFn, negFn, hmulFn, hmulNatFn, hsmulFn?, hsmulNatFn?, zero, one?
-      ringInst?, commRingInst?, orderedRingInst?, charInst?, ringId?, fieldInst?, ofNatZero
+      ringInst?, commRingInst?, ringIsOrdInst?, charInst?, ringId?, fieldInst?, ofNatZero
     }
     modify' fun s => { s with structs := s.structs.push struct }
     if let some one := one? then
       if ringInst?.isSome then LinearM.run id do
-        if orderedRingInst?.isSome then
+        if ringIsOrdInst?.isSome then
           -- Create `1` variable, and assert strict lower bound `0 < 1` and `0 ≠ 1`
           let x ← mkVar one (mark := false)
           addZeroLtOne x