refactor: simplify inferface between core and offset module

`processNewEqLit` optimization is not worth the extra complexity.

src/Init/Control/Lawful.lean

@@ -9,3 +9,4 @@ prelude
 import Init.Control.Lawful.Basic
 import Init.Control.Lawful.Instances
 import Init.Control.Lawful.Lemmas
+import Init.Control.Lawful.MonadLift

src/Init/Control/Lawful/MonadLift.lean

@@ -0,0 +1,11 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+module
+
+prelude
+import Init.Control.Lawful.MonadLift.Basic
+import Init.Control.Lawful.MonadLift.Lemmas
+import Init.Control.Lawful.MonadLift.Instances

src/Init/Control/Lawful/MonadLift/Basic.lean

@@ -0,0 +1,52 @@
+/-
+Copyright (c) 2025 Quang Dao. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Quang Dao
+-/
+module
+
+prelude
+import Init.Control.Basic
+
+/-!
+# LawfulMonadLift and LawfulMonadLiftT
+
+This module provides classes asserting that `MonadLift` and `MonadLiftT` are lawful, which means
+that `monadLift` is compatible with `pure` and `bind`.
+-/
+
+section MonadLift
+
+/-- The `MonadLift` typeclass only contains the lifting operation. `LawfulMonadLift` further
+  asserts that lifting commutes with `pure` and `bind`:
+```
+monadLift (pure a) = pure a
+monadLift (ma >>= f) = monadLift ma >>= monadLift ∘ f
+```
+-/
+class LawfulMonadLift (m : semiOutParam (Type u → Type v)) (n : Type u → Type w)
+    [Monad m] [Monad n] [inst : MonadLift m n] : Prop where
+  /-- Lifting preserves `pure` -/
+  monadLift_pure {α : Type u} (a : α) : inst.monadLift (pure a) = pure a
+  /-- Lifting preserves `bind` -/
+  monadLift_bind {α β : Type u} (ma : m α) (f : α → m β) :
+    inst.monadLift (ma >>= f) = inst.monadLift ma >>= (fun x => inst.monadLift (f x))
+
+/-- The `MonadLiftT` typeclass only contains the transitive lifting operation.
+  `LawfulMonadLiftT` further asserts that lifting commutes with `pure` and `bind`:
+```
+monadLift (pure a) = pure a
+monadLift (ma >>= f) = monadLift ma >>= monadLift ∘ f
+```
+-/
+class LawfulMonadLiftT (m : Type u → Type v) (n : Type u → Type w) [Monad m] [Monad n]
+    [inst : MonadLiftT m n] : Prop where
+  /-- Lifting preserves `pure` -/
+  monadLift_pure {α : Type u} (a : α) : inst.monadLift (pure a) = pure a
+  /-- Lifting preserves `bind` -/
+  monadLift_bind {α β : Type u} (ma : m α) (f : α → m β) :
+    inst.monadLift (ma >>= f) = monadLift ma >>= (fun x => monadLift (f x))
+
+export LawfulMonadLiftT (monadLift_pure monadLift_bind)
+
+end MonadLift

src/Init/Control/Lawful/MonadLift/Instances.lean

@@ -0,0 +1,137 @@
+/-
+Copyright (c) 2025 Quang Dao. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Quang Dao, Paul Reichert
+-/
+module
+
+prelude
+import all Init.Control.Option
+import all Init.Control.Except
+import all Init.Control.ExceptCps
+import all Init.Control.StateRef
+import all Init.Control.StateCps
+import Init.Control.Lawful.MonadLift.Lemmas
+import Init.Control.Lawful.Instances
+
+universe u v w x
+
+variable {m : Type u → Type v} {n : Type u → Type w} {o : Type u → Type x}
+
+variable (m n o) in
+instance [Monad m] [Monad n] [Monad o] [MonadLift n o] [MonadLiftT m n]
+    [LawfulMonadLift n o] [LawfulMonadLiftT m n] : LawfulMonadLiftT m o where
+  monadLift_pure := fun a => by
+    simp only [monadLift, LawfulMonadLift.monadLift_pure, liftM_pure]
+  monadLift_bind := fun ma f => by
+    simp only [monadLift, LawfulMonadLift.monadLift_bind, liftM_bind]
+
+variable (m) in
+instance [Monad m] : LawfulMonadLiftT m m where
+  monadLift_pure _ := rfl
+  monadLift_bind _ _ := rfl
+
+namespace StateT
+
+variable [Monad m] [LawfulMonad m]
+
+instance {σ : Type u} : LawfulMonadLift m (StateT σ m) where
+  monadLift_pure _ := by ext; simp [MonadLift.monadLift]
+  monadLift_bind _ _ := by ext; simp [MonadLift.monadLift]
+
+end StateT
+
+namespace ReaderT
+
+variable [Monad m]
+
+instance {ρ : Type u} : LawfulMonadLift m (ReaderT ρ m) where
+  monadLift_pure _ := rfl
+  monadLift_bind _ _ := rfl
+
+end ReaderT
+
+namespace OptionT
+
+variable [Monad m] [LawfulMonad m]
+
+@[simp]
+theorem lift_pure {α : Type u} (a : α) : OptionT.lift (pure a : m α) = pure a := by
+  simp only [OptionT.lift, OptionT.mk, bind_pure_comp, map_pure, pure, OptionT.pure]
+
+@[simp]
+theorem lift_bind {α β : Type u} (ma : m α) (f : α → m β) :
+    OptionT.lift (ma >>= f) = OptionT.lift ma >>= (fun a => OptionT.lift (f a)) := by
+  simp only [instMonad, OptionT.bind, OptionT.mk, OptionT.lift, bind_pure_comp, bind_map_left,
+    map_bind]
+
+instance : LawfulMonadLift m (OptionT m) where
+  monadLift_pure := lift_pure
+  monadLift_bind := lift_bind
+
+end OptionT
+
+namespace ExceptT
+
+variable [Monad m] [LawfulMonad m]
+
+@[simp]
+theorem lift_bind {α β ε : Type u} (ma : m α) (f : α → m β) :
+    ExceptT.lift (ε := ε) (ma >>= f) = ExceptT.lift ma >>= (fun a => ExceptT.lift (f a)) := by
+  simp only [instMonad, ExceptT.bind, mk, ExceptT.lift, bind_map_left, ExceptT.bindCont, map_bind]
+
+instance : LawfulMonadLift m (ExceptT ε m) where
+  monadLift_pure := lift_pure
+  monadLift_bind := lift_bind
+
+instance : LawfulMonadLift (Except ε) (ExceptT ε m) where
+  monadLift_pure _ := by
+    simp only [MonadLift.monadLift, mk, pure, Except.pure, ExceptT.pure]
+  monadLift_bind ma _ := by
+    simp only [instMonad, ExceptT.bind, mk, MonadLift.monadLift, pure_bind, ExceptT.bindCont,
+      Except.instMonad, Except.bind]
+    rcases ma with _ | _ <;> simp
+
+end ExceptT
+
+namespace StateRefT'
+
+instance {ω σ : Type} {m : Type → Type} [Monad m] : LawfulMonadLift m (StateRefT' ω σ m) where
+  monadLift_pure _ := by
+    simp only [MonadLift.monadLift, pure]
+    unfold StateRefT'.lift ReaderT.pure
+    simp only
+  monadLift_bind _ _ := by
+    simp only [MonadLift.monadLift, bind]
+    unfold StateRefT'.lift ReaderT.bind
+    simp only
+
+end StateRefT'
+
+namespace StateCpsT
+
+instance {σ : Type u} [Monad m] [LawfulMonad m] : LawfulMonadLift m (StateCpsT σ m) where
+  monadLift_pure _ := by
+    simp only [MonadLift.monadLift, pure]
+    unfold StateCpsT.lift
+    simp only [pure_bind]
+  monadLift_bind _ _ := by
+    simp only [MonadLift.monadLift, bind]
+    unfold StateCpsT.lift
+    simp only [bind_assoc]
+
+end StateCpsT
+
+namespace ExceptCpsT
+
+instance {ε : Type u} [Monad m] [LawfulMonad m] : LawfulMonadLift m (ExceptCpsT ε m) where
+  monadLift_pure _ := by
+    simp only [MonadLift.monadLift, pure]
+    unfold ExceptCpsT.lift
+    simp only [pure_bind]
+  monadLift_bind _ _ := by
+    simp only [MonadLift.monadLift, bind]
+    unfold ExceptCpsT.lift
+    simp only [bind_assoc]
+
+end ExceptCpsT

src/Init/Control/Lawful/MonadLift/Lemmas.lean

@@ -0,0 +1,63 @@
+/-
+Copyright (c) 2025 Quang Dao. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Quang Dao
+-/
+module
+
+prelude
+import Init.Control.Lawful.Basic
+import Init.Control.Lawful.MonadLift.Basic
+
+universe u v w
+
+variable {m : Type u → Type v} {n : Type u → Type w} [Monad m] [Monad n] [MonadLiftT m n]
+  [LawfulMonadLiftT m n] {α β : Type u}
+
+theorem monadLift_map [LawfulMonad m] [LawfulMonad n] (f : α → β) (ma : m α) :
+    monadLift (f <$> ma) = f <$> (monadLift ma : n α) := by
+  rw [← bind_pure_comp, ← bind_pure_comp, monadLift_bind]
+  simp only [bind_pure_comp, monadLift_pure]
+
+theorem monadLift_seq [LawfulMonad m] [LawfulMonad n] (mf : m (α → β)) (ma : m α) :
+    monadLift (mf <*> ma) = monadLift mf <*> (monadLift ma : n α) := by
+  simp only [seq_eq_bind, monadLift_map, monadLift_bind]
+
+theorem monadLift_seqLeft [LawfulMonad m] [LawfulMonad n] (x : m α) (y : m β) :
+    monadLift (x <* y) = (monadLift x : n α) <* (monadLift y : n β) := by
+  simp only [seqLeft_eq, monadLift_map, monadLift_seq]
+
+theorem monadLift_seqRight [LawfulMonad m] [LawfulMonad n] (x : m α) (y : m β) :
+    monadLift (x *> y) = (monadLift x : n α) *> (monadLift y : n β) := by
+  simp only [seqRight_eq, monadLift_map, monadLift_seq]
+
+/-! We duplicate the theorems for `monadLift` to `liftM` since `rw` matches on syntax only. -/
+
+@[simp]
+theorem liftM_pure (a : α) : liftM (pure a : m α) = pure (f := n) a :=
+  monadLift_pure _
+
+@[simp]
+theorem liftM_bind (ma : m α) (f : α → m β) :
+    liftM (n := n) (ma >>= f) = liftM ma >>= (fun a => liftM (f a)) :=
+  monadLift_bind _ _
+
+@[simp]
+theorem liftM_map [LawfulMonad m] [LawfulMonad n] (f : α → β) (ma : m α) :
+    liftM (f <$> ma) = f <$> (liftM ma : n α) :=
+  monadLift_map _ _
+
+@[simp]
+theorem liftM_seq [LawfulMonad m] [LawfulMonad n] (mf : m (α → β)) (ma : m α) :
+    liftM (mf <*> ma) = liftM mf <*> (liftM ma : n α) :=
+  monadLift_seq _ _
+
+@[simp]
+theorem liftM_seqLeft [LawfulMonad m] [LawfulMonad n] (x : m α) (y : m β) :
+    liftM (x <* y) = (liftM x : n α) <* (liftM y : n β) :=
+  monadLift_seqLeft _ _
+
+@[simp]
+theorem liftM_seqRight [LawfulMonad m] [LawfulMonad n] (x : m α) (y : m β) :
+    liftM (x *> y) = (liftM x : n α) *> (liftM y : n β) :=
+  monadLift_seqRight _ _

src/Init/Data/BEq.lean

@@ -27,7 +27,7 @@ class EquivBEq (α) [BEq α] : Prop extends PartialEquivBEq α, ReflBEq α
 theorem BEq.symm [BEq α] [PartialEquivBEq α] {a b : α} : a == b → b == a :=
   PartialEquivBEq.symm
 
-@[grind] theorem BEq.comm [BEq α] [PartialEquivBEq α] {a b : α} : (a == b) = (b == a) :=
+theorem BEq.comm [BEq α] [PartialEquivBEq α] {a b : α} : (a == b) = (b == a) :=
   Bool.eq_iff_iff.2 ⟨BEq.symm, BEq.symm⟩
 
 theorem bne_comm [BEq α] [PartialEquivBEq α] {a b : α} : (a != b) = (b != a) := by

src/Init/Data/List/Basic.lean

@@ -2096,7 +2096,7 @@ where
   | 0,   acc => acc
   | n+1, acc => loop n (n::acc)
 
-@[simp] theorem range_zero : range 0 = [] := rfl
+@[simp, grind =] theorem range_zero : range 0 = [] := rfl
 
 /-! ### range' -/
 

src/Init/Data/List/Range.lean

@@ -142,6 +142,8 @@ theorem range'_eq_cons_iff : range' s n = a :: xs ↔ s = a ∧ 0 < n ∧ xs = r
 
 /-! ### range -/
 
+@[simp, grind =] theorem range_one : range 1 = [0] := rfl
+
 theorem range_loop_range' : ∀ s n, range.loop s (range' s n) = range' 0 (n + s)
   | 0, _ => rfl
   | s + 1, n => by rw [← Nat.add_assoc, Nat.add_right_comm n s 1]; exact range_loop_range' s (n + 1)

src/Init/Grind/Lemmas.lean

@@ -89,6 +89,12 @@ theorem beq_eq_true_of_eq {α : Type u} {_ : BEq α} {_ : LawfulBEq α} {a b :
 theorem beq_eq_false_of_diseq {α : Type u} {_ : BEq α} {_ : LawfulBEq α} {a b : α} (h : ¬ a = b) : (a == b) = false := by
   simp[*]
 
+theorem eq_of_beq_eq_true {α : Type u} {_ : BEq α} {_ : LawfulBEq α} {a b : α} (h : (a == b) = true) : a = b := by
+  simp [beq_iff_eq.mp h]
+
+theorem ne_of_beq_eq_false {α : Type u} {_ : BEq α} {_ : LawfulBEq α} {a b : α} (h : (a == b) = false) : (a = b) = False := by
+  simp [beq_eq_false_iff_ne.mp h]
+
 /-! Bool.and -/
 
 theorem Bool.and_eq_of_eq_true_left {a b : Bool} (h : a = true) : (a && b) = b := by simp [h]

src/Lean/Compiler/LCNF/Specialize.lean

@@ -80,6 +80,13 @@ def isGround [TraverseFVar α] (e : α) : SpecializeM Bool := do
   let fvarId := decl.fvarId
   withReader (fun { scope, ground, declName } => { declName, scope := scope.insert fvarId, ground := if grd then ground.insert fvarId else ground }) x
 
+@[inline] def withFunDecl (decl : FunDecl) (x : SpecializeM α) : SpecializeM α := do
+  let ctx ← read
+  let grd := allFVar (x := decl.value) fun fvarId =>
+    !(ctx.scope.contains fvarId) || ctx.ground.contains fvarId
+  let fvarId := decl.fvarId
+  withReader (fun { scope, ground, declName } => { declName, scope := scope.insert fvarId, ground := if grd then ground.insert fvarId else ground }) x
+
 namespace Collector
 /-!
 # Dependency collector for the code specialization function.
@@ -317,7 +324,11 @@ mutual
         decl ← decl.updateValue value
       let k ← withLetDecl decl <| visitCode k
       return code.updateLet! decl k
-    | .fun decl k | .jp decl k =>
+    | .fun decl k =>
+      let decl ← visitFunDecl decl
+      let k ← withFunDecl decl <| visitCode k
+      return code.updateFun! decl k
+    | .jp decl k =>
       let decl ← visitFunDecl decl
       let k ← withFVar decl.fvarId <| visitCode k
       return code.updateFun! decl k

src/Lean/Expr.lean

@@ -166,32 +166,13 @@ def BinderInfo.toUInt64 : BinderInfo → UInt64
   | .strictImplicit => 2
   | .instImplicit   => 3
 
-def Expr.mkData
-    (h : UInt64) (looseBVarRange : Nat := 0) (approxDepth : UInt32 := 0)
-    (hasFVar hasExprMVar hasLevelMVar hasLevelParam : Bool := false)
-    : Expr.Data :=
-  let approxDepth : UInt8 := if approxDepth > 255 then 255 else approxDepth.toUInt8
-  assert! (looseBVarRange ≤ Nat.pow 2 20 - 1)
-  let r : UInt64 :=
-      h.toUInt32.toUInt64 +
-      approxDepth.toUInt64.shiftLeft 32 +
-      hasFVar.toUInt64.shiftLeft 40 +
-      hasExprMVar.toUInt64.shiftLeft 41 +
-      hasLevelMVar.toUInt64.shiftLeft 42 +
-      hasLevelParam.toUInt64.shiftLeft 43 +
-      looseBVarRange.toUInt64.shiftLeft 44
-  r
+@[extern "lean_expr_mk_data"]
+opaque Expr.mkData (h : UInt64) (looseBVarRange : Nat := 0) (approxDepth : UInt32 := 0)
+    (hasFVar hasExprMVar hasLevelMVar hasLevelParam : Bool := false) : Expr.Data
 
 /-- Optimized version of `Expr.mkData` for applications. -/
-@[inline] def Expr.mkAppData (fData : Data) (aData : Data) : Data :=
-  let depth          := (max fData.approxDepth.toUInt16 aData.approxDepth.toUInt16) + 1
-  let approxDepth    := if depth > 255 then 255 else depth.toUInt8
-  let looseBVarRange := max fData.looseBVarRange aData.looseBVarRange
-  let hash           := mixHash fData aData
-  let fData : UInt64 := fData
-  let aData : UInt64 := aData
-  assert! (looseBVarRange ≤ (Nat.pow 2 20 - 1).toUInt32)
-  ((fData ||| aData) &&& ((15 : UInt64) <<< (40 : UInt64))) ||| hash.toUInt32.toUInt64 ||| (approxDepth.toUInt64 <<< (32 : UInt64)) ||| (looseBVarRange.toUInt64 <<< (44 : UInt64))
+@[extern "lean_expr_mk_app_data"]
+opaque Expr.mkAppData (fData : Data) (aData : Data) : Data
 
 @[inline] def Expr.mkDataForBinder (h : UInt64) (looseBVarRange : Nat) (approxDepth : UInt32) (hasFVar hasExprMVar hasLevelMVar hasLevelParam : Bool) : Expr.Data :=
   Expr.mkData h looseBVarRange approxDepth hasFVar hasExprMVar hasLevelMVar hasLevelParam

src/Lean/Level.lean

@@ -43,11 +43,8 @@ def Level.Data.hasMVar (c : Level.Data) : Bool :=
 def Level.Data.hasParam (c : Level.Data) : Bool :=
   ((c.shiftRight 33).land 1) == 1
 
-def Level.mkData (h : UInt64) (depth : Nat := 0) (hasMVar hasParam : Bool := false) : Level.Data :=
-  if depth > Nat.pow 2 24 - 1 then panic! "universe level depth is too big"
-  else
-    let r : UInt64 := h.toUInt32.toUInt64 + hasMVar.toUInt64.shiftLeft 32 + hasParam.toUInt64.shiftLeft 33 + depth.toUInt64.shiftLeft 40
-    r
+@[extern "lean_level_mk_data"]
+opaque Level.mkData (h : UInt64) (depth : Nat := 0) (hasMVar hasParam : Bool := false) : Level.Data
 
 instance : Repr Level.Data where
   reprPrec v prec := Id.run do

src/Lean/Meta/Tactic/Grind/AlphaShareCommon.lean

@@ -13,7 +13,7 @@ private def hashChild (e : Expr) : UInt64 :=
   | .bvar .. | .mvar .. | .const .. | .fvar .. | .sort .. | .lit .. =>
     hash e
   | .app .. | .letE .. | .forallE .. | .lam .. | .mdata .. | .proj .. =>
-    (unsafe ptrAddrUnsafe e).toUInt64
+    hashPtrExpr e
 
 private def alphaHash (e : Expr) : UInt64 :=
   match e with

src/Lean/Meta/Tactic/Grind/Arith/Offset/Main.lean

@@ -339,9 +339,7 @@ def internalize (e : Expr) (parent? : Option Expr) : GoalM Unit := do
     if let some (b, k) := isNatOffset? e then
       internalizeTerm e b k
     else if let some k := isNatNum? e then
-      -- core module has support for detecting equality between literals
-      unless isEqParent parent? do
-        internalizeTerm e z k
+      internalizeTerm e z k
 
 @[export lean_process_new_offset_eq]
 def processNewEqImpl (a b : Expr) : GoalM Unit := do
@@ -353,17 +351,6 @@ def processNewEqImpl (a b : Expr) : GoalM Unit := do
     addEdge u v 0 <| mkApp3 (mkConst ``Grind.Nat.le_of_eq_1) a b h
     addEdge v u 0 <| mkApp3 (mkConst ``Grind.Nat.le_of_eq_2) a b h
 
-@[export lean_process_new_offset_eq_lit]
-def processNewEqLitImpl (a b : Expr) : GoalM Unit := do
-  unless isSameExpr a b do
-    trace[grind.offset.eq.to] "{a}, {b}"
-    let some k := isNatNum? b | unreachable!
-    let u ← getNodeId a
-    let z ← mkNode (← getNatZeroExpr)
-    let h ← mkEqProof a b
-    addEdge u z k <| mkApp3 (mkConst ``Grind.Nat.le_of_eq_1) a b h
-    addEdge z u (-k) <| mkApp3 (mkConst ``Grind.Nat.le_of_eq_2) a b h
-
 def traceDists : GoalM Unit := do
   let s ← get'
   for u in [:s.targets.size], es in s.targets.toArray do

src/Lean/Meta/Tactic/Grind/Core.lean

@@ -133,22 +133,15 @@ private def checkOffsetEq (rhsRoot lhsRoot : ENode) : GoalM PendingTheoryPropaga
   | some lhsOffset =>
     if let some rhsOffset := rhsRoot.offset? then
       return .eq lhsOffset rhsOffset
-    else if isNatNum rhsRoot.self then
-      return .eqLit lhsOffset rhsRoot.self
     else
       -- We have to retrieve the node because other fields have been updated
       let rhsRoot ← getENode rhsRoot.self
       setENode rhsRoot.self { rhsRoot with offset? := lhsOffset }
       return .none
-  | none =>
-    if isNatNum lhsRoot.self then
-      if let some rhsOffset := rhsRoot.offset? then
-        return .eqLit rhsOffset lhsRoot.self
-    return .none
+  | none => return .none
 
 def propagateOffset : PendingTheoryPropagation → GoalM Unit
   | .eq lhs rhs => Arith.Offset.processNewEq lhs rhs
-  | .eqLit lhs lit => Arith.Offset.processNewEqLit lhs lit
   | _ => return ()
 
 /--

src/Lean/Meta/Tactic/Grind/ENodeKey.lean

@@ -21,8 +21,11 @@ have been hash-consed, i.e., we have applied `shareCommon`.
 structure ENodeKey where
   expr : Expr
 
+abbrev hashPtrExpr (e : Expr) : UInt64 :=
+  unsafe (ptrAddrUnsafe e >>> 3).toUInt64
+
 instance : Hashable ENodeKey where
-  hash k := unsafe (ptrAddrUnsafe k.expr).toUInt64
+  hash k := hashPtrExpr k.expr
 
 instance : BEq ENodeKey where
   beq k₁ k₂ := isSameExpr k₁.expr k₂.expr

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

@@ -62,7 +62,7 @@ def isMorallyIff (e : Expr) : Bool :=
 private def checkAndAddSplitCandidate (e : Expr) : GoalM Unit := do
   match h : e with
   | .app .. =>
-    if (← getConfig).splitIte && (e.isIte || e.isDIte) then
+    if (← getConfig).splitIte && (isIte e || isDIte e) then
       addSplitCandidate (.default e)
       return ()
     if isMorallyIff e then
@@ -87,7 +87,7 @@ private def checkAndAddSplitCandidate (e : Expr) : GoalM Unit := do
       else if (← getConfig).splitIndPred then
         addSplitCandidate (.default e)
   | .fvar .. =>
-    let .const declName _ := (← whnfD (← inferType e)).getAppFn | return ()
+    let .const declName _ := (← whnf (← inferType e)).getAppFn | return ()
     if (← get).split.casesTypes.isSplit declName then
       addSplitCandidate (.default e)
   | .forallE _ d _ _ =>
@@ -201,7 +201,7 @@ these facts.
 -/
 private def propagateEtaStruct (a : Expr) (generation : Nat) : GoalM Unit := do
   unless (← getConfig).etaStruct do return ()
-  let aType ← whnfD (← inferType a)
+  let aType ← whnf (← inferType a)
   matchConstStructureLike aType.getAppFn (fun _ => return ()) fun inductVal us ctorVal => do
     unless a.isAppOf ctorVal.name do
       -- TODO: remove ctorVal.numFields after update stage0
@@ -215,7 +215,9 @@ private def propagateEtaStruct (a : Expr) (generation : Nat) : GoalM Unit := do
           ctorApp := mkApp ctorApp proj
         ctorApp ← preprocessLight ctorApp
         internalize ctorApp generation
-        pushEq a ctorApp <| (← mkEqRefl a)
+        let u ← getLevel aType
+        let expectedProp := mkApp3 (mkConst ``Eq [u]) aType a ctorApp
+        pushEq a ctorApp <| mkExpectedPropHint (mkApp2 (mkConst ``Eq.refl [u]) aType a) expectedProp
 
 /-- Returns `true` if we can ignore `ext` for functions occurring as arguments of a `declName`-application. -/
 private def extParentsToIgnore (declName : Name) : Bool :=
@@ -366,6 +368,7 @@ where
           let c := args[0]!
           internalizeImpl c generation e
           registerParent e c
+          pushEqTrue c <| mkApp2 (mkConst ``eq_true) c args[1]!
         else if f.isConstOf ``ite && args.size == 5 then
           let c := args[1]!
           internalizeImpl c generation e

src/Lean/Meta/Tactic/Grind/Propagate.lean

@@ -173,6 +173,25 @@ builtin_grind_propagator propagateEqDown ↓Eq := fun e => do
       for thm in (← getExtTheorems α) do
         instantiateExtTheorem thm e
 
+private def getLawfulBEqInst? (u : List Level) (α : Expr) (binst : Expr) : MetaM (Option Expr) := do
+  let lawfulBEq := mkApp2 (mkConst ``LawfulBEq u) α binst
+  let .some linst ← trySynthInstance lawfulBEq | return none
+  return some linst
+
+/-
+Note about `BEq.beq`
+Given `a b : α` in a context where we have `[BEq α] [LawfulBEq α]`
+The normalizer (aka `simp`) fails to normalize `if a == b then ... else ...` to `if a = b then ... else ...` using
+```
+theorem beq_iff_eq [BEq α] [LawfulBEq α] {a b : α} : a == b ↔ a = b :=
+  ⟨eq_of_beq, beq_of_eq⟩
+```
+The main issue is that `ite_congr` requires that the resulting proposition to be decidable,
+and we don't have `[DecidableEq α]`. Thus, the normalization step fails.
+The following propagators for `BEq.beq` ensure `grind` does not assume this normalization
+rule has been applied.
+-/
+
 builtin_grind_propagator propagateBEqUp ↑BEq.beq := fun e => do
   /-
   `grind` uses the normalization rule `Bool.beq_eq_decide_eq`, but it is only applicable if
@@ -181,17 +200,27 @@ builtin_grind_propagator propagateBEqUp ↑BEq.beq := fun e => do
   Thus, we have added this propagator as a backup.
   -/
   let_expr f@BEq.beq α binst a b := e | return ()
+  let u := f.constLevels!
   if (← isEqv a b) then
-    let u := f.constLevels!
-    let lawfulBEq := mkApp2 (mkConst ``LawfulBEq u) α binst
-    let .some linst ← trySynthInstance lawfulBEq | return ()
+    let some linst ← getLawfulBEqInst? u α binst | return ()
     pushEqBoolTrue e <| mkApp6 (mkConst ``Grind.beq_eq_true_of_eq u) α binst linst a b (← mkEqProof a b)
   else if let some h ← mkDiseqProof? a b then
-    let u := f.constLevels!
-    let lawfulBEq := mkApp2 (mkConst ``LawfulBEq u) α binst
-    let .some linst ← trySynthInstance lawfulBEq | return ()
+    let some linst ← getLawfulBEqInst? u α binst | return ()
     pushEqBoolFalse e <| mkApp6 (mkConst ``Grind.beq_eq_false_of_diseq u) α binst linst a b h
 
+builtin_grind_propagator propagateBEqDown ↓BEq.beq := fun e => do
+  /- See comment above -/
+  let_expr f@BEq.beq α binst a b := e | return ()
+  let u := f.constLevels!
+  if (← isEqBoolTrue e) then
+    let some linst ← getLawfulBEqInst? u α binst | return ()
+    pushEq a b <| mkApp6 (mkConst ``Grind.eq_of_beq_eq_true u) α binst linst a b (← mkEqProof e (← getBoolTrueExpr))
+  else if (← isEqBoolFalse e) then
+    let some linst ← getLawfulBEqInst? u α binst | return ()
+    let eq ← shareCommon (mkApp3 (mkConst ``Eq [u.head!.succ]) α a b)
+    internalize eq (← getGeneration a)
+    pushEqFalse eq <| mkApp6 (mkConst ``Grind.ne_of_beq_eq_false u) α binst linst a b (← mkEqProof e (← getBoolFalseExpr))
+
 /-- Propagates `EqMatch` downwards -/
 builtin_grind_propagator propagateEqMatchDown ↓Grind.EqMatch := fun e => do
   if (← isEqTrue e) then
@@ -211,35 +240,73 @@ builtin_grind_propagator propagateHEqUp ↑HEq := fun e => do
   if (← isEqv a b) then
     pushEqTrue e <| mkEqTrueCore e (← mkHEqProof a b)
 
+/--
+Helper function for propagating over-applied `ite` and `dite`-applications.
+`h` is a proof for the `e`'s prefix (of size `prefixSize`) that is equal to `rhs`.
+`args` contains all arguments of `e`.
+`prefixSize <= args.size`
+-/
+private def applyCongrFun (e rhs : Expr) (h : Expr) (prefixSize : Nat) (args : Array Expr) : GoalM Unit := do
+  if prefixSize == args.size then
+    internalize rhs (← getGeneration e)
+    pushEq e rhs h
+  else
+    go rhs h prefixSize
+where
+  go (rhs : Expr) (h : Expr) (i : Nat) : GoalM Unit := do
+    if _h : i < args.size then
+      let arg := args[i]
+      let rhs' := mkApp rhs arg
+      let h' ← mkCongrFun h arg
+      go rhs' h' (i+1)
+    else
+      let rhs ← preprocessLight rhs
+      internalize rhs (← getGeneration e)
+      pushEq e rhs h
+
 /-- Propagates `ite` upwards -/
 builtin_grind_propagator propagateIte ↑ite := fun e => do
-  let_expr f@ite α c h a b := e | return ()
+  let numArgs := e.getAppNumArgs
+  if numArgs < 5 then return ()
+  let c := e.getArg! 1 numArgs
   if (← isEqTrue c) then
-    internalize a (← getGeneration e)
-    pushEq e a <| mkApp6 (mkConst ``ite_cond_eq_true f.constLevels!) α c h a b (← mkEqTrueProof c)
+    let f := e.getAppFn
+    let args := e.getAppArgs
+    let rhs := args[3]!
+    let h := mkApp (mkAppRange (mkConst ``ite_cond_eq_true f.constLevels!) 0 5 args) (← mkEqTrueProof c)
+    applyCongrFun e rhs h 5 args
   else if (← isEqFalse c) then
-    internalize b (← getGeneration e)
-    pushEq e b <| mkApp6 (mkConst ``ite_cond_eq_false f.constLevels!) α c h a b (← mkEqFalseProof c)
+    let f := e.getAppFn
+    let args := e.getAppArgs
+    let rhs := args[4]!
+    let h := mkApp (mkAppRange (mkConst ``ite_cond_eq_false f.constLevels!) 0 5 args) (← mkEqFalseProof c)
+    applyCongrFun e rhs h 5 args
 
 /-- Propagates `dite` upwards -/
 builtin_grind_propagator propagateDIte ↑dite := fun e => do
-  let_expr f@dite α c h a b := e | return ()
+  let numArgs := e.getAppNumArgs
+  if numArgs < 5 then return ()
+  let c := e.getArg! 1 numArgs
   if (← isEqTrue c) then
-     let h₁ ← mkEqTrueProof c
-     let ah₁ := mkApp a (mkOfEqTrueCore c h₁)
-     let p ← preprocess ah₁
-     let r := p.expr
-     let h₂ ← p.getProof
-     internalize r (← getGeneration e)
-     pushEq e r <| mkApp8 (mkConst ``Grind.dite_cond_eq_true' f.constLevels!) α c h a b r h₁ h₂
+    let f := e.getAppFn
+    let args := e.getAppArgs
+    let h₁ ← mkEqTrueProof c
+    let ah₁ := mkApp args[3]! (mkOfEqTrueCore c h₁)
+    let p ← preprocess ah₁
+    let r := p.expr
+    let h₂ ← p.getProof
+    let h := mkApp3 (mkAppRange (mkConst ``Grind.dite_cond_eq_true' f.constLevels!) 0 5 args) r h₁ h₂
+    applyCongrFun e r h 5 args
   else if (← isEqFalse c) then
-     let h₁ ← mkEqFalseProof c
-     let bh₁ := mkApp b (mkOfEqFalseCore c h₁)
-     let p ← preprocess bh₁
-     let r := p.expr
-     let h₂ ← p.getProof
-     internalize r (← getGeneration e)
-     pushEq e r <| mkApp8 (mkConst ``Grind.dite_cond_eq_false' f.constLevels!) α c h a b r h₁ h₂
+    let f := e.getAppFn
+    let args := e.getAppArgs
+    let h₁ ← mkEqFalseProof c
+    let bh₁ := mkApp args[4]! (mkOfEqFalseCore c h₁)
+    let p ← preprocess bh₁
+    let r := p.expr
+    let h₂ ← p.getProof
+    let h := mkApp3 (mkAppRange (mkConst ``Grind.dite_cond_eq_false' f.constLevels!) 0 5 args) r h₁ h₂
+    applyCongrFun e r h 5 args
 
 builtin_grind_propagator propagateDecideDown ↓decide := fun e => do
   let root ← getRootENode e

src/Lean/Meta/Tactic/Grind/Split.lean

@@ -93,9 +93,9 @@ private def checkDefaultSplitStatus (e : Expr) : GoalM SplitStatus := do
       checkIffStatus e a b
     else
       return .ready 2
-  | ite _ c _ _ _ => checkIteCondStatus c
-  | dite _ c _ _ _ => checkIteCondStatus c
   | _ =>
+    if isIte e || isDIte e then
+      return (← checkIteCondStatus (e.getArg! 1))
     if (← isResolvedCaseSplit e) then
       trace_goal[grind.debug.split] "split resolved: {e}"
       return .resolved
@@ -215,8 +215,6 @@ private def mkGrindEM (c : Expr) :=
 private def mkCasesMajor (c : Expr) : GoalM Expr := do
   match_expr c with
   | And a b => return mkApp3 (mkConst ``Grind.or_of_and_eq_false) a b (← mkEqFalseProof c)
-  | ite _ c _ _ _ => return mkGrindEM c
-  | dite _ c _ _ _ => return mkGrindEM c
   | Eq _ a b =>
     if isMorallyIff c then
       if (← isEqTrue c) then
@@ -228,7 +226,9 @@ private def mkCasesMajor (c : Expr) : GoalM Expr := do
       return mkGrindEM c
   | Not e => return mkGrindEM e
   | _ =>
-    if (← isEqTrue c) then
+    if isIte c || isDIte c then
+      return mkGrindEM (c.getArg! 1)
+    else if (← isEqTrue c) then
       return mkOfEqTrueCore c (← mkEqTrueProof c)
     else
       return c

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

@@ -86,7 +86,7 @@ instance : BEq CongrTheoremCacheKey where
 
 -- We manually define `Hashable` because we want to use pointer equality.
 instance : Hashable CongrTheoremCacheKey where
-  hash a := mixHash (unsafe ptrAddrUnsafe a.f).toUInt64 (hash a.numArgs)
+  hash a := mixHash (hashPtrExpr a.f) (hash a.numArgs)
 
 structure EMatchTheoremTrace where
   origin : Origin
@@ -372,9 +372,9 @@ structure CongrKey (enodes : ENodeMap) where
 
 private def hashRoot (enodes : ENodeMap) (e : Expr) : UInt64 :=
   if let some node := enodes.find? { expr := e } then
-    unsafe (ptrAddrUnsafe node.root).toUInt64
+    hashPtrExpr node.root
   else
-    13
+    hashPtrExpr e
 
 private def hasSameRoot (enodes : ENodeMap) (a b : Expr) : Bool := Id.run do
   if isSameExpr a b then
@@ -461,9 +461,9 @@ structure PreInstance where
 
 instance : Hashable PreInstance where
   hash i := Id.run do
-    let mut r := unsafe (ptrAddrUnsafe i.proof >>> 3).toUInt64
+    let mut r := hashPtrExpr i.proof
     for v in i.assignment do
-      r := mixHash r (unsafe (ptrAddrUnsafe v >>> 3).toUInt64)
+      r := mixHash r (hashPtrExpr v)
     return r
 
 instance : BEq PreInstance where
@@ -957,14 +957,6 @@ Notifies the offset constraint module that `a = b` where
 @[extern "lean_process_new_offset_eq"] -- forward definition
 opaque Arith.Offset.processNewEq (a b : Expr) : GoalM Unit
 
-/--
-Notifies the offset constraint module that `a = k` where
-`a` is term that has been internalized by this module,
-and `k` is a numeral.
--/
-@[extern "lean_process_new_offset_eq_lit"] -- forward definition
-opaque Arith.Offset.processNewEqLit (a k : Expr) : GoalM Unit
-
 /-- Returns `true` if `e` is a numeral and has type `Nat`. -/
 def isNatNum (e : Expr) : Bool := Id.run do
   let_expr OfNat.ofNat _ _ inst := e | false
@@ -980,8 +972,6 @@ def markAsOffsetTerm (e : Expr) : GoalM Unit := do
   let root ← getRootENode e
   if let some e' := root.offset? then
     Arith.Offset.processNewEq e e'
-  else if isNatNum root.self && !isSameExpr e root.self then
-    Arith.Offset.processNewEqLit e root.self
   else
     setENode root.self { root with offset? := some e }
 

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

@@ -216,4 +216,10 @@ def replacePreMatchCond (e : Expr) : MetaM Simp.Result := do
     let e' ← Core.transform e (pre := pre)
     return { expr := e', proof? := mkExpectedPropHint (← mkEqRefl e') (← mkEq e e') }
 
+def isIte (e : Expr) :=
+  e.isAppOf ``ite && e.getAppNumArgs >= 5
+
+def isDIte (e : Expr) :=
+  e.isAppOf ``dite && e.getAppNumArgs >= 5
+
 end Lean.Meta.Grind

src/Std/Data/Internal/LawfulMonadLiftFunction.lean

@@ -0,0 +1,74 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Init.Control.Basic
+import Init.Control.Lawful.Basic
+import Init.NotationExtra
+import Init.Control.Lawful.MonadLift
+
+/-!
+# Typeclass for lawfule monad lifting functions
+
+This module provides a typeclass `LawfulMonadLiftFunction f` that asserts that a function `f`
+mapping values from one monad to another monad commutes with `pure` and `bind`. This equivalent to
+the requirement that the `MonadLift(T)` instance induced by `f` admits a
+`LawfulMonadLift(T)` instance.
+-/
+
+namespace Std.Internal
+
+class LawfulMonadLiftFunction {m : Type u → Type v} {n : Type u → Type w}
+    [Monad m] [Monad n] (lift : ⦃α : Type u⦄ → m α → n α) where
+  lift_pure {α : Type u} (a : α) : lift (pure a) = pure a
+  lift_bind {α β : Type u} (ma : m α) (f : α → m β) :
+    lift (ma >>= f) = lift ma >>= (fun x => lift (f x))
+
+instance {m : Type u → Type v} [Monad m] : LawfulMonadLiftFunction (fun ⦃α⦄ => (id : m α → m α)) where
+  lift_pure := by simp
+  lift_bind := by simp
+
+instance {m : Type u → Type v} [Monad m] {n : Type u → Type w} [Monad n] [MonadLiftT m n]
+    [LawfulMonadLiftT m n] :
+    LawfulMonadLiftFunction (fun ⦃α⦄ => (monadLift : m α → n α)) where
+  lift_pure := monadLift_pure
+  lift_bind := monadLift_bind
+
+variable {m : Type u → Type v} {n : Type u → Type w} [Monad m] [Monad n]
+    {lift : ⦃α : Type u⦄ → m α → n α}
+
+theorem LawfulMonadLiftFunction.lift_map [LawfulMonad m] [LawfulMonad n]
+    [LawfulMonadLiftFunction lift] (f : α → β) (ma : m α) :
+    lift (f <$> ma) = f <$> (lift ma : n α) := by
+  rw [← bind_pure_comp, ← bind_pure_comp, lift_bind (lift := lift)]
+  simp only [bind_pure_comp, lift_pure]
+
+theorem LawfulMonadLiftFunction.lift_seq [LawfulMonad m] [LawfulMonad n]
+    [LawfulMonadLiftFunction lift] (mf : m (α → β)) (ma : m α) :
+    lift (mf <*> ma) = lift mf <*> (lift ma : n α) := by
+  simp only [seq_eq_bind, lift_map, lift_bind]
+
+theorem LawfulMonadLiftFunction.lift_seqLeft [LawfulMonad m] [LawfulMonad n]
+    [LawfulMonadLiftFunction lift] (x : m α) (y : m β) :
+    lift (x <* y) = (lift x : n α) <* (lift y : n β) := by
+  simp only [seqLeft_eq, lift_map, lift_seq]
+
+theorem LawfulMonadLiftFunction.lift_seqRight [LawfulMonad m] [LawfulMonad n]
+    [LawfulMonadLiftFunction lift] (x : m α) (y : m β) :
+    lift (x *> y) = (lift x : n α) *> (lift y : n β) := by
+  simp only [seqRight_eq, lift_map, lift_seq]
+
+def instMonadLiftOfFunction {lift : ⦃α : Type u⦄ -> m α → n α} :
+    MonadLift m n where
+  monadLift := lift (α := _)
+
+instance [LawfulMonadLiftFunction lift] :
+    letI : MonadLift m n := ⟨lift (α := _)⟩
+    LawfulMonadLift m n :=
+  letI : MonadLift m n := ⟨lift (α := _)⟩
+  { monadLift_pure := LawfulMonadLiftFunction.lift_pure
+    monadLift_bind := LawfulMonadLiftFunction.lift_bind }
+
+end Std.Internal

src/Std/Data/Iterators.lean

@@ -7,8 +7,10 @@ prelude
 import Std.Data.Iterators.Basic
 import Std.Data.Iterators.Producers
 import Std.Data.Iterators.Consumers
-import Std.Data.Iterators.Internal
+import Std.Data.Iterators.Combinators
 import Std.Data.Iterators.Lemmas
+import Std.Data.Iterators.PostConditionMonad
+import Std.Data.Iterators.Internal
 
 /-!
 # Iterators

src/Std/Data/Iterators/Basic.lean

@@ -221,7 +221,7 @@ def PlausibleIterStep (IsPlausibleStep : IterStep α β → Prop) := Subtype IsP
 /--
 Match pattern for the `yield` case. See also `IterStep.yield`.
 -/
-@[match_pattern]
+@[match_pattern, simp]
 def PlausibleIterStep.yield {IsPlausibleStep : IterStep α β → Prop}
     (it' : α) (out : β) (h : IsPlausibleStep (.yield it' out)) :
     PlausibleIterStep IsPlausibleStep :=
@@ -230,7 +230,7 @@ def PlausibleIterStep.yield {IsPlausibleStep : IterStep α β → Prop}
 /--
 Match pattern for the `skip` case. See also `IterStep.skip`.
 -/
-@[match_pattern]
+@[match_pattern, simp]
 def PlausibleIterStep.skip {IsPlausibleStep : IterStep α β → Prop}
     (it' : α) (h : IsPlausibleStep (.skip it')) : PlausibleIterStep IsPlausibleStep :=
   ⟨.skip it', h⟩
@@ -238,7 +238,7 @@ def PlausibleIterStep.skip {IsPlausibleStep : IterStep α β → Prop}
 /--
 Match pattern for the `done` case. See also `IterStep.done`.
 -/
-@[match_pattern]
+@[match_pattern, simp]
 def PlausibleIterStep.done {IsPlausibleStep : IterStep α β → Prop}
     (h : IsPlausibleStep .done) : PlausibleIterStep IsPlausibleStep :=
   ⟨.done, h⟩

src/Std/Data/Iterators/Combinators.lean

@@ -0,0 +1,12 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Std.Data.Iterators.Combinators.Monadic
+import Std.Data.Iterators.Combinators.Take
+import Std.Data.Iterators.Combinators.TakeWhile
+import Std.Data.Iterators.Combinators.DropWhile
+import Std.Data.Iterators.Combinators.FilterMap
+import Std.Data.Iterators.Combinators.Zip

src/Std/Data/Iterators/Combinators/DropWhile.lean

@@ -0,0 +1,59 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Std.Data.Iterators.Combinators.Monadic.DropWhile
+
+namespace Std.Iterators
+
+/--
+Constructs intermediate states of an iterator created with the combinator `Iter.dropWhile`.
+When `it.dropWhile P` has stopped dropping elements, its new state cannot be created
+directly with `Iter.dropWhile` but only with `Intermediate.dropWhile`.
+
+`Intermediate.dropWhile` is meant to be used only for internally or for verification purposes.
+-/
+@[always_inline, inline]
+def Iter.Intermediate.dropWhile (P : β → Bool) (dropping : Bool)
+    (it : Iter (α := α) β) :=
+  ((IterM.Intermediate.dropWhile P dropping it.toIterM).toIter : Iter β)
+
+/--
+Given an iterator `it` and a predicate `P`, `it.dropWhile P` is an iterator that
+emits the values emitted by `it` starting from the first value that is rejected by `P`.
+The elements before are dropped.
+
+In situations where `P` is monadic, use `dropWhileM` instead.
+
+**Marble diagram:**
+
+Assuming that the predicate `P` accepts `a` and `b` but rejects `c`:
+
+```text
+it               ---a----b---c--d-e--⊥
+it.dropWhile P   ------------c--d-e--⊥
+
+it               ---a----⊥
+it.dropWhile P   --------⊥
+```
+
+**Termination properties:**
+
+* `Finite` instance: only if `it` is finite
+* `Productive` instance: only if `it` is finite
+
+Depending on `P`, it is possible that `it.dropWhileM P` is productive although
+`it` is not. In this case, the `Productive` instance needs to be proved manually.
+
+**Performance:**
+
+This combinator calls `P` on each output of `it` until the predicate evaluates to false. After
+that, the combinator incurs an addictional O(1) cost for each value emitted by `it`.
+-/
+@[always_inline, inline]
+def Iter.dropWhile {α : Type w} {β : Type w} (P : β → Bool) (it : Iter (α := α) β) :=
+  (it.toIterM.dropWhile P |>.toIter : Iter β)
+
+end Std.Iterators

src/Std/Data/Iterators/Combinators/FilterMap.lean

@@ -0,0 +1,304 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Std.Data.Iterators.Combinators.Monadic.FilterMap
+
+/-!
+
+# `filterMap`, `filter` and `map` combinators
+
+This file provides iterator combinators for filtering and mapping.
+
+* `IterM.filterMap` either modifies or drops each value based on an option-valued mapping function.
+* `IterM.filter` drops some elements based on a predicate.
+* `IterM.map` modifies each value based on a mapping function
+
+Several variants of these combinators are provided:
+
+* `M` suffix: Instead of a pure function, these variants take a monadic function. Given a suitable
+  `MonadLiftT` instance, they also allow lifting the iterator to another monad first and then
+  applying the mapping function in this monad.
+* `WithPostcondition` suffix: These variants take a monadic function where the return type in the
+  monad is a subtype. This variant is in rare cases necessary for the intrinsic verification of an
+  iterator, and particularly for specialized termination proofs. If possible, avoid this.
+-/
+
+namespace Std.Iterators
+
+-- We cannot use `inherit_doc` because the docstring for `IterM` states that a `MonadLiftT` instance
+-- is needed.
+/--
+*Note: This is a very general combinator that requires an advanced understanding of monads,
+dependent types and termination proofs. The variants `filterMap` and `filterMapM` are easier to use
+and sufficient for most use cases.*
+
+If `it` is an iterator, then `it.filterMapWithPostcondition f` is another iterator that applies a monadic
+function `f` to all values emitted by `it`. `f` is expected to return an `Option` inside the monad.
+If `f` returns `none`, then nothing is emitted; if it returns `some x`, then `x` is emitted.
+
+`f` is expected to return `PostconditionT n (Option _)`, where `n` is an arbitrary monad.
+The `PostconditionT` transformer allows the caller to intrinsically prove properties about
+`f`'s return value in the monad `n`, enabling termination proofs depending on the specific behavior
+of `f`.
+
+**Marble diagram (without monadic effects):**
+
+```text
+it                                ---a --b--c --d-e--⊥
+it.filterMapWithPostcondition     ---a'-----c'-------⊥
+```
+
+(given that `f a = pure (some a)'`, `f c = pure (some c')` and `f b = f d = d e = pure none`)
+
+**Termination properties:**
+
+* `Finite` instance: only if `it` is finite
+* `Productive` instance: only if `it` is finite`
+
+For certain mapping functions `f`, the resulting iterator will be finite (or productive) even though
+no `Finite` (or `Productive`) instance is provided. For example, if `f` never returns `none`, then
+this combinator will preserve productiveness. If `f` is an `ExceptT` monad and will always fail,
+then `it.filterMapWithPostcondition` will be finite even if `it` isn't. In the first case, consider
+using the `map`/`mapM`/`mapWithPostcondition` combinators instead, which provide more instances out of
+the box.
+
+In such situations, the missing instances can be proved manually if the postcondition bundled in
+the `PostconditionT n` monad is strong enough. If `f` always returns `some _`, a suitable
+postcondition is `fun x => x.isSome`; if `f` always fails, a suitable postcondition might be
+`fun _ => False`.
+
+**Performance:**
+
+For each value emitted by the base iterator `it`, this combinator calls `f` and matches on the
+returned `Option` value.
+-/
+@[always_inline, inline]
+def Iter.filterMapWithPostcondition {α β γ : Type w} [Iterator α Id β] {m : Type w → Type w'}
+    [Monad m] (f : β → PostconditionT m (Option γ)) (it : Iter (α := α) β) :=
+  (letI : MonadLift Id m := ⟨pure⟩; it.toIterM.filterMapWithPostcondition f : IterM m γ)
+
+/--
+*Note: This is a very general combinator that requires an advanced understanding of monads,
+dependent types and termination proofs. The variants `filter` and `filterM` are easier to use and
+sufficient for most use cases.*
+
+If `it` is an iterator, then `it.filterWithPostcondition f` is another iterator that applies a monadic
+predicate `f` to all values emitted by `it` and emits them only if they are accepted by `f`.
+
+`f` is expected to return `PostconditionT n (ULift Bool)`, where `n` is an arbitrary monad.
+The `PostconditionT` transformer allows the caller to intrinsically prove properties about
+`f`'s return value in the monad `n`, enabling termination proofs depending on the specific behavior
+of `f`.
+
+**Marble diagram (without monadic effects):**
+
+```text
+it                             ---a--b--c--d-e--⊥
+it.filterWithPostcondition     ---a-----c-------⊥
+```
+
+(given that `f a = f c = pure true` and `f b = f d = d e = pure false`)
+
+**Termination properties:**
+
+* `Finite` instance: only if `it` is finite
+* `Productive` instance: only if `it` is finite`
+
+For certain mapping functions `f`, the resulting iterator will be finite (or productive) even though
+no `Finite` (or `Productive`) instance is provided. For exaple, if `f` is an `ExceptT` monad and
+will always fail, then `it.filterWithPostcondition` will be finite -- and productive -- even if `it`
+isn't.
+
+In such situations, the missing instances can be proved manually if the postcondition bundled in
+the `PostconditionT n` monad is strong enough. In the given example, a suitable postcondition might
+be `fun _ => False`.
+
+**Performance:**
+
+For each value emitted by the base iterator `it`, this combinator calls `f`.
+-/
+@[always_inline, inline]
+def Iter.filterWithPostcondition {α β : Type w} [Iterator α Id β] {m : Type w → Type w'}
+    [Monad m] (f : β → PostconditionT m (ULift Bool)) (it : Iter (α := α) β) :=
+  (letI : MonadLift Id m := ⟨pure⟩; it.toIterM.filterWithPostcondition f : IterM m β)
+
+/--
+*Note: This is a very general combinator that requires an advanced understanding of monads,
+dependent types and termination proofs. The variants `map` and `mapM` are easier to use and
+sufficient for most use cases.*
+
+If `it` is an iterator, then `it.mapWithPostcondition f` is another iterator that applies a monadic
+function `f` to all values emitted by `it` and emits the result.
+
+`f` is expected to return `PostconditionT n _`, where `n` is an arbitrary monad.
+The `PostconditionT` transformer allows the caller to intrinsically prove properties about
+`f`'s return value in the monad `n`, enabling termination proofs depending on the specific behavior
+of `f`.
+
+**Marble diagram (without monadic effects):**
+
+```text
+it                          ---a --b --c --d -e ----⊥
+it.mapWithPostcondition     ---a'--b'--c'--d'-e'----⊥
+```
+
+(given that `f a = pure a'`, `f b = pure b'` etc.)
+
+**Termination properties:**
+
+* `Finite` instance: only if `it` is finite
+* `Productive` instance: only if `it` is productive
+
+For certain mapping functions `f`, the resulting iterator will be finite (or productive) even though
+no `Finite` (or `Productive`) instance is provided. For exaple, if `f` is an `ExceptT` monad and
+will always fail, then `it.mapWithPostcondition` will be finite even if `it` isn't.
+
+In such situations, the missing instances can be proved manually if the postcondition bundled in
+the `PostconditionT n` monad is strong enough. In the given example, a suitable postcondition might
+be `fun _ => False`.
+
+**Performance:**
+
+For each value emitted by the base iterator `it`, this combinator calls `f`.
+-/
+@[always_inline, inline]
+def Iter.mapWithPostcondition {α β γ : Type w} [Iterator α Id β] {m : Type w → Type w'}
+    [Monad m] (f : β → PostconditionT m γ) (it : Iter (α := α) β) :=
+  (letI : MonadLift Id m := ⟨pure⟩; it.toIterM.mapWithPostcondition f : IterM m γ)
+
+/--
+If `it` is an iterator, then `it.filterMapM f` is another iterator that applies a monadic
+function `f` to all values emitted by `it`. `f` is expected to return an `Option` inside the monad.
+If `f` returns `none`, then nothing is emitted; if it returns `some x`, then `x` is emitted.
+
+If `f` is pure, then the simpler variant `it.filterMap` can be used instead.
+
+**Marble diagram (without monadic effects):**
+
+```text
+it                ---a --b--c --d-e--⊥
+it.filterMapM     ---a'-----c'-------⊥
+```
+
+(given that `f a = pure (some a)'`, `f c = pure (some c')` and `f b = f d = d e = pure none`)
+
+**Termination properties:**
+
+* `Finite` instance: only if `it` is finite
+* `Productive` instance: only if `it` is finite`
+
+For certain mapping functions `f`, the resulting iterator will be finite (or productive) even though
+no `Finite` (or `Productive`) instance is provided. For example, if `f` never returns `none`, then
+this combinator will preserve productiveness. If `f` is an `ExceptT` monad and will always fail,
+then `it.filterMapM` will be finite even if `it` isn't. In the first case, consider
+using the `map`/`mapM`/`mapWithPostcondition` combinators instead, which provide more instances out
+of the box.
+
+If that does not help, the more general combinator `it.filterMapWithPostcondition f` makes it
+possible to manually prove `Finite` and `Productive` instances depending on the concrete choice of `f`.
+
+**Performance:**
+
+For each value emitted by the base iterator `it`, this combinator calls `f` and matches on the
+returned `Option` value.
+-/
+@[always_inline, inline]
+def Iter.filterMapM {α β γ : Type w} [Iterator α Id β] {m : Type w → Type w'}
+    [Monad m] (f : β → m (Option γ)) (it : Iter (α := α) β) :=
+  (letI : MonadLift Id m := ⟨pure⟩; it.toIterM.filterMapM f : IterM m γ)
+
+/--
+If `it` is an iterator, then `it.filterM f` is another iterator that applies a monadic
+predicate `f` to all values emitted by `it` and emits them only if they are accepted by `f`.
+
+If `f` is pure, then the simpler variant `it.filter` can be used instead.
+
+**Marble diagram (without monadic effects):**
+
+```text
+it             ---a--b--c--d-e--⊥
+it.filterM     ---a-----c-------⊥
+```
+
+(given that `f a = f c = pure true` and `f b = f d = d e = pure false`)
+
+**Termination properties:**
+
+* `Finite` instance: only if `it` is finite
+* `Productive` instance: only if `it` is finite`
+
+For certain mapping functions `f`, the resulting iterator will be finite (or productive) even though
+no `Finite` (or `Productive`) instance is provided. For exaple, if `f` is an `ExceptT` monad and
+will always fail, then `it.filterWithPostcondition` will be finite -- and productive -- even if `it`
+isn't.
+
+In such situations, the more general combinator `it.filterWithPostcondition f` makes it possible to
+manually prove `Finite` and `Productive` instances depending on the concrete choice of `f`.
+
+**Performance:**
+
+For each value emitted by the base iterator `it`, this combinator calls `f`.
+-/
+@[always_inline, inline]
+def Iter.filterM {α β : Type w} [Iterator α Id β] {m : Type w → Type w'}
+    [Monad m] (f : β → m (ULift Bool)) (it : Iter (α := α) β) :=
+  (letI : MonadLift Id m := ⟨pure⟩; it.toIterM.filterM f : IterM m β)
+
+/--
+If `it` is an iterator, then `it.mapM f` is another iterator that applies a monadic
+function `f` to all values emitted by `it` and emits the result.
+
+The base iterator `it` being monadic in `m`, `f` can return values in any monad `n` for which a
+`MonadLiftT m n` instance is available.
+
+If `f` is pure, then the simpler variant `it.map` can be used instead.
+
+**Marble diagram (without monadic effects):**
+
+```text
+it          ---a --b --c --d -e ----⊥
+it.mapM     ---a'--b'--c'--d'-e'----⊥
+```
+
+(given that `f a = pure a'`, `f b = pure b'` etc.)
+
+**Termination properties:**
+
+* `Finite` instance: only if `it` is finite
+* `Productive` instance: only if `it` is productive
+
+For certain mapping functions `f`, the resulting iterator will be finite (or productive) even though
+no `Finite` (or `Productive`) instance is provided. For exaple, if `f` is an `ExceptT` monad and
+will always fail, then `it.mapM` will be finite even if `it` isn't.
+
+If that does not help, the more general combinator `it.mapWithPostcondition f` makes it possible to
+manually prove `Finite` and `Productive` instances depending on the concrete choice of `f`.
+
+**Performance:**
+
+For each value emitted by the base iterator `it`, this combinator calls `f`.
+-/
+@[always_inline, inline]
+def Iter.mapM {α β γ : Type w} [Iterator α Id β] {m : Type w → Type w'}
+    [Monad m] (f : β → m γ) (it : Iter (α := α) β) :=
+  (letI : MonadLift Id m := ⟨pure⟩; it.toIterM.mapM f : IterM m γ)
+
+@[always_inline, inline, inherit_doc IterM.filterMap]
+def Iter.filterMap {α : Type w} {β : Type w} {γ : Type w} [Iterator α Id β]
+    (f : β → Option γ) (it : Iter (α := α) β) :=
+  ((it.toIterM.filterMap f).toIter : Iter γ)
+
+@[always_inline, inline, inherit_doc IterM.filter]
+def Iter.filter {α : Type w} {β : Type w} [Iterator α Id β]
+    (f : β → Bool) (it : Iter (α := α) β) :=
+  ((it.toIterM.filter f).toIter : Iter β)
+
+@[always_inline, inline, inherit_doc IterM.map]
+def Iter.map {α : Type w} {β : Type w} {γ : Type w} [Iterator α Id β]
+    (f : β → γ) (it : Iter (α := α) β) :=
+  ((it.toIterM.map f).toIter : Iter γ)
+
+end Std.Iterators

src/Std/Data/Iterators/Combinators/Monadic.lean

@@ -0,0 +1,11 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Std.Data.Iterators.Combinators.Monadic.Take
+import Std.Data.Iterators.Combinators.Monadic.TakeWhile
+import Std.Data.Iterators.Combinators.Monadic.DropWhile
+import Std.Data.Iterators.Combinators.Monadic.FilterMap
+import Std.Data.Iterators.Combinators.Monadic.Zip

src/Std/Data/Iterators/Combinators/Monadic/DropWhile.lean

@@ -0,0 +1,289 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Init.Data.Nat.Lemmas
+import Init.RCases
+import Std.Data.Iterators.Basic
+import Std.Data.Iterators.Consumers.Monadic.Collect
+import Std.Data.Iterators.Consumers.Monadic.Loop
+import Std.Data.Iterators.Internal.Termination
+import Std.Data.Iterators.PostConditionMonad
+
+/-!
+# Monadic `dropWhile` iterator combinator
+
+This module provides the iterator combinator `IterM.dropWhile` that will drop all values emitted
+by a given iterator until a given predicate on these values becomes false the first fime. Beginning
+with that moment, the combinator will forward all emitted values.
+
+Several variants of this combinator are provided:
+
+* `M` suffix: Instead of a pure function, this variant takes a monadic function. Given a suitable
+  `MonadLiftT` instance, it will also allow lifting the iterator to another monad first and then
+  applying the mapping function in this monad.
+* `WithPostcondition` suffix: This variant takes a monadic function where the return type in the
+  monad is a subtype. This variant is in rare cases necessary for the intrinsic verification of an
+  iterator, and particularly for specialized termination proofs. If possible, avoid this.
+-/
+
+namespace Std.Iterators
+
+variable {α : Type w} {m : Type w → Type w'} {β : Type w}
+
+/--
+Internal state of the `dropWhile` combinator. Do not depend on its internals.
+-/
+@[unbox]
+structure DropWhile (α : Type w) (m : Type w → Type w') (β : Type w)
+    (P : β → PostconditionT m (ULift Bool)) where
+  /-- Internal implementation detail of the iterator library. -/
+  dropping : Bool
+  /-- Internal implementation detail of the iterator library. -/
+  inner : IterM (α := α) m β
+
+/--
+Constructs intermediate states of an iterator created with the combinator
+`IterM.dropWhileWithPostcondition`.
+When `it.dropWhileWithPostcondition P` has stopped dropping elements, its new state cannot be
+created directly with `IterM.dropWhileWithPostcondition` but only with
+`Intermediate.dropWhileWithPostcondition`.
+
+`Intermediate.dropWhileWithPostcondition` is meant to be used only for internally or for
+verification purposes.
+-/
+@[always_inline, inline]
+def IterM.Intermediate.dropWhileWithPostcondition (P : β → PostconditionT m (ULift Bool))
+    (dropping : Bool) (it : IterM (α := α) m β) :=
+  (toIterM (DropWhile.mk (P := P) dropping it) m β : IterM m β)
+
+/--
+Constructs intermediate states of an iterator created with the combinator `IterM.dropWhileM`.
+When `it.dropWhileM P` has stopped dropping elements, its new state cannot be created
+directly with `IterM.dropWhileM` but only with `Intermediate.dropWhileM`.
+
+`Intermediate.dropWhileM` is meant to be used only for internally or for verification purposes.
+-/
+@[always_inline, inline]
+def IterM.Intermediate.dropWhileM [Monad m] (P : β → m (ULift Bool)) (dropping : Bool)
+    (it : IterM (α := α) m β) :=
+  (IterM.Intermediate.dropWhileWithPostcondition (PostconditionT.lift ∘ P) dropping it : IterM m β)
+
+/--
+Constructs intermediate states of an iterator created with the combinator `IterM.dropWhile`.
+When `it.dropWhile P` has stopped dropping elements, its new state cannot be created
+directly with `IterM.dropWhile` but only with `Intermediate.dropWhile`.
+
+`Intermediate.dropWhile` is meant to be used only for internally or for verification purposes.
+-/
+@[always_inline, inline]
+def IterM.Intermediate.dropWhile [Monad m] (P : β → Bool) (dropping : Bool)
+    (it : IterM (α := α) m β) :=
+  (IterM.Intermediate.dropWhileM (pure ∘ ULift.up ∘ P) dropping it : IterM m β)
+
+/--
+*Note: This is a very general combinator that requires an advanced understanding of monads,
+dependent types and termination proofs. The variants `dropWhile` and `dropWhileM` are easier to use
+and sufficient for most use cases.*
+
+Given an iterator `it` and a monadic predicate `P`, `it.dropWhileWithPostcondition P` is an iterator
+that emits the values emitted by `it` starting from the first value that is rejected by `P`.
+The elements before are dropped.
+
+`P` is expected to return `PostconditionT m (ULift Bool)`. The `PostconditionT` transformer allows
+the caller to intrinsically prove properties about `P`'s return value in the monad `m`, enabling
+termination proofs depending on the specific behavior of `P`.
+
+**Marble diagram (ignoring monadic effects):**
+
+Assuming that the predicate `P` accepts `a` and `b` but rejects `c`:
+
+```text
+it                                ---a----b---c--d-e--⊥
+it.dropWhileWithPostcondition P   ------------c--d-e--⊥
+
+it                                ---a----⊥
+it.dropWhileWithPostcondition P   --------⊥
+```
+
+**Termination properties:**
+
+* `Finite` instance: only if `it` is finite
+* `Productive` instance: only if `it` is finite
+
+Depending on `P`, it is possible that `it.dropWhileWithPostcondition P` is finite (or productive) although
+`it` is not. In this case, the `Finite` (or `Productive`) instance needs to be proved manually.
+
+**Performance:**
+
+This combinator calls `P` on each output of `it` until the predicate evaluates to false. After
+that, the combinator incurs an addictional O(1) cost for each value emitted by `it`.
+-/
+@[always_inline, inline]
+def IterM.dropWhileWithPostcondition (P : β → PostconditionT m (ULift Bool)) (it : IterM (α := α) m β) :=
+  (Intermediate.dropWhileWithPostcondition P true it : IterM m β)
+
+/--
+Given an iterator `it` and a monadic predicate `P`, `it.dropWhileM P` is an iterator that
+emits the values emitted by `it` starting from the first value that is rejected by `P`.
+The elements before are dropped.
+
+If `P` is pure, then the simpler variant `dropWhile` can be used instead.
+
+**Marble diagram (ignoring monadic effects):**
+
+Assuming that the predicate `P` accepts `a` and `b` but rejects `c`:
+
+```text
+it                ---a----b---c--d-e--⊥
+it.dropWhileM P   ------------c--d-e--⊥
+
+it                ---a----⊥
+it.dropWhileM P   --------⊥
+```
+
+**Termination properties:**
+
+* `Finite` instance: only if `it` is finite
+* `Productive` instance: only if `it` is finite
+
+Depending on `P`, it is possible that `it.dropWhileM P` is finite (or productive) although
+`it` is not. In this case, the `Finite` (or `Productive`) instance needs to be proved manually.
+Use `dropWhileWithPostcondition` if the termination behavior depends on `P`'s behavior.
+
+**Performance:**
+
+This combinator calls `P` on each output of `it` until the predicate evaluates to false. After
+that, the combinator incurs an addictional O(1) cost for each value emitted by `it`.
+-/
+@[always_inline, inline]
+def IterM.dropWhileM [Monad m] (P : β → m (ULift Bool)) (it : IterM (α := α) m β) :=
+  (Intermediate.dropWhileM P true it : IterM m β)
+
+/--
+Given an iterator `it` and a predicate `P`, `it.dropWhile P` is an iterator that
+emits the values emitted by `it` starting from the first value that is rejected by `P`.
+The elements before are dropped.
+
+In situations where `P` is monadic, use `dropWhileM` instead.
+
+**Marble diagram (ignoring monadic effects):**
+
+Assuming that the predicate `P` accepts `a` and `b` but rejects `c`:
+
+```text
+it               ---a----b---c--d-e--⊥
+it.dropWhile P   ------------c--d-e--⊥
+
+it               ---a----⊥
+it.dropWhile P   --------⊥
+```
+
+**Termination properties:**
+
+* `Finite` instance: only if `it` is finite
+* `Productive` instance: only if `it` is finite
+
+Depending on `P`, it is possible that `it.dropWhileM P` is productive although
+`it` is not. In this case, the `Productive` instance needs to be proved manually.
+
+**Performance:**
+
+This combinator calls `P` on each output of `it` until the predicate evaluates to false. After
+that, the combinator incurs an addictional O(1) cost for each value emitted by `it`.
+-/
+@[always_inline, inline]
+def IterM.dropWhile [Monad m] (P : β → Bool) (it : IterM (α := α) m β) :=
+  (Intermediate.dropWhile P true it: IterM m β)
+
+/--
+`it.PlausibleStep step` is the proposition that `step` is a possible next step from the
+`dropWhile` iterator `it`. This is mostly internally relevant, except if one needs to manually
+prove termination (`Finite` or `Productive` instances, for example) of a `dropWhile` iterator.
+-/
+inductive DropWhile.PlausibleStep [Iterator α m β] {P} (it : IterM (α := DropWhile α m β P) m β) :
+    (step : IterStep (IterM (α := DropWhile α m β P) m β) β) → Prop where
+  | yield : ∀ {it' out}, it.internalState.inner.IsPlausibleStep (.yield it' out) →
+      it.internalState.dropping = false →
+      PlausibleStep it (.yield (IterM.Intermediate.dropWhileWithPostcondition P false it') out)
+  | skip : ∀ {it'}, it.internalState.inner.IsPlausibleStep (.skip it') →
+      PlausibleStep it (.skip (IterM.Intermediate.dropWhileWithPostcondition P it.internalState.dropping it'))
+  | done : it.internalState.inner.IsPlausibleStep .done → PlausibleStep it .done
+  | start : ∀ {it' out}, it.internalState.inner.IsPlausibleStep (.yield it' out) →
+      it.internalState.dropping = true → (P out).Property (.up false) →
+      PlausibleStep it (.yield (IterM.Intermediate.dropWhileWithPostcondition P false it') out)
+  | dropped : ∀ {it' out}, it.internalState.inner.IsPlausibleStep (.yield it' out) →
+      it.internalState.dropping = true → (P out).Property (.up true) →
+      PlausibleStep it (.skip (IterM.Intermediate.dropWhileWithPostcondition P true it'))
+
+@[always_inline, inline]
+instance DropWhile.instIterator [Monad m] [Iterator α m β] {P} :
+    Iterator (DropWhile α m β P) m β where
+  IsPlausibleStep := DropWhile.PlausibleStep
+  step it := do
+    match ← it.internalState.inner.step with
+    | .yield it' out h =>
+      if h' : it.internalState.dropping = true then
+        match ← (P out).operation with
+        | ⟨.up true, h''⟩ =>
+          return .skip (IterM.Intermediate.dropWhileWithPostcondition P true it') (.dropped h h' h'')
+        | ⟨.up false, h''⟩ =>
+          return .yield (IterM.Intermediate.dropWhileWithPostcondition P false it') out (.start h h' h'')
+      else
+        return .yield (IterM.Intermediate.dropWhileWithPostcondition P false it') out
+            (.yield h (Bool.not_eq_true _ ▸ h'))
+    | .skip it' h =>
+      return .skip (IterM.Intermediate.dropWhileWithPostcondition P it.internalState.dropping it') (.skip h)
+    | .done h =>
+      return .done (.done h)
+
+private def DropWhile.instFinitenessRelation [Monad m] [Iterator α m β]
+    [Finite α m] {P} :
+    FinitenessRelation (DropWhile α m β P) m where
+  rel := InvImage WellFoundedRelation.rel
+      (IterM.finitelyManySteps ∘ DropWhile.inner ∘ IterM.internalState)
+  wf := by
+    apply InvImage.wf
+    exact WellFoundedRelation.wf
+  subrelation {it it'} h := by
+    obtain ⟨step, h, h'⟩ := h
+    cases h'
+    case yield it' out k h' h'' =>
+      cases h
+      exact IterM.TerminationMeasures.Finite.rel_of_yield h'
+    case skip it' out h' =>
+      cases h
+      exact IterM.TerminationMeasures.Finite.rel_of_skip h'
+    case done _ =>
+      cases h
+    case start it' out h' h'' h''' =>
+      cases h
+      exact IterM.TerminationMeasures.Finite.rel_of_yield h'
+    case dropped it' out h' h'' h''' =>
+      cases h
+      exact IterM.TerminationMeasures.Finite.rel_of_yield h'
+
+instance DropWhile.instFinite [Monad m] [Iterator α m β] [Finite α m] {P} :
+    Finite (DropWhile α m β P) m :=
+  Finite.of_finitenessRelation instFinitenessRelation
+
+instance DropWhile.instIteratorCollect [Monad m] [Monad n] [Iterator α m β] [Productive α m] {P} :
+    IteratorCollect (DropWhile α m β P) m n :=
+  .defaultImplementation
+
+instance DropWhile.instIteratorCollectPartial [Monad m] [Monad n] [Iterator α m β] {P} :
+    IteratorCollectPartial (DropWhile α m β P) m n :=
+  .defaultImplementation
+
+instance DropWhile.instIteratorLoop [Monad m] [Monad n] [Iterator α m β] :
+    IteratorLoop α m n :=
+  .defaultImplementation
+
+instance DropWhile.instIteratorForPartial [Monad m] [Monad n] [Iterator α m β]
+    [IteratorLoopPartial α m n] [MonadLiftT m n] {P} :
+    IteratorLoopPartial (DropWhile α m β P) m n :=
+  .defaultImplementation
+
+end Std.Iterators

src/Std/Data/Iterators/Combinators/Monadic/FilterMap.lean

@@ -0,0 +1,600 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Std.Data.Iterators.Basic
+import Std.Data.Iterators.Consumers.Collect
+import Std.Data.Iterators.Consumers.Loop
+import Std.Data.Iterators.PostConditionMonad
+import Std.Data.Iterators.Internal.Termination
+
+/-!
+
+# Monadic `filterMap`, `filter` and `map` combinators
+
+This file provides iterator combinators for filtering and mapping.
+
+* `IterM.filterMap` either modifies or drops each value based on an option-valued mapping function.
+* `IterM.filter` drops some elements based on a predicate.
+* `IterM.map` modifies each value based on a mapping function
+
+Several variants of these combinators are provided:
+
+* `M` suffix: Instead of a pure function, these variants take a monadic function. Given a suitable
+  `MonadLiftT` instance, they also allow lifting the iterator to another monad first and then
+  applying the mapping function in this monad.
+* `WithPostcondition` suffix: These variants take a monadic function where the return type in the
+  monad is a subtype. This variant is in rare cases necessary for the intrinsic verification of an
+  iterator, and particularly for specialized termination proofs. If possible, avoid this.
+-/
+
+namespace Std.Iterators
+
+/--
+Internal state of the `filterMap` combinator. Do not depend on its internals.
+-/
+@[ext, unbox]
+structure FilterMap (α : Type w) {β γ : Type w}
+    (m : Type w → Type w') (n : Type w → Type w'') (lift : ⦃α : Type w⦄ → m α → n α)
+    (f : β → PostconditionT n (Option γ)) where
+  /-- Internal implementation detail of the iterator library. -/
+  inner : IterM (α := α) m β
+
+/--
+Internal state of the `map` combinator. Do not depend on its internals.
+-/
+def Map (α : Type w) {β γ : Type w} (m : Type w → Type w') (n : Type w → Type w'')
+    (lift : ⦃α : Type w⦄ → m α → n α) [Functor n]
+    (f : β → PostconditionT n γ) :=
+  FilterMap α m n lift (fun b => PostconditionT.map some (f b))
+
+@[always_inline, inline]
+def IterM.InternalCombinators.filterMap {α β γ : Type w} {m : Type w → Type w'}
+    {n : Type w → Type w''} (lift : ⦃α : Type w⦄ → m α → n α)
+    [Iterator α m β] (f : β → PostconditionT n (Option γ))
+    (it : IterM (α := α) m β) : IterM (α := FilterMap α m n lift f) n γ :=
+  toIterM ⟨it⟩ n γ
+
+@[always_inline, inline]
+def IterM.InternalCombinators.map {α β γ : Type w} {m : Type w → Type w'}
+    {n : Type w → Type w''} [Monad n] (lift : ⦃α : Type w⦄ → m α → n α)
+    [Iterator α m β] (f : β → PostconditionT n γ)
+    (it : IterM (α := α) m β) : IterM (α := Map α m n lift f) n γ :=
+  toIterM ⟨it⟩ n γ
+
+/--
+*Note: This is a very general combinator that requires an advanced understanding of monads,
+dependent types and termination proofs. The variants `filterMap` and `filterMapM` are easier to use
+and sufficient for most use cases.*
+
+If `it` is an iterator, then `it.filterMapWithPostcondition f` is another iterator that applies a
+monadic function `f` to all values emitted by `it`. `f` is expected to return an `Option` inside the
+monad. If `f` returns `none`, then nothing is emitted; if it returns `some x`, then `x` is emitted.
+
+`f` is expected to return `PostconditionT n (Option _)`. The base iterator `it` being monadic in
+`m`, `n` can be different from `m`, but `it.filterMapWithPostcondition f` expects a `MonadLiftT m n`
+instance. The `PostconditionT` transformer allows the caller to intrinsically prove properties about
+`f`'s return value in the monad `n`, enabling termination proofs depending on the specific behavior
+of `f`.
+
+**Marble diagram (without monadic effects):**
+
+```text
+it                                ---a --b--c --d-e--⊥
+it.filterMapWithPostcondition     ---a'-----c'-------⊥
+```
+
+(given that `f a = pure (some a)'`, `f c = pure (some c')` and `f b = f d = d e = pure none`)
+
+**Termination properties:**
+
+* `Finite` instance: only if `it` is finite
+* `Productive` instance: only if `it` is finite`
+
+For certain mapping functions `f`, the resulting iterator will be finite (or productive) even though
+no `Finite` (or `Productive`) instance is provided. For example, if `f` never returns `none`, then
+this combinator will preserve productiveness. If `f` is an `ExceptT` monad and will always fail,
+then `it.filterMapWithPostcondition` will be finite even if `it` isn't. In the first case, consider
+using the `map`/`mapM`/`mapWithPostcondition` combinators instead, which provide more instances out of
+the box.
+
+In such situations, the missing instances can be proved manually if the postcondition bundled in
+the `PostconditionT n` monad is strong enough. If `f` always returns `some _`, a suitable
+postcondition is `fun x => x.isSome`; if `f` always fails, a suitable postcondition might be
+`fun _ => False`.
+
+**Performance:**
+
+For each value emitted by the base iterator `it`, this combinator calls `f` and matches on the
+returned `Option` value.
+-/
+@[inline]
+def IterM.filterMapWithPostcondition {α β γ : Type w} {m : Type w → Type w'} {n : Type w → Type w''}
+    [MonadLiftT m n] [Iterator α m β] (f : β → PostconditionT n (Option γ))
+    (it : IterM (α := α) m β) : IterM (α := FilterMap α m n (fun ⦃_⦄ => monadLift) f) n γ :=
+  IterM.InternalCombinators.filterMap (fun ⦃_⦄ => monadLift) f it
+
+/--
+`it.PlausibleStep step` is the proposition that `step` is a possible next step from the
+`filterMap` iterator `it`. This is mostly internally relevant, except if one needs to manually
+prove termination (`Finite` or `Productive` instances, for example) of a `filterMap` iterator.
+-/
+inductive FilterMap.PlausibleStep {α β γ : Type w} {m : Type w → Type w'} {n : Type w → Type w''}
+    {lift : ⦃α : Type w⦄ → m α → n α} {f : β → PostconditionT n (Option γ)} [Iterator α m β]
+    (it : IterM (α := FilterMap α m n lift f) n γ) :
+    IterStep (IterM (α := FilterMap α m n lift f) n γ) γ → Prop where
+  | yieldNone : ∀ {it' out},
+      it.internalState.inner.IsPlausibleStep (.yield it' out) →
+      (f out).Property none →
+      PlausibleStep it (.skip (IterM.InternalCombinators.filterMap lift f it'))
+  | yieldSome : ∀ {it' out out'}, it.internalState.inner.IsPlausibleStep (.yield it' out) →
+      (f out).Property (some out') →
+      PlausibleStep it (.yield (IterM.InternalCombinators.filterMap lift f it') out')
+  | skip : ∀ {it'}, it.internalState.inner.IsPlausibleStep (.skip it') →
+      PlausibleStep it (.skip (IterM.InternalCombinators.filterMap lift f it'))
+  | done : it.internalState.inner.IsPlausibleStep .done → PlausibleStep it .done
+
+instance FilterMap.instIterator {α β γ : Type w} {m : Type w → Type w'} {n : Type w → Type w''}
+    {lift : ⦃α : Type w⦄ → m α → n α} {f : β → PostconditionT n (Option γ)}
+    [Iterator α m β] [Monad n] :
+    Iterator (FilterMap α m n lift f) n γ where
+  IsPlausibleStep := FilterMap.PlausibleStep (m := m) (n := n)
+  step it :=
+    letI : MonadLift m n := ⟨lift (α := _)⟩
+    do
+      match ← it.internalState.inner.step with
+      | .yield it' out h => do
+        match ← (f out).operation with
+        | ⟨none, h'⟩ => pure <| .skip (it'.filterMapWithPostcondition f) (.yieldNone h h')
+        | ⟨some out', h'⟩ => pure <| .yield (it'.filterMapWithPostcondition f) out' (.yieldSome h h')
+      | .skip it' h => pure <| .skip (it'.filterMapWithPostcondition f) (.skip h)
+      | .done h => pure <| .done (.done h)
+
+instance {α β γ : Type w} {m : Type w → Type w'} {n : Type w → Type w''} [Monad n] [Iterator α m β]
+    {lift : ⦃α : Type w⦄ → m α → n α}
+    {f : β → PostconditionT n γ} :
+    Iterator (Map α m n lift f) n γ :=
+  inferInstanceAs <| Iterator (FilterMap α m n lift _) n γ
+
+private def FilterMap.instFinitenessRelation {α β γ : Type w} {m : Type w → Type w'}
+    {n : Type w → Type w''} [Monad n] [Iterator α m β] {lift : ⦃α : Type w⦄ → m α → n α}
+    {f : β → PostconditionT n (Option γ)} [Finite α m] :
+    FinitenessRelation (FilterMap α m n lift f) n where
+  rel := InvImage IterM.IsPlausibleSuccessorOf (FilterMap.inner ∘ IterM.internalState)
+  wf := InvImage.wf _ Finite.wf
+  subrelation {it it'} h := by
+    obtain ⟨step, h, h'⟩ := h
+    cases h'
+    case yieldNone it' out h' h'' =>
+      cases h
+      exact IterM.isPlausibleSuccessorOf_of_yield h'
+    case yieldSome it' out h' h'' =>
+      cases h
+      exact IterM.isPlausibleSuccessorOf_of_yield h'
+    case skip it' h' =>
+      cases h
+      exact IterM.isPlausibleSuccessorOf_of_skip h'
+    case done h' =>
+      cases h
+
+instance FilterMap.instFinite {α β γ : Type w} {m : Type w → Type w'}
+    {n : Type w → Type w''} [Monad n] [Iterator α m β] {lift : ⦃α : Type w⦄ → m α → n α}
+    {f : β → PostconditionT n (Option γ)} [Finite α m] : Finite (FilterMap α m n lift f) n :=
+  Finite.of_finitenessRelation FilterMap.instFinitenessRelation
+
+instance {α β γ : Type w} {m : Type w → Type w'} {n : Type w → Type w''} [Monad n] [Iterator α m β]
+    {lift : ⦃α : Type w⦄ → m α → n α} {f : β → PostconditionT n γ} [Finite α m] :
+    Finite (Map α m n lift f) n :=
+  Finite.of_finitenessRelation FilterMap.instFinitenessRelation
+
+private def Map.instProductivenessRelation {α β γ : Type w} {m : Type w → Type w'}
+    {n : Type w → Type w''} [Monad n] [Iterator α m β] {lift : ⦃α : Type w⦄ → m α → n α}
+    {f : β → PostconditionT n γ} [Productive α m] :
+    ProductivenessRelation (Map α m n lift f) n where
+  rel := InvImage IterM.IsPlausibleSkipSuccessorOf (FilterMap.inner ∘ IterM.internalState)
+  wf := InvImage.wf _ Productive.wf
+  subrelation {it it'} h := by
+    cases h
+    case yieldNone it' out h h' =>
+      simp at h'
+    case skip it' h =>
+      exact h
+
+instance Map.instProductive {α β γ : Type w} {m : Type w → Type w'}
+    {n : Type w → Type w''} [Monad n] [Iterator α m β] {lift : ⦃α : Type w⦄ → m α → n α}
+    {f : β → PostconditionT n γ} [Productive α m] :
+    Productive (Map α m n lift f) n :=
+  Productive.of_productivenessRelation Map.instProductivenessRelation
+
+instance {α β γ : Type w} {m : Type w → Type w'}
+    {n : Type w → Type w''} {o : Type w → Type x} [Monad n] [Monad o] [Iterator α m β]
+    {lift : ⦃α : Type w⦄ → m α → n α}
+    {f : β → PostconditionT n (Option γ)} :
+    IteratorCollect (FilterMap α m n lift f) n o :=
+  .defaultImplementation
+
+instance {α β γ : Type w} {m : Type w → Type w'}
+    {n : Type w → Type w''} {o : Type w → Type x} [Monad n] [Monad o] [Iterator α m β]
+    {lift : ⦃α : Type w⦄ → m α → n α}
+    {f : β → PostconditionT n (Option γ)} [Finite α m] :
+    IteratorCollectPartial (FilterMap α m n lift f) n o :=
+  .defaultImplementation
+
+instance FilterMap.instIteratorLoop {α β γ : Type w} {m : Type w → Type w'}
+    {n : Type w → Type w''} {o : Type w → Type w'''}
+    [Monad n] [Monad o] [Iterator α m β] {lift : ⦃α : Type w⦄ → m α → n α}
+    {f : β → PostconditionT n (Option γ)} [Finite α m] :
+    IteratorLoop (FilterMap α m n lift f) n o :=
+  .defaultImplementation
+
+instance FilterMap.instIteratorLoopPartial {α β γ : Type w} {m : Type w → Type w'}
+    {n : Type w → Type w''} {o : Type w → Type w'''}
+    [Monad n] [Monad o] [Iterator α m β] {lift : ⦃α : Type w⦄ → m α → n α}
+    {f : β → PostconditionT n (Option γ)} [Finite α m] :
+    IteratorLoopPartial (FilterMap α m n lift f) n o :=
+  .defaultImplementation
+
+/--
+`map` operations allow for a more efficient implementation of `toArray`. For example,
+`array.iter.map f |>.toArray happens in-place if possible.
+-/
+instance Map.instIteratorCollect {α β γ : Type w} {m : Type w → Type w'}
+    {n : Type w → Type w''} {o : Type w → Type x} [Monad n] [Monad o] [Iterator α m β]
+    {lift₁ : ⦃α : Type w⦄ → m α → n α}
+    {f : β → PostconditionT n γ} [IteratorCollect α m o] [Finite α m] :
+    IteratorCollect (Map α m n lift₁ f) n o where
+  toArrayMapped lift₂ _ g it :=
+    letI : MonadLift m n := ⟨lift₁ (α := _)⟩
+    letI : MonadLift n o := ⟨lift₂ (δ := _)⟩
+    IteratorCollect.toArrayMapped
+      (lift := fun ⦃_⦄ => monadLift)
+      (fun x => do g (← (f x).operation))
+      it.internalState.inner (m := m)
+
+instance Map.instIteratorCollectPartial {α β γ : Type w} {m : Type w → Type w'}
+    {n : Type w → Type w''} {o : Type w → Type x} [Monad n] [Monad o] [Iterator α m β]
+    {lift₁ : ⦃α : Type w⦄ → m α → n α}
+    {f : β → PostconditionT n γ} [IteratorCollectPartial α m o] :
+    IteratorCollectPartial (Map α m n lift₁ f) n o where
+  toArrayMappedPartial lift₂ _ g it :=
+    IteratorCollectPartial.toArrayMappedPartial
+      (lift := fun ⦃_⦄ a => lift₂ (lift₁ a))
+      (fun x => do g (← lift₂ (f x).operation))
+      it.internalState.inner (m := m)
+
+instance Map.instIteratorLoop {α β γ : Type w} {m : Type w → Type w'}
+    {n : Type w → Type w''} {o : Type w → Type x} [Monad n] [Monad o] [Iterator α m β]
+    {lift : ⦃α : Type w⦄ → m α → n α}
+    {f : β → PostconditionT n γ} :
+    IteratorLoop (Map α m n lift f) n o :=
+  .defaultImplementation
+
+instance Map.instIteratorLoopPartial {α β γ : Type w} {m : Type w → Type w'}
+    {n : Type w → Type w''} {o : Type w → Type x} [Monad n] [Monad o] [Iterator α m β]
+    {lift : ⦃α : Type w⦄ → m α → n α}
+    {f : β → PostconditionT n γ} :
+    IteratorLoopPartial (Map α m n lift f) n o :=
+  .defaultImplementation
+
+/--
+*Note: This is a very general combinator that requires an advanced understanding of monads, dependent
+types and termination proofs. The variants `map` and `mapM` are easier to use and sufficient
+for most use cases.*
+
+If `it` is an iterator, then `it.mapWithPostcondition f` is another iterator that applies a monadic
+function `f` to all values emitted by `it` and emits the result.
+
+`f` is expected to return `PostconditionT n _`. The base iterator `it` being monadic in
+`m`, `n` can be different from `m`, but `it.mapWithPostcondition f` expects a `MonadLiftT m n`
+instance. The `PostconditionT` transformer allows the caller to intrinsically prove properties about
+`f`'s return value in the monad `n`, enabling termination proofs depending on the specific behavior
+of `f`.
+
+**Marble diagram (without monadic effects):**
+
+```text
+it                          ---a --b --c --d -e ----⊥
+it.mapWithPostcondition     ---a'--b'--c'--d'-e'----⊥
+```
+
+(given that `f a = pure a'`, `f b = pure b'` etc.)
+
+**Termination properties:**
+
+* `Finite` instance: only if `it` is finite
+* `Productive` instance: only if `it` is productive
+
+For certain mapping functions `f`, the resulting iterator will be finite (or productive) even though
+no `Finite` (or `Productive`) instance is provided. For exaple, if `f` is an `ExceptT` monad and
+will always fail, then `it.mapWithPostcondition` will be finite even if `it` isn't.
+
+In such situations, the missing instances can be proved manually if the postcondition bundled in
+the `PostconditionT n` monad is strong enough. In the given example, a suitable postcondition might
+be `fun _ => False`.
+
+**Performance:**
+
+For each value emitted by the base iterator `it`, this combinator calls `f`.
+-/
+@[inline]
+def IterM.mapWithPostcondition {α β γ : Type w} {m : Type w → Type w'} {n : Type w → Type w''}
+    [Monad n] [MonadLiftT m n] [Iterator α m β] (f : β → PostconditionT n γ)
+    (it : IterM (α := α) m β) : IterM (α := Map α m n (fun ⦃_⦄ => monadLift) f) n γ :=
+  InternalCombinators.map (fun {_} => monadLift) f it
+
+/--
+*Note: This is a very general combinator that requires an advanced understanding of monads,
+dependent types and termination proofs. The variants `filter` and `filterM` are easier to use and
+sufficient for most use cases.*
+
+If `it` is an iterator, then `it.filterWithPostcondition f` is another iterator that applies a monadic
+predicate `f` to all values emitted by `it` and emits them only if they are accepted by `f`.
+
+`f` is expected to return `PostconditionT n (ULift Bool)`. The base iterator `it` being monadic in
+`m`, `n` can be different from `m`, but `it.filterWithPostcondition f` expects a `MonadLiftT m n`
+instance. The `PostconditionT` transformer allows the caller to intrinsically prove properties about
+`f`'s return value in the monad `n`, enabling termination proofs depending on the specific behavior
+of `f`.
+
+**Marble diagram (without monadic effects):**
+
+```text
+it                             ---a--b--c--d-e--⊥
+it.filterWithPostcondition     ---a-----c-------⊥
+```
+
+(given that `f a = f c = pure true` and `f b = f d = d e = pure false`)
+
+**Termination properties:**
+
+* `Finite` instance: only if `it` is finite
+* `Productive` instance: only if `it` is finite`
+
+For certain mapping functions `f`, the resulting iterator will be finite (or productive) even though
+no `Finite` (or `Productive`) instance is provided. For exaple, if `f` is an `ExceptT` monad and
+will always fail, then `it.filterWithPostcondition` will be finite -- and productive -- even if `it`
+isn't.
+
+In such situations, the missing instances can be proved manually if the postcondition bundled in
+the `PostconditionT n` monad is strong enough. In the given example, a suitable postcondition might
+be `fun _ => False`.
+
+**Performance:**
+
+For each value emitted by the base iterator `it`, this combinator calls `f`.
+-/
+@[inline]
+def IterM.filterWithPostcondition {α β : Type w} {m : Type w → Type w'} {n : Type w → Type w''}
+    [Monad n] [MonadLiftT m n] [Iterator α m β] (f : β → PostconditionT n (ULift Bool))
+    (it : IterM (α := α) m β) :=
+  (it.filterMapWithPostcondition
+    (fun b => (f b).map (fun x => if x.down = true then some b else none)) : IterM n β)
+
+/--
+If `it` is an iterator, then `it.filterMapM f` is another iterator that applies a monadic
+function `f` to all values emitted by `it`. `f` is expected to return an `Option` inside the monad.
+If `f` returns `none`, then nothing is emitted; if it returns `some x`, then `x` is emitted.
+
+The base iterator `it` being monadic in `m`, `f` can return values in any monad `n` for which a
+`MonadLiftT m n` instance is available.
+
+If `f` is pure, then the simpler variant `it.filterMap` can be used instead.
+
+**Marble diagram (without monadic effects):**
+
+```text
+it                ---a --b--c --d-e--⊥
+it.filterMapM     ---a'-----c'-------⊥
+```
+
+(given that `f a = pure (some a)'`, `f c = pure (some c')` and `f b = f d = d e = pure none`)
+
+**Termination properties:**
+
+* `Finite` instance: only if `it` is finite
+* `Productive` instance: only if `it` is finite`
+
+For certain mapping functions `f`, the resulting iterator will be finite (or productive) even though
+no `Finite` (or `Productive`) instance is provided. For example, if `f` never returns `none`, then
+this combinator will preserve productiveness. If `f` is an `ExceptT` monad and will always fail,
+then `it.filterMapM` will be finite even if `it` isn't. In the first case, consider
+using the `map`/`mapM`/`mapWithPostcondition` combinators instead, which provide more instances out of
+the box.
+
+If that does not help, the more general combinator `it.filterMapWithPostcondition f` makes it
+possible to manually prove `Finite` and `Productive` instances depending on the concrete choice of `f`.
+
+**Performance:**
+
+For each value emitted by the base iterator `it`, this combinator calls `f` and matches on the
+returned `Option` value.
+-/
+@[inline]
+def IterM.filterMapM {α β γ : Type w} {m : Type w → Type w'} {n : Type w → Type w''}
+    [Iterator α m β] [Monad n] [MonadLiftT m n]
+    (f : β → n (Option γ)) (it : IterM (α := α) m β) :=
+  (it.filterMapWithPostcondition (fun b => PostconditionT.lift (f b)) : IterM n γ)
+
+/--
+If `it` is an iterator, then `it.mapM f` is another iterator that applies a monadic
+function `f` to all values emitted by `it` and emits the result.
+
+The base iterator `it` being monadic in `m`, `f` can return values in any monad `n` for which a
+`MonadLiftT m n` instance is available.
+
+If `f` is pure, then the simpler variant `it.map` can be used instead.
+
+**Marble diagram (without monadic effects):**
+
+```text
+it          ---a --b --c --d -e ----⊥
+it.mapM     ---a'--b'--c'--d'-e'----⊥
+```
+
+(given that `f a = pure a'`, `f b = pure b'` etc.)
+
+**Termination properties:**
+
+* `Finite` instance: only if `it` is finite
+* `Productive` instance: only if `it` is productive
+
+For certain mapping functions `f`, the resulting iterator will be finite (or productive) even though
+no `Finite` (or `Productive`) instance is provided. For exaple, if `f` is an `ExceptT` monad and
+will always fail, then `it.mapM` will be finite even if `it` isn't.
+
+If that does not help, the more general combinator `it.mapWithPostcondition f` makes it possible to
+manually prove `Finite` and `Productive` instances depending on the concrete choice of `f`.
+
+**Performance:**
+
+For each value emitted by the base iterator `it`, this combinator calls `f`.
+-/
+@[inline]
+def IterM.mapM {α β γ : Type w} {m : Type w → Type w'} {n : Type w → Type w''} [Iterator α m β]
+    [Monad n] [MonadLiftT m n] (f : β → n γ) (it : IterM (α := α) m β) :=
+  (it.filterMapWithPostcondition (fun b => some <$> PostconditionT.lift (f b)) : IterM n γ)
+
+/--
+If `it` is an iterator, then `it.filterM f` is another iterator that applies a monadic
+predicate `f` to all values emitted by `it` and emits them only if they are accepted by `f`.
+
+The base iterator `it` being monadic in `m`, `f` can return values in any monad `n` for which a
+`MonadLiftT m n` instance is available.
+
+If `f` is pure, then the simpler variant `it.filter` can be used instead.
+
+**Marble diagram (without monadic effects):**
+
+```text
+it             ---a--b--c--d-e--⊥
+it.filterM     ---a-----c-------⊥
+```
+
+(given that `f a = f c = pure true` and `f b = f d = d e = pure false`)
+
+**Termination properties:**
+
+* `Finite` instance: only if `it` is finite
+* `Productive` instance: only if `it` is finite`
+
+For certain mapping functions `f`, the resulting iterator will be finite (or productive) even though
+no `Finite` (or `Productive`) instance is provided. For exaple, if `f` is an `ExceptT` monad and
+will always fail, then `it.filterWithPostcondition` will be finite -- and productive -- even if `it`
+isn't.
+
+In such situations, the more general combinator `it.filterWithPostcondition f` makes it possible to
+manually prove `Finite` and `Productive` instances depending on the concrete choice of `f`.
+
+**Performance:**
+
+For each value emitted by the base iterator `it`, this combinator calls `f`.
+-/
+@[inline]
+def IterM.filterM {α β : Type w} {m : Type w → Type w'} {n : Type w → Type w''} [Iterator α m β]
+    [Monad n] [MonadLiftT m n] (f : β → n (ULift Bool)) (it : IterM (α := α) m β) :=
+  (it.filterMapWithPostcondition
+    (fun b => (PostconditionT.lift (f b)).map (if ·.down = true then some b else none)) : IterM n β)
+
+/--
+If `it` is an iterator, then `it.filterMap f` is another iterator that applies a function `f` to all
+values emitted by `it`. `f` is expected to return an `Option`. If it returns `none`, then nothing is
+emitted; if it returns `some x`, then `x` is emitted.
+
+In situations where `f` is monadic, use `filterMapM` instead.
+
+**Marble diagram:**
+
+```text
+it               ---a --b--c --d-e--⊥
+it.filterMap     ---a'-----c'-------⊥
+```
+
+(given that `f a = some a'`, `f c = c'` and `f b = f d = d e = none`)
+
+**Termination properties:**
+
+* `Finite` instance: only if `it` is finite
+* `Productive` instance: only if `it` is finite`
+
+For certain mapping functions `f`, the resulting iterator will be productive even though
+no `Productive` instance is provided. For example, if `f` never returns `none`, then
+this combinator will preserve productiveness. In such situations, the missing instance needs to
+be proved manually.
+
+**Performance:**
+
+For each value emitted by the base iterator `it`, this combinator calls `f` and matches on the
+returned `Option` value.
+-/
+@[inline]
+def IterM.filterMap {α β γ : Type w} {m : Type w → Type w'}
+    [Iterator α m β] [Monad m] (f : β → Option γ) (it : IterM (α := α) m β) :=
+  (it.filterMapWithPostcondition (fun b => pure (f b)) : IterM m γ)
+
+/--
+If `it` is an iterator, then `it.map f` is another iterator that applies a
+function `f` to all values emitted by `it` and emits the result.
+
+In situations where `f` is monadic, use `mapM` instead.
+
+**Marble diagram:**
+
+```text
+it         ---a --b --c --d -e ----⊥
+it.map     ---a'--b'--c'--d'-e'----⊥
+```
+
+(given that `f a = a'`, `f b = b'` etc.)
+
+**Termination properties:**
+
+* `Finite` instance: only if `it` is finite
+* `Productive` instance: only if `it` is productive
+
+**Performance:**
+
+For each value emitted by the base iterator `it`, this combinator calls `f`.
+-/
+@[inline]
+def IterM.map {α β γ : Type w} {m : Type w → Type w'} [Iterator α m β] [Monad m] (f : β → γ)
+    (it : IterM (α := α) m β) :=
+  (it.mapWithPostcondition (fun b => pure (f b)) : IterM m γ)
+
+/--
+If `it` is an iterator, then `it.filter f` is another iterator that applies a
+predicate `f` to all values emitted by `it` and emits them only if they are accepted by `f`.
+
+In situations where `f` is monadic, use `filterM` instead.
+
+**Marble diagram (without monadic effects):**
+
+```text
+it            ---a--b--c--d-e--⊥
+it.filter     ---a-----c-------⊥
+```
+
+(given that `f a = f c = true` and `f b = f d = d e = false`)
+
+**Termination properties:**
+
+* `Finite` instance: only if `it` is finite
+* `Productive` instance: only if `it` is finite`
+
+For certain mapping functions `f`, the resulting iterator will be productive even though
+no `Productive` instance is provided. For example, if `f` always returns `True`, the resulting
+iterator will be productive as long as `it` is. In such situations, the missing instance needs to
+be proved manually.
+
+**Performance:**
+
+For each value emitted by the base iterator `it`, this combinator calls `f` and matches on the
+returned value.
+-/
+@[inline]
+def IterM.filter {α β : Type w} {m : Type w → Type w'} [Iterator α m β] [Monad m]
+    (f : β → Bool) (it : IterM (α := α) m β) :=
+  (it.filterMap (fun b => if f b then some b else none) : IterM m β)
+
+end Std.Iterators

src/Std/Data/Iterators/Combinators/Monadic/Take.lean

@@ -0,0 +1,198 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Init.Data.Nat.Lemmas
+import Init.RCases
+import Std.Data.Iterators.Basic
+import Std.Data.Iterators.Consumers.Monadic.Collect
+import Std.Data.Iterators.Consumers.Monadic.Loop
+import Std.Data.Iterators.Internal.Termination
+
+/-!
+This module provides the iterator combinator `IterM.take`.
+-/
+
+namespace Std.Iterators
+
+variable {α : Type w} {m : Type w → Type w'} {n : Type w → Type w''} {β : Type w}
+
+/--
+The internal state of the `IterM.take` iterator combinator.
+-/
+@[unbox]
+structure Take (α : Type w) (m : Type w → Type w') (β : Type w) where
+  /-- Internal implementation detail of the iterator library -/
+  remaining : Nat
+  /-- Internal implementation detail of the iterator library -/
+  inner : IterM (α := α) m β
+
+/--
+Given an iterator `it` and a natural number `n`, `it.take n` is an iterator that outputs
+up to the first `n` of `it`'s values in order and then terminates.
+
+**Marble diagram:**
+
+```text
+it          ---a----b---c--d-e--⊥
+it.take 3   ---a----b---c⊥
+
+it          ---a--⊥
+it.take 3   ---a--⊥
+```
+
+**Termination properties:**
+
+* `Finite` instance: only if `it` is productive
+* `Productive` instance: only if `it` is productive
+
+**Performance:**
+
+This combinator incurs an additional O(1) cost with each output of `it`.
+-/
+@[always_inline, inline]
+def IterM.take (n : Nat) (it : IterM (α := α) m β) :=
+  toIterM (Take.mk n it) m β
+
+theorem IterM.take.surjective {α : Type w} {m : Type w → Type w'} {β : Type w}
+    (it : IterM (α := Take α m β) m β) :
+    ∃ (it₀ : IterM (α := α) m β) (k : Nat), it = it₀.take k := by
+  refine ⟨it.internalState.inner, it.internalState.remaining, rfl⟩
+
+inductive Take.PlausibleStep [Iterator α m β] (it : IterM (α := Take α m β) m β) :
+    (step : IterStep (IterM (α := Take α m β) m β) β) → Prop where
+  | yield : ∀ {it' out k}, it.internalState.inner.IsPlausibleStep (.yield it' out) →
+      it.internalState.remaining = k + 1 → PlausibleStep it (.yield (it'.take k) out)
+  | skip : ∀ {it' k}, it.internalState.inner.IsPlausibleStep (.skip it') →
+      it.internalState.remaining = k + 1 → PlausibleStep it (.skip (it'.take (k + 1)))
+  | done : it.internalState.inner.IsPlausibleStep .done → PlausibleStep it .done
+  | depleted : it.internalState.remaining = 0 →
+      PlausibleStep it .done
+
+@[always_inline, inline]
+instance Take.instIterator [Monad m] [Iterator α m β] : Iterator (Take α m β) m β where
+  IsPlausibleStep := Take.PlausibleStep
+  step it :=
+    match h : it.internalState.remaining with
+    | 0 => pure <| .done (.depleted h)
+    | k + 1 => do
+      match ← it.internalState.inner.step with
+      | .yield it' out h' => pure <| .yield (it'.take k) out (.yield h' h)
+      | .skip it' h' => pure <| .skip (it'.take (k + 1)) (.skip h' h)
+      | .done h' => pure <| .done (.done h')
+
+def Take.Rel (m : Type w → Type w') [Monad m] [Iterator α m β] [Productive α m] :
+    IterM (α := Take α m β) m β → IterM (α := Take α m β) m β → Prop :=
+  InvImage (Prod.Lex Nat.lt_wfRel.rel IterM.TerminationMeasures.Productive.Rel)
+    (fun it => (it.internalState.remaining, it.internalState.inner.finitelyManySkips))
+
+theorem Take.rel_of_remaining [Monad m] [Iterator α m β] [Productive α m]
+    {it it' : IterM (α := Take α m β) m β}
+    (h : it'.internalState.remaining < it.internalState.remaining) : Take.Rel m it' it :=
+  Prod.Lex.left _ _ h
+
+theorem Take.rel_of_inner [Monad m] [Iterator α m β] [Productive α m] {remaining : Nat}
+    {it it' : IterM (α := α) m β}
+    (h : it'.finitelyManySkips.Rel it.finitelyManySkips) :
+    Take.Rel m (it'.take remaining) (it.take remaining) :=
+  Prod.Lex.right _ h
+
+private def Take.instFinitenessRelation [Monad m] [Iterator α m β]
+    [Productive α m] :
+    FinitenessRelation (Take α m β) m where
+  rel := Take.Rel m
+  wf := by
+    apply InvImage.wf
+    refine ⟨fun (a, b) => Prod.lexAccessible (WellFounded.apply ?_ a) (WellFounded.apply ?_) b⟩
+    · exact WellFoundedRelation.wf
+    · exact WellFoundedRelation.wf
+  subrelation {it it'} h := by
+    obtain ⟨step, h, h'⟩ := h
+    cases h'
+    case yield it' out k h' h'' =>
+      cases h
+      apply rel_of_remaining
+      simp_all [IterM.take]
+    case skip it' out k h' h'' =>
+      cases h
+      obtain ⟨it, k, rfl⟩ := IterM.take.surjective it
+      cases h''
+      apply Take.rel_of_inner
+      exact IterM.TerminationMeasures.Productive.rel_of_skip h'
+    case done _ =>
+      cases h
+    case depleted _ =>
+      cases h
+
+instance Take.instFinite [Monad m] [Iterator α m β] [Productive α m] :
+    Finite (Take α m β) m :=
+  Finite.of_finitenessRelation instFinitenessRelation
+
+instance Take.instIteratorCollect [Monad m] [Monad n] [Iterator α m β] [Productive α m] :
+    IteratorCollect (Take α m β) m n :=
+  .defaultImplementation
+
+instance Take.instIteratorCollectPartial [Monad m] [Monad n] [Iterator α m β] :
+    IteratorCollectPartial (Take α m β) m n :=
+  .defaultImplementation
+
+private def Take.PlausibleForInStep {β : Type u} {γ : Type v}
+    (f : β → γ → ForInStep γ → Prop) :
+    β → γ × Nat → (ForInStep (γ × Nat)) → Prop
+  | out, (c, n), ForInStep.yield (c', n') => n = n' + 1 ∧ f out c (.yield c')
+  | _, _, .done _ => True
+
+private def Take.wellFounded_plausibleForInStep {α β : Type w} {m : Type w → Type w'}
+    [Monad m] [Iterator α m β] {γ : Type x}
+    {f : β → γ → ForInStep γ → Prop} (wf : IteratorLoop.WellFounded (Take α m β) m f) :
+    IteratorLoop.WellFounded α m (PlausibleForInStep f) := by
+      simp only [IteratorLoop.WellFounded] at ⊢ wf
+      letI : WellFoundedRelation _ := ⟨_, wf⟩
+      apply Subrelation.wf
+        (r := InvImage WellFoundedRelation.rel fun p => (p.1.take (p.2.2 + 1), p.2.1))
+        (fun {p q} h => by
+          simp only [InvImage, WellFoundedRelation.rel, this, IteratorLoop.rel,
+            IterM.IsPlausibleStep, Iterator.IsPlausibleStep]
+          obtain ⟨out, h, h'⟩ | ⟨h, h'⟩ := h
+          · apply Or.inl
+            exact ⟨out, .yield h (by simp only [IterM.take, internalState_toIterM,
+                Nat.add_right_cancel_iff, this]; exact h'.1), h'.2⟩
+          · apply Or.inr
+            refine ⟨?_, by rw [h']⟩
+            rw [h']
+            apply PlausibleStep.skip
+            · exact h
+            · rfl)
+      apply InvImage.wf
+      exact WellFoundedRelation.wf
+
+instance Take.instIteratorFor [Monad m] [Monad n] [Iterator α m β]
+    [IteratorLoop α m n] [MonadLiftT m n] :
+    IteratorLoop (Take α m β) m n where
+  forIn lift {γ} Plausible wf it init f := by
+    refine Prod.fst <$> IteratorLoop.forIn lift (γ := γ × Nat)
+        (PlausibleForInStep Plausible)
+        (wellFounded_plausibleForInStep wf)
+        it.internalState.inner
+        (init, it.internalState.remaining)
+        fun out acc =>
+          match h : acc.snd with
+          | 0 => pure <| ⟨.done acc, True.intro⟩
+          | n + 1 => (fun
+              | ⟨.yield x, hp⟩ => ⟨.yield ⟨x, n⟩, ⟨h, hp⟩⟩
+              | ⟨.done x ,hp⟩ => ⟨.done ⟨x, n⟩, .intro⟩) <$> f out acc.fst
+
+instance Take.instIteratorForPartial [Monad m] [Monad n] [Iterator α m β]
+    [IteratorLoopPartial α m n] [MonadLiftT m n] :
+    IteratorLoopPartial (Take α m β) m n where
+  forInPartial lift {γ} it init f := do
+    Prod.fst <$> IteratorLoopPartial.forInPartial lift it.internalState.inner (γ := γ × Nat)
+        (init, it.internalState.remaining)
+        fun out acc =>
+          match acc.snd with
+          | 0 => pure <| .done acc
+          | n + 1 => (fun | .yield x => .yield ⟨x, n⟩ | .done x => .done ⟨x, n⟩) <$> f out acc.fst
+
+end Std.Iterators

src/Std/Data/Iterators/Combinators/Monadic/TakeWhile.lean

@@ -0,0 +1,289 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Init.Data.Nat.Lemmas
+import Init.RCases
+import Std.Data.Iterators.Basic
+import Std.Data.Iterators.Consumers.Monadic.Collect
+import Std.Data.Iterators.Consumers.Monadic.Loop
+import Std.Data.Iterators.Internal.Termination
+import Std.Data.Iterators.PostConditionMonad
+
+/-!
+# Monadic `takeWhile` iterator combinator
+
+This module provides the iterator combinator `IterM.takeWhile` that will take all values emitted
+by a given iterator until a given predicate on these values becomes false the first fime. Then
+the combinator will terminate.
+
+Several variants of this combinator are provided:
+
+* `M` suffix: Instead of a pure function, this variant takes a monadic function. Given a suitable
+  `MonadLiftT` instance, it will also allow lifting the iterator to another monad first and then
+  applying the mapping function in this monad.
+* `WithPostcondition` suffix: This variant takes a monadic function where the return type in the
+  monad is a subtype. This variant is in rare cases necessary for the intrinsic verification of an
+  iterator, and particularly for specialized termination proofs. If possible, avoid this.
+-/
+
+namespace Std.Iterators
+
+variable {α : Type w} {m : Type w → Type w'} {n : Type w → Type w''} {β : Type w}
+
+/--
+Internal state of the `takeWhile` combinator. Do not depend on its internals.
+-/
+@[unbox]
+structure TakeWhile (α : Type w) (m : Type w → Type w') (β : Type w)
+    (P : β → PostconditionT m (ULift Bool)) where
+  /-- Internal implementation detail of the iterator library. -/
+  inner : IterM (α := α) m β
+
+/--
+*Note: This is a very general combinator that requires an advanced understanding of monads,
+dependent types and termination proofs. The variants `takeWhile` and `takeWhileM` are easier to use
+and sufficient for most use cases.*
+
+Given an iterator `it` and a monadic predicate `P`, `it.takeWhileWithPostcondition P` is an iterator
+that emits the values emitted by `it` until one of those values is rejected by `P`.
+If some emitted value is rejected by `P`, the value is dropped and the iterator terminates.
+
+`P` is expected to return `PostconditionT m (ULift Bool)`. The `PostconditionT` transformer allows
+the caller to intrinsically prove properties about `P`'s return value in the monad `m`, enabling
+termination proofs depending on the specific behavior of `P`.
+
+**Marble diagram (ignoring monadic effects):**
+
+Assuming that the predicate `P` accepts `a` and `b` but rejects `c`:
+
+```text
+it                                ---a----b---c--d-e--⊥
+it.takeWhileWithPostcondition P   ---a----b---⊥
+
+it                                ---a----⊥
+it.takeWhileWithPostcondition P   ---a----⊥
+```
+
+**Termination properties:**
+
+* `Finite` instance: only if `it` is finite
+* `Productive` instance: only if `it` is productive
+
+Depending on `P`, it is possible that `it.takeWhileWithPostcondition P` is finite (or productive)
+although `it` is not. In this case, the `Finite` (or `Productive`) instance needs to be proved
+manually.
+
+**Performance:**
+
+This combinator calls `P` on each output of `it` until the predicate evaluates to false. Then
+it terminates.
+-/
+@[always_inline, inline]
+def IterM.takeWhileWithPostcondition (P : β → PostconditionT m (ULift Bool)) (it : IterM (α := α) m β) :=
+  (toIterM (TakeWhile.mk (P := P) it) m β : IterM m β)
+
+/--
+Given an iterator `it` and a monadic predicate `P`, `it.takeWhileM P` is an iterator that outputs
+the values emitted by `it` until one of those values is rejected by `P`.
+If some emitted value is rejected by `P`, the value is dropped and the iterator terminates.
+
+If `P` is pure, then the simpler variant `takeWhile` can be used instead.
+
+**Marble diagram (ignoring monadic effects):**
+
+Assuming that the predicate `P` accepts `a` and `b` but rejects `c`:
+
+```text
+it                ---a----b---c--d-e--⊥
+it.takeWhileM P   ---a----b---⊥
+
+it                ---a----⊥
+it.takeWhileM P   ---a----⊥
+```
+
+**Termination properties:**
+
+* `Finite` instance: only if `it` is finite
+* `Productive` instance: only if `it` is productive
+
+Depending on `P`, it is possible that `it.takeWhileM P` is finite (or productive) although `it` is not.
+In this case, the `Finite` (or `Productive`) instance needs to be proved manually.
+
+**Performance:**
+
+This combinator calls `P` on each output of `it` until the predicate evaluates to false. Then
+it terminates.
+-/
+@[always_inline, inline]
+def IterM.takeWhileM [Monad m] (P : β → m (ULift Bool)) (it : IterM (α := α) m β) :=
+  (it.takeWhileWithPostcondition (PostconditionT.lift ∘ P) : IterM m β)
+
+/--
+Given an iterator `it` and a predicate `P`, `it.takeWhile P` is an iterator that outputs
+the values emitted by `it` until one of those values is rejected by `P`.
+If some emitted value is rejected by `P`, the value is dropped and the iterator terminates.
+
+In situations where `P` is monadic, use `takeWhileM` instead.
+
+**Marble diagram (ignoring monadic effects):**
+
+Assuming that the predicate `P` accepts `a` and `b` but rejects `c`:
+
+```text
+it               ---a----b---c--d-e--⊥
+it.takeWhile P   ---a----b---⊥
+
+it               ---a----⊥
+it.takeWhile P   ---a----⊥
+```
+
+**Termination properties:**
+
+* `Finite` instance: only if `it` is finite
+* `Productive` instance: only if `it` is productive
+
+Depending on `P`, it is possible that `it.takeWhile P` is finite (or productive) although `it` is not.
+In this case, the `Finite` (or `Productive`) instance needs to be proved manually.
+
+**Performance:**
+
+This combinator calls `P` on each output of `it` until the predicate evaluates to false. Then
+it terminates.
+-/
+@[always_inline, inline]
+def IterM.takeWhile [Monad m] (P : β → Bool) (it : IterM (α := α) m β) :=
+  (it.takeWhileM (pure ∘ ULift.up ∘ P) : IterM m β)
+
+/--
+`it.PlausibleStep step` is the proposition that `step` is a possible next step from the
+`takeWhile` iterator `it`. This is mostly internally relevant, except if one needs to manually
+prove termination (`Finite` or `Productive` instances, for example) of a `takeWhile` iterator.
+-/
+inductive TakeWhile.PlausibleStep [Iterator α m β] {P} (it : IterM (α := TakeWhile α m β P) m β) :
+    (step : IterStep (IterM (α := TakeWhile α m β P) m β) β) → Prop where
+  | yield : ∀ {it' out}, it.internalState.inner.IsPlausibleStep (.yield it' out) →
+      (P out).Property (.up true) → PlausibleStep it (.yield (it'.takeWhileWithPostcondition P) out)
+  | skip : ∀ {it'}, it.internalState.inner.IsPlausibleStep (.skip it') →
+      PlausibleStep it (.skip (it'.takeWhileWithPostcondition P))
+  | done : it.internalState.inner.IsPlausibleStep .done → PlausibleStep it .done
+  | rejected : ∀ {it' out}, it.internalState.inner.IsPlausibleStep (.yield it' out) →
+      (P out).Property (.up false) → PlausibleStep it .done
+
+@[always_inline, inline]
+instance TakeWhile.instIterator [Monad m] [Iterator α m β] {P} :
+    Iterator (TakeWhile α m β P) m β where
+  IsPlausibleStep := TakeWhile.PlausibleStep
+  step it := do
+    match ← it.internalState.inner.step with
+    | .yield it' out h => match ← (P out).operation with
+      | ⟨.up true, h'⟩ => pure <| .yield (it'.takeWhileWithPostcondition P) out (.yield h h')
+      | ⟨.up false, h'⟩ => pure <| .done (.rejected h h')
+    | .skip it' h => pure <| .skip (it'.takeWhileWithPostcondition P) (.skip h)
+    | .done h => pure <| .done (.done h)
+
+private def TakeWhile.instFinitenessRelation [Monad m] [Iterator α m β]
+    [Finite α m] {P} :
+    FinitenessRelation (TakeWhile α m β P) m where
+  rel := InvImage WellFoundedRelation.rel (IterM.finitelyManySteps ∘ TakeWhile.inner ∘ IterM.internalState)
+  wf := by
+    apply InvImage.wf
+    exact WellFoundedRelation.wf
+  subrelation {it it'} h := by
+    obtain ⟨step, h, h'⟩ := h
+    cases h'
+    case yield it' out k h' h'' =>
+      cases h
+      exact IterM.TerminationMeasures.Finite.rel_of_yield h'
+    case skip it' out h' =>
+      cases h
+      exact IterM.TerminationMeasures.Finite.rel_of_skip h'
+    case done _ =>
+      cases h
+    case rejected _ =>
+      cases h
+
+instance TakeWhile.instFinite [Monad m] [Iterator α m β] [Finite α m] {P} :
+    Finite (TakeWhile α m β P) m :=
+  Finite.of_finitenessRelation instFinitenessRelation
+
+private def TakeWhile.instProductivenessRelation [Monad m] [Iterator α m β]
+    [Productive α m] {P} :
+    ProductivenessRelation (TakeWhile α m β P) m where
+  rel := InvImage WellFoundedRelation.rel (IterM.finitelyManySkips ∘ TakeWhile.inner ∘ IterM.internalState)
+  wf := by
+    apply InvImage.wf
+    exact WellFoundedRelation.wf
+  subrelation {it it'} h := by
+    cases h
+    exact IterM.TerminationMeasures.Productive.rel_of_skip ‹_›
+
+instance TakeWhile.instProductive [Monad m] [Iterator α m β] [Productive α m] {P} :
+    Productive (TakeWhile α m β P) m :=
+  Productive.of_productivenessRelation instProductivenessRelation
+
+instance TakeWhile.instIteratorCollect [Monad m] [Monad n] [Iterator α m β] [Productive α m] {P} :
+    IteratorCollect (TakeWhile α m β P) m n :=
+  .defaultImplementation
+
+instance TakeWhile.instIteratorCollectPartial [Monad m] [Monad n] [Iterator α m β] {P} :
+    IteratorCollectPartial (TakeWhile α m β P) m n :=
+  .defaultImplementation
+
+private def TakeWhile.PlausibleForInStep {β : Type u} {γ : Type v}
+    (P : β → PostconditionT m (ULift Bool))
+    (f : β → γ → ForInStep γ → Prop) :
+    β → γ → (ForInStep γ) → Prop
+  | out, c, ForInStep.yield c' => (P out).Property (.up true) ∧ f out c (.yield c')
+  | _, _, .done _ => True
+
+private def TakeWhile.wellFounded_plausibleForInStep {α β : Type w} {m : Type w → Type w'}
+    [Monad m] [Iterator α m β] {γ : Type x} {P}
+    {f : β → γ → ForInStep γ → Prop} (wf : IteratorLoop.WellFounded (TakeWhile α m β P) m f) :
+    IteratorLoop.WellFounded α m (PlausibleForInStep P f) := by
+      simp only [IteratorLoop.WellFounded] at ⊢ wf
+      letI : WellFoundedRelation _ := ⟨_, wf⟩
+      apply Subrelation.wf
+        (r := InvImage WellFoundedRelation.rel fun p => (p.1.takeWhileWithPostcondition P, p.2))
+        (fun {p q} h => by
+          simp only [InvImage, WellFoundedRelation.rel, this, IteratorLoop.rel,
+            IterM.IsPlausibleStep, Iterator.IsPlausibleStep]
+          obtain ⟨out, h, h'⟩ | ⟨h, h'⟩ := h
+          · apply Or.inl
+            exact ⟨out, .yield h h'.1, h'.2⟩
+          · apply Or.inr
+            refine ⟨?_, h'⟩
+            exact PlausibleStep.skip h)
+      apply InvImage.wf
+      exact WellFoundedRelation.wf
+
+instance TakeWhile.instIteratorLoop [Monad m] [Monad n] [Iterator α m β]
+    [IteratorLoop α m n] [MonadLiftT m n] :
+    IteratorLoop (TakeWhile α m β P) m n where
+  forIn lift {γ} Plausible wf it init f := by
+    refine IteratorLoop.forIn lift (γ := γ)
+        (PlausibleForInStep P Plausible)
+        (wellFounded_plausibleForInStep wf)
+        it.internalState.inner
+        init
+        fun out acc => do match ← (P out).operation with
+          | ⟨.up true, h⟩ => match ← f out acc with
+            | ⟨.yield c, h'⟩ => pure ⟨.yield c, h, h'⟩
+            | ⟨.done c, h'⟩ => pure ⟨.done c, .intro⟩
+          | ⟨.up false, h⟩ => pure ⟨.done acc, .intro⟩
+
+instance TakeWhile.instIteratorForPartial [Monad m] [Monad n] [Iterator α m β]
+    [IteratorLoopPartial α m n] [MonadLiftT m n] {P} :
+    IteratorLoopPartial (TakeWhile α m β P) m n where
+  forInPartial lift {γ} it init f := do
+    IteratorLoopPartial.forInPartial lift it.internalState.inner (γ := γ)
+        init
+        fun out acc => do match ← (P out).operation with
+          | ⟨.up true, _⟩ => match ← f out acc with
+            | .yield c => pure (.yield c)
+            | .done c => pure (.done c)
+          | ⟨.up false, _⟩ => pure (.done acc)
+
+end Std.Iterators

src/Std/Data/Iterators/Combinators/Monadic/Zip.lean

@@ -0,0 +1,395 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Init.Data.Option.Lemmas
+import Std.Data.Iterators.Basic
+import Std.Data.Iterators.Consumers.Collect
+import Std.Data.Iterators.Consumers.Loop
+import Std.Data.Iterators.Internal.Termination
+
+/-!
+
+# Monadic `zip` combinator
+
+This file provides an iterator combinator `IterM.zip` that combines two iterators into an iterator
+of pairs.
+-/
+
+namespace Std.Internal.Option
+
+/- TODO: move this to Init.Data.Option -/
+namespace SomeLtNone
+
+/--
+Lifts an ordering relation to `Option`, such that `none` is the greatest element.
+
+It can be understood as adding a distinguished greatest element, represented by `none`, to both `α`
+and `β`.
+
+Caution: Given `LT α`, `Option.SomeLtNone.lt LT.lt` differs from the `LT (Option α)` instance,
+which is implemented by `Option.lt Lt.lt`.
+
+Examples:
+ * `Option.lt (fun n k : Nat => n < k) none none = False`
+ * `Option.lt (fun n k : Nat => n < k) none (some 3) = False`
+ * `Option.lt (fun n k : Nat => n < k) (some 3) none = True`
+ * `Option.lt (fun n k : Nat => n < k) (some 4) (some 5) = True`
+ * `Option.lt (fun n k : Nat => n < k) (some 4) (some 4) = False`
+-/
+def lt {α} (r : α → α → Prop) : Option α → Option α → Prop
+  | none, _ => false
+  | some _, none => true
+  | some a', some a => r a' a
+
+end SomeLtNone
+
+/- TODO: Move these to Init.Data.Option.Lemmas in a separate PR -/
+theorem wellFounded_lt {α} {rel : α → α → Prop} (h : WellFounded rel) :
+    WellFounded (Option.lt rel) := by
+  refine ⟨fun x => ?_⟩
+  have hn : Acc (Option.lt rel) none := by
+    refine Acc.intro none ?_
+    intro y hyx
+    cases y <;> cases hyx
+  cases x
+  · exact hn
+  · rename_i x
+    induction h.apply x
+    rename_i x' h ih
+    refine Acc.intro _ ?_
+    intro y hyx'
+    cases y
+    · exact hn
+    · exact ih _ hyx'
+
+theorem SomeLtNone.wellFounded_lt {α} {r : α → α → Prop} (h : WellFounded r) :
+    WellFounded (SomeLtNone.lt r) := by
+  refine ⟨?_⟩
+  intro x
+  constructor
+  intro x' hlt
+  match x' with
+  | none => contradiction
+  | some x' =>
+    clear hlt
+    induction h.apply x'
+    rename_i ih
+    constructor
+    intro x'' hlt'
+    match x'' with
+    | none => contradiction
+    | some x'' => exact ih x'' hlt'
+
+end Std.Internal.Option
+
+namespace Std.Iterators
+open Std.Internal
+
+variable {m : Type w → Type w'}
+  {α₁ : Type w} {β₁ : Type w} [Iterator α₁ m β₁]
+  {α₂ : Type w} {β₂ : Type w} [Iterator α₂ m β₂]
+
+/--
+Internal state of the `zip` combinator. Do not depend on its internals.
+-/
+@[unbox]
+structure Zip (α₁ : Type w) (m : Type w → Type w') {β₁ : Type w} [Iterator α₁ m β₁] (α₂ : Type w) (β₂ : Type w) where
+  left : IterM (α := α₁) m β₁
+  memoizedLeft : (Option { out : β₁ // ∃ it : IterM (α := α₁) m β₁, it.IsPlausibleOutput out })
+  right : IterM (α := α₂) m β₂
+
+/--
+`it.PlausibleStep step` is the proposition that `step` is a possible next step from the
+`zip` iterator `it`. This is mostly internally relevant, except if one needs to manually
+prove termination (`Finite` or `Productive` instances, for example) of a `zip` iterator.
+-/
+inductive Zip.PlausibleStep (it : IterM (α := Zip α₁ m α₂ β₂) m (β₁ × β₂)) :
+    IterStep (IterM (α := Zip α₁ m α₂ β₂) m (β₁ × β₂)) (β₁ × β₂) → Prop where
+  | yieldLeft (hm : it.internalState.memoizedLeft = none) {it' out}
+      (hp : it.internalState.left.IsPlausibleStep (.yield it' out)) :
+      PlausibleStep it (.skip ⟨⟨it', (some ⟨out, _, _, hp⟩), it.internalState.right⟩⟩)
+  | skipLeft (hm : it.internalState.memoizedLeft = none) {it'}
+      (hp : it.internalState.left.IsPlausibleStep (.skip it')) :
+      PlausibleStep it (.skip ⟨⟨it', none, it.internalState.right⟩⟩)
+  | doneLeft (hm : it.internalState.memoizedLeft = none)
+      (hp : it.internalState.left.IsPlausibleStep .done) :
+      PlausibleStep it .done
+  | yieldRight {out₁} (hm : it.internalState.memoizedLeft = some out₁) {it₂' out₂}
+      (hp : it.internalState.right.IsPlausibleStep (.yield it₂' out₂)) :
+      PlausibleStep it (.yield ⟨⟨it.internalState.left, none, it₂'⟩⟩ (out₁, out₂))
+  | skipRight {out₁} (hm : it.internalState.memoizedLeft = some out₁) {it₂'}
+      (hp : it.internalState.right.IsPlausibleStep (.skip it₂')) :
+      PlausibleStep it (.skip ⟨⟨it.internalState.left, (some out₁), it₂'⟩⟩)
+  | doneRight {out₁} (hm : it.internalState.memoizedLeft = some out₁)
+      (hp : it.internalState.right.IsPlausibleStep .done) :
+      PlausibleStep it .done
+
+instance Zip.instIterator [Monad m] :
+    Iterator (Zip α₁ m α₂ β₂) m (β₁ × β₂) where
+  IsPlausibleStep := PlausibleStep
+  step it :=
+    match hm : it.internalState.memoizedLeft with
+    | none => do
+      match ← it.internalState.left.step with
+      | .yield it₁' out hp =>
+          pure <| .skip ⟨⟨it₁', (some ⟨out, _, _, hp⟩), it.internalState.right⟩⟩ (.yieldLeft hm hp)
+      | .skip it₁' hp =>
+          pure <| .skip ⟨⟨it₁', none, it.internalState.right⟩⟩ (.skipLeft hm hp)
+      | .done hp =>
+          pure <| .done (.doneLeft hm hp)
+    | some out₁ => do
+      match ← it.internalState.right.step with
+      | .yield it₂' out₂ hp =>
+          pure <| .yield ⟨⟨it.internalState.left, none, it₂'⟩⟩ (out₁, out₂) (.yieldRight hm hp)
+      | .skip it₂' hp =>
+          pure <| .skip ⟨⟨it.internalState.left, (some out₁), it₂'⟩⟩ (.skipRight hm hp)
+      | .done hp =>
+          pure <| .done (.doneRight hm hp)
+
+/--
+Given two iterators `left` and `right`, `left.zip right` is an iterator that yields pairs of
+outputs of `left` and `right`. When one of them terminates,
+the `zip` iterator will also terminate.
+
+**Marble diagram:**
+
+```text
+left               --a        ---b        --c
+right                 --x         --y        --⊥
+left.zip right     -----(a, x)------(b, y)-----⊥
+```
+
+**Termination properties:**
+
+* `Finite` instance: only if either `left` or `right` is finite and the other is productive
+* `Productive` instance: only if `left` and `right` are productive
+
+There are situations where `left.zip right` is finite (or productive) but none of the instances
+above applies. For example, if the computation happens in an `Except` monad and `left` immediately
+fails when calling `step`, then `left.zip right` will also do so. In such a case, the `Finite`
+(or `Productive`) instance needs to be proved manually.
+
+**Performance:**
+
+This combinator incurs an additional O(1) cost with each step taken by `left` or `right`.
+
+Right now, the compiler does not unbox the internal state, leading to worse performance than
+possible.
+-/
+@[always_inline, inline]
+def IterM.zip
+    (left : IterM (α := α₁) m β₁) (right : IterM (α := α₂) m β₂) :
+    IterM (α := Zip α₁ m α₂ β₂) m (β₁ × β₂) :=
+  toIterM ⟨left, none, right⟩ m _
+
+variable (m) in
+def Zip.Rel₁ [Finite α₁ m] [Productive α₂ m] :
+    IterM (α := Zip α₁ m α₂ β₂) m (β₁ × β₂) → IterM (α := Zip α₁ m α₂ β₂) m (β₁ × β₂) → Prop :=
+  InvImage (Prod.Lex
+      IterM.TerminationMeasures.Finite.Rel
+      (Prod.Lex (Option.lt emptyRelation) IterM.TerminationMeasures.Productive.Rel))
+    (fun it => (it.internalState.left.finitelyManySteps, (it.internalState.memoizedLeft, it.internalState.right.finitelyManySkips)))
+
+theorem Zip.rel₁_of_left [Finite α₁ m] [Productive α₂ m] {it' it : IterM (α := Zip α₁ m α₂ β₂) m (β₁ × β₂)}
+    (h : it'.internalState.left.finitelyManySteps.Rel it.internalState.left.finitelyManySteps) :
+    Zip.Rel₁ m it' it :=
+  Prod.Lex.left _ _ h
+
+theorem Zip.rel₁_of_memoizedLeft [Finite α₁ m] [Productive α₂ m]
+    {left : IterM (α := α₁) m β₁} {b' b} {right' right : IterM (α := α₂) m β₂}
+    (h : Option.lt emptyRelation b' b) :
+    Zip.Rel₁ m ⟨left, b', right'⟩ ⟨left, b, right⟩ :=
+  Prod.Lex.right _ <| Prod.Lex.left _ _ h
+
+theorem Zip.rel₁_of_right [Finite α₁ m] [Productive α₂ m]
+    {left : IterM (α := α₁) m β₁} {b b' : _} {it' it : IterM (α := α₂) m β₂}
+    (h : b' = b)
+    (h' : it'.finitelyManySkips.Rel it.finitelyManySkips) :
+    Zip.Rel₁ m ⟨left, b', it'⟩ ⟨left, b, it⟩ := by
+  cases h
+  exact Prod.Lex.right _ <| Prod.Lex.right _ h'
+
+def Zip.instFinitenessRelation₁ [Monad m] [Finite α₁ m] [Productive α₂ m] :
+    FinitenessRelation (Zip α₁ m α₂ β₂) m where
+  rel := Zip.Rel₁ m
+  wf := by
+    apply InvImage.wf
+    refine ⟨fun (a, b) => Prod.lexAccessible (WellFounded.apply ?_ a) (WellFounded.apply ?_) b⟩
+    · exact WellFoundedRelation.wf
+    · refine ⟨fun (a, b) => Prod.lexAccessible (WellFounded.apply ?_ a) (WellFounded.apply ?_) b⟩
+      · apply Option.wellFounded_lt
+        exact emptyWf.wf
+      · exact WellFoundedRelation.wf
+  subrelation {it it'} h := by
+    obtain ⟨step, h, h'⟩ := h
+    cases h'
+    case yieldLeft hm it' out hp =>
+      cases h
+      apply Zip.rel₁_of_left
+      exact IterM.TerminationMeasures.Finite.rel_of_yield ‹_›
+    case skipLeft hm it' hp =>
+      cases h
+      apply Zip.rel₁_of_left
+      exact IterM.TerminationMeasures.Finite.rel_of_skip ‹_›
+    case doneLeft hm hp =>
+      cases h
+    case yieldRight out₁ hm it₂' out₂ hp =>
+      cases h
+      apply Zip.rel₁_of_memoizedLeft
+      simp [Option.lt, hm]
+    case skipRight out₁ hm it₂' hp =>
+      cases h
+      apply Zip.rel₁_of_right
+      · simp_all
+      · exact IterM.TerminationMeasures.Productive.rel_of_skip ‹_›
+    case doneRight out₁ hm hp =>
+      cases h
+
+instance Zip.instFinite₁ [Monad m] [Finite α₁ m] [Productive α₂ m] :
+    Finite (Zip α₁ m α₂ β₂) m :=
+  Finite.of_finitenessRelation Zip.instFinitenessRelation₁
+
+variable (m) in
+def Zip.Rel₂ [Productive α₁ m] [Finite α₂ m] :
+    IterM (α := Zip α₁ m α₂ β₂) m (β₁ × β₂) → IterM (α := Zip α₁ m α₂ β₂) m (β₁ × β₂) → Prop :=
+  InvImage (Prod.Lex
+      IterM.TerminationMeasures.Finite.Rel
+      (Prod.Lex (Option.SomeLtNone.lt emptyRelation) IterM.TerminationMeasures.Productive.Rel))
+    (fun it => (it.internalState.right.finitelyManySteps, (it.internalState.memoizedLeft, it.internalState.left.finitelyManySkips)))
+
+theorem Zip.rel₂_of_right [Productive α₁ m] [Finite α₂ m] {it' it : IterM (α := Zip α₁ m α₂ β₂) m (β₁ × β₂)}
+    (h : it'.internalState.right.finitelyManySteps.Rel it.internalState.right.finitelyManySteps) : Zip.Rel₂ m it' it :=
+  Prod.Lex.left _ _ h
+
+theorem Zip.rel₂_of_memoizedLeft [Productive α₁ m] [Finite α₂ m]
+    {right : IterM (α := α₂) m β₂} {b' b} {left' left : IterM (α := α₁) m β₁}
+    (h : Option.SomeLtNone.lt emptyRelation b' b) :
+    Zip.Rel₂ m ⟨left, b', right⟩ ⟨left', b, right⟩ :=
+  Prod.Lex.right _ <| Prod.Lex.left _ _ h
+
+theorem Zip.rel₂_of_left [Productive α₁ m] [Finite α₂ m]
+    {right : IterM (α := α₂) m β₂} {b b' : _} {it' it : IterM (α := α₁) m β₁}
+    (h : b' = b)
+    (h' : it'.finitelyManySkips.Rel it.finitelyManySkips) :
+    Zip.Rel₂ m ⟨it', b', right⟩ ⟨it, b, right⟩ := by
+  cases h
+  exact Prod.Lex.right _ <| Prod.Lex.right _ h'
+
+def Zip.instFinitenessRelation₂ [Monad m] [Productive α₁ m] [Finite α₂ m] :
+    FinitenessRelation (Zip α₁ m α₂ β₂) m where
+  rel := Zip.Rel₂ m
+  wf := by
+    apply InvImage.wf
+    refine ⟨fun (a, b) => Prod.lexAccessible (WellFounded.apply ?_ a) (WellFounded.apply ?_) b⟩
+    · exact WellFoundedRelation.wf
+    · refine ⟨fun (a, b) => Prod.lexAccessible (WellFounded.apply ?_ a) (WellFounded.apply ?_) b⟩
+      · apply Option.SomeLtNone.wellFounded_lt
+        exact emptyWf.wf
+      · exact WellFoundedRelation.wf
+  subrelation {it it'} h := by
+    obtain ⟨step, h, h'⟩ := h
+    cases h'
+    case yieldLeft hm it' out hp =>
+      cases h
+      apply Zip.rel₂_of_memoizedLeft
+      simp_all [Option.SomeLtNone.lt]
+    case skipLeft hm it' hp =>
+      cases h
+      apply Zip.rel₂_of_left
+      · simp_all
+      · exact IterM.TerminationMeasures.Productive.rel_of_skip ‹_›
+    case doneLeft hm hp =>
+      cases h
+    case yieldRight out₁ hm it₂' out₂ hp =>
+      cases h
+      apply Zip.rel₂_of_right
+      exact IterM.TerminationMeasures.Finite.rel_of_yield ‹_›
+    case skipRight out₁ hm it₂' hp =>
+      cases h
+      apply Zip.rel₂_of_right
+      exact IterM.TerminationMeasures.Finite.rel_of_skip ‹_›
+    case doneRight out₁ hm hp =>
+      cases h
+
+instance Zip.instFinite₂ [Monad m] [Productive α₁ m] [Finite α₂ m] :
+    Finite (Zip α₁ m α₂ β₂) m :=
+  Finite.of_finitenessRelation Zip.instFinitenessRelation₂
+
+variable (m) in
+def Zip.Rel₃ [Productive α₁ m] [Productive α₂ m] :
+    IterM (α := Zip α₁ m α₂ β₂) m (β₁ × β₂) → IterM (α := Zip α₁ m α₂ β₂) m (β₁ × β₂) → Prop :=
+  InvImage (Prod.Lex
+      (Option.SomeLtNone.lt emptyRelation)
+      (Prod.Lex (IterM.TerminationMeasures.Productive.Rel) IterM.TerminationMeasures.Productive.Rel))
+    (fun it => (it.internalState.memoizedLeft, (it.internalState.left.finitelyManySkips, it.internalState.right.finitelyManySkips)))
+
+theorem Zip.rel₃_of_memoizedLeft [Productive α₁ m] [Productive α₂ m] {it' it : IterM (α := Zip α₁ m α₂ β₂) m (β₁ × β₂)}
+    (h : Option.SomeLtNone.lt emptyRelation it'.internalState.memoizedLeft it.internalState.memoizedLeft) :
+    Zip.Rel₃ m it' it :=
+  Prod.Lex.left _ _ h
+
+theorem Zip.rel₃_of_left [Productive α₁ m] [Productive α₂ m]
+    {left' left : IterM (α := α₁) m β₁} {b} {right' right : IterM (α := α₂) m β₂}
+    (h : left'.finitelyManySkips.Rel left.finitelyManySkips) :
+    Zip.Rel₃ m ⟨left', b, right'⟩ ⟨left, b, right⟩ :=
+  Prod.Lex.right _ <| Prod.Lex.left _ _ h
+
+theorem Zip.rel₃_of_right [Productive α₁ m] [Productive α₂ m]
+    {left : IterM (α := α₁) m β₁} {b b' : _} {it' it : IterM (α := α₂) m β₂}
+    (h : b' = b)
+    (h' : it'.finitelyManySkips.Rel it.finitelyManySkips) :
+    Zip.Rel₃ m ⟨left, b', it'⟩ ⟨left, b, it⟩ := by
+  cases h
+  exact Prod.Lex.right _ <| Prod.Lex.right _ h'
+
+def Zip.instProductivenessRelation [Monad m] [Productive α₁ m] [Productive α₂ m] :
+    ProductivenessRelation (Zip α₁ m α₂ β₂) m where
+  rel := Zip.Rel₃ m
+  wf := by
+    apply InvImage.wf
+    refine ⟨fun (a, b) => Prod.lexAccessible (WellFounded.apply ?_ a) (WellFounded.apply ?_) b⟩
+    · apply Option.SomeLtNone.wellFounded_lt
+      exact emptyWf.wf
+    · refine ⟨fun (a, b) => Prod.lexAccessible (WellFounded.apply ?_ a) (WellFounded.apply ?_) b⟩
+      · exact WellFoundedRelation.wf
+      · exact WellFoundedRelation.wf
+  subrelation {it it'} h := by
+    cases h
+    case yieldLeft hm it' out hp =>
+      apply Zip.rel₃_of_memoizedLeft
+      simp [Option.SomeLtNone.lt, hm]
+    case skipLeft hm it' hp =>
+      obtain ⟨⟨left, memoizedLeft, right⟩⟩ := it
+      simp only at hm
+      rw [hm]
+      apply Zip.rel₃_of_left
+      exact IterM.TerminationMeasures.Productive.rel_of_skip ‹_›
+    case skipRight out₁ hm it₂' hp =>
+      apply Zip.rel₃_of_right
+      · simp_all
+      · exact IterM.TerminationMeasures.Productive.rel_of_skip ‹_›
+
+instance Zip.instProductive [Monad m] [Productive α₁ m] [Productive α₂ m] :
+    Productive (Zip α₁ m α₂ β₂) m :=
+  Productive.of_productivenessRelation Zip.instProductivenessRelation
+
+instance Zip.instIteratorCollect [Monad m] [Monad n] :
+    IteratorCollect (Zip α₁ m α₂ β₂) m n :=
+  .defaultImplementation
+
+instance Zip.instIteratorCollectPartial [Monad m] [Monad n] :
+    IteratorCollectPartial (Zip α₁ m α₂ β₂) m n :=
+  .defaultImplementation
+
+instance Zip.instIteratorLoop [Monad m] [Monad n] :
+    IteratorLoop (Zip α₁ m α₂ β₂) m n :=
+  .defaultImplementation
+
+instance Zip.instIteratorLoopPartial [Monad m] [Monad n] :
+    IteratorLoopPartial (Zip α₁ m α₂ β₂) m n :=
+  .defaultImplementation
+
+end Std.Iterators

src/Std/Data/Iterators/Combinators/Take.lean

@@ -0,0 +1,39 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Std.Data.Iterators.Combinators.Monadic.Take
+
+namespace Std.Iterators
+
+/--
+Given an iterator `it` and a natural number `n`, `it.take n` is an iterator that outputs
+up to the first `n` of `it`'s values in order and then terminates.
+
+**Marble diagram:**
+
+```text
+it          ---a----b---c--d-e--⊥
+it.take 3   ---a----b---c⊥
+
+it          ---a--⊥
+it.take 3   ---a--⊥
+```
+
+**Termination properties:**
+
+* `Finite` instance: only if `it` is productive
+* `Productive` instance: only if `it` is productive
+
+**Performance:**
+
+This combinator incurs an additional O(1) cost with each output of `it`.
+-/
+@[always_inline, inline]
+def Iter.take {α : Type w} {β : Type w} (n : Nat) (it : Iter (α := α) β) :
+    Iter (α := Take α Id β) β :=
+  it.toIterM.take n |>.toIter
+
+end Std.Iterators

src/Std/Data/Iterators/Combinators/TakeWhile.lean

@@ -0,0 +1,45 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Std.Data.Iterators.Combinators.Monadic.TakeWhile
+
+namespace Std.Iterators
+
+/--
+Given an iterator `it` and a predicate `P`, `it.takeWhile P` is an iterator that outputs
+the values emitted by `it` until one of those values is rejected by `P`.
+If some emitted value is rejected by `P`, the value is dropped and the iterator terminates.
+
+**Marble diagram:**
+
+Assuming that the predicate `P` accepts `a` and `b` but rejects `c`:
+
+```text
+it               ---a----b---c--d-e--⊥
+it.takeWhile P   ---a----b---⊥
+
+it               ---a----⊥
+it.takeWhile P   ---a----⊥
+```
+
+**Termination properties:**
+
+* `Finite` instance: only if `it` is finite
+* `Productive` instance: only if `it` is productive
+
+Depending on `P`, it is possible that `it.takeWhile P` is finite (or productive) although `it` is not.
+In this case, the `Finite` (or `Productive`) instance needs to be proved manually.
+
+**Performance:**
+
+This combinator calls `P` on each output of `it` until the predicate evaluates to false. Then
+it terminates.
+-/
+@[always_inline, inline]
+def Iter.takeWhile {α : Type w} {β : Type w} (P : β → Bool) (it : Iter (α := α) β) :=
+  (it.toIterM.takeWhile P |>.toIter : Iter β)
+
+end Std.Iterators

src/Std/Data/Iterators/Combinators/Zip.lean

@@ -0,0 +1,47 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Std.Data.Iterators.Combinators.Monadic.Zip
+
+namespace Std.Iterators
+
+/--
+Given two iterators `left` and `right`, `left.zip right` is an iterator that yields pairs of
+outputs of `left` and `right`. When one of them terminates,
+the `zip` iterator will also terminate.
+
+**Marble diagram:**
+
+```text
+left               --a        ---b        --c
+right                 --x         --y        --⊥
+left.zip right     -----(a, x)------(b, y)-----⊥
+```
+
+**Termination properties:**
+
+* `Finite` instance: only if either `left` or `right` is finite and the other is productive
+* `Productive` instance: only if `left` and `right` are productive
+
+There are situations where `left.zip right` is finite (or productive) but none of the instances
+above applies. For example, if `left` immediately terminates but `right` always skips, then
+`left.zip.right` is finite even though no `Finite` (or even `Productive`) instance is available.
+Such instances need to be proved manually.
+
+**Performance:**
+
+This combinator incurs an additional O(1) cost with each step taken by `left` or `right`.
+
+Right now, the compiler does not unbox the internal state, leading to worse performance than
+theoretically possible.
+-/
+@[always_inline, inline]
+def Iter.zip {α₁ : Type w} {β₁: Type w} {α₂ : Type w} {β₂ : Type w}
+    [Iterator α₁ Id β₁] [Iterator α₂ Id β₂]
+    (left : Iter (α := α₁) β₁) (right : Iter (α := α₂) β₂) :=
+  ((left.toIterM.zip right.toIterM).toIter : Iter (β₁ × β₂))
+
+end Std.Iterators

src/Std/Data/Iterators/Consumers/Collect.lean

@@ -26,12 +26,12 @@ namespace Std.Iterators
 
 @[always_inline, inline, inherit_doc IterM.toArray]
 def Iter.toArray {α : Type w} {β : Type w}
-    [Iterator α Id β] [Finite α Id] [IteratorCollect α Id] (it : Iter (α := α) β) : Array β :=
+    [Iterator α Id β] [Finite α Id] [IteratorCollect α Id Id] (it : Iter (α := α) β) : Array β :=
   it.toIterM.toArray.run
 
 @[always_inline, inline, inherit_doc IterM.Partial.toArray]
 def Iter.Partial.toArray {α : Type w} {β : Type w}
-    [Iterator α Id β] [IteratorCollectPartial α Id] (it : Iter.Partial (α := α) β) : Array β :=
+    [Iterator α Id β] [IteratorCollectPartial α Id Id] (it : Iter.Partial (α := α) β) : Array β :=
   it.it.toIterM.allowNontermination.toArray.run
 
 @[always_inline, inline, inherit_doc IterM.toListRev]
@@ -46,12 +46,12 @@ def Iter.Partial.toListRev {α : Type w} {β : Type w}
 
 @[always_inline, inline, inherit_doc IterM.toList]
 def Iter.toList {α : Type w} {β : Type w}
-    [Iterator α Id β] [Finite α Id] [IteratorCollect α Id] (it : Iter (α := α) β) : List β :=
+    [Iterator α Id β] [Finite α Id] [IteratorCollect α Id Id] (it : Iter (α := α) β) : List β :=
   it.toIterM.toList.run
 
 @[always_inline, inline, inherit_doc IterM.Partial.toList]
 def Iter.Partial.toList {α : Type w} {β : Type w}
-    [Iterator α Id β] [IteratorCollectPartial α Id] (it : Iter.Partial (α := α) β) : List β :=
+    [Iterator α Id β] [IteratorCollectPartial α Id Id] (it : Iter.Partial (α := α) β) : List β :=
   it.it.toIterM.allowNontermination.toList.run
 
 end Std.Iterators

src/Std/Data/Iterators/Consumers/Loop.lean

@@ -35,6 +35,16 @@ instance (α : Type w) (β : Type w) (n : Type w → Type w') [Monad n]
     letI : MonadLift Id n := ⟨pure⟩
     ForIn.forIn it.it.toIterM.allowNontermination init f
 
+instance {m : Type w → Type w'}
+    {α : Type w} {β : Type w} [Iterator α Id β] [Finite α Id] [IteratorLoop α Id m] :
+    ForM m (Iter (α := α) β) β where
+  forM it f := forIn it PUnit.unit (fun out _ => do f out; return .yield .unit)
+
+instance {m : Type w → Type w'}
+    {α : Type w} {β : Type w} [Iterator α Id β] [Finite α Id] [IteratorLoopPartial α Id m] :
+    ForM m (Iter.Partial (α := α) β) β where
+  forM it f := forIn it PUnit.unit (fun out _ => do f out; return .yield .unit)
+
 /--
 Folds a monadic function over an iterator from the left, accumulating a value starting with `init`.
 The accumulated value is combined with the each element of the list in order, using `f`.
@@ -47,10 +57,10 @@ number of steps. If the iterator is not finite or such an instance is not availa
 verify the behavior of the partial variant.
 -/
 @[always_inline, inline]
-def Iter.foldM {n : Type w → Type w} [Monad n]
+def Iter.foldM {m : Type w → Type w'} [Monad m]
     {α : Type w} {β : Type w} {γ : Type w} [Iterator α Id β] [Finite α Id]
-    [IteratorLoop α Id n] (f : γ → β → n γ)
-    (init : γ) (it : Iter (α := α) β) : n γ :=
+    [IteratorLoop α Id m] (f : γ → β → m γ)
+    (init : γ) (it : Iter (α := α) β) : m γ :=
   ForIn.forIn it init (fun x acc => ForInStep.yield <$> f acc x)
 
 /--
@@ -63,10 +73,10 @@ This is a partial, potentially nonterminating, function. It is not possible to f
 its behavior. If the iterator has a `Finite` instance, consider using `IterM.foldM` instead.
 -/
 @[always_inline, inline]
-def Iter.Partial.foldM {n : Type w → Type w} [Monad n]
+def Iter.Partial.foldM {m : Type w → Type w'} [Monad m]
     {α : Type w} {β : Type w} {γ : Type w} [Iterator α Id β]
-    [IteratorLoopPartial α Id n] (f : γ → β → n γ)
-    (init : γ) (it : Iter.Partial (α := α) β) : n γ :=
+    [IteratorLoopPartial α Id m] (f : γ → β → m γ)
+    (init : γ) (it : Iter.Partial (α := α) β) : m γ :=
   ForIn.forIn it init (fun x acc => ForInStep.yield <$> f acc x)
 
 /--

src/Std/Data/Iterators/Consumers/Monadic/Collect.lean

@@ -5,6 +5,7 @@ Authors: Paul Reichert
 -/
 prelude
 import Std.Data.Iterators.Consumers.Monadic.Partial
+import Std.Data.Internal.LawfulMonadLiftFunction
 
 /-!
 # Collectors
@@ -23,6 +24,7 @@ asserts that an `IteratorCollect` instance equals the default implementation.
 -/
 
 namespace Std.Iterators
+open Std.Internal
 
 section Typeclasses
 
@@ -33,13 +35,20 @@ iterators. Right now, it is limited to a potentially optimized `toArray` impleme
 This class is experimental and users of the iterator API should not explicitly depend on it.
 They can, however, assume that consumers that require an instance will work for all iterators
 provided by the standard library.
+
+Note: For this to be compositional enough to be useful, `toArrayMapped` would need to accept a
+termination proof for the specific mapping function used instead of the blanket `Finite α m`
+instance. Otherwise, most combinators like `map` cannot implement their own instance relying on
+the instance of their base iterators. However, fixing this is currently low priority.
 -/
-class IteratorCollect (α : Type w) (m : Type w → Type w') {β : Type w} [Iterator α m β] where
+class IteratorCollect (α : Type w) (m : Type w → Type w') (n : Type w → Type w'')
+    {β : Type w} [Iterator α m β] where
   /--
   Maps the emitted values of an iterator using the given function and collects the results in an
   `Array`. This is an internal implementation detail. Consider using `it.map f |>.toArray` instead.
   -/
-  toArrayMapped [Finite α m] : ∀ {γ : Type w}, (β → m γ) → IterM (α := α) m β → m (Array γ)
+  toArrayMapped [Finite α m] :
+    (lift : ⦃δ : Type w⦄ → m δ → n δ) → {γ : Type w} → (β → n γ) → IterM (α := α) m β → n (Array γ)
 
 /--
 `IteratorCollectPartial α m` provides efficient implementations of collectors for `α`-based
@@ -49,14 +58,15 @@ This class is experimental and users of the iterator API should not explicitly d
 They can, however, assume that consumers that require an instance will work for all iterators
 provided by the standard library.
 -/
-class IteratorCollectPartial
-    (α : Type w) (m : Type w → Type w') {β : Type w} [Iterator α m β] where
+class IteratorCollectPartial (α : Type w) (m : Type w → Type w') (n : Type w → Type w'')
+    {β : Type w} [Iterator α m β] where
   /--
   Maps the emitted values of an iterator using the given function and collects the results in an
   `Array`. This is an internal implementation detail.
   Consider using `it.map f |>.allowNontermination.toArray` instead.
   -/
-  toArrayMappedPartial : ∀ {γ : Type w}, (β → m γ) → IterM (α := α) m β → m (Array γ)
+  toArrayMappedPartial :
+    (lift : ⦃δ : Type w⦄ → m δ → n δ) → {γ : Type w} → (β → n γ) → IterM (α := α) m β → n (Array γ)
 
 end Typeclasses
 
@@ -69,12 +79,14 @@ It iterates over an iterator and applies `f` whenever a value is emitted before
 of `f` into an array.
 -/
 @[always_inline, inline]
-def IterM.DefaultConsumers.toArrayMapped {α : Type w} {m : Type w → Type w'} [Monad m] {β : Type w}
-    [Iterator α m β] [Finite α m] {γ : Type w} (f : β → m γ) (it : IterM (α := α) m β) : m (Array γ) :=
+def IterM.DefaultConsumers.toArrayMapped {α β : Type w} {m : Type w → Type w'}
+    {n : Type w → Type w''} [Monad n] [Iterator α m β] [Finite α m]
+    (lift : ⦃α : Type w⦄ → m α → n α) {γ : Type w} (f : β → n γ)
+    (it : IterM (α := α) m β) : n (Array γ) :=
   go it #[]
 where
   @[specialize]
-  go [Monad m] [Finite α m] (it : IterM (α := α) m β) a := do
+  go [Monad n] [Finite α m] (it : IterM (α := α) m β) a := letI : MonadLift m n := ⟨lift (α := _)⟩; do
     match ← it.step with
     | .yield it' b _ => go it' (a.push (← f b))
     | .skip it' _ => go it' a
@@ -88,30 +100,36 @@ data structure. For certain iterators, more efficient implementations are possib
 used instead.
 -/
 @[always_inline, inline]
-def IteratorCollect.defaultImplementation {α : Type w} {m : Type w → Type w'}
-    [Monad m] [Iterator α m β] : IteratorCollect α m where
+def IteratorCollect.defaultImplementation {α β : Type w} {m : Type w → Type w'}
+    {n : Type w → Type w''} [Monad n] [Iterator α m β] :
+    IteratorCollect α m n where
   toArrayMapped := IterM.DefaultConsumers.toArrayMapped
 
 /--
 Asserts that a given `IteratorCollect` instance is equal to `IteratorCollect.defaultImplementation`.
 (Even though equal, the given instance might be vastly more efficient.)
 -/
-class LawfulIteratorCollect (α : Type w) (m : Type w → Type w') [Monad m] [Iterator α m β]
-    [i : IteratorCollect α m] where
-  lawful : i = .defaultImplementation
+class LawfulIteratorCollect (α : Type w) (m : Type w → Type w') (n : Type w → Type w'')
+    {β : Type w} [Monad m] [Monad n] [Iterator α m β] [i : IteratorCollect α m n] where
+  lawful_toArrayMapped : ∀ lift [LawfulMonadLiftFunction lift] [Finite α m],
+    i.toArrayMapped lift (α := α) (γ := γ)
+      = IteratorCollect.defaultImplementation.toArrayMapped lift
 
-theorem LawfulIteratorCollect.toArrayMapped_eq {α β γ : Type w} {m : Type w → Type w'} [Monad m]
-    [Iterator α m β] [Finite α m] [IteratorCollect α m] [hl : LawfulIteratorCollect α m]
-    {f : β → m γ} {it : IterM (α := α) m β} :
-    IteratorCollect.toArrayMapped f it = IterM.DefaultConsumers.toArrayMapped f it := by
-  cases hl.lawful; rfl
+theorem LawfulIteratorCollect.toArrayMapped_eq {α β γ : Type w} {m : Type w → Type w'}
+    {n : Type w → Type w''} [Monad m] [Monad n] [Iterator α m β] [Finite α m] [IteratorCollect α m n]
+    [hl : LawfulIteratorCollect α m n] {lift : ⦃δ : Type w⦄ → m δ → n δ}
+    [LawfulMonadLiftFunction lift]
+    {f : β → n γ} {it : IterM (α := α) m β} :
+    IteratorCollect.toArrayMapped lift f it (m := m) =
+      IterM.DefaultConsumers.toArrayMapped lift f it (m := m) := by
+  rw [lawful_toArrayMapped]; rfl
 
-instance (α : Type w) (m : Type w → Type w') [Monad m] [Iterator α m β]
-    [Monad m] [Iterator α m β] [Finite α m] :
-    haveI : IteratorCollect α m := .defaultImplementation
-    LawfulIteratorCollect α m :=
-  letI : IteratorCollect α m := .defaultImplementation
-  ⟨rfl⟩
+instance (α β : Type w) (m : Type w → Type w') (n : Type w → Type w'') [Monad n]
+    [Iterator α m β] [Monad m] [Iterator α m β] [Finite α m] :
+    haveI : IteratorCollect α m n := .defaultImplementation
+    LawfulIteratorCollect α m n :=
+  letI : IteratorCollect α m n := .defaultImplementation
+  ⟨fun _ => rfl⟩
 
 /--
 This is an internal function used in `IteratorCollectPartial.defaultImplementation`.
@@ -120,12 +138,14 @@ It iterates over an iterator and applies `f` whenever a value is emitted before
 of `f` into an array.
 -/
 @[always_inline, inline]
-partial def IterM.DefaultConsumers.toArrayMappedPartial {α : Type w} {m : Type w → Type w'} [Monad m] {β : Type w}
-    [Iterator α m β] {γ : Type w} (f : β → m γ) (it : IterM (α := α) m β) : m (Array γ) :=
+partial def IterM.DefaultConsumers.toArrayMappedPartial {α β : Type w} {m : Type w → Type w'}
+    {n : Type w → Type w''} [Monad n] [Iterator α m β]
+    (lift : {α : Type w} → m α → n α) {γ : Type w} (f : β → n γ)
+    (it : IterM (α := α) m β) : n (Array γ) :=
   go it #[]
 where
   @[specialize]
-  go [Monad m] (it : IterM (α := α) m β) a := do
+  go [Monad n] (it : IterM (α := α) m β) a := letI : MonadLift m n := ⟨lift⟩; do
     match ← it.step with
     | .yield it' b _ => go it' (a.push (← f b))
     | .skip it' _ => go it' a
@@ -138,8 +158,9 @@ data structure. For certain iterators, more efficient implementations are possib
 used instead.
 -/
 @[always_inline, inline]
-def IteratorCollectPartial.defaultImplementation {α : Type w} {m : Type w → Type w'}
-    [Monad m] [Iterator α m β] : IteratorCollectPartial α m where
+def IteratorCollectPartial.defaultImplementation {α β : Type w} {m : Type w → Type w'}
+    {n : Type w → Type w''} [Monad n] [Iterator α m β] :
+    IteratorCollectPartial α m n where
   toArrayMappedPartial := IterM.DefaultConsumers.toArrayMappedPartial
 
 /--
@@ -151,9 +172,10 @@ number of steps. If the iterator is not finite or such an instance is not availa
 verify the behavior of the partial variant.
 -/
 @[always_inline, inline]
-def IterM.toArray {α : Type w} {m : Type w → Type w'} {β : Type w} [Monad m]
-    [Iterator α m β] [Finite α m] [IteratorCollect α m] (it : IterM (α := α) m β) : m (Array β) :=
-  IteratorCollect.toArrayMapped pure it
+def IterM.toArray {α β : Type w} {m : Type w → Type w'} [Monad m]
+    [Iterator α m β] [Finite α m] [IteratorCollect α m m]
+    (it : IterM (α := α) m β) : m (Array β) :=
+  IteratorCollect.toArrayMapped (fun ⦃_⦄ => id) pure it
 
 /--
 Traverses the given iterator and stores the emitted values in an array.
@@ -163,8 +185,8 @@ its behavior. If the iterator has a `Finite` instance, consider using `IterM.toA
 -/
 @[always_inline, inline]
 def IterM.Partial.toArray {α : Type w} {m : Type w → Type w'} {β : Type w} [Monad m]
-    [Iterator α m β] (it : IterM.Partial (α := α) m β) [IteratorCollectPartial α m] : m (Array β) :=
-  IteratorCollectPartial.toArrayMappedPartial pure it.it
+    [Iterator α m β] (it : IterM.Partial (α := α) m β) [IteratorCollectPartial α m m] : m (Array β) :=
+  IteratorCollectPartial.toArrayMappedPartial (fun ⦃_⦄ => id) pure it.it
 
 end ToArray
 
@@ -219,7 +241,7 @@ formally verify the behavior of the partial variant.
 -/
 @[always_inline, inline]
 def IterM.toList {α : Type w} {m : Type w → Type w'} [Monad m] {β : Type w}
-    [Iterator α m β] [Finite α m] [IteratorCollect α m] (it : IterM (α := α) m β) : m (List β) :=
+    [Iterator α m β] [Finite α m] [IteratorCollect α m m] (it : IterM (α := α) m β) : m (List β) :=
   Array.toList <$> IterM.toArray it
 
 /--
@@ -231,7 +253,8 @@ its behavior. If the iterator has a `Finite` instance, consider using `IterM.toL
 -/
 @[always_inline, inline]
 def IterM.Partial.toList {α : Type w} {m : Type w → Type w'} [Monad m] {β : Type w}
-    [Iterator α m β] (it : IterM.Partial (α := α) m β) [IteratorCollectPartial α m] : m (List β) :=
+    [Iterator α m β] (it : IterM.Partial (α := α) m β) [IteratorCollectPartial α m m] :
+    m (List β) :=
   Array.toList <$> it.toArray
 
 end Std.Iterators

src/Std/Data/Iterators/Consumers/Monadic/Loop.lean

@@ -170,8 +170,8 @@ It simply iterates through the iterator using `IterM.step`. For certain iterator
 implementations are possible and should be used instead.
 -/
 @[always_inline, inline]
-def IteratorLoopPartial.defaultImplementation {α : Type w} {m : Type w → Type w'} {n : Type w → Type w'}
-    [Monad m] [Monad n] [Iterator α m β] :
+def IteratorLoopPartial.defaultImplementation {α : Type w} {m : Type w → Type w'}
+    {n : Type w → Type w''} [Monad m] [Monad n] [Iterator α m β] :
     IteratorLoopPartial α m n where
   forInPartial lift := IterM.DefaultConsumers.forInPartial lift _
 
@@ -182,6 +182,19 @@ instance (α : Type w) (m : Type w → Type w') (n : Type w → Type w')
   letI : IteratorLoop α m n := .defaultImplementation
   ⟨rfl⟩
 
+theorem IteratorLoop.wellFounded_of_finite {m : Type w → Type w'}
+    {α β γ : Type w} [Iterator α m β] [Finite α m] :
+    WellFounded α m (γ := γ) fun _ _ _ => True := by
+  apply Subrelation.wf
+    (r := InvImage IterM.TerminationMeasures.Finite.Rel (fun p => p.1.finitelyManySteps))
+  · intro p' p h
+    apply Relation.TransGen.single
+    obtain ⟨b, h, _⟩ | ⟨h, _⟩ := h
+    · exact ⟨.yield p'.fst b, rfl, h⟩
+    · exact ⟨.skip p'.fst, rfl, h⟩
+  · apply InvImage.wf
+    exact WellFoundedRelation.wf
+
 /--
 This `ForIn`-style loop construct traverses a finite iterator using an `IteratorLoop` instance.
 -/
@@ -192,16 +205,7 @@ def IteratorLoop.finiteForIn {m : Type w → Type w'} {n : Type w → Type w''}
     ForIn n (IterM (α := α) m β) β where
   forIn {γ} [Monad n] it init f :=
     IteratorLoop.forIn (α := α) (m := m) lift γ (fun _ _ _ => True)
-      (by
-        apply Subrelation.wf
-          (r := InvImage IterM.TerminationMeasures.Finite.Rel (fun p => p.1.finitelyManySteps))
-        · intro p' p h
-          apply Relation.TransGen.single
-          obtain ⟨b, h, _⟩ | ⟨h, _⟩ := h
-          · exact ⟨.yield p'.fst b, rfl, h⟩
-          · exact ⟨.skip p'.fst, rfl, h⟩
-        · apply InvImage.wf
-          exact WellFoundedRelation.wf)
+      wellFounded_of_finite
       it init ((⟨·, .intro⟩) <$> f · ·)
 
 instance {m : Type w → Type w'} {n : Type w → Type w''}
@@ -212,7 +216,20 @@ instance {m : Type w → Type w'} {n : Type w → Type w''}
 instance {m : Type w → Type w'} {n : Type w → Type w''}
     {α : Type w} {β : Type w} [Iterator α m β] [IteratorLoopPartial α m n] [MonadLiftT m n] :
     ForIn n (IterM.Partial (α := α) m β) β where
-  forIn it init f := IteratorLoopPartial.forInPartial (α := α) (m := m) (fun _ => monadLift) it.it init f
+  forIn it init f :=
+    IteratorLoopPartial.forInPartial (α := α) (m := m) (fun _ => monadLift) it.it init f
+
+instance {m : Type w → Type w'} {n : Type w → Type w''}
+    {α : Type w} {β : Type w} [Iterator α m β] [Finite α m] [IteratorLoop α m n]
+    [MonadLiftT m n] :
+    ForM n (IterM (α := α) m β) β where
+  forM it f := forIn it PUnit.unit (fun out _ => do f out; return .yield .unit)
+
+instance {m : Type w → Type w'} {n : Type w → Type w''}
+    {α : Type w} {β : Type w} [Iterator α m β] [Finite α m] [IteratorLoopPartial α m n]
+    [MonadLiftT m n] :
+    ForM n (IterM.Partial (α := α) m β) β where
+  forM it f := forIn it PUnit.unit (fun out _ => do f out; return .yield .unit)
 
 /--
 Folds a monadic function over an iterator from the left, accumulating a value starting with `init`.
@@ -227,7 +244,7 @@ number of steps. If the iterator is not finite or such an instance is not availa
 verify the behavior of the partial variant.
 -/
 @[always_inline, inline]
-def IterM.foldM {m : Type w → Type w'} {n : Type w → Type w'} [Monad n]
+def IterM.foldM {m : Type w → Type w'} {n : Type w → Type w''} [Monad n]
     {α : Type w} {β : Type w} {γ : Type w} [Iterator α m β] [Finite α m] [IteratorLoop α m n]
     [MonadLiftT m n]
     (f : γ → β → n γ) (init : γ) (it : IterM (α := α) m β) : n γ :=
@@ -295,7 +312,7 @@ verify the behavior of the partial variant.
 def IterM.drain {α : Type w} {m : Type w → Type w'} [Monad m] {β : Type w}
     [Iterator α m β] [Finite α m] (it : IterM (α := α) m β) [IteratorLoop α m m] :
     m PUnit :=
-  it.foldM (γ := PUnit) (fun _ _ => pure .unit) .unit
+  it.fold (γ := PUnit) (fun _ _ => .unit) .unit
 
 /--
 Iterates over the whole iterator, applying the monadic effects of each step, discarding all
@@ -308,6 +325,6 @@ its behavior. If the iterator has a `Finite` instance, consider using `IterM.dra
 def IterM.Partial.drain {α : Type w} {m : Type w → Type w'} [Monad m] {β : Type w}
     [Iterator α m β] (it : IterM.Partial (α := α) m β) [IteratorLoopPartial α m m] :
     m PUnit :=
-  it.foldM (γ := PUnit) (fun _ _ => pure .unit) .unit
+  it.fold (γ := PUnit) (fun _ _ => .unit) .unit
 
 end Std.Iterators

src/Std/Data/Iterators/Lemmas.lean

@@ -7,4 +7,5 @@ prelude
 import Std.Data.Iterators.Lemmas.Basic
 import Std.Data.Iterators.Lemmas.Monadic
 import Std.Data.Iterators.Lemmas.Consumers
+import Std.Data.Iterators.Lemmas.Combinators
 import Std.Data.Iterators.Lemmas.Producers

src/Std/Data/Iterators/Lemmas/Combinators.lean

@@ -0,0 +1,12 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Std.Data.Iterators.Lemmas.Combinators.Monadic
+import Std.Data.Iterators.Lemmas.Combinators.Take
+import Std.Data.Iterators.Lemmas.Combinators.TakeWhile
+import Std.Data.Iterators.Lemmas.Combinators.DropWhile
+import Std.Data.Iterators.Lemmas.Combinators.FilterMap
+import Std.Data.Iterators.Lemmas.Combinators.Zip

src/Std/Data/Iterators/Lemmas/Combinators/DropWhile.lean

@@ -0,0 +1,124 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Std.Data.Iterators.Combinators.DropWhile
+import Std.Data.Iterators.Lemmas.Combinators.Monadic.DropWhile
+import Std.Data.Iterators.Lemmas.Consumers
+
+namespace Std.Iterators
+
+theorem Iter.dropWhile_eq_intermediateDropWhile {α β} [Iterator α Id β] {P}
+    {it : Iter (α := α) β} :
+    it.dropWhile P = Intermediate.dropWhile P true it :=
+  rfl
+
+theorem Iter.Intermediate.dropWhile_eq_dropWhile_toIterM {α β} [Iterator α Id β] {P}
+    {it : Iter (α := α) β} {dropping} :
+    Intermediate.dropWhile P dropping it =
+      (IterM.Intermediate.dropWhile P dropping it.toIterM).toIter :=
+  rfl
+
+theorem Iter.dropWhile_eq_dropWhile_toIterM {α β} [Iterator α Id β] {P}
+    {it : Iter (α := α) β} :
+    it.dropWhile P = (it.toIterM.dropWhile P).toIter :=
+  rfl
+
+theorem Iter.step_intermediateDropWhile {α β} [Iterator α Id β]
+    {it : Iter (α := α) β} {P} {dropping} :
+    (Iter.Intermediate.dropWhile P dropping it).step = (match it.step with
+      | .yield it' out h =>
+        if h' : dropping = true then
+          match P out with
+          | true =>
+            .skip (Intermediate.dropWhile P true it') (.dropped h h' True.intro)
+          | false =>
+            .yield (Intermediate.dropWhile P false it') out (.start h h' True.intro)
+        else
+          .yield (Intermediate.dropWhile P false it') out
+              (.yield h (Bool.not_eq_true _ ▸ h'))
+      | .skip it' h =>
+        .skip (Intermediate.dropWhile P dropping it') (.skip h)
+      | .done h =>
+        .done (.done h)) := by
+  simp [Intermediate.dropWhile_eq_dropWhile_toIterM, Iter.step, IterM.step_intermediateDropWhile]
+  cases it.toIterM.step.run using PlausibleIterStep.casesOn
+  · simp only [IterM.Step.toPure_yield, PlausibleIterStep.yield, toIter_toIterM, toIterM_toIter]
+    split
+    · split
+      · split
+        · rfl
+        · exfalso; simp_all
+      · split
+        · exfalso; simp_all
+        · rfl
+    · rfl
+  · rfl
+  · rfl
+
+theorem Iter.step_dropWhile {α β} [Iterator α Id β] {P}
+    {it : Iter (α := α) β} :
+    (it.dropWhile P).step = (match it.step with
+    | .yield it' out h =>
+        match P out with
+        | true =>
+          .skip (Intermediate.dropWhile P true it') (.dropped h rfl True.intro)
+        | false =>
+          .yield (Intermediate.dropWhile P false it') out (.start h rfl True.intro)
+    | .skip it' h =>
+      .skip (Intermediate.dropWhile P true it') (.skip h)
+    | .done h =>
+      .done (.done h)) := by
+  simp [dropWhile_eq_intermediateDropWhile, step_intermediateDropWhile]
+
+theorem Iter.toList_intermediateDropWhile_of_finite {α β} [Iterator α Id β] {P dropping}
+    [Finite α Id] [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
+    {it : Iter (α := α) β} :
+    (Intermediate.dropWhile P dropping it).toList =
+      if dropping = true then it.toList.dropWhile P else it.toList := by
+  induction it using Iter.inductSteps generalizing dropping with | step it ihy ihs =>
+  rw [toList_eq_match_step, toList_eq_match_step, step_intermediateDropWhile]
+  cases it.step using PlausibleIterStep.casesOn
+  · rename_i hp
+    simp [List.dropWhile_cons]
+    cases P _
+    · cases dropping
+      · specialize ihy hp (dropping := false)
+        rw [if_neg (by simp)] at ihy
+        simp [ihy]
+      · specialize ihy hp (dropping := false)
+        rw [if_neg (by simp)] at ihy
+        simp [ihy]
+    · cases dropping
+      · specialize ihy hp (dropping := false)
+        simp [ihy]
+      · specialize ihy hp (dropping := true)
+        simp [ihy]
+  · rename_i hp
+    simp [ihs hp]
+  · simp
+
+@[simp]
+theorem Iter.toList_dropWhile_of_finite {α β} [Iterator α Id β] {P}
+    [Finite α Id] [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
+    {it : Iter (α := α) β} :
+    (it.dropWhile P).toList = it.toList.dropWhile P := by
+  simp [dropWhile_eq_intermediateDropWhile, toList_intermediateDropWhile_of_finite]
+
+@[simp]
+theorem Iter.toArray_dropWhile_of_finite {α β} [Iterator α Id β] {P}
+    [Finite α Id] [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
+    {it : Iter (α := α) β} :
+    (it.dropWhile P).toArray = (it.toList.dropWhile P).toArray := by
+  simp only [← toArray_toList, toList_dropWhile_of_finite]
+
+@[simp]
+theorem Iter.toListRev_dropWhile_of_finite {α β} [Iterator α Id β] {P}
+    [Finite α Id] [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
+    {it : Iter (α := α) β} :
+    (it.dropWhile P).toListRev = (it.toList.dropWhile P).reverse := by
+  rw [toListRev_eq, toList_dropWhile_of_finite]
+
+end Std.Iterators

src/Std/Data/Iterators/Lemmas/Combinators/FilterMap.lean

@@ -0,0 +1,317 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Std.Data.Iterators.Lemmas.Consumers
+import Std.Data.Iterators.Lemmas.Combinators.Monadic.FilterMap
+import Std.Data.Iterators.Combinators.FilterMap
+
+namespace Std.Iterators
+
+variable {α β γ : Type w} [Iterator α Id β] {it : Iter (α := α) β}
+    {m : Type w → Type w'} {n : Type w → Type w''}
+
+theorem Iter.filterMapWithPostcondition_eq_toIter_filterMapWithPostcondition_toIterM [Monad m]
+    {f : β → PostconditionT m (Option γ)} :
+    it.filterMapWithPostcondition f = (letI : MonadLift Id m := ⟨pure⟩; it.toIterM.filterMapWithPostcondition f) :=
+  rfl
+
+theorem Iter.filterWithPostcondition_eq_toIter_filterMapWithPostcondition_toIterM [Monad m]
+    {f : β → PostconditionT m (ULift Bool)} :
+    it.filterWithPostcondition f = (letI : MonadLift Id m := ⟨pure⟩; it.toIterM.filterWithPostcondition f) :=
+  rfl
+
+theorem Iter.mapWithPostcondition_eq_toIter_mapWithPostcondition_toIterM [Monad m] {f : β → PostconditionT m γ} :
+    it.mapWithPostcondition f = (letI : MonadLift Id m := ⟨pure⟩; it.toIterM.mapWithPostcondition f) :=
+  rfl
+
+theorem Iter.filterMapM_eq_toIter_filterMapM_toIterM [Monad m] {f : β → m (Option γ)} :
+    it.filterMapM f = (letI : MonadLift Id m := ⟨pure⟩; it.toIterM.filterMapM f) :=
+  rfl
+
+theorem Iter.filterM_eq_toIter_filterM_toIterM [Monad m] {f : β → m (ULift Bool)} :
+    it.filterM f = (letI : MonadLift Id m := ⟨pure⟩; it.toIterM.filterM f) :=
+  rfl
+
+theorem Iter.mapM_eq_toIter_mapM_toIterM [Monad m] {f : β → m γ} :
+    it.mapM f = (letI : MonadLift Id m := ⟨pure⟩; it.toIterM.mapM f) :=
+  rfl
+
+theorem Iter.filterMap_eq_toIter_filterMap_toIterM {f : β → Option γ} :
+    it.filterMap f = (it.toIterM.filterMap f).toIter :=
+  rfl
+
+theorem Iter.map_eq_toIter_map_toIterM {f : β → γ} :
+    it.map f = (it.toIterM.map f).toIter :=
+  rfl
+
+theorem Iter.filter_eq_toIter_filter_toIterM [Monad m] {f : β → Bool} :
+    it.filter f = (it.toIterM.filter f).toIter :=
+  rfl
+
+theorem Iter.step_filterMapWithPostcondition {f : β → PostconditionT n (Option γ)}
+    [Monad n] [LawfulMonad n] [MonadLiftT m n] :
+  (it.filterMapWithPostcondition f).step = (do
+    match it.step with
+    | .yield it' out h => do
+      match ← (f out).operation with
+      | ⟨none, h'⟩ =>
+        pure <| .skip (it'.filterMapWithPostcondition f) (.yieldNone (out := out) h h')
+      | ⟨some out', h'⟩ =>
+        pure <| .yield (it'.filterMapWithPostcondition f) out' (.yieldSome (out := out) h h')
+    | .skip it' h =>
+      pure <| .skip (it'.filterMapWithPostcondition f) (.skip h)
+    | .done h =>
+      pure <| .done (.done h)) := by
+  simp only [filterMapWithPostcondition_eq_toIter_filterMapWithPostcondition_toIterM, IterM.step_filterMapWithPostcondition,
+    step]
+  simp only [liftM, monadLift, pure_bind]
+  generalize it.toIterM.step = step
+  match step with
+  | .yield it' out h =>
+    apply bind_congr
+    intro step
+    rcases step with _ | _ <;> rfl
+  | .skip it' h => rfl
+  | .done h => rfl
+
+theorem Iter.step_filterWithPostcondition {f : β → PostconditionT n (ULift Bool)}
+    [Monad n] [LawfulMonad n] [MonadLiftT m n] :
+  (it.filterWithPostcondition f).step = (do
+    match it.step with
+    | .yield it' out h => do
+      match ← (f out).operation with
+      | ⟨.up false, h'⟩ =>
+        pure <| .skip (it'.filterWithPostcondition f) (.yieldNone (out := out) h ⟨⟨_, h'⟩, rfl⟩)
+      | ⟨.up true, h'⟩ =>
+        pure <| .yield (it'.filterWithPostcondition f) out (.yieldSome (out := out) h ⟨⟨_, h'⟩, rfl⟩)
+    | .skip it' h =>
+      pure <| .skip (it'.filterWithPostcondition f) (.skip h)
+    | .done h =>
+      pure <| .done (.done h)) := by
+  simp only [filterWithPostcondition_eq_toIter_filterMapWithPostcondition_toIterM, IterM.step_filterWithPostcondition, step]
+  simp only [liftM, monadLift, pure_bind]
+  generalize it.toIterM.step = step
+  match step with
+  | .yield it' out h =>
+    apply bind_congr
+    intro step
+    rcases step with _ | _ <;> rfl
+  | .skip it' h => rfl
+  | .done h => rfl
+
+theorem Iter.step_mapWithPostcondition {f : β → PostconditionT n γ}
+    [Monad n] [LawfulMonad n] [MonadLiftT m n] :
+  (it.mapWithPostcondition f).step = (do
+    match it.step with
+    | .yield it' out h => do
+      let out' ← (f out).operation
+      pure <| .yield (it'.mapWithPostcondition f) out'.1 (.yieldSome h ⟨out', rfl⟩)
+    | .skip it' h =>
+      pure <| .skip (it'.mapWithPostcondition f) (.skip h)
+    | .done h =>
+      pure <| .done (.done h)) := by
+  simp only [mapWithPostcondition_eq_toIter_mapWithPostcondition_toIterM, IterM.step_mapWithPostcondition, step]
+  simp only [liftM, monadLift, pure_bind]
+  generalize it.toIterM.step = step
+  match step with
+  | .yield it' out h =>
+    simp only [PostconditionT.operation_map, bind_map_left, bind_pure_comp]
+    rfl
+  | .skip it' h => rfl
+  | .done h => rfl
+
+theorem Iter.step_filterMapM {β' : Type w} {f : β → n (Option β')}
+    [Monad n] [LawfulMonad n] [MonadLiftT m n] :
+  (it.filterMapM f).step = (do
+    match it.step with
+    | .yield it' out h => do
+      match ← f out with
+      | none =>
+        pure <| .skip (it'.filterMapM f) (.yieldNone (out := out) h .intro)
+      | some out' =>
+        pure <| .yield (it'.filterMapM f) out' (.yieldSome (out := out) h .intro)
+    | .skip it' h =>
+      pure <| .skip (it'.filterMapM f) (.skip h)
+    | .done h =>
+      pure <| .done (.done h)) := by
+  simp only [filterMapM_eq_toIter_filterMapM_toIterM, IterM.step_filterMapM, step]
+  simp only [liftM, monadLift, pure_bind]
+  generalize it.toIterM.step = step
+  match step with
+  | .yield it' out h =>
+    simp only [monadLift, MonadLift.monadLift, monadLift_self, bind_map_left]
+    apply bind_congr
+    intro step
+    rcases step with _ | _ <;> rfl
+  | .skip it' h => rfl
+  | .done h => rfl
+
+theorem Iter.step_filterM {f : β → n (ULift Bool)}
+    [Monad n] [LawfulMonad n] [MonadLiftT m n] :
+  (it.filterM f).step = (do
+    match it.step with
+    | .yield it' out h => do
+      match ← f out with
+      | .up false =>
+        pure <| .skip (it'.filterM f) (.yieldNone (out := out) h ⟨⟨.up false, .intro⟩, rfl⟩)
+      | .up true =>
+        pure <| .yield (it'.filterM f) out (.yieldSome (out := out) h ⟨⟨.up true, .intro⟩, rfl⟩)
+    | .skip it' h =>
+      pure <| .skip (it'.filterM f) (.skip h)
+    | .done h =>
+      pure <| .done (.done h)) := by
+  simp only [filterM_eq_toIter_filterM_toIterM, IterM.step_filterM, step]
+  simp only [liftM, monadLift, pure_bind]
+  generalize it.toIterM.step = step
+  match step with
+  | .yield it' out h =>
+    simp [PostconditionT.lift, liftM, monadLift, MonadLift.monadLift]
+    apply bind_congr
+    intro step
+    rcases step with _ | _ <;> rfl
+  | .skip it' h => rfl
+  | .done h => rfl
+
+theorem Iter.step_mapM {f : β → n γ}
+    [Monad n] [LawfulMonad n] [MonadLiftT m n] :
+  (it.mapM f).step = (do
+    match it.step with
+    | .yield it' out h => do
+      let out' ← f out
+      pure <| .yield (it'.mapM f) out' (.yieldSome h ⟨_, rfl⟩)
+    | .skip it' h =>
+      pure <| .skip (it'.mapM f) (.skip h)
+    | .done h =>
+      pure <| .done (.done h)) := by
+  simp only [mapM_eq_toIter_mapM_toIterM, IterM.step_mapM, step]
+  simp only [liftM, monadLift, pure_bind]
+  generalize it.toIterM.step = step
+  match step with
+  | .yield it' out h =>
+    simp only [PostconditionT.operation_map, bind_map_left, bind_pure_comp]
+    simp only [monadLift, MonadLift.monadLift, monadLift_self, Functor.map, Functor.map_map,
+      bind_map_left, bind_pure_comp]
+    rfl
+  | .skip it' h => rfl
+  | .done h => rfl
+
+theorem Iter.step_filterMap {f : β → Option γ} :
+    (it.filterMap f).step = match it.step with
+      | .yield it' out h =>
+        match h' : f out with
+        | none => .skip (it'.filterMap f) (.yieldNone (out := out) h h')
+        | some out' => .yield (it'.filterMap f) out' (.yieldSome (out := out) h h')
+      | .skip it' h => .skip (it'.filterMap f) (.skip h)
+      | .done h => .done (.done h) := by
+  simp only [filterMap_eq_toIter_filterMap_toIterM, toIterM_toIter, IterM.step_filterMap, step]
+  simp only [liftM, monadLift, pure_bind, Id.run_bind]
+  generalize it.toIterM.step.run = step
+  cases step using PlausibleIterStep.casesOn
+  · simp only [IterM.Step.toPure_yield, toIter_toIterM, toIterM_toIter]
+    split <;> split <;> (try exfalso; simp_all; done)
+    · rfl
+    · rename_i h₁ _ h₂
+      rw [h₁] at h₂
+      cases h₂
+      rfl
+  · simp
+  · simp
+
+def Iter.step_map {f : β → γ} :
+    (it.map f).step = match it.step with
+      | .yield it' out h =>
+        .yield (it'.map f) (f out) (.yieldSome (out := out) h ⟨⟨f out, rfl⟩, rfl⟩)
+      | .skip it' h =>
+        .skip (it'.map f) (.skip h)
+      | .done h =>
+        .done (.done h) := by
+  simp only [map_eq_toIter_map_toIterM, step, toIterM_toIter, IterM.step_map, Id.run_bind]
+  generalize it.toIterM.step.run = step
+  cases step using PlausibleIterStep.casesOn <;> simp
+
+def Iter.step_filter {f : β → Bool} :
+    (it.filter f).step = match it.step with
+      | .yield it' out h =>
+        if h' : f out = true then
+          .yield (it'.filter f) out (.yieldSome (out := out) h (by simp [h']))
+        else
+          .skip (it'.filter f) (.yieldNone h (by simp [h']))
+      | .skip it' h =>
+        .skip (it'.filter f) (.skip h)
+      | .done h =>
+        .done (.done h) := by
+  simp only [filter_eq_toIter_filter_toIterM, step, toIterM_toIter, IterM.step_filter, Id.run_bind]
+  generalize it.toIterM.step.run = step
+  cases step using PlausibleIterStep.casesOn
+  · simp only
+    split <;> simp [*]
+  · simp
+  · simp
+
+@[simp]
+theorem Iter.toList_filterMap
+    [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id] [Finite α Id]
+    {f : β → Option γ} :
+    (it.filterMap f).toList = it.toList.filterMap f := by
+  simp [filterMap_eq_toIter_filterMap_toIterM, toList_eq_toList_toIterM, IterM.toList_filterMap]
+
+@[simp]
+theorem Iter.toList_map
+    [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id] [Finite α Id]
+    {f : β → γ} :
+    (it.map f).toList = it.toList.map f := by
+  simp [map_eq_toIter_map_toIterM, IterM.toList_map, Iter.toList_eq_toList_toIterM]
+
+@[simp]
+theorem Iter.toList_filter
+    [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id] [Finite α Id]
+    {f : β → Bool} :
+    (it.filter f).toList = it.toList.filter f := by
+  simp [filter_eq_toIter_filter_toIterM, IterM.toList_filter, Iter.toList_eq_toList_toIterM]
+
+@[simp]
+theorem Iter.toListRev_filterMap
+    [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id] [Finite α Id]
+    {f : β → Option γ} :
+    (it.filterMap f).toListRev = it.toListRev.filterMap f := by
+  simp [filterMap_eq_toIter_filterMap_toIterM, toListRev_eq_toListRev_toIterM, IterM.toListRev_filterMap]
+
+@[simp]
+theorem Iter.toListRev_map
+    [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id] [Finite α Id]
+    {f : β → γ} :
+    (it.map f).toListRev = it.toListRev.map f := by
+  simp [map_eq_toIter_map_toIterM, IterM.toListRev_map, Iter.toListRev_eq_toListRev_toIterM]
+
+@[simp]
+theorem Iter.toListRev_filter
+    [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id] [Finite α Id]
+    {f : β → Bool} :
+    (it.filter f).toListRev = it.toListRev.filter f := by
+  simp [filter_eq_toIter_filter_toIterM, IterM.toListRev_filter, Iter.toListRev_eq_toListRev_toIterM]
+
+@[simp]
+theorem Iter.toArray_filterMap
+    [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id] [Finite α Id]
+    {f : β → Option γ} :
+    (it.filterMap f).toArray = it.toArray.filterMap f := by
+  simp [filterMap_eq_toIter_filterMap_toIterM, toArray_eq_toArray_toIterM, IterM.toArray_filterMap]
+
+@[simp]
+theorem Iter.toArray_map
+    [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id] [Finite α Id]
+    {f : β → γ} :
+    (it.map f).toArray = it.toArray.map f := by
+  simp [map_eq_toIter_map_toIterM, IterM.toArray_map, Iter.toArray_eq_toArray_toIterM]
+
+@[simp]
+theorem Iter.toArray_filter
+    [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id] [Finite α Id]
+    {f : β → Bool} :
+    (it.filter f).toArray = it.toArray.filter f := by
+  simp [filter_eq_toIter_filter_toIterM, IterM.toArray_filter, Iter.toArray_eq_toArray_toIterM]
+
+end Std.Iterators

src/Std/Data/Iterators/Lemmas/Combinators/Monadic.lean

@@ -0,0 +1,11 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Std.Data.Iterators.Lemmas.Combinators.Monadic.Take
+import Std.Data.Iterators.Lemmas.Combinators.Monadic.TakeWhile
+import Std.Data.Iterators.Lemmas.Combinators.Monadic.DropWhile
+import Std.Data.Iterators.Lemmas.Combinators.Monadic.FilterMap
+import Std.Data.Iterators.Lemmas.Combinators.Monadic.Zip

src/Std/Data/Iterators/Lemmas/Combinators/Monadic/DropWhile.lean

@@ -0,0 +1,172 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Std.Data.Iterators.Combinators.Monadic.DropWhile
+import Std.Data.Iterators.Lemmas.Consumers.Monadic
+
+namespace Std.Iterators
+
+theorem IterM.Intermediate.dropWhileM_eq_dropWhileWithPostcondition {α m β} [Monad m]
+    [Iterator α m β] {it : IterM (α := α) m β} {P dropping} :
+    Intermediate.dropWhileM P dropping it =
+      Intermediate.dropWhileWithPostcondition (PostconditionT.lift ∘ P) dropping it :=
+  rfl
+
+theorem IterM.Intermediate.dropWhile_eq_dropWhileM {α m β} [Monad m]
+    [Iterator α m β] {it : IterM (α := α) m β} {P} :
+    Intermediate.dropWhile P dropping it =
+      Intermediate.dropWhileM (pure ∘ ULift.up ∘ P) dropping it :=
+  rfl
+
+theorem IterM.dropWhileWithPostcondition_eq_intermediateDropWhileWithPostcondition {α m β}
+    [Iterator α m β] {it : IterM (α := α) m β} {P} :
+    it.dropWhileWithPostcondition P = Intermediate.dropWhileWithPostcondition P true it :=
+  rfl
+
+theorem IterM.dropWhileM_eq_intermediateDropWhileM {α m β} [Monad m]
+    [Iterator α m β] {it : IterM (α := α) m β} {P} :
+    it.dropWhileM P = Intermediate.dropWhileM P true it :=
+  rfl
+
+theorem IterM.dropWhile_eq_intermediateDropWhile {α m β} [Monad m]
+    [Iterator α m β] {it : IterM (α := α) m β} {P} :
+    it.dropWhile P = Intermediate.dropWhile P true it :=
+  rfl
+
+theorem IterM.step_intermediateDropWhileWithPostcondition {α m β} [Monad m] [Iterator α m β]
+    {it : IterM (α := α) m β} {P} {dropping} :
+    (IterM.Intermediate.dropWhileWithPostcondition P dropping it).step = (do
+    match ← it.step with
+    | .yield it' out h =>
+      if h' : dropping = true then
+        match ← (P out).operation with
+        | ⟨.up true, h''⟩ =>
+          return .skip (IterM.Intermediate.dropWhileWithPostcondition P true it') (.dropped h h' h'')
+        | ⟨.up false, h''⟩ =>
+          return .yield (IterM.Intermediate.dropWhileWithPostcondition P false it') out (.start h h' h'')
+      else
+        return .yield (IterM.Intermediate.dropWhileWithPostcondition P false it') out
+            (.yield h (Bool.not_eq_true _ ▸ h'))
+    | .skip it' h =>
+      return .skip (IterM.Intermediate.dropWhileWithPostcondition P dropping it') (.skip h)
+    | .done h =>
+      return .done (.done h)) := by
+  simp only [dropWhileWithPostcondition, step, Iterator.step, internalState_toIterM]
+  apply bind_congr
+  intro step
+  cases step using PlausibleIterStep.casesOn <;> rfl
+
+theorem IterM.step_dropWhileWithPostcondition {α m β} [Monad m] [Iterator α m β]
+    {it : IterM (α := α) m β} {P} :
+    (it.dropWhileWithPostcondition P).step = (do
+    match ← it.step with
+    | .yield it' out h =>
+        match ← (P out).operation with
+        | ⟨.up true, h''⟩ =>
+          return .skip (IterM.Intermediate.dropWhileWithPostcondition P true it') (.dropped h rfl h'')
+        | ⟨.up false, h''⟩ =>
+          return .yield (IterM.Intermediate.dropWhileWithPostcondition P false it') out (.start h rfl h'')
+    | .skip it' h =>
+      return .skip (IterM.Intermediate.dropWhileWithPostcondition P true it') (.skip h)
+    | .done h =>
+      return .done (.done h)) := by
+  simp [dropWhileWithPostcondition_eq_intermediateDropWhileWithPostcondition, step_intermediateDropWhileWithPostcondition]
+
+theorem IterM.step_intermediateDropWhileM {α m β} [Monad m] [LawfulMonad m] [Iterator α m β]
+    {it : IterM (α := α) m β} {P} {dropping} :
+    (IterM.Intermediate.dropWhileM P dropping it).step = (do
+    match ← it.step with
+    | .yield it' out h =>
+      if h' : dropping = true then
+        match ← P out with
+        | .up true =>
+          return .skip (IterM.Intermediate.dropWhileM P true it') (.dropped h h' True.intro)
+        | .up false =>
+          return .yield (IterM.Intermediate.dropWhileM P false it') out (.start h h' True.intro)
+      else
+        return .yield (IterM.Intermediate.dropWhileM P false it') out
+            (.yield h (Bool.not_eq_true _ ▸ h'))
+    | .skip it' h =>
+      return .skip (IterM.Intermediate.dropWhileM P dropping it') (.skip h)
+    | .done h =>
+      return .done (.done h)) := by
+  simp only [Intermediate.dropWhileM_eq_dropWhileWithPostcondition, step_intermediateDropWhileWithPostcondition]
+  apply bind_congr
+  intro step
+  cases step using PlausibleIterStep.casesOn
+  · simp only [Function.comp_apply, PostconditionT.operation_lift, PlausibleIterStep.skip,
+    PlausibleIterStep.yield, bind_map_left]
+    split
+    · apply bind_congr
+      rintro ⟨x⟩
+      cases x <;> rfl
+    · rfl
+  · rfl
+  · rfl
+
+theorem IterM.step_dropWhileM {α m β} [Monad m] [LawfulMonad m] [Iterator α m β]
+    {it : IterM (α := α) m β} {P} :
+    (it.dropWhileM P).step = (do
+    match ← it.step with
+    | .yield it' out h =>
+      match ← P out with
+      | .up true =>
+        return .skip (IterM.Intermediate.dropWhileM P true it') (.dropped h rfl True.intro)
+      | .up false =>
+        return .yield (IterM.Intermediate.dropWhileM P false it') out (.start h rfl True.intro)
+    | .skip it' h =>
+      return .skip (IterM.Intermediate.dropWhileM P true it') (.skip h)
+    | .done h =>
+      return .done (.done h)) := by
+  simp [dropWhileM_eq_intermediateDropWhileM, step_intermediateDropWhileM]
+
+theorem IterM.step_intermediateDropWhile {α m β} [Monad m] [LawfulMonad m] [Iterator α m β]
+    {it : IterM (α := α) m β} {P} {dropping} :
+    (IterM.Intermediate.dropWhile P dropping it).step = (do
+    match ← it.step with
+    | .yield it' out h =>
+      if h' : dropping = true then
+        match P out with
+        | true =>
+          return .skip (IterM.Intermediate.dropWhile P true it') (.dropped h h' True.intro)
+        | false =>
+          return .yield (IterM.Intermediate.dropWhile P false it') out (.start h h' True.intro)
+      else
+        return .yield (IterM.Intermediate.dropWhile P false it') out
+            (.yield h (Bool.not_eq_true _ ▸ h'))
+    | .skip it' h =>
+      return .skip (IterM.Intermediate.dropWhile P dropping it') (.skip h)
+    | .done h =>
+      return .done (.done h)) := by
+  simp only [Intermediate.dropWhile_eq_dropWhileM, step_intermediateDropWhileM]
+  apply bind_congr
+  intro step
+  cases step using PlausibleIterStep.casesOn
+  · simp only [Function.comp_apply, PostconditionT.operation_lift, PlausibleIterStep.skip,
+    PlausibleIterStep.yield, bind_map_left]
+    split
+    · cases P _ <;> simp
+    · rfl
+  · rfl
+  · rfl
+
+theorem IterM.step_dropWhile {α m β} [Monad m] [LawfulMonad m] [Iterator α m β]
+    {it : IterM (α := α) m β} {P} :
+    (it.dropWhile P).step = (do
+    match ← it.step with
+    | .yield it' out h =>
+        match P out with
+        | true =>
+          return .skip (IterM.Intermediate.dropWhile P true it') (.dropped h rfl True.intro)
+        | false =>
+          return .yield (IterM.Intermediate.dropWhile P false it') out (.start h rfl True.intro)
+    | .skip it' h =>
+      return .skip (IterM.Intermediate.dropWhile P true it') (.skip h)
+    | .done h =>
+      return .done (.done h)) := by
+  simp [dropWhile_eq_intermediateDropWhile, step_intermediateDropWhile]
+
+end Std.Iterators

src/Std/Data/Iterators/Lemmas/Combinators/Monadic/FilterMap.lean

@@ -0,0 +1,411 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Std.Data.Iterators.Combinators.Monadic.FilterMap
+import Std.Data.Iterators.Lemmas.Consumers.Monadic
+import Std.Data.Internal.LawfulMonadLiftFunction
+
+namespace Std.Iterators
+open Std.Internal
+
+section Step
+
+variable {α β β' : Type w} {m : Type w → Type w'} {n : Type w → Type w''}
+  [Iterator α m β] {it : IterM (α := α) m β}
+
+theorem IterM.step_filterMapWithPostcondition {f : β → PostconditionT n (Option β')}
+    [Monad n] [LawfulMonad n] [MonadLiftT m n] :
+  (it.filterMapWithPostcondition f).step = (do
+    match ← it.step with
+    | .yield it' out h => do
+      match ← (f out).operation with
+      | ⟨none, h'⟩ =>
+        pure <| .skip (it'.filterMapWithPostcondition f) (.yieldNone (out := out) h h')
+      | ⟨some out', h'⟩ =>
+        pure <| .yield (it'.filterMapWithPostcondition f) out' (.yieldSome (out := out) h h')
+    | .skip it' h =>
+      pure <| .skip (it'.filterMapWithPostcondition f) (.skip h)
+    | .done h =>
+      pure <| .done (.done h)) := by
+  apply bind_congr
+  intro step
+  match step with
+  | .yield it' out h =>
+    simp only [PlausibleIterStep.skip, PlausibleIterStep.yield]
+    apply bind_congr
+    intro step
+    rcases step with _ | _ <;> rfl
+  | .skip it' h => rfl
+  | .done h => rfl
+
+theorem IterM.step_filterWithPostcondition {f : β → PostconditionT n (ULift Bool)}
+    [Monad n] [LawfulMonad n] [MonadLiftT m n] :
+  (it.filterWithPostcondition f).step = (do
+    match ← it.step with
+    | .yield it' out h => do
+      match ← (f out).operation with
+      | ⟨.up false, h'⟩ =>
+        pure <| .skip (it'.filterWithPostcondition f) (.yieldNone (out := out) h ⟨⟨_, h'⟩, rfl⟩)
+      | ⟨.up true, h'⟩ =>
+        pure <| .yield (it'.filterWithPostcondition f) out (.yieldSome (out := out) h ⟨⟨_, h'⟩, rfl⟩)
+    | .skip it' h =>
+      pure <| .skip (it'.filterWithPostcondition f) (.skip h)
+    | .done h =>
+      pure <| .done (.done h)) := by
+  apply bind_congr
+  intro step
+  match step with
+  | .yield it' out h =>
+    simp only [PostconditionT.operation_map, PlausibleIterStep.skip, PlausibleIterStep.yield,
+      bind_map_left]
+    apply bind_congr
+    intro step
+    rcases step with _ | _ <;> rfl
+  | .skip it' h => rfl
+  | .done h => rfl
+
+theorem IterM.step_mapWithPostcondition {γ : Type w} {f : β → PostconditionT n γ}
+    [Monad n] [LawfulMonad n] [MonadLiftT m n] :
+  (it.mapWithPostcondition f).step = (do
+    match ← it.step with
+    | .yield it' out h => do
+      let out' ← (f out).operation
+      pure <| .yield (it'.mapWithPostcondition f) out'.1 (.yieldSome h ⟨out', rfl⟩)
+    | .skip it' h =>
+      pure <| .skip (it'.mapWithPostcondition f) (.skip h)
+    | .done h =>
+      pure <| .done (.done h)) := by
+  apply bind_congr
+  intro step
+  match step with
+  | .yield it' out h =>
+    simp only [PostconditionT.operation_map, bind_map_left, bind_pure_comp]
+    rfl
+  | .skip it' h => rfl
+  | .done h => rfl
+
+theorem IterM.step_filterMapM {f : β → n (Option β')}
+    [Monad n] [LawfulMonad n] [MonadLiftT m n] :
+  (it.filterMapM f).step = (do
+    match ← it.step with
+    | .yield it' out h => do
+      match ← f out with
+      | none =>
+        pure <| .skip (it'.filterMapM f) (.yieldNone (out := out) h .intro)
+      | some out' =>
+        pure <| .yield (it'.filterMapM f) out' (.yieldSome (out := out) h .intro)
+    | .skip it' h =>
+      pure <| .skip (it'.filterMapM f) (.skip h)
+    | .done h =>
+      pure <| .done (.done h)) := by
+  apply bind_congr
+  intro step
+  match step with
+  | .yield it' out h =>
+    simp only [PostconditionT.lift, bind_map_left]
+    apply bind_congr
+    intro step
+    rcases step with _ | _ <;> rfl
+  | .skip it' h => rfl
+  | .done h => rfl
+
+theorem IterM.step_filterM {f : β → n (ULift Bool)}
+    [Monad n] [LawfulMonad n] [MonadLiftT m n] :
+  (it.filterM f).step = (do
+    match ← it.step with
+    | .yield it' out h => do
+      match ← f out with
+      | .up false =>
+        pure <| .skip (it'.filterM f) (.yieldNone (out := out) h ⟨⟨.up false, .intro⟩, rfl⟩)
+      | .up true =>
+        pure <| .yield (it'.filterM f) out (.yieldSome (out := out) h ⟨⟨.up true, .intro⟩, rfl⟩)
+    | .skip it' h =>
+      pure <| .skip (it'.filterM f) (.skip h)
+    | .done h =>
+      pure <| .done (.done h)) := by
+  apply bind_congr
+  intro step
+  match step with
+  | .yield it' out h =>
+    simp only [PostconditionT.lift, liftM, monadLift, MonadLift.monadLift, monadLift_self,
+      PostconditionT.operation_map, Functor.map_map, PlausibleIterStep.skip,
+      PlausibleIterStep.yield, bind_map_left]
+    apply bind_congr
+    intro step
+    rcases step with _ | _ <;> rfl
+  | .skip it' h => rfl
+  | .done h => rfl
+
+theorem IterM.step_mapM {γ : Type w} {f : β → n γ}
+    [Monad n] [LawfulMonad n] [MonadLiftT m n] :
+  (it.mapM f).step = (do
+    match ← it.step with
+    | .yield it' out h => do
+      let out' ← f out
+      pure <| .yield (it'.mapM f) out' (.yieldSome h ⟨_, rfl⟩)
+    | .skip it' h =>
+      pure <| .skip (it'.mapM f) (.skip h)
+    | .done h =>
+      pure <| .done (.done h)) := by
+  apply bind_congr
+  intro step
+  match step with
+  | .yield it' out h =>
+    simp only [PostconditionT.operation_map, bind_map_left, bind_pure_comp]
+    simp only [PostconditionT.lift, Functor.map, Functor.map_map,
+      bind_map_left, bind_pure_comp]
+    rfl
+  | .skip it' h => rfl
+  | .done h => rfl
+
+theorem IterM.step_filterMap [Monad m] [LawfulMonad m] {f : β → Option β'} :
+  (it.filterMap f).step = (do
+    match ← it.step with
+    | .yield it' out h => do
+      match h' : f out with
+      | none =>
+        pure <| .skip (it'.filterMap f) (.yieldNone h h')
+      | some out' =>
+        pure <| .yield (it'.filterMap f) out' (.yieldSome h h')
+    | .skip it' h =>
+      pure <| .skip (it'.filterMap f) (.skip h)
+    | .done h =>
+      pure <| .done (.done h)) := by
+  simp only [IterM.filterMap, step_filterMapWithPostcondition, pure]
+  apply bind_congr
+  intro step
+  split
+  · simp only [pure_bind]
+    split <;> split <;> simp_all
+  · simp
+  · simp
+
+theorem IterM.step_map [Monad m] [LawfulMonad m] {f : β → β'} :
+  (it.map f).step = (do
+    match ← it.step with
+    | .yield it' out h =>
+      let out' := f out
+      pure <| .yield (it'.map f) out' (.yieldSome h ⟨⟨out', rfl⟩, rfl⟩)
+    | .skip it' h =>
+      pure <| .skip (it'.map f) (.skip h)
+    | .done h => pure <| .done (.done h)) := by
+  simp only [map, IterM.step_mapWithPostcondition]
+  apply bind_congr
+  intro step
+  split
+  · simp
+  · rfl
+  · rfl
+
+theorem IterM.step_filter [Monad m] [LawfulMonad m] {f : β → Bool} :
+  (it.filter f).step = (do
+    match ← it.step with
+    | .yield it' out h =>
+      if h' : f out = true then
+        pure <| .yield (it'.filter f) out (.yieldSome h (by simp [h']))
+      else
+        pure <| .skip (it'.filter f) (.yieldNone h (by simp [h']))
+    | .skip it' h =>
+      pure <| .skip (it'.filter f) (.skip h)
+    | .done h => pure <| .done (.done h)) := by
+  simp only [filter, IterM.step_filterMap]
+  apply bind_congr
+  intro step
+  split
+  · split
+    · split
+      · exfalso; simp_all
+      · rfl
+    · split
+      · congr; simp_all
+      · exfalso; simp_all
+  · rfl
+  · rfl
+
+end Step
+
+section Lawful
+
+
+instance {α β γ : Type w} {m : Type w → Type w'} {n : Type w → Type w''} {o : Type w → Type x}
+    [Monad m] [Monad n] [Monad o] [LawfulMonad n] [LawfulMonad o] [Iterator α m β] [Finite α m]
+    [IteratorCollect α m o] [LawfulIteratorCollect α m o]
+    {lift : ⦃δ : Type w⦄ -> m δ → n δ} {f : β → PostconditionT n γ} [LawfulMonadLiftFunction lift] :
+    LawfulIteratorCollect (Map α m n lift f) n o where
+  lawful_toArrayMapped := by
+    intro δ lift' _ _
+    letI : MonadLift m n := ⟨lift (δ := _)⟩
+    letI : MonadLift n o := ⟨lift' (α := _)⟩
+    ext g it
+    have : it = IterM.mapWithPostcondition _ it.internalState.inner := by rfl
+    generalize it.internalState.inner = it at *
+    cases this
+    simp only [LawfulIteratorCollect.toArrayMapped_eq]
+    simp only [IteratorCollect.toArrayMapped]
+    rw [LawfulIteratorCollect.toArrayMapped_eq]
+    induction it using IterM.inductSteps with | step it ih_yield ih_skip =>
+    rw [IterM.DefaultConsumers.toArrayMapped_eq_match_step]
+    rw [IterM.DefaultConsumers.toArrayMapped_eq_match_step]
+    simp only [bind_assoc]
+    rw [IterM.step_mapWithPostcondition]
+    simp only [liftM_bind (m := n) (n := o), bind_assoc]
+    apply bind_congr
+    intro step
+    split
+    · simp only [bind_pure_comp, bind_map_left, ← ih_yield ‹_›]
+      simp only [liftM_map, bind_map_left]
+      apply bind_congr
+      intro out'
+      simp only [← ih_yield ‹_›]
+      rfl
+    · simp only [bind_pure_comp, pure_bind, liftM_pure, pure_bind, ← ih_skip ‹_›]
+      simp only [IterM.mapWithPostcondition, IterM.InternalCombinators.map, internalState_toIterM]
+    · simp
+
+end Lawful
+
+section ToList
+
+theorem IterM.InternalConsumers.toList_filterMap {α β γ: Type w} {m : Type w → Type w'}
+    [Monad m] [LawfulMonad m]
+    [Iterator α m β] [IteratorCollect α m m] [LawfulIteratorCollect α m m] [Finite α m]
+    {f : β → Option γ} (it : IterM (α := α) m β) :
+    (it.filterMap f).toList = (fun x => x.filterMap f) <$> it.toList := by
+  induction it using IterM.inductSteps
+  rename_i it ihy ihs
+  rw [IterM.toList_eq_match_step, IterM.toList_eq_match_step]
+  simp only [bind_pure_comp, map_bind]
+  rw [step_filterMap]
+  simp only [bind_assoc, IterM.step, map_eq_pure_bind]
+  apply bind_congr
+  intro step
+  split
+  · simp only [List.filterMap_cons, bind_assoc, pure_bind, bind_pure]
+    split
+    · split
+      · simp only [bind_pure_comp, pure_bind]
+        exact ihy ‹_›
+      · simp_all
+    · split
+      · simp_all
+      · simp_all [ihy ‹_›]
+  · simp only [bind_pure_comp, pure_bind]
+    apply ihs
+    assumption
+  · simp
+
+theorem IterM.toList_filterMap {α β γ : Type w} {m : Type w → Type w'}
+    [Monad m] [LawfulMonad m]
+    [Iterator α m β] [IteratorCollect α m m] [LawfulIteratorCollect α m m] [Finite α m]
+    {f : β → Option γ} (it : IterM (α := α) m β) :
+    (it.filterMap f).toList = (fun x => x.filterMap f) <$> it.toList := by
+  induction it using IterM.inductSteps
+  rename_i it ihy ihs
+  rw [IterM.toList_eq_match_step, IterM.toList_eq_match_step]
+  simp only [bind_pure_comp, map_bind]
+  rw [step_filterMap]
+  simp only [bind_assoc, IterM.step, map_eq_pure_bind]
+  apply bind_congr
+  intro step
+  split
+  · simp only [List.filterMap_cons, bind_assoc, pure_bind, bind_pure]
+    split
+    · split
+      · simp only [bind_pure_comp, pure_bind]
+        exact ihy ‹_›
+      · simp_all
+    · split
+      · simp_all
+      · simp_all [ihy ‹_›]
+  · simp only [bind_pure_comp, pure_bind]
+    apply ihs
+    assumption
+  · simp
+
+theorem IterM.toList_map {α β β' : Type w} {m : Type w → Type w'} [Monad m] [LawfulMonad m]
+    [Iterator α m β] [IteratorCollect α m m] [LawfulIteratorCollect α m m] [Finite α m] {f : β → β'}
+    (it : IterM (α := α) m β) :
+    (it.map f).toList = (fun x => x.map f) <$> it.toList := by
+  rw [LawfulIteratorCollect.toList_eq, ← List.filterMap_eq_map, ← toList_filterMap]
+  let t := type_of% (it.map f)
+  let t' := type_of% (it.filterMap (some ∘ f))
+  congr
+  · simp [Map]
+  · simp [instIteratorMap, inferInstanceAs]
+    congr
+    simp
+  · refine heq_of_eqRec_eq ?_ rfl
+    congr
+    simp only [Map, PostconditionT.map_pure, Function.comp_apply]
+    simp only [instIteratorMap, inferInstanceAs, Function.comp_apply]
+    congr
+    simp
+  · simp [Map]
+  · simp only [instIteratorMap, inferInstanceAs, Function.comp_apply]
+    congr
+    simp
+  · simp only [map, mapWithPostcondition, InternalCombinators.map, Function.comp_apply, filterMap,
+    filterMapWithPostcondition, InternalCombinators.filterMap]
+    congr
+    · simp [Map]
+    · simp
+
+theorem IterM.toList_filter {α : Type w} {m : Type w → Type w'} [Monad m] [LawfulMonad m]
+    {β : Type w} [Iterator α m β] [Finite α m] [IteratorCollect α m m] [LawfulIteratorCollect α m m]
+    {f : β → Bool} {it : IterM (α := α) m β} :
+    (it.filter f).toList = List.filter f <$> it.toList := by
+  simp only [filter, toList_filterMap, ← List.filterMap_eq_filter]
+  rfl
+
+end ToList
+
+section ToListRev
+
+theorem IterM.toListRev_filterMap {α β γ : Type w} {m : Type w → Type w'}
+    [Monad m] [LawfulMonad m]
+    [Iterator α m β] [IteratorCollect α m m] [LawfulIteratorCollect α m m] [Finite α m]
+    {f : β → Option γ} (it : IterM (α := α) m β) :
+    (it.filterMap f).toListRev = (fun x => x.filterMap f) <$> it.toListRev := by
+  simp [toListRev_eq, toList_filterMap]
+
+theorem IterM.toListRev_map {α β γ : Type w} {m : Type w → Type w'} [Monad m] [LawfulMonad m]
+    [Iterator α m β] [IteratorCollect α m m] [LawfulIteratorCollect α m m] [Finite α m] {f : β → γ}
+    (it : IterM (α := α) m β) :
+    (it.map f).toListRev = (fun x => x.map f) <$> it.toListRev := by
+  simp [toListRev_eq, toList_map]
+
+theorem IterM.toListRev_filter {α β : Type w} {m : Type w → Type w'} [Monad m] [LawfulMonad m]
+    [Iterator α m β] [Finite α m] [IteratorCollect α m m] [LawfulIteratorCollect α m m]
+    {f : β → Bool} {it : IterM (α := α) m β} :
+    (it.filter f).toListRev = List.filter f <$> it.toListRev := by
+  simp [toListRev_eq, toList_filter]
+
+end ToListRev
+
+section ToArray
+
+theorem IterM.toArray_filterMap {α β γ : Type w} {m : Type w → Type w'}
+    [Monad m] [LawfulMonad m]
+    [Iterator α m β] [IteratorCollect α m m] [LawfulIteratorCollect α m m] [Finite α m]
+    {f : β → Option γ} (it : IterM (α := α) m β) :
+    (it.filterMap f).toArray = (fun x => x.filterMap f) <$> it.toArray := by
+  simp [← toArray_toList, toList_filterMap]
+
+theorem IterM.toArray_map {α β γ : Type w} {m : Type w → Type w'} [Monad m] [LawfulMonad m]
+    [Iterator α m β] [IteratorCollect α m m] [LawfulIteratorCollect α m m] [Finite α m] {f : β → γ}
+    (it : IterM (α := α) m β) :
+    (it.map f).toArray = (fun x => x.map f) <$> it.toArray := by
+  simp [← toArray_toList, toList_map]
+
+theorem IterM.toArray_filter {α : Type w} {m : Type w → Type w'} [Monad m] [LawfulMonad m]
+    {β : Type w} [Iterator α m β] [Finite α m] [IteratorCollect α m m] [LawfulIteratorCollect α m m]
+    {f : β → Bool} {it : IterM (α := α) m β} :
+    (it.filter f).toArray = Array.filter f <$> it.toArray := by
+  simp [← toArray_toList, toList_filter]
+
+end ToArray
+
+end Std.Iterators

src/Std/Data/Iterators/Lemmas/Combinators/Monadic/Take.lean

@@ -0,0 +1,38 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Std.Data.Iterators.Combinators.Monadic.Take
+import Std.Data.Iterators.Lemmas.Consumers.Monadic
+
+namespace Std.Iterators
+
+theorem IterM.step_take {α m β} [Monad m] [Iterator α m β] {n : Nat}
+    {it : IterM (α := α) m β} :
+    (it.take n).step = (match n with
+      | 0 => pure <| .done (.depleted rfl)
+      | k + 1 => do
+        match ← it.step with
+        | .yield it' out h => pure <| .yield (it'.take k) out (.yield h rfl)
+        | .skip it' h => pure <| .skip (it'.take (k + 1)) (.skip h rfl)
+        | .done h => pure <| .done (.done h)) := by
+  simp only [take, step, Iterator.step, internalState_toIterM, Nat.succ_eq_add_one]
+  cases n
+  case zero => rfl
+  case succ k =>
+    apply bind_congr
+    intro step
+    obtain ⟨step, h⟩ := step
+    cases step <;> rfl
+
+theorem IterM.toList_take_zero {α m β} [Monad m] [LawfulMonad m] [Iterator α m β]
+    [Finite (Take α m β) m]
+    [IteratorCollect (Take α m β) m m] [LawfulIteratorCollect (Take α m β) m m]
+    {it : IterM (α := α) m β} :
+    (it.take 0).toList = pure [] := by
+  rw [toList_eq_match_step]
+  simp [step_take]
+
+end Std.Iterators

src/Std/Data/Iterators/Lemmas/Combinators/Monadic/TakeWhile.lean

@@ -0,0 +1,65 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Std.Data.Iterators.Combinators.Monadic.TakeWhile
+import Std.Data.Iterators.Lemmas.Consumers.Monadic
+
+namespace Std.Iterators
+
+theorem IterM.step_takeWhileWithPostcondition {α m β} [Monad m] [Iterator α m β]
+    {it : IterM (α := α) m β} {P} :
+    (it.takeWhileWithPostcondition P).step = (do
+      match ← it.step with
+      | .yield it' out h => match ← (P out).operation with
+        | ⟨.up true, h'⟩ => pure <| .yield (it'.takeWhileWithPostcondition P) out (.yield h h')
+        | ⟨.up false, h'⟩ => pure <| .done (.rejected h h')
+      | .skip it' h => pure <| .skip (it'.takeWhileWithPostcondition P) (.skip h)
+      | .done h => pure <| .done (.done h)) := by
+  simp only [takeWhileWithPostcondition, step, Iterator.step, internalState_toIterM]
+  apply bind_congr
+  intro step
+  cases step using PlausibleIterStep.casesOn <;> rfl
+
+theorem IterM.step_takeWhileM {α m β} [Monad m] [LawfulMonad m] [Iterator α m β]
+    {it : IterM (α := α) m β} {P} :
+    (it.takeWhileM P).step = (do
+      match ← it.step with
+      | .yield it' out h => match ← P out with
+        | .up true => pure <| .yield (it'.takeWhileM P) out (.yield h True.intro)
+        | .up false => pure <| .done (.rejected h True.intro)
+      | .skip it' h => pure <| .skip (it'.takeWhileM P) (.skip h)
+      | .done h => pure <| .done (.done h)) := by
+  simp only [takeWhileM, step_takeWhileWithPostcondition]
+  apply bind_congr
+  intro step
+  cases step using PlausibleIterStep.casesOn
+  · simp only [Function.comp_apply, PostconditionT.operation_lift, PlausibleIterStep.yield,
+    PlausibleIterStep.done, bind_map_left]
+    apply bind_congr
+    rintro ⟨x⟩
+    cases x <;> rfl
+  · simp
+  · simp
+
+theorem IterM.step_takeWhile {α m β} [Monad m] [LawfulMonad m] [Iterator α m β]
+    {it : IterM (α := α) m β} {P} :
+    (it.takeWhile P).step = (do
+      match ← it.step with
+      | .yield it' out h => match P out with
+        | true => pure <| .yield (it'.takeWhile P) out (.yield h True.intro)
+        | false => pure <| .done (.rejected h True.intro)
+      | .skip it' h => pure <| .skip (it'.takeWhile P) (.skip h)
+      | .done h => pure <| .done (.done h)) := by
+  simp only [takeWhile, step_takeWhileM]
+  apply bind_congr
+  intro step
+  cases step using PlausibleIterStep.casesOn
+  · simp only [Function.comp_apply, PlausibleIterStep.yield, PlausibleIterStep.done, pure_bind]
+    cases P _ <;> rfl
+  · simp
+  · simp
+
+end Std.Iterators

src/Std/Data/Iterators/Lemmas/Combinators/Monadic/Zip.lean

@@ -0,0 +1,88 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Std.Data.Iterators.Combinators.Monadic.Zip
+import Std.Data.Iterators.Lemmas.Consumers.Monadic
+
+namespace Std.Iterators
+
+variable {α₁ α₂ β₁ β₂ : Type w} {m : Type w → Type w'}
+
+/--
+Constructs intermediate states of an iterator created with the combinator `IterM.zip`.
+When `left.zip right` has already obtained a value from `left` but not yet from right,
+it remembers `left`'s value in a field of its internal state. This intermediate state
+cannot be created directly with `IterM.zip`.
+
+`Intermediate.zip` is meant to be used only for verification purposes.
+-/
+noncomputable def IterM.Intermediate.zip [Iterator α₁ m β₁] (it₁ : IterM (α := α₁) m β₁)
+    (memo : (Option { out : β₁ //
+        ∃ it : IterM (α := α₁) m β₁, it.IsPlausibleOutput out }))
+    (it₂ : IterM (α := α₂) m β₂) :
+    IterM (α := Zip α₁ m α₂ β₂) m (β₁ × β₂) :=
+  ⟨⟨it₁, memo, it₂⟩⟩
+
+theorem IterM.zip_eq_intermediateZip [Iterator α₁ m β₁]
+    (it₁ : IterM (α := α₁) m β₁) (it₂ : IterM (α := α₂) m β₂) :
+    it₁.zip it₂ = Intermediate.zip it₁ none it₂ := rfl
+
+theorem IterM.step_intermediateZip [Monad m] [Iterator α₁ m β₁] [Iterator α₂ m β₂]
+    {it₁ : IterM (α := α₁) m β₁}
+    {memo : Option { out : β₁ //
+        ∃ it : IterM (α := α₁) m β₁, it.IsPlausibleOutput out }}
+    {it₂ : IterM (α := α₂) m β₂} :
+    (Intermediate.zip it₁ memo it₂).step = (do
+      match memo with
+      | none =>
+        match ← it₁.step with
+        | .yield it₁' out hp =>
+          pure <| .skip (Intermediate.zip it₁' (some ⟨out, _, _, hp⟩) it₂)
+            (.yieldLeft rfl hp)
+        | .skip it₁' hp =>
+          pure <| .skip (Intermediate.zip it₁' none it₂)
+            (.skipLeft rfl hp)
+        | .done hp =>
+          pure <| .done (.doneLeft rfl hp)
+      | some out₁ =>
+        match ← it₂.step with
+        | .yield it₂' out₂ hp =>
+          pure <| .yield (Intermediate.zip it₁ none it₂') (out₁, out₂)
+            (.yieldRight rfl hp)
+        | .skip it₂' hp =>
+          pure <| .skip (Intermediate.zip it₁ (some out₁) it₂')
+            (.skipRight rfl hp)
+        | .done hp =>
+          pure <| .done (.doneRight rfl hp)) := by
+  simp only [Intermediate.zip, step, Iterator.step, internalState_toIterM]
+  split
+  · apply bind_congr
+    intro step
+    obtain ⟨step, h⟩ := step
+    cases step <;> rfl
+  · rename_i heq
+    cases heq
+    apply bind_congr
+    intro step
+    obtain ⟨step, h⟩ := step
+    cases step <;> rfl
+
+theorem IterM.step_zip [Monad m] [Iterator α₁ m β₁] [Iterator α₂ m β₂]
+    {it₁ : IterM (α := α₁) m β₁}
+    {it₂ : IterM (α := α₂) m β₂} :
+    (it₁.zip it₂).step = (do
+      match ← it₁.step with
+      | .yield it₁' out hp =>
+        pure <| .skip (Intermediate.zip it₁' (some ⟨out, _, _, hp⟩) it₂)
+          (.yieldLeft rfl hp)
+      | .skip it₁' hp =>
+        pure <| .skip (Intermediate.zip it₁' none it₂)
+          (.skipLeft rfl hp)
+      | .done hp =>
+        pure <| .done (.doneLeft rfl hp)) := by
+  simp [zip_eq_intermediateZip, step_intermediateZip]
+
+end Std.Iterators

src/Std/Data/Iterators/Lemmas/Combinators/Take.lean

@@ -0,0 +1,95 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Std.Data.Iterators.Combinators.Take
+import Std.Data.Iterators.Consumers.Access
+import Std.Data.Iterators.Lemmas.Combinators.Monadic.Take
+import Std.Data.Iterators.Lemmas.Consumers
+
+namespace Std.Iterators
+
+theorem Iter.take_eq_toIter_take_toIterM {α β} [Iterator α Id β] {n : Nat}
+    {it : Iter (α := α) β} :
+    it.take n = (it.toIterM.take n).toIter :=
+  rfl
+
+theorem Iter.step_take {α β} [Iterator α Id β] {n : Nat}
+    {it : Iter (α := α) β} :
+    (it.take n).step = (match n with
+      | 0 => .done (.depleted rfl)
+      | k + 1 =>
+        match it.step with
+        | .yield it' out h => .yield (it'.take k) out (.yield h rfl)
+        | .skip it' h => .skip (it'.take (k + 1)) (.skip h rfl)
+        | .done h => .done (.done h)) := by
+  simp only [Iter.step, Iter.step, Iter.take_eq_toIter_take_toIterM, IterM.step_take, toIterM_toIter]
+  cases n
+  case zero => simp [PlausibleIterStep.done]
+  case succ k =>
+    simp only [Id.run_bind]
+    generalize it.toIterM.step.run = step
+    cases step using PlausibleIterStep.casesOn <;>
+      simp [PlausibleIterStep.yield, PlausibleIterStep.skip, PlausibleIterStep.done]
+
+theorem Iter.atIdxSlow?_take {α β}
+    [Iterator α Id β] [Productive α Id] {k l : Nat}
+    {it : Iter (α := α) β} :
+    (it.take k).atIdxSlow? l = if l < k then it.atIdxSlow? l else none := by
+  fun_induction it.atIdxSlow? l generalizing k
+  case case1 it it' out h h' =>
+    simp only [atIdxSlow?.eq_def (it := it.take k), step_take, h']
+    cases k <;> simp
+  case case2 it it' out h h' l ih =>
+    simp only [Nat.succ_eq_add_one, atIdxSlow?.eq_def (it := it.take k), step_take, h']
+    cases k <;> cases l <;> simp [ih]
+  case case3 l it it' h h' ih =>
+    simp only [atIdxSlow?.eq_def (it := it.take k), step_take, h']
+    cases k <;> cases l <;> simp [ih]
+  case case4 l it h h' =>
+    simp only [atIdxSlow?.eq_def (it := it.take k), atIdxSlow?.eq_def (it := it), step_take, h']
+    cases k <;> cases l <;> simp
+
+@[simp]
+theorem Iter.toList_take_of_finite {α β} [Iterator α Id β] {n : Nat}
+    [Finite α Id] [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
+    {it : Iter (α := α) β} :
+    (it.take n).toList = it.toList.take n := by
+  induction it using Iter.inductSteps generalizing n with | step it ihy ihs =>
+  rw [Iter.toList_eq_match_step, Iter.toList_eq_match_step, Iter.step_take]
+  cases n
+  case zero => simp
+  case succ k =>
+    simp
+    obtain ⟨step, h⟩ := it.step
+    cases step
+    · simp [ihy h]
+    · simp [ihs h]
+    · simp
+
+@[simp]
+theorem Iter.toListRev_take_of_finite {α β} [Iterator α Id β] {n : Nat}
+    [Finite α Id] [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
+    {it : Iter (α := α) β} :
+    (it.take n).toListRev = it.toListRev.drop (it.toList.length - n) := by
+  rw [toListRev_eq, toList_take_of_finite, List.reverse_take, toListRev_eq]
+
+@[simp]
+theorem Iter.toArray_take_of_finite {α β} [Iterator α Id β] {n : Nat}
+    [Finite α Id] [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
+    {it : Iter (α := α) β} :
+    (it.take n).toArray = it.toArray.take n := by
+  rw [← toArray_toList, ← toArray_toList, List.take_toArray, toList_take_of_finite]
+
+@[simp]
+theorem Iter.toList_take_zero {α β} [Iterator α Id β]
+    [Finite (Take α Id β) Id]
+    [IteratorCollect (Take α Id β) Id Id] [LawfulIteratorCollect (Take α Id β) Id Id]
+    {it : Iter (α := α) β} :
+    (it.take 0).toList = [] := by
+  rw [toList_eq_match_step]
+  simp [step_take]
+
+end Std.Iterators

src/Std/Data/Iterators/Lemmas/Combinators/TakeWhile.lean

@@ -0,0 +1,134 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Std.Data.Iterators.Combinators.TakeWhile
+import Std.Data.Iterators.Lemmas.Combinators.Monadic.TakeWhile
+import Std.Data.Iterators.Lemmas.Consumers
+
+namespace Std.Iterators
+
+theorem Iter.takeWhile_eq {α β} [Iterator α Id β] {P}
+    {it : Iter (α := α) β} :
+    it.takeWhile P = (it.toIterM.takeWhile P).toIter :=
+  rfl
+
+theorem Iter.step_takeWhile {α β} [Iterator α Id β] {P}
+    {it : Iter (α := α) β} :
+    (it.takeWhile P).step = (match it.step with
+      | .yield it' out h => match P out with
+        | true => .yield (it'.takeWhile P) out (.yield h True.intro)
+        | false => .done (.rejected h True.intro)
+      | .skip it' h => .skip (it'.takeWhile P) (.skip h)
+      | .done h => .done (.done h)) := by
+  simp [Iter.takeWhile_eq, Iter.step, toIterM_toIter, IterM.step_takeWhile]
+  generalize it.toIterM.step.run = step
+  cases step using PlausibleIterStep.casesOn
+  · simp only [IterM.Step.toPure_yield, PlausibleIterStep.yield, toIter_toIterM, toIterM_toIter]
+    cases P _ <;> rfl
+  · simp
+  · simp
+
+theorem Iter.atIdxSlow?_takeWhile {α β}
+    [Iterator α Id β] [Productive α Id] {l : Nat}
+    {it : Iter (α := α) β} {P} :
+    (it.takeWhile P).atIdxSlow? l = if ∀ k, k ≤ l → (it.atIdxSlow? k).any P then it.atIdxSlow? l else none := by
+  fun_induction it.atIdxSlow? l
+  case case1 it it' out h h' =>
+    simp only [atIdxSlow?.eq_def (it := it.takeWhile P), step_takeWhile, h',
+      PlausibleIterStep.yield, PlausibleIterStep.done, Nat.le_zero_eq, forall_eq]
+    rw [atIdxSlow?, h']
+    simp only [Option.any_some]
+    apply Eq.symm
+    split
+    · cases h' : P out
+      · exfalso; simp_all
+      · simp
+    · cases h' : P out
+      · simp
+      · exfalso; simp_all
+  case case2 it it' out h h' l ih =>
+    simp only [Nat.succ_eq_add_one, atIdxSlow?.eq_def (it := it.takeWhile P), step_takeWhile, h']
+    simp only [atIdxSlow?.eq_def (it := it), h']
+    cases hP : P out
+    · simp
+      intro h
+      specialize h 0 (Nat.zero_le _)
+      simp at h
+      exfalso; simp_all
+    · simp [ih]
+      split
+      · rename_i h
+        rw [if_pos]
+        intro k hk
+        split
+        · exact hP
+        · simp at hk
+          exact h _ hk
+      · rename_i hl
+        rw [if_neg]
+        intro hl'
+        apply hl
+        intro k hk
+        exact hl' (k + 1) (Nat.succ_le_succ hk)
+  case case3 l it it' h h' ih =>
+    simp only [atIdxSlow?.eq_def (it := it.takeWhile P), step_takeWhile, h', ih]
+    simp only [atIdxSlow?.eq_def (it := it), h']
+  case case4 l it h h' =>
+    simp only [atIdxSlow?.eq_def (it := it), atIdxSlow?.eq_def (it := it.takeWhile P), h',
+      step_takeWhile]
+    split <;> rfl
+
+private theorem List.getElem?_takeWhile {l : List α} {P : α → Bool} {k} :
+    (l.takeWhile P)[k]? = if ∀ k' : Nat, k' ≤ k → l[k']?.any P then l[k]? else none := by
+  induction l generalizing k
+  · simp
+  · rename_i x xs ih
+    rw [List.takeWhile_cons]
+    split
+    · cases k
+      · simp [*]
+      · simp [ih]
+        split
+        · rw [if_pos]
+          intro k' hk'
+          cases k'
+          · simp [*]
+          · simp_all
+        · rename_i hP
+          rw [if_neg]
+          intro hP'
+          apply hP
+          intro k' hk'
+          specialize hP' (k' + 1) (by omega)
+          simp_all
+    · simp
+      intro h
+      specialize h 0
+      simp_all
+
+@[simp]
+theorem Iter.toList_takeWhile_of_finite {α β} [Iterator α Id β] {P}
+    [Finite α Id] [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
+    {it : Iter (α := α) β} :
+    (it.takeWhile P).toList = it.toList.takeWhile P := by
+  ext
+  simp only [getElem?_toList_eq_atIdxSlow?, atIdxSlow?_takeWhile, List.getElem?_takeWhile]
+
+@[simp]
+theorem Iter.toListRev_takeWhile_of_finite {α β} [Iterator α Id β] {P}
+    [Finite α Id] [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
+    {it : Iter (α := α) β} :
+    (it.takeWhile P).toListRev = (it.toList.takeWhile P).reverse := by
+  rw [toListRev_eq, toList_takeWhile_of_finite]
+
+@[simp]
+theorem Iter.toArray_takeWhile_of_finite {α β} [Iterator α Id β] {P}
+    [Finite α Id] [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
+    {it : Iter (α := α) β} :
+    (it.takeWhile P).toArray = it.toArray.takeWhile P := by
+  rw [← toArray_toList, ← toArray_toList, List.takeWhile_toArray, toList_takeWhile_of_finite]
+
+end Std.Iterators

src/Std/Data/Iterators/Lemmas/Combinators/Zip.lean

@@ -0,0 +1,398 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Std.Data.Iterators.Combinators.Take
+import Std.Data.Iterators.Combinators.Zip
+import Std.Data.Iterators.Consumers.Access
+import Std.Data.Iterators.Lemmas.Combinators.Monadic.Zip
+import Std.Data.Iterators.Lemmas.Combinators.Take
+import Std.Data.Iterators.Lemmas.Consumers
+
+namespace Std.Iterators
+
+variable {α₁ α₂ β₁ β₂ : Type w} {m : Type w → Type w'}
+
+/--
+Constructs intermediate states of an iterator created with the combinator `Iter.zip`.
+When `left.zip right` has already obtained a value from `left` but not yet from right,
+it remembers `left`'s value in a field of its internal state. This intermediate state
+cannot be created directly with `Iter.zip`.
+
+`Intermediate.zip` is meant to be used only for verification purposes.
+-/
+noncomputable def Iter.Intermediate.zip [Iterator α₁ Id β₁]
+    (it₁ : Iter (α := α₁) β₁)
+    (memo : (Option { out : β₁ //
+        ∃ it : Iter (α := α₁) β₁, it.toIterM.IsPlausibleOutput out }))
+    (it₂ : Iter (α := α₂) β₂) :
+    Iter (α := Zip α₁ Id α₂ β₂) (β₁ × β₂) :=
+  (IterM.Intermediate.zip
+    it₁.toIterM
+    ((fun x => ⟨x.1, x.2.choose.toIterM, x.2.choose_spec⟩) <$> memo)
+    it₂.toIterM).toIter
+
+def Iter.Intermediate.zip_inj [Iterator α₁ Id β₁] :
+    ∀ {it₁ it₁' : Iter (α := α₁) β₁} {memo memo'} {it₂ it₂' : Iter (α := α₂) β₂},
+      zip it₁ memo it₂ = zip it₁' memo' it₂' ↔ it₁ = it₁' ∧ memo = memo' ∧ it₂ = it₂' := by
+  intro it₁ it₁' memo memo' it₂ it₂'
+  apply Iff.intro
+  · intro h
+    cases it₁; cases it₁'; cases it₂; cases it₂'
+    obtain _ | ⟨⟨_⟩⟩ := memo <;> obtain _ | ⟨⟨_⟩⟩ := memo' <;>
+      simp_all [toIterM, IterM.toIter, zip, IterM.Intermediate.zip, Option.map_eq_map]
+  · rintro ⟨rfl, rfl, rfl⟩
+    rfl
+
+def Iter.Intermediate.zip_surj [Iterator α₁ Id β₁] :
+    ∀ it : Iter (α := Zip α₁ Id α₂ β₂) (β₁ × β₂), ∃ it₁ memo it₂, it = Intermediate.zip it₁ memo it₂ := by
+  refine fun it => ⟨it.internalState.left.toIter,
+      (fun x => ⟨x.1, x.2.choose.toIter, x.2.choose_spec⟩) <$> it.internalState.memoizedLeft,
+      it.internalState.right.toIter, ?_⟩
+  simp only [zip, toIterM_toIter, Option.map_eq_map, Option.map_map]
+  change it = (IterM.Intermediate.zip _ (Option.map id it.internalState.memoizedLeft) it.internalState.right).toIter
+  simp only [Option.map_id_fun, id_eq]
+  rfl
+
+theorem Iter.zip_eq_intermediateZip [Iterator α₁ Id β₁]
+    [Iterator α₂ Id β₂]
+    (it₁ : Iter (α := α₁) β₁) (it₂ : Iter (α := α₂) β₂) :
+    it₁.zip it₂ = Intermediate.zip it₁ none it₂ := by
+  rfl
+
+theorem Iter.step_intermediateZip
+    [Iterator α₁ Id β₁] [Iterator α₂ Id β₂]
+    {it₁ : Iter (α := α₁) β₁}
+    {memo : Option { out : β₁ //
+        ∃ it : Iter (α := α₁) β₁, it.toIterM.IsPlausibleOutput out }}
+    {it₂ : Iter (α := α₂) β₂} :
+    (Intermediate.zip it₁ memo it₂).step = (
+      match memo with
+      | none =>
+        match it₁.step with
+        | .yield it₁' out hp =>
+          .skip (Intermediate.zip it₁' (some ⟨out, _, _, hp⟩) it₂)
+            (.yieldLeft rfl hp)
+        | .skip it₁' hp =>
+          .skip (Intermediate.zip it₁' none it₂)
+            (.skipLeft rfl hp)
+        | .done hp =>
+          .done (.doneLeft rfl hp)
+      | some out₁ =>
+        match it₂.step with
+        | .yield it₂' out₂ hp =>
+          .yield (Intermediate.zip it₁ none it₂') (out₁, out₂)
+            (.yieldRight (it := Intermediate.zip it₁ (some out₁) it₂ |>.toIterM) rfl hp)
+        | .skip it₂' hp =>
+          .skip (Intermediate.zip it₁ (some out₁) it₂')
+            (.skipRight rfl hp)
+        | .done hp =>
+          .done (.doneRight rfl hp)) := by
+  simp only [Intermediate.zip, IterM.step_intermediateZip, Iter.step, toIterM_toIter]
+  cases memo
+  case none =>
+    simp only [Option.map_eq_map, Option.map_none, PlausibleIterStep.skip, PlausibleIterStep.done,
+      Id.run_bind, Option.map_some]
+    obtain ⟨step, h⟩ := it₁.toIterM.step.run
+    cases step <;> simp
+  case some out₁ =>
+    simp only [Option.map_eq_map, Option.map_some, PlausibleIterStep.yield, PlausibleIterStep.skip,
+      PlausibleIterStep.done, Id.run_bind, Option.map_none]
+    obtain ⟨step, h⟩ := it₂.toIterM.step.run
+    cases step <;> simp
+
+theorem Iter.toList_intermediateZip_of_finite [Iterator α₁ Id β₁] [Iterator α₂ Id β₂]
+    {it₁ : Iter (α := α₁) β₁} {memo} {it₂ : Iter (α := α₂) β₂}
+    [Finite α₁ Id] [Finite α₂ Id]
+    [IteratorCollect α₁ Id Id] [LawfulIteratorCollect α₁ Id Id]
+    [IteratorCollect α₂ Id Id] [LawfulIteratorCollect α₂ Id Id]
+    [IteratorCollect (Zip α₁ Id α₂ β₂) Id Id]
+    [LawfulIteratorCollect (Zip α₁ Id α₂ β₂) Id Id] :
+    (Intermediate.zip it₁ memo it₂).toList = ((memo.map Subtype.val).toList ++ it₁.toList).zip it₂.toList := by
+  generalize h : Intermediate.zip it₁ memo it₂ = it
+  revert h it₁ memo it₂
+  induction it using Iter.inductSteps with | step _ ihy ihs
+  rintro it₁ memo it₂ rfl
+  rw [Iter.toList_eq_match_step]
+  match hs : (Intermediate.zip it₁ memo it₂).step with
+  | .yield it' out hp =>
+    rw [step_intermediateZip] at hs
+    cases memo
+    case none =>
+      generalize it₁.step = step₁ at *
+      obtain ⟨step₁, h₁⟩ := step₁
+      cases step₁ <;> cases hs
+    case some =>
+      rw [Iter.toList_eq_match_step (it := it₂)]
+      generalize it₂.step = step₂ at *
+      obtain ⟨step₂, h₂⟩ := step₂
+      cases step₂
+      · cases hs
+        simp [ihy hp rfl]
+      · cases hs
+      · cases hs
+  | .skip it' hp =>
+    rw [step_intermediateZip] at hs
+    cases memo
+    case none =>
+      rw [Iter.toList_eq_match_step (it := it₁)]
+      generalize it₁.step = step₁ at *
+      obtain ⟨step₁, h₁⟩ := step₁
+      cases step₁
+      · cases hs
+        simp [ihs hp rfl]
+      · cases hs
+        simp [ihs hp rfl]
+      · cases hs
+    case some =>
+      rw [Iter.toList_eq_match_step (it := it₂)]
+      generalize it₂.step = step₂ at *
+      obtain ⟨step₂, h₂⟩ := step₂
+      cases step₂
+      · cases hs
+      · cases hs
+        simp [ihs hp rfl]
+      · cases hs
+  | .done hp =>
+    rw [step_intermediateZip] at hs
+    cases memo
+    case none =>
+      rw [Iter.toList_eq_match_step (it := it₁)]
+      generalize it₁.step = step₁ at *
+      obtain ⟨step₁, h₁⟩ := step₁
+      cases step₁
+      · cases hs
+      · cases hs
+      · cases hs
+        simp
+    case some =>
+      rw [Iter.toList_eq_match_step (it := it₂)]
+      generalize it₂.step = step₂ at *
+      obtain ⟨step₂, h₁⟩ := step₂
+      cases step₂
+      · cases hs
+      · cases hs
+      · cases hs
+        simp
+
+theorem Iter.atIdxSlow?_intermediateZip [Iterator α₁ Id β₁] [Iterator α₂ Id β₂]
+    [Productive α₁ Id] [Productive α₂ Id]
+    {it₁ : Iter (α := α₁) β₁} {memo} {it₂ : Iter (α := α₂) β₂} {n : Nat} :
+    (Intermediate.zip it₁ memo it₂).atIdxSlow? n =
+      (match memo with
+      | none => do return (← it₁.atIdxSlow? n, ← it₂.atIdxSlow? n)
+      | some memo => match n with
+        | 0 => do return (memo.val, ← it₂.atIdxSlow? n)
+        | n' + 1 => do return (← it₁.atIdxSlow? n', ← it₂.atIdxSlow? (n' + 1))) := by
+  generalize h : Intermediate.zip it₁ memo it₂ = it
+  revert h it₁ memo it₂
+  fun_induction it.atIdxSlow? n
+  rintro it₁ memo it₂ rfl
+  case case1 it it' out h h' =>
+    rw [atIdxSlow?]
+    simp only [Option.pure_def, Option.bind_eq_bind]
+    simp only [step_intermediateZip, PlausibleIterStep.skip, PlausibleIterStep.done,
+      PlausibleIterStep.yield] at h'
+    split at h'
+    · split at h' <;> cases h'
+    · split at h' <;> cases h'
+      rename_i hs₂
+      rw [atIdxSlow?, hs₂]
+      simp
+  case case2 it it' out h  h' n ih =>
+    rintro it₁ memo it₂ rfl
+    simp only [Nat.succ_eq_add_one, Option.pure_def, Option.bind_eq_bind]
+    cases memo
+    case none =>
+      rw [step_intermediateZip] at h'
+      simp only at h'
+      split at h' <;> cases h'
+    case some =>
+      rw [step_intermediateZip] at h'
+      simp only at h'
+      split at h' <;> cases h'
+      rename_i hs₂
+      simp only [ih rfl, Option.pure_def, Option.bind_eq_bind]
+      rw [atIdxSlow?.eq_def (it := it₂), hs₂]
+  case case3 it it' h h' ih =>
+    rintro it₁ memo it₂ rfl
+    obtain ⟨it₁', memo', it₂', rfl⟩ := Intermediate.zip_surj it'
+    specialize ih rfl
+    rw [step_intermediateZip] at h'
+    simp only [PlausibleIterStep.skip, PlausibleIterStep.done, PlausibleIterStep.yield] at h'
+    rw [Subtype.ext_iff] at h'
+    split at h'
+    · split at h' <;> rename_i hs₁
+      · simp only [IterStep.skip.injEq, Intermediate.zip_inj] at h'
+        obtain ⟨rfl, rfl, rfl⟩ := h'
+        simp only [ih, Option.pure_def, Option.bind_eq_bind, atIdxSlow?.eq_def (it := it₁), hs₁]
+        split <;> rfl
+      · simp only [IterStep.skip.injEq, Intermediate.zip_inj] at h'
+        obtain ⟨rfl, rfl, rfl⟩ := h'
+        simp [ih, atIdxSlow?.eq_def (it := it₁), hs₁]
+      · cases h'
+    · split at h' <;> rename_i hs₂ <;> (try cases h')
+      simp only [IterStep.skip.injEq, Intermediate.zip_inj] at h'
+      obtain ⟨rfl, rfl, rfl⟩ := h'
+      simp [ih, atIdxSlow?.eq_def (it := it₂), hs₂]
+  case case4 it _ h =>
+    rintro it₁ memo it₂ rfl
+    rw [atIdxSlow?]
+    simp only [step_intermediateZip] at h
+    cases memo
+    case none =>
+      simp only at h
+      split at h <;> cases h
+      rename_i hs₁
+      simp [atIdxSlow?.eq_def (it := it₁), hs₁]
+    case some =>
+      simp only at h
+      split at h <;> cases h
+      rename_i hs₂
+      simp only [atIdxSlow?.eq_def (it := it₂), hs₂, Option.pure_def, Option.bind_eq_bind,
+        Option.bind_none, Option.bind_fun_none]
+      split <;> rfl
+
+theorem Iter.atIdxSlow?_zip {α₁ α₂ β₁ β₂} [Iterator α₁ Id β₁] [Iterator α₂ Id β₂]
+    [Productive α₁ Id] [Productive α₂ Id]
+    {it₁ : Iter (α := α₁) β₁} {it₂ : Iter (α := α₂) β₂} {n : Nat} :
+    (it₁.zip it₂).atIdxSlow? n = do return (← it₁.atIdxSlow? n, ← it₂.atIdxSlow? n) := by
+  rw [zip_eq_intermediateZip, atIdxSlow?_intermediateZip]
+
+@[simp]
+theorem Iter.toList_zip_of_finite {α₁ α₂ β₁ β₂} [Iterator α₁ Id β₁] [Iterator α₂ Id β₂]
+    {it₁ : Iter (α := α₁) β₁} {it₂ : Iter (α := α₂) β₂}
+    [Finite α₁ Id] [Finite α₂ Id]
+    [IteratorCollect α₁ Id Id] [LawfulIteratorCollect α₁ Id Id]
+    [IteratorCollect α₂ Id Id] [LawfulIteratorCollect α₂ Id Id]
+    [IteratorCollect (Zip α₁ Id α₂ β₂) Id Id]
+    [LawfulIteratorCollect (Zip α₁ Id α₂ β₂) Id Id] :
+    (it₁.zip it₂).toList = it₁.toList.zip it₂.toList := by
+  simp [zip_eq_intermediateZip, Iter.toList_intermediateZip_of_finite]
+
+theorem Iter.toList_zip_of_finite_left {α₁ α₂ β₁ β₂} [Iterator α₁ Id β₁] [Iterator α₂ Id β₂]
+    {it₁ : Iter (α := α₁) β₁} {it₂ : Iter (α := α₂) β₂}
+    [Finite α₁ Id] [Productive α₂ Id] [IteratorCollect α₁ Id Id] [LawfulIteratorCollect α₁ Id Id]
+    [IteratorCollect (Zip α₁ Id α₂ β₂) Id Id]
+    [LawfulIteratorCollect (Zip α₁ Id α₂ β₂) Id Id] :
+    (it₁.zip it₂).toList = it₁.toList.zip (it₂.take it₁.toList.length).toList := by
+  ext
+  simp only [List.getElem?_zip_eq_some, getElem?_toList_eq_atIdxSlow?, atIdxSlow?_zip, Option.pure_def, Option.bind_eq_bind,
+    atIdxSlow?_take, Option.ite_none_right_eq_some]
+  constructor
+  · intro h
+    simp only [Option.bind_eq_some_iff, Option.some.injEq] at h
+    obtain ⟨b₁, hb₁, b₂, hb₂, rfl⟩ := h
+    refine ⟨hb₁, ?_, hb₂⟩
+    false_or_by_contra
+    rw [← getElem?_toList_eq_atIdxSlow?] at hb₁
+    rename_i h
+    simp only [Nat.not_lt, ← List.getElem?_eq_none_iff, hb₁] at h
+    cases h
+  · rintro ⟨h₁, h₂, h₃⟩
+    simp [h₁, h₃]
+
+theorem Iter.toList_zip_of_finite_right {α₁ α₂ β₁ β₂} [Iterator α₁ Id β₁] [Iterator α₂ Id β₂]
+    {it₁ : Iter (α := α₁) β₁} {it₂ : Iter (α := α₂) β₂}
+    [Productive α₁ Id] [Finite α₂ Id] [IteratorCollect α₂ Id Id] [LawfulIteratorCollect α₂ Id Id]
+    [IteratorCollect (Zip α₁ Id α₂ β₂) Id Id]
+    [LawfulIteratorCollect (Zip α₁ Id α₂ β₂) Id Id] :
+    (it₁.zip it₂).toList = (it₁.take it₂.toList.length).toList.zip it₂.toList := by
+  ext
+  simp only [List.getElem?_zip_eq_some, getElem?_toList_eq_atIdxSlow?, atIdxSlow?_zip, Option.pure_def, Option.bind_eq_bind,
+    atIdxSlow?_take, Option.ite_none_right_eq_some]
+  constructor
+  · intro h
+    simp only [Option.bind_eq_some_iff, Option.some.injEq] at h
+    obtain ⟨b₁, hb₁, b₂, hb₂, rfl⟩ := h
+    refine ⟨⟨?_, hb₁⟩, hb₂⟩
+    false_or_by_contra
+    rw [← getElem?_toList_eq_atIdxSlow?] at hb₂
+    rename_i h
+    simp only [Nat.not_lt, ← List.getElem?_eq_none_iff, hb₂] at h
+    cases h
+  · rintro ⟨⟨h₁, h₂⟩, h₃⟩
+    simp [h₂, h₃]
+
+@[simp]
+theorem Iter.toListRev_zip_of_finite {α₁ α₂ β₁ β₂} [Iterator α₁ Id β₁] [Iterator α₂ Id β₂]
+    {it₁ : Iter (α := α₁) β₁} {it₂ : Iter (α := α₂) β₂}
+    [Finite α₁ Id] [Finite α₂ Id]
+    [IteratorCollect α₁ Id Id] [LawfulIteratorCollect α₁ Id Id]
+    [IteratorCollect α₂ Id Id] [LawfulIteratorCollect α₂ Id Id]
+    [IteratorCollect (Zip α₁ Id α₂ β₂) Id Id]
+    [LawfulIteratorCollect (Zip α₁ Id α₂ β₂) Id Id] :
+    (it₁.zip it₂).toListRev = (it₁.toList.zip it₂.toList).reverse := by
+  simp [toListRev_eq]
+
+theorem Iter.toListRev_zip_of_finite_left {α₁ α₂ β₁ β₂} [Iterator α₁ Id β₁] [Iterator α₂ Id β₂]
+    {it₁ : Iter (α := α₁) β₁} {it₂ : Iter (α := α₂) β₂}
+    [Finite α₁ Id] [Productive α₂ Id] [IteratorCollect α₁ Id Id] [LawfulIteratorCollect α₁ Id Id]
+    [IteratorCollect (Zip α₁ Id α₂ β₂) Id Id]
+    [LawfulIteratorCollect (Zip α₁ Id α₂ β₂) Id Id] :
+    (it₁.zip it₂).toListRev = (it₁.toList.zip (it₂.take it₁.toList.length).toList).reverse := by
+  simp [toListRev_eq, toList_zip_of_finite_left]
+
+theorem Iter.toListRev_zip_of_finite_right {α₁ α₂ β₁ β₂} [Iterator α₁ Id β₁] [Iterator α₂ Id β₂]
+    {it₁ : Iter (α := α₁) β₁} {it₂ : Iter (α := α₂) β₂}
+    [Productive α₁ Id] [Finite α₂ Id] [IteratorCollect α₂ Id Id] [LawfulIteratorCollect α₂ Id Id]
+    [IteratorCollect (Zip α₁ Id α₂ β₂) Id Id]
+    [LawfulIteratorCollect (Zip α₁ Id α₂ β₂) Id Id] :
+    (it₁.zip it₂).toListRev = ((it₁.take it₂.toList.length).toList.zip it₂.toList).reverse := by
+  simp [toListRev_eq, toList_zip_of_finite_right]
+
+@[simp]
+theorem Iter.toArray_zip_of_finite {α₁ α₂ β₁ β₂} [Iterator α₁ Id β₁] [Iterator α₂ Id β₂]
+    {it₁ : Iter (α := α₁) β₁} {it₂ : Iter (α := α₂) β₂}
+    [Finite α₁ Id] [Finite α₂ Id]
+    [IteratorCollect α₁ Id Id] [LawfulIteratorCollect α₁ Id Id]
+    [IteratorCollect α₂ Id Id] [LawfulIteratorCollect α₂ Id Id]
+    [IteratorCollect (Zip α₁ Id α₂ β₂) Id Id]
+    [LawfulIteratorCollect (Zip α₁ Id α₂ β₂) Id Id] :
+    (it₁.zip it₂).toArray = it₁.toArray.zip it₂.toArray := by
+  simp [← toArray_toList]
+
+theorem Iter.toArray_zip_of_finite_left {α₁ α₂ β₁ β₂} [Iterator α₁ Id β₁] [Iterator α₂ Id β₂]
+    {it₁ : Iter (α := α₁) β₁} {it₂ : Iter (α := α₂) β₂}
+    [Finite α₁ Id] [Productive α₂ Id] [IteratorCollect α₁ Id Id] [LawfulIteratorCollect α₁ Id Id]
+    [IteratorCollect (Zip α₁ Id α₂ β₂) Id Id]
+    [LawfulIteratorCollect (Zip α₁ Id α₂ β₂) Id Id] :
+    (it₁.zip it₂).toArray = it₁.toArray.zip (it₂.take it₁.toArray.size).toArray := by
+  simp [← toArray_toList, toList_zip_of_finite_left]
+
+theorem Iter.toArray_zip_of_finite_right {α₁ α₂ β₁ β₂} [Iterator α₁ Id β₁] [Iterator α₂ Id β₂]
+    {it₁ : Iter (α := α₁) β₁} {it₂ : Iter (α := α₂) β₂}
+    [Productive α₁ Id] [Finite α₂ Id] [IteratorCollect α₂ Id Id] [LawfulIteratorCollect α₂ Id Id]
+    [IteratorCollect (Zip α₁ Id α₂ β₂) Id Id]
+    [LawfulIteratorCollect (Zip α₁ Id α₂ β₂) Id Id] :
+    (it₁.zip it₂).toArray = (it₁.take it₂.toArray.size).toArray.zip it₂.toArray := by
+  simp [← toArray_toList, toList_zip_of_finite_right]
+
+@[simp]
+theorem Iter.toList_take_zip {α₁ α₂ β₁ β₂} [Iterator α₁ Id β₁] [Iterator α₂ Id β₂]
+    [Productive α₁ Id] [Productive α₂ Id]
+    {it₁ : Iter (α := α₁) β₁} {it₂ : Iter (α := α₂) β₂} {n : Nat} :
+    ((it₁.zip it₂).take n).toList = (it₁.take n).toList.zip (it₂.take n).toList := by
+  rw [← toList_zip_of_finite]
+  apply toList_eq_of_atIdxSlow?_eq
+  intro k
+  simp only [atIdxSlow?_take, atIdxSlow?_zip, Option.pure_def, Option.bind_eq_bind]
+  split <;> rfl
+
+@[simp]
+theorem Iter.toListRev_take_zip {α₁ α₂ β₁ β₂} [Iterator α₁ Id β₁] [Iterator α₂ Id β₂]
+    [Productive α₁ Id] [Productive α₂ Id]
+    {it₁ : Iter (α := α₁) β₁} {it₂ : Iter (α := α₂) β₂} {n : Nat} :
+    ((it₁.zip it₂).take n).toListRev = ((it₁.take n).toList.zip (it₂.take n).toList).reverse := by
+  simp [toListRev_eq]
+
+@[simp]
+theorem Iter.toArray_take_zip {α₁ α₂ β₁ β₂} [Iterator α₁ Id β₁] [Iterator α₂ Id β₂]
+    [Productive α₁ Id] [Productive α₂ Id]
+    {it₁ : Iter (α := α₁) β₁} {it₂ : Iter (α := α₂) β₂} {n : Nat} :
+    ((it₁.zip it₂).take n).toArray = ((it₁.take n).toList.zip (it₂.take n).toList).toArray := by
+  simp [← toArray_toList]
+
+end Iterators

src/Std/Data/Iterators/Lemmas/Consumers.lean

@@ -6,3 +6,4 @@ Authors: Paul Reichert
 prelude
 import Std.Data.Iterators.Lemmas.Consumers.Monadic
 import Std.Data.Iterators.Lemmas.Consumers.Collect
+import Std.Data.Iterators.Lemmas.Consumers.Loop

src/Std/Data/Iterators/Lemmas/Consumers/Collect.lean

@@ -11,13 +11,13 @@ import Std.Data.Iterators.Lemmas.Consumers.Monadic.Collect
 
 namespace Std.Iterators
 
-theorem Iter.toArray_eq_toArray_toIterM {α β} [Iterator α Id β] [Finite α Id] [IteratorCollect α Id]
-    [LawfulIteratorCollect α Id] {it : Iter (α := α) β} :
+theorem Iter.toArray_eq_toArray_toIterM {α β} [Iterator α Id β] [Finite α Id] [IteratorCollect α Id Id]
+    [LawfulIteratorCollect α Id Id] {it : Iter (α := α) β} :
     it.toArray = it.toIterM.toArray.run :=
   rfl
 
-theorem Iter.toList_eq_toList_toIterM {α β} [Iterator α Id β] [Finite α Id] [IteratorCollect α Id]
-    [LawfulIteratorCollect α Id] {it : Iter (α := α) β} :
+theorem Iter.toList_eq_toList_toIterM {α β} [Iterator α Id β] [Finite α Id] [IteratorCollect α Id Id]
+    [LawfulIteratorCollect α Id Id] {it : Iter (α := α) β} :
     it.toList = it.toIterM.toList.run :=
   rfl
 
@@ -27,7 +27,7 @@ theorem Iter.toListRev_eq_toListRev_toIterM {α β} [Iterator α Id β] [Finite
   rfl
 
 @[simp]
-theorem IterM.toList_toIter {α β} [Iterator α Id β] [Finite α Id] [IteratorCollect α Id]
+theorem IterM.toList_toIter {α β} [Iterator α Id β] [Finite α Id] [IteratorCollect α Id Id]
     {it : IterM (α := α) Id β} :
     it.toIter.toList = it.toList.run :=
   rfl
@@ -38,23 +38,23 @@ theorem IterM.toListRev_toIter {α β} [Iterator α Id β] [Finite α Id]
     it.toIter.toListRev = it.toListRev.run :=
   rfl
 
-theorem Iter.toList_toArray {α β} [Iterator α Id β] [Finite α Id] [IteratorCollect α Id]
-    [LawfulIteratorCollect α Id] {it : Iter (α := α) β} :
+theorem Iter.toList_toArray {α β} [Iterator α Id β] [Finite α Id] [IteratorCollect α Id Id]
+    [LawfulIteratorCollect α Id Id] {it : Iter (α := α) β} :
     it.toArray.toList = it.toList := by
   simp [toArray_eq_toArray_toIterM, toList_eq_toList_toIterM, ← IterM.toList_toArray]
 
-theorem Iter.toArray_toList {α β} [Iterator α Id β] [Finite α Id] [IteratorCollect α Id]
-    [LawfulIteratorCollect α Id] {it : Iter (α := α) β} :
+theorem Iter.toArray_toList {α β} [Iterator α Id β] [Finite α Id] [IteratorCollect α Id Id]
+    [LawfulIteratorCollect α Id Id] {it : Iter (α := α) β} :
     it.toList.toArray = it.toArray := by
   simp [toArray_eq_toArray_toIterM, toList_eq_toList_toIterM, ← IterM.toArray_toList]
 
-theorem Iter.toListRev_eq {α β} [Iterator α Id β] [Finite α Id] [IteratorCollect α Id]
-    [LawfulIteratorCollect α Id] {it : Iter (α := α) β} :
+theorem Iter.toListRev_eq {α β} [Iterator α Id β] [Finite α Id] [IteratorCollect α Id Id]
+    [LawfulIteratorCollect α Id Id] {it : Iter (α := α) β} :
     it.toListRev = it.toList.reverse := by
   simp [Iter.toListRev_eq_toListRev_toIterM, Iter.toList_eq_toList_toIterM, IterM.toListRev_eq]
 
-theorem Iter.toArray_eq_match_step {α β} [Iterator α Id β] [Finite α Id] [IteratorCollect α Id]
-    [LawfulIteratorCollect α Id] {it : Iter (α := α) β} :
+theorem Iter.toArray_eq_match_step {α β} [Iterator α Id β] [Finite α Id] [IteratorCollect α Id Id]
+    [LawfulIteratorCollect α Id Id] {it : Iter (α := α) β} :
     it.toArray = match it.step with
       | .yield it' out _ => #[out] ++ it'.toArray
       | .skip it' _ => it'.toArray
@@ -64,8 +64,8 @@ theorem Iter.toArray_eq_match_step {α β} [Iterator α Id β] [Finite α Id] [I
   generalize it.toIterM.step.run = step
   cases step using PlausibleIterStep.casesOn <;> simp
 
-theorem Iter.toList_eq_match_step {α β} [Iterator α Id β] [Finite α Id] [IteratorCollect α Id]
-    [LawfulIteratorCollect α Id] {it : Iter (α := α) β} :
+theorem Iter.toList_eq_match_step {α β} [Iterator α Id β] [Finite α Id] [IteratorCollect α Id Id]
+    [LawfulIteratorCollect α Id Id] {it : Iter (α := α) β} :
     it.toList = match it.step with
       | .yield it' out _ => out :: it'.toList
       | .skip it' _ => it'.toList
@@ -83,7 +83,7 @@ theorem Iter.toListRev_eq_match_step {α β} [Iterator α Id β] [Finite α Id]
   cases step using PlausibleIterStep.casesOn <;> simp
 
 theorem Iter.getElem?_toList_eq_atIdxSlow? {α β}
-    [Iterator α Id β] [Finite α Id] [IteratorCollect α Id] [LawfulIteratorCollect α Id]
+    [Iterator α Id β] [Finite α Id] [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
     {it : Iter (α := α) β} {k : Nat} :
     it.toList[k]? = it.atIdxSlow? k := by
   induction it using Iter.inductSteps generalizing k with | step it ihy ihs =>
@@ -95,8 +95,8 @@ theorem Iter.getElem?_toList_eq_atIdxSlow? {α β}
   · simp
 
 theorem Iter.toList_eq_of_atIdxSlow?_eq {α₁ α₂ β}
-    [Iterator α₁ Id β] [Finite α₁ Id] [IteratorCollect α₁ Id] [LawfulIteratorCollect α₁ Id]
-    [Iterator α₂ Id β] [Finite α₂ Id] [IteratorCollect α₂ Id] [LawfulIteratorCollect α₂ Id]
+    [Iterator α₁ Id β] [Finite α₁ Id] [IteratorCollect α₁ Id Id] [LawfulIteratorCollect α₁ Id Id]
+    [Iterator α₂ Id β] [Finite α₂ Id] [IteratorCollect α₂ Id Id] [LawfulIteratorCollect α₂ Id Id]
     {it₁ : Iter (α := α₁) β} {it₂ : Iter (α := α₂) β}
     (h : ∀ k, it₁.atIdxSlow? k = it₂.atIdxSlow? k) :
     it₁.toList = it₂.toList := by

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

@@ -0,0 +1,170 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Init.Data.List.Control
+import Std.Data.Iterators.Lemmas.Basic
+import Std.Data.Iterators.Lemmas.Consumers.Collect
+import Std.Data.Iterators.Lemmas.Consumers.Monadic.Loop
+import Std.Data.Iterators.Consumers.Collect
+import Std.Data.Iterators.Consumers.Loop
+
+namespace Std.Iterators
+
+theorem Iter.forIn_eq {α β : Type w} [Iterator α Id β] [Finite α Id]
+    {m : Type w → Type w''} [Monad m] [IteratorLoop α Id m] [hl : LawfulIteratorLoop α Id m]
+    {γ : Type w} {it : Iter (α := α) β} {init : γ}
+    {f : β → γ → m (ForInStep γ)} :
+    ForIn.forIn it init f =
+      IterM.DefaultConsumers.forIn (fun _ c => pure c.run) γ (fun _ _ _ => True)
+        IteratorLoop.wellFounded_of_finite it.toIterM init ((⟨·, .intro⟩) <$> f · ·) := by
+  cases hl.lawful; rfl
+
+theorem Iter.forIn_eq_forIn_toIterM {α β : Type w} [Iterator α Id β]
+    [Finite α Id] {m : Type w → Type w''} [Monad m] [LawfulMonad m]
+    [IteratorLoop α Id m] [LawfulIteratorLoop α Id m]
+    {γ : Type w} {it : Iter (α := α) β} {init : γ}
+    {f : β → γ → m (ForInStep γ)} :
+    ForIn.forIn it init f = letI : MonadLift Id m := ⟨pure⟩; ForIn.forIn it.toIterM init f := by
+  rfl
+
+theorem Iter.forIn_eq_match_step {α β : Type w} [Iterator α Id β]
+    [Finite α Id] {m : Type w → Type w''} [Monad m] [LawfulMonad m]
+    [IteratorLoop α Id m] [LawfulIteratorLoop α Id m]
+    {γ : Type w} {it : Iter (α := α) β} {init : γ}
+    {f : β → γ → m (ForInStep γ)} :
+    ForIn.forIn it init f = (do
+      match it.step with
+      | .yield it' out _ =>
+        match ← f out init with
+        | .yield c => ForIn.forIn it' c f
+        | .done c => return c
+      | .skip it' _ => ForIn.forIn it' init f
+      | .done _ => return init) := by
+  rw [Iter.forIn_eq_forIn_toIterM, @IterM.forIn_eq_match_step, Iter.step]
+  simp only [liftM, monadLift, pure_bind]
+  generalize it.toIterM.step = step
+  cases step using PlausibleIterStep.casesOn
+  · apply bind_congr
+    intro forInStep
+    rfl
+  · rfl
+  · rfl
+
+theorem Iter.forIn_toList {α β : Type w} [Iterator α Id β]
+    [Finite α Id] {m : Type w → Type w''} [Monad m] [LawfulMonad m]
+    [IteratorLoop α Id m] [LawfulIteratorLoop α Id m]
+    [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
+    {γ : Type w} {it : Iter (α := α) β} {init : γ}
+    {f : β → γ → m (ForInStep γ)} :
+    ForIn.forIn it.toList init f = ForIn.forIn it init f := by
+  rw [List.forIn_eq_foldlM]
+  induction it using Iter.inductSteps generalizing init with case step it ihy ihs =>
+  rw [forIn_eq_match_step, Iter.toList_eq_match_step]
+  simp only [map_eq_pure_bind]
+  generalize it.step = step
+  cases step using PlausibleIterStep.casesOn
+  · rename_i it' out h
+    simp only [List.foldlM_cons, bind_pure_comp, map_bind]
+    apply bind_congr
+    intro forInStep
+    cases forInStep
+    · induction it'.toList <;> simp [*]
+    · 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]
+    rw [ihs h]
+  · simp
+
+theorem Iter.foldM_eq_forIn {α β γ : Type w} [Iterator α Id β] [Finite α Id] {m : Type w → Type w'}
+    [Monad m] [IteratorLoop α Id m] {f : γ → β → m γ}
+    {init : γ} {it : Iter (α := α) β} :
+    it.foldM (init := init) f = ForIn.forIn it init (fun x acc => ForInStep.yield <$> f acc x) :=
+  rfl
+
+theorem Iter.forIn_yield_eq_foldM {α β γ δ : Type w} [Iterator α Id β]
+    [Finite α Id] {m : Type w → Type w''} [Monad m] [LawfulMonad m] [IteratorLoop α Id m]
+    [LawfulIteratorLoop α Id m] {f : β → γ → m δ} {g : β → γ → δ → γ} {init : γ}
+    {it : Iter (α := α) β} :
+    ForIn.forIn it init (fun c b => (fun d => .yield (g c b d)) <$> f c b) =
+      it.foldM (fun b c => g c b <$> f c b) init := by
+  simp [Iter.foldM_eq_forIn]
+
+theorem Iter.foldM_eq_match_step {α β γ : Type w} [Iterator α Id β] [Finite α Id]
+    {m : Type w → Type w'} [Monad m] [LawfulMonad m] [IteratorLoop α Id m]
+    [LawfulIteratorLoop α Id m] {f : γ → β → m γ} {init : γ} {it : Iter (α := α) β} :
+    it.foldM (init := init) f = (do
+      match it.step with
+      | .yield it' out _ => it'.foldM (init := ← f init out) f
+      | .skip it' _ => it'.foldM (init := init) f
+      | .done _ => return init) := by
+  rw [Iter.foldM_eq_forIn, Iter.forIn_eq_match_step]
+  generalize it.step = step
+  cases step using PlausibleIterStep.casesOn <;> simp [foldM_eq_forIn]
+
+theorem Iter.foldlM_toList {α β γ : Type w} [Iterator α Id β] [Finite α Id] {m : Type w → Type w'}
+    [Monad m] [LawfulMonad m] [IteratorLoop α Id m] [LawfulIteratorLoop α Id m]
+    [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
+    {f : γ → β → m γ}
+    {init : γ} {it : Iter (α := α) β} :
+    it.toList.foldlM (init := init) f = it.foldM (init := init) f := by
+  rw [Iter.foldM_eq_forIn, ← Iter.forIn_toList]
+  simp only [List.forIn_yield_eq_foldlM, id_map']
+
+theorem IterM.forIn_eq_foldM {α β : Type w} [Iterator α Id β]
+    [Finite α Id] {m : Type w → Type w''} [Monad m] [LawfulMonad m]
+    [IteratorLoop α Id m] [LawfulIteratorLoop α Id m]
+    [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
+    {γ : Type w} {it : Iter (α := α) β} {init : γ}
+    {f : β → γ → m (ForInStep γ)} :
+    forIn it init f = ForInStep.value <$>
+      it.foldM (fun c b => match c with
+        | .yield c => f b c
+        | .done c => pure (.done c)) (ForInStep.yield init) := by
+  simp only [← Iter.forIn_toList, List.forIn_eq_foldlM, ← Iter.foldlM_toList]; rfl
+
+theorem Iter.fold_eq_forIn {α β γ : Type w} [Iterator α Id β]
+    [Finite α Id] [IteratorLoop α Id Id] {f : γ → β → γ} {init : γ} {it : Iter (α := α) β} :
+    it.fold (init := init) f =
+      (ForIn.forIn (m := Id) it init (fun x acc => pure (ForInStep.yield (f acc x)))).run := by
+  rfl
+
+theorem Iter.fold_eq_foldM {α β γ : Type w} [Iterator α Id β]
+    [Finite α Id] [IteratorLoop α Id Id] {f : γ → β → γ} {init : γ}
+    {it : Iter (α := α) β} :
+    it.fold (init := init) f = (it.foldM (m := Id) (init := init) (pure <| f · ·)).run := by
+  simp [foldM_eq_forIn, fold_eq_forIn]
+
+@[simp]
+theorem Iter.forIn_pure_yield_eq_fold {α β γ : Type w} [Iterator α Id β]
+    [Finite α Id] [IteratorLoop α Id Id]
+    [LawfulIteratorLoop α Id Id] {f : β → γ → γ} {init : γ}
+    {it : Iter (α := α) β} :
+    ForIn.forIn (m := Id) it init (fun c b => pure (.yield (f c b))) =
+      pure (it.fold (fun b c => f c b) init) := by
+  simp only [fold_eq_forIn]
+  rfl
+
+theorem Iter.fold_eq_match_step {α β γ : Type w} [Iterator α Id β] [Finite α Id]
+    [IteratorLoop α Id Id] [LawfulIteratorLoop α Id Id]
+    {f : γ → β → γ} {init : γ} {it : Iter (α := α) β} :
+    it.fold (init := init) f = (match it.step with
+      | .yield it' out _ => it'.fold (init := f init out) f
+      | .skip it' _ => it'.fold (init := init) f
+      | .done _ => init) := by
+  rw [fold_eq_foldM, foldM_eq_match_step]
+  simp only [fold_eq_foldM]
+  generalize it.step = step
+  cases step using PlausibleIterStep.casesOn <;> simp
+
+theorem Iter.foldl_toList {α β γ : Type w} [Iterator α Id β] [Finite α Id]
+    [IteratorLoop α Id Id] [LawfulIteratorLoop α Id Id]
+    [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
+    {f : γ → β → γ} {init : γ} {it : Iter (α := α) β} :
+    it.toList.foldl (init := init) f = it.fold (init := init) f := by
+  rw [fold_eq_foldM, List.foldl_eq_foldlM, ← Iter.foldlM_toList]
+
+end Std.Iterators

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

@@ -13,9 +13,13 @@ namespace Std.Iterators
 
 section Consumers
 
-theorem IterM.DefaultConsumers.toArrayMapped.go.aux₁ [Monad m] [LawfulMonad m] [Iterator α m β] [Finite α m]
-    {it : IterM (α := α) m β} {b : γ} {bs : Array γ} {f : β → m γ} :
-    IterM.DefaultConsumers.toArrayMapped.go f it (#[b] ++ bs) = (#[b] ++ ·) <$> IterM.DefaultConsumers.toArrayMapped.go f it bs := by
+variable {α β γ : Type w} {m : Type w → Type w'} {n : Type w → Type w''}
+  {lift : ⦃δ : Type w⦄ → m δ → n δ} {f : β → n γ} {it : IterM (α := α) m β}
+
+theorem IterM.DefaultConsumers.toArrayMapped.go.aux₁ [Monad n] [LawfulMonad n] [Iterator α m β]
+    [Finite α m] {b : γ} {bs : Array γ} :
+    IterM.DefaultConsumers.toArrayMapped.go lift f it (#[b] ++ bs) (m := m) =
+      (#[b] ++ ·) <$> IterM.DefaultConsumers.toArrayMapped.go lift f it bs (m := m) := by
   induction it, bs using IterM.DefaultConsumers.toArrayMapped.go.induct
   next it bs ih₁ ih₂ =>
   rw [go, map_eq_pure_bind, go, bind_assoc]
@@ -26,10 +30,10 @@ theorem IterM.DefaultConsumers.toArrayMapped.go.aux₁ [Monad m] [LawfulMonad m]
   · simp [ih₂ _ ‹_›]
   · simp
 
-theorem IterM.DefaultConsumers.toArrayMapped.go.aux₂ [Monad m] [LawfulMonad m]
-    [Iterator α m β] [Finite α m] {it : IterM (α := α) m β} {acc : Array γ} {f : β → m γ} :
-    IterM.DefaultConsumers.toArrayMapped.go f it acc =
-      (acc ++ ·) <$> IterM.DefaultConsumers.toArrayMapped f it := by
+theorem IterM.DefaultConsumers.toArrayMapped.go.aux₂ [Monad n] [LawfulMonad n] [Iterator α m β]
+    [Finite α m] {acc : Array γ} :
+    IterM.DefaultConsumers.toArrayMapped.go lift f it acc (m := m) =
+      (acc ++ ·) <$> IterM.DefaultConsumers.toArrayMapped lift f it (m := m) := by
   rw [← Array.toArray_toList (xs := acc)]
   generalize acc.toList = acc
   induction acc with
@@ -38,21 +42,21 @@ theorem IterM.DefaultConsumers.toArrayMapped.go.aux₂ [Monad m] [LawfulMonad m]
     rw [List.toArray_cons, IterM.DefaultConsumers.toArrayMapped.go.aux₁, ih]
     simp only [Functor.map_map, Array.append_assoc]
 
-theorem IterM.DefaultConsumers.toArrayMapped_eq_match_step [Monad m] [LawfulMonad m]
-    [Iterator α m β] [Finite α m] {it : IterM (α := α) m β} {f : β → m γ} :
-    IterM.DefaultConsumers.toArrayMapped f it = (do
+theorem IterM.DefaultConsumers.toArrayMapped_eq_match_step [Monad n] [LawfulMonad n]
+    [Iterator α m β] [Finite α m] :
+    IterM.DefaultConsumers.toArrayMapped lift f it (m := m) = letI : MonadLift m n := ⟨lift (δ := _)⟩; (do
       match ← it.step with
-      | .yield it' out _ => return #[← f out] ++ (← IterM.DefaultConsumers.toArrayMapped f it')
-      | .skip it' _ => IterM.DefaultConsumers.toArrayMapped f it'
+      | .yield it' out _ =>
+        return #[← f out] ++ (← IterM.DefaultConsumers.toArrayMapped lift f it' (m := m))
+      | .skip it' _ => IterM.DefaultConsumers.toArrayMapped lift f it' (m := m)
       | .done _ => return #[]) := by
   rw [IterM.DefaultConsumers.toArrayMapped, IterM.DefaultConsumers.toArrayMapped.go]
   apply bind_congr
   intro step
   split <;> simp [IterM.DefaultConsumers.toArrayMapped.go.aux₂]
 
-theorem IterM.toArray_eq_match_step [Monad m] [LawfulMonad m]
-    [Iterator α m β] [Finite α m] [IteratorCollect α m] [LawfulIteratorCollect α m]
-    {it : IterM (α := α) m β} :
+theorem IterM.toArray_eq_match_step [Monad m] [LawfulMonad m] [Iterator α m β] [Finite α m]
+    [IteratorCollect α m m] [LawfulIteratorCollect α m m] :
     it.toArray = (do
       match ← it.step with
       | .yield it' out _ => return #[out] ++ (← it'.toArray)
@@ -62,18 +66,18 @@ theorem IterM.toArray_eq_match_step [Monad m] [LawfulMonad m]
   rw [IterM.DefaultConsumers.toArrayMapped_eq_match_step]
   simp [bind_pure_comp, pure_bind, toArray]
 
-theorem IterM.toList_toArray [Monad m] [Iterator α m β] [Finite α m] [IteratorCollect α m]
+theorem IterM.toList_toArray [Monad m] [Iterator α m β] [Finite α m] [IteratorCollect α m m]
     {it : IterM (α := α) m β} :
     Array.toList <$> it.toArray = it.toList := by
   simp [IterM.toList]
 
 theorem IterM.toArray_toList [Monad m] [LawfulMonad m] [Iterator α m β] [Finite α m]
-    [IteratorCollect α m] {it : IterM (α := α) m β} :
+    [IteratorCollect α m m] {it : IterM (α := α) m β} :
     List.toArray <$> it.toList = it.toArray := by
   simp [IterM.toList]
 
 theorem IterM.toList_eq_match_step [Monad m] [LawfulMonad m] [Iterator α m β] [Finite α m]
-    [IteratorCollect α m] [LawfulIteratorCollect α m] {it : IterM (α := α) m β} :
+    [IteratorCollect α m m] [LawfulIteratorCollect α m m] {it : IterM (α := α) m β} :
     it.toList = (do
       match ← it.step with
       | .yield it' out _ => return out :: (← it'.toList)
@@ -119,7 +123,7 @@ theorem IterM.toListRev_eq_match_step [Monad m] [LawfulMonad m] [Iterator α m
   cases step using PlausibleIterStep.casesOn <;> simp [IterM.toListRev.go.aux₂]
 
 theorem IterM.reverse_toListRev [Monad m] [LawfulMonad m] [Iterator α m β] [Finite α m]
-    [IteratorCollect α m] [LawfulIteratorCollect α m]
+    [IteratorCollect α m m] [LawfulIteratorCollect α m m]
     {it : IterM (α := α) m β} :
     List.reverse <$> it.toListRev = it.toList := by
   apply Eq.symm
@@ -131,12 +135,26 @@ theorem IterM.reverse_toListRev [Monad m] [LawfulMonad m] [Iterator α m β] [Fi
   split <;> simp (discharger := assumption) [ihy, ihs]
 
 theorem IterM.toListRev_eq [Monad m] [LawfulMonad m] [Iterator α m β] [Finite α m]
-    [IteratorCollect α m] [LawfulIteratorCollect α m]
+    [IteratorCollect α m m] [LawfulIteratorCollect α m m]
     {it : IterM (α := α) m β} :
     it.toListRev = List.reverse <$> it.toList := by
   rw [← IterM.reverse_toListRev]
   simp
 
+theorem LawfulIteratorCollect.toArray_eq {α β : Type w} {m : Type w → Type w'}
+    [Monad m] [Iterator α m β] [Finite α m] [IteratorCollect α m m]
+    [hl : LawfulIteratorCollect α m m]
+    {it : IterM (α := α) m β} :
+    it.toArray = (letI : IteratorCollect α m m := .defaultImplementation; it.toArray) := by
+  simp only [IterM.toArray, toArrayMapped_eq]
+
+theorem LawfulIteratorCollect.toList_eq {α β : Type w} {m : Type w → Type w'}
+    [Monad m] [Iterator α m β] [Finite α m] [IteratorCollect α m m]
+    [hl : LawfulIteratorCollect α m m]
+    {it : IterM (α := α) m β} :
+    it.toList = (letI : IteratorCollect α m m := .defaultImplementation; it.toList) := by
+  simp [IterM.toList, toArray_eq]
+
 end Consumers
 
 end Std.Iterators

src/Std/Data/Iterators/Lemmas/Consumers/Monadic/Loop.lean

@@ -0,0 +1,236 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Init.Control.Lawful.Basic
+import Std.Data.Iterators.Consumers.Monadic.Collect
+import Std.Data.Iterators.Consumers.Monadic.Loop
+import Std.Data.Iterators.Lemmas.Monadic.Basic
+import Std.Data.Iterators.Lemmas.Consumers.Monadic.Collect
+
+namespace Std.Iterators
+
+theorem IterM.DefaultConsumers.forIn_eq_match_step {α β : Type w} {m : Type w → Type w'}
+    [Iterator α m β]
+    {n : Type w → Type w''} [Monad n]
+    {lift : ∀ γ, m γ → n γ} {γ : Type w}
+    {plausible_forInStep : β → γ → ForInStep γ → Prop}
+    {wf : IteratorLoop.WellFounded α m plausible_forInStep}
+    {it : IterM (α := α) m β} {init : γ}
+    {f : (b : β) → (c : γ) → n (Subtype (plausible_forInStep b c))} :
+    IterM.DefaultConsumers.forIn lift γ plausible_forInStep wf it init f = (do
+      match ← lift _ it.step with
+      | .yield it' out _ =>
+        match ← f out init with
+        | ⟨.yield c, _⟩ => IterM.DefaultConsumers.forIn lift _ plausible_forInStep wf it' c f
+        | ⟨.done c, _⟩ => return c
+      | .skip it' _ => IterM.DefaultConsumers.forIn lift _ plausible_forInStep wf it' init f
+      | .done _ => return init) := by
+  rw [forIn]
+  apply bind_congr
+  intro step
+  cases step using PlausibleIterStep.casesOn <;> rfl
+
+theorem IterM.forIn_eq {α β : Type w} {m : Type w → Type w'} [Iterator α m β] [Finite α m]
+    {n : Type w → Type w''} [Monad n] [IteratorLoop α m n] [hl : LawfulIteratorLoop α m n]
+    [MonadLiftT m n] {γ : Type w} {it : IterM (α := α) m β} {init : γ}
+    {f : β → γ → n (ForInStep γ)} :
+    ForIn.forIn it init f = IterM.DefaultConsumers.forIn (fun _ => monadLift) γ (fun _ _ _ => True)
+        IteratorLoop.wellFounded_of_finite it init ((⟨·, .intro⟩) <$> f · ·) := by
+  cases hl.lawful; rfl
+
+theorem IterM.forIn_eq_match_step {α β : Type w} {m : Type w → Type w'} [Iterator α m β]
+    [Finite α m] {n : Type w → Type w''} [Monad n] [LawfulMonad n]
+    [IteratorLoop α m n] [LawfulIteratorLoop α m n]
+    [MonadLiftT m n] {γ : Type w} {it : IterM (α := α) m β} {init : γ}
+    {f : β → γ → n (ForInStep γ)} :
+    ForIn.forIn it init f = (do
+      match ← it.step with
+      | .yield it' out _ =>
+        match ← f out init with
+        | .yield c => ForIn.forIn it' c f
+        | .done c => return c
+      | .skip it' _ => ForIn.forIn it' init f
+      | .done _ => return init) := by
+  rw [IterM.forIn_eq, DefaultConsumers.forIn_eq_match_step]
+  apply bind_congr
+  intro step
+  cases step using PlausibleIterStep.casesOn
+  · simp only [map_eq_pure_bind, bind_assoc]
+    apply bind_congr
+    intro forInStep
+    cases forInStep <;> simp [IterM.forIn_eq]
+  · simp [IterM.forIn_eq]
+  · simp
+
+theorem IterM.forM_eq_forIn {α β : Type w} {m : Type w → Type w'} [Iterator α m β]
+    [Finite α m] {n : Type w → Type w''} [Monad n] [LawfulMonad n]
+    [IteratorLoop α m n] [LawfulIteratorLoop α m n]
+    [MonadLiftT m n] {it : IterM (α := α) m β}
+    {f : β → n PUnit} :
+    ForM.forM it f = ForIn.forIn it PUnit.unit (fun out _ => do f out; return .yield .unit) :=
+  rfl
+
+theorem IterM.forM_eq_match_step {α β : Type w} {m : Type w → Type w'} [Iterator α m β]
+    [Finite α m] {n : Type w → Type w''} [Monad n] [LawfulMonad n]
+    [IteratorLoop α m n] [LawfulIteratorLoop α m n]
+    [MonadLiftT m n] {it : IterM (α := α) m β}
+    {f : β → n PUnit} :
+    ForM.forM it f = (do
+      match ← it.step with
+      | .yield it' out _ =>
+        f out
+        ForM.forM it' f
+      | .skip it' _ => ForM.forM it' f
+      | .done _ => return) := by
+  rw [forM_eq_forIn, forIn_eq_match_step]
+  apply bind_congr
+  intro step
+  cases step using PlausibleIterStep.casesOn <;> simp [forM_eq_forIn]
+
+theorem IterM.foldM_eq_forIn {α β γ : Type w} {m : Type w → Type w'} [Iterator α m β] [Finite α m]
+    {n : Type w → Type w''} [Monad n] [IteratorLoop α m n] [MonadLiftT m n] {f : γ → β → n γ}
+    {init : γ} {it : IterM (α := α) m β} :
+    it.foldM (init := init) f = ForIn.forIn it init (fun x acc => ForInStep.yield <$> f acc x) :=
+  rfl
+
+theorem IterM.forIn_yield_eq_foldM {α β γ δ : Type w} {m : Type w → Type w'} [Iterator α m β]
+    [Finite α m] {n : Type w → Type w''} [Monad n] [LawfulMonad n] [IteratorLoop α m n]
+    [LawfulIteratorLoop α m n] [MonadLiftT m n] {f : β → γ → n δ} {g : β → γ → δ → γ} {init : γ}
+    {it : IterM (α := α) m β} :
+    ForIn.forIn it init (fun c b => (fun d => .yield (g c b d)) <$> f c b) =
+      it.foldM (fun b c => g c b <$> f c b) init := by
+  simp [IterM.foldM_eq_forIn]
+
+theorem IterM.foldM_eq_match_step {α β γ : Type w} {m : Type w → Type w'} [Iterator α m β] [Finite α m]
+    {n : Type w → Type w''} [Monad n] [LawfulMonad n] [IteratorLoop α m n] [LawfulIteratorLoop α m n]
+    [MonadLiftT m n] {f : γ → β → n γ} {init : γ} {it : IterM (α := α) m β} :
+    it.foldM (init := init) f = (do
+      match ← it.step with
+      | .yield it' out _ => it'.foldM (init := ← f init out) f
+      | .skip it' _ => it'.foldM (init := init) f
+      | .done _ => return init) := by
+  rw [IterM.foldM_eq_forIn, IterM.forIn_eq_match_step]
+  apply bind_congr
+  intro step
+  cases step using PlausibleIterStep.casesOn <;> simp [foldM_eq_forIn]
+
+theorem IterM.fold_eq_forIn {α β γ : Type w} {m : Type w → Type w'} [Iterator α m β]
+    [Finite α m] [Monad m]
+    [IteratorLoop α m m] {f : γ → β → γ} {init : γ} {it : IterM (α := α) m β} :
+    it.fold (init := init) f =
+      ForIn.forIn (m := m) it init (fun x acc => pure (ForInStep.yield (f acc x))) := by
+  rfl
+
+theorem IterM.fold_eq_foldM {α β γ : Type w} {m : Type w → Type w'} [Iterator α m β]
+    [Finite α m] [Monad m] [LawfulMonad m] [IteratorLoop α m m] {f : γ → β → γ} {init : γ}
+    {it : IterM (α := α) m β} :
+    it.fold (init := init) f = it.foldM (init := init) (pure <| f · ·) := by
+  simp [foldM_eq_forIn, fold_eq_forIn]
+
+@[simp]
+theorem IterM.forIn_pure_yield_eq_fold {α β γ : Type w} {m : Type w → Type w'} [Iterator α m β]
+    [Finite α m] [Monad m] [LawfulMonad m] [IteratorLoop α m m]
+    [LawfulIteratorLoop α m m] {f : β → γ → γ} {init : γ}
+    {it : IterM (α := α) m β} :
+    ForIn.forIn it init (fun c b => pure (.yield (f c b))) =
+      it.fold (fun b c => f c b) init := by
+  simp [IterM.fold_eq_forIn]
+
+theorem IterM.fold_eq_match_step {α β γ : Type w} {m : Type w → Type w'} [Iterator α m β] [Finite α m]
+    [Monad m] [LawfulMonad m] [IteratorLoop α m m] [LawfulIteratorLoop α m m]
+    {f : γ → β → γ} {init : γ} {it : IterM (α := α) m β} :
+    it.fold (init := init) f = (do
+      match ← it.step with
+      | .yield it' out _ => it'.fold (init := f init out) f
+      | .skip it' _ => it'.fold (init := init) f
+      | .done _ => return init) := by
+  rw [fold_eq_foldM, foldM_eq_match_step]
+  simp only [fold_eq_foldM]
+  apply bind_congr
+  intro step
+  cases step using PlausibleIterStep.casesOn <;> simp
+
+theorem IterM.toList_eq_fold {α β : Type w} {m : Type w → Type w'} [Iterator α m β]
+    [Finite α m] [Monad m] [LawfulMonad m] [IteratorLoop α m m] [LawfulIteratorLoop α m m]
+    [IteratorCollect α m m] [LawfulIteratorCollect α m m]
+    {it : IterM (α := α) m β} :
+    it.toList = it.fold (init := []) (fun l out => l ++ [out]) := by
+  suffices h : ∀ l' : List β, (l' ++ ·) <$> it.toList =
+      it.fold (init := l') (fun l out => l ++ [out]) by
+    specialize h []
+    simpa using h
+  induction it using IterM.inductSteps with | step it ihy ihs =>
+  intro l'
+  rw [IterM.toList_eq_match_step, IterM.fold_eq_match_step]
+  simp only [map_eq_pure_bind, bind_assoc]
+  apply bind_congr
+  intro step
+  cases step using PlausibleIterStep.casesOn
+  · rename_i it' out h
+    specialize ihy h (l' ++ [out])
+    simpa using ihy
+  · rename_i it' h
+    simp [ihs h]
+  · simp
+
+theorem IterM.drain_eq_fold {α β : Type w} {m : Type w → Type w'} [Iterator α m β] [Finite α m]
+    [Monad m] [IteratorLoop α m m] {it : IterM (α := α) m β} :
+    it.drain = it.fold (init := PUnit.unit) (fun _ _ => .unit) :=
+  rfl
+
+theorem IterM.drain_eq_foldM {α β : Type w} {m : Type w → Type w'} [Iterator α m β] [Finite α m]
+    [Monad m] [LawfulMonad m] [IteratorLoop α m m] {it : IterM (α := α) m β} :
+    it.drain = it.foldM (init := PUnit.unit) (fun _ _ => pure .unit) := by
+  simp [IterM.drain_eq_fold, IterM.fold_eq_foldM]
+
+theorem IterM.drain_eq_forIn {α β : Type w} {m : Type w → Type w'}  [Iterator α m β] [Finite α m]
+    [Monad m] [IteratorLoop α m m] {it : IterM (α := α) m β} :
+    it.drain = ForIn.forIn (m := m) it PUnit.unit (fun _ _ => pure (ForInStep.yield .unit)) := by
+  simp [IterM.drain_eq_fold, IterM.fold_eq_forIn]
+
+theorem IterM.drain_eq_match_step {α β : Type w} {m : Type w → Type w'} [Iterator α m β] [Finite α m]
+    [Monad m] [LawfulMonad m] [IteratorLoop α m m] [LawfulIteratorLoop α m m]
+    {it : IterM (α := α) m β} :
+    it.drain = (do
+      match ← it.step with
+      | .yield it' _ _ => it'.drain
+      | .skip it' _ => it'.drain
+      | .done _ => return .unit) := by
+  rw [IterM.drain_eq_fold, IterM.fold_eq_match_step]
+  simp [IterM.drain_eq_fold]
+
+theorem IterM.drain_eq_map_toList {α β : Type w} {m : Type w → Type w'} [Iterator α m β]
+    [Finite α m] [Monad m] [LawfulMonad m] [IteratorLoop α m m] [LawfulIteratorLoop α m m]
+    [IteratorCollect α m m] [LawfulIteratorCollect α m m]
+    {it : IterM (α := α) m β} :
+    it.drain = (fun _ => .unit) <$> it.toList := by
+  induction it using IterM.inductSteps with | step it ihy ihs =>
+  rw [IterM.drain_eq_match_step, IterM.toList_eq_match_step]
+  simp only [map_eq_pure_bind, bind_assoc]
+  apply bind_congr
+  intro step
+  cases step using PlausibleIterStep.casesOn
+  · rename_i it' out h
+    simp [ihy h]
+  · rename_i it' h
+    simp [ihs h]
+  · simp
+
+theorem IterM.drain_eq_map_toListRev {α β : Type w} {m : Type w → Type w'} [Iterator α m β]
+    [Finite α m] [Monad m] [LawfulMonad m] [IteratorLoop α m m] [LawfulIteratorLoop α m m]
+    [IteratorCollect α m m] [LawfulIteratorCollect α m m]
+    {it : IterM (α := α) m β} :
+    it.drain = (fun _ => .unit) <$> it.toListRev := by
+  simp [IterM.drain_eq_map_toList, IterM.toListRev_eq]
+
+theorem IterM.drain_eq_map_toArray {α β : Type w} {m : Type w → Type w'} [Iterator α m β]
+    [Finite α m] [Monad m] [LawfulMonad m] [IteratorLoop α m m] [LawfulIteratorLoop α m m]
+    [IteratorCollect α m m] [LawfulIteratorCollect α m m]
+    {it : IterM (α := α) m β} :
+    it.drain = (fun _ => .unit) <$> it.toList := by
+  simp [IterM.drain_eq_map_toList]
+
+end Std.Iterators

src/Std/Data/Iterators/Lemmas/Producers.lean

@@ -5,4 +5,6 @@ Authors: Paul Reichert
 -/
 prelude
 import Std.Data.Iterators.Lemmas.Producers.Monadic
+import Std.Data.Iterators.Lemmas.Producers.Array
 import Std.Data.Iterators.Lemmas.Producers.List
+import Std.Data.Iterators.Lemmas.Producers.Repeat

src/Std/Data/Iterators/Lemmas/Producers/Array.lean

@@ -0,0 +1,87 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Std.Data.Iterators.Lemmas.Consumers.Collect
+import Std.Data.Iterators.Lemmas.Producers.Monadic.Array
+
+/-!
+# Lemmas about array iterators
+
+This module provides lemmas about the interactions of `Array.iter` with `Iter.step` and various
+collectors.
+-/
+
+namespace Std.Iterators
+
+variable {β : Type w}
+
+theorem _root_.Array.iter_eq_toIter_iterM {array : Array β} :
+    array.iter = (array.iterM Id).toIter :=
+  rfl
+
+theorem _root_.Array.iter_eq_iterFromIdx {array : Array β} :
+    array.iter = array.iterFromIdx 0 :=
+  rfl
+
+theorem _root_.Array.iterFromIdx_eq_toIter_iterFromIdxM {array : Array β} {pos : Nat} :
+    array.iterFromIdx pos = (array.iterFromIdxM Id pos).toIter :=
+  rfl
+
+theorem _root_.Array.step_iterFromIdx {array : Array β} {pos : Nat} :
+    (array.iterFromIdx pos).step = if h : pos < array.size then
+        .yield
+          (array.iterFromIdx (pos + 1))
+          array[pos]
+          ⟨rfl, rfl, h, rfl⟩
+      else
+        .done (Nat.not_lt.mp h) := by
+  simp only [Array.iterFromIdx_eq_toIter_iterFromIdxM, Iter.step, Iter.toIterM_toIter,
+    Array.step_iterFromIdxM, Id.run_pure]
+  split <;> rfl
+
+theorem _root_.Array.step_iter {array : Array β} :
+    array.iter.step = if h : 0 < array.size then
+        .yield
+          (array.iterFromIdx 1)
+          array[0]
+          ⟨rfl, rfl, h, rfl⟩
+      else
+        .done (Nat.not_lt.mp h) := by
+  simp only [Array.iter_eq_iterFromIdx, Array.step_iterFromIdx]
+
+@[simp]
+theorem _root_.Array.toList_iterFromIdx {array : Array β}
+    {pos : Nat} :
+    (array.iterFromIdx pos).toList = array.toList.drop pos := by
+  simp [Iter.toList, Array.iterFromIdx_eq_toIter_iterFromIdxM, Iter.toIterM_toIter,
+    Array.toList_iterFromIdxM]
+
+@[simp]
+theorem _root_.Array.toList_iter {array : Array β} :
+    array.iter.toList = array.toList := by
+  simp [Array.iter_eq_iterFromIdx, Array.toList_iterFromIdx]
+
+@[simp]
+theorem _root_.Array.toArray_iterFromIdx {array : Array β} {pos : Nat} :
+    (array.iterFromIdx pos).toArray = array.extract pos := by
+  simp [Array.iterFromIdx_eq_toIter_iterFromIdxM, Iter.toArray]
+
+@[simp]
+theorem _root_.Array.toArray_toIter {array : Array β} :
+    array.iter.toArray = array := by
+  simp [Array.iter_eq_iterFromIdx, Array.toArray_iterFromIdxM]
+
+@[simp]
+theorem _root_.Array.toListRev_iterFromIdx {array : Array β} {pos : Nat} :
+    (array.iterFromIdx pos).toListRev = (array.toList.drop pos).reverse := by
+  simp [Iter.toListRev_eq, Array.toList_iterFromIdx]
+
+@[simp]
+theorem _root_.Array.toListRev_toIter {array : Array β} :
+    array.iter.toListRev = array.toListRev := by
+  simp [Array.iter_eq_iterFromIdx]
+
+end Std.Iterators

src/Std/Data/Iterators/Lemmas/Producers/List.lean

@@ -30,17 +30,17 @@ theorem _root_.List.step_iter_cons {x : β} {xs : List β} :
   simp only [List.iter, List.iterM, IterM.step, Iterator.step]; rfl
 
 @[simp]
-theorem _root_.List.toArray_iter {m : Type w → Type w'} [Monad m] [LawfulMonad m] {l : List β} :
+theorem _root_.List.toArray_iter {l : List β} :
     l.iter.toArray = l.toArray := by
   simp [List.iter, List.toArray_iterM, Iter.toArray_eq_toArray_toIterM]
 
 @[simp]
-theorem _root_.List.toList_iter {m : Type w → Type w'} [Monad m] [LawfulMonad m] {l : List β} :
+theorem _root_.List.toList_iter {l : List β} :
     l.iter.toList = l := by
   simp [List.iter, List.toList_iterM]
 
 @[simp]
-theorem _root_.List.toListRev_iter {m : Type w → Type w'} [Monad m] [LawfulMonad m] {l : List β} :
+theorem _root_.List.toListRev_iter {l : List β} :
     l.iter.toListRev = l.reverse := by
   simp [List.iter, Iter.toListRev_eq_toListRev_toIterM, List.toListRev_iterM]
 

src/Std/Data/Iterators/Lemmas/Producers/Monadic.lean

@@ -4,4 +4,5 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Paul Reichert
 -/
 prelude
+import Std.Data.Iterators.Lemmas.Producers.Monadic.Array
 import Std.Data.Iterators.Lemmas.Producers.Monadic.List

src/Std/Data/Iterators/Lemmas/Producers/Monadic/Array.lean

@@ -0,0 +1,120 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Std.Data.Iterators.Producers.Monadic.Array
+import Std.Data.Iterators.Consumers
+import Std.Data.Iterators.Lemmas.Consumers.Monadic
+import Std.Data.Internal.LawfulMonadLiftFunction
+
+/-!
+# Lemmas about array iterators
+
+This module provides lemmas about the interactions of `Array.iterM` with `IterM.step` and various
+collectors.
+-/
+
+namespace Std.Iterators
+
+variable {m : Type w → Type w'} [Monad m] {β : Type w}
+
+theorem _root_.Array.iterM_eq_iterFromIdxM {array : Array β} :
+    array.iterM m = array.iterFromIdxM m 0 :=
+  rfl
+
+theorem _root_.Array.step_iterFromIdxM {array : Array β} {pos : Nat} :
+    (array.iterFromIdxM m pos).step = (pure <| if h : pos < array.size then
+        .yield
+          (array.iterFromIdxM m (pos + 1))
+          array[pos]
+          ⟨rfl, rfl, h, rfl⟩
+      else
+        .done (Nat.not_lt.mp h)) := by
+  rfl
+
+theorem _root_.Array.step_iterM {array : Array β} :
+    (array.iterM m).step = (pure <| if h : 0 < array.size then
+        .yield
+          (array.iterFromIdxM m 1)
+          array[0]
+          ⟨rfl, rfl, h, rfl⟩
+      else
+        .done (Nat.not_lt.mp h)) := by
+  rfl
+
+@[simp]
+theorem _root_.Array.toList_iterFromIdxM [LawfulMonad m] {array : Array β}
+    {pos : Nat} :
+    (array.iterFromIdxM m pos).toList = pure (array.toList.drop pos) := by
+  by_cases h : pos < array.size
+  · suffices h' : ∀ n p, p ≥ array.size - n → (array.iterFromIdxM m p).toList = pure (array.toList.drop p) by
+      apply h' array.size
+      omega
+    intro n
+    induction n
+    · intro p hp
+      rw [IterM.toList_eq_match_step]
+      simp [Array.step_iterFromIdxM]
+      rw [List.drop_eq_nil_iff.mpr]
+      · simp [show ¬ p < array.size by omega]
+      · simp only [Array.length_toList]
+        omega
+    · rename_i n ih
+      intro p hp
+      by_cases h : p ≥ array.size - n
+      · apply ih
+        assumption
+      · rw [IterM.toList_eq_match_step, Array.step_iterFromIdxM]
+        simp [show p < array.size by omega]
+        rw [ih _ (by omega)]
+        simp
+        apply congrArg pure
+        rw (occs := [2]) [← List.getElem_cons_drop_succ_eq_drop]
+        simp
+        rw [Array.getElem_toList]
+  · rw [IterM.toList_eq_match_step, List.drop_eq_nil_iff.mpr]
+    · simp [Array.step_iterFromIdxM, h]
+    · simp only [Array.length_toList]
+      omega
+
+@[simp]
+theorem _root_.Array.toList_iterM [LawfulMonad m] {array : Array β} :
+    (array.iterM m).toList = pure array.toList := by
+  simp [Array.iterM_eq_iterFromIdxM, Array.toList_iterFromIdxM]
+
+-- TODO: move to Init.Data.Array.Lemmas in a separate PR afterwards
+private theorem _root_.List.drop_toArray' {l : List α} {k : Nat} :
+    l.toArray.drop k = (l.drop k).toArray := by
+  induction l generalizing k
+  case nil => simp
+  case cons l' ih =>
+    match k with
+    | 0 => simp
+    | k' + 1 => simp [List.drop_succ_cons, ← ih]
+
+@[simp]
+theorem _root_.Array.toArray_iterFromIdxM [LawfulMonad m] {array : Array β} {pos : Nat} :
+    (array.iterFromIdxM m pos).toArray = pure (array.extract pos) := by
+  simp [← IterM.toArray_toList, Array.toList_iterFromIdxM]
+  rw [← Array.drop_eq_extract]
+  rw (occs := [2]) [← Array.toArray_toList (xs := array)]
+  rw [List.drop_toArray']
+
+@[simp]
+theorem _root_.Array.toArray_toIterM [LawfulMonad m] {array : Array β} :
+    (array.iterM m).toArray = pure array := by
+  simp [Array.iterM_eq_iterFromIdxM, Array.toArray_iterFromIdxM]
+
+@[simp]
+theorem _root_.Array.toListRev_iterFromIdxM [LawfulMonad m] {array : Array β} {pos : Nat} :
+    (array.iterFromIdxM m pos).toListRev = pure (array.toList.drop pos).reverse := by
+  simp [IterM.toListRev_eq, Array.toList_iterFromIdxM]
+
+@[simp]
+theorem _root_.Array.toListRev_toIterM [LawfulMonad m] {array : Array β} :
+    (array.iterM m).toListRev = pure array.toListRev := by
+  simp [Array.iterM_eq_iterFromIdxM, Array.toListRev_iterFromIdxM]
+
+end Std.Iterators

src/Std/Data/Iterators/Lemmas/Producers/Monadic/List.lean

@@ -7,6 +7,7 @@ prelude
 import Std.Data.Iterators.Producers.Monadic.List
 import Std.Data.Iterators.Consumers
 import Std.Data.Iterators.Lemmas.Consumers.Monadic
+import Std.Data.Internal.LawfulMonadLiftFunction
 
 /-!
 # Lemmas about list iterators
@@ -16,8 +17,9 @@ collectors.
 -/
 
 namespace Std.Iterators
+open Std.Internal
 
-variable {m : Type w → Type w'} [Monad m] {β : Type w}
+variable {m : Type w → Type w'} {n : Type w → Type w''} [Monad m] {β : Type w}
 
 @[simp]
 theorem _root_.List.step_iterM_nil :
@@ -29,22 +31,23 @@ theorem _root_.List.step_iterM_cons {x : β} {xs : List β} :
     ((x :: xs).iterM m).step = pure ⟨.yield (xs.iterM m) x, rfl⟩ := by
   simp only [List.iterM, IterM.step, Iterator.step]; rfl
 
-theorem ListIterator.toArrayMapped_toIterM [LawfulMonad m]
-    {β : Type w} {γ : Type w} {f : β → m γ} {l : List β} :
-    IteratorCollect.toArrayMapped f (l.iterM m) = List.toArray <$> l.mapM f := by
+theorem ListIterator.toArrayMapped_iterM [Monad n] [LawfulMonad n]
+    {β : Type w} {γ : Type w} {lift : ⦃δ : Type w⦄ → m δ → n δ}
+    [LawfulMonadLiftFunction lift] {f : β → n γ} {l : List β} :
+    IteratorCollect.toArrayMapped lift f (l.iterM m) (m := m) = List.toArray <$> l.mapM f := by
   rw [LawfulIteratorCollect.toArrayMapped_eq]
   induction l with
   | nil =>
     rw [IterM.DefaultConsumers.toArrayMapped_eq_match_step]
-    simp [List.step_iterM_nil]
+    simp [List.step_iterM_nil, LawfulMonadLiftFunction.lift_pure]
   | cons x xs ih =>
     rw [IterM.DefaultConsumers.toArrayMapped_eq_match_step]
-    simp [List.step_iterM_cons, List.mapM_cons, pure_bind, ih]
+    simp [List.step_iterM_cons, List.mapM_cons, pure_bind, ih, LawfulMonadLiftFunction.lift_pure]
 
 @[simp]
 theorem _root_.List.toArray_iterM [LawfulMonad m] {l : List β} :
     (l.iterM m).toArray = pure l.toArray := by
-  simp only [IterM.toArray, ListIterator.toArrayMapped_toIterM]
+  simp only [IterM.toArray, ListIterator.toArrayMapped_iterM]
   rw [List.mapM_pure, map_pure, List.map_id']
 
 @[simp]

src/Std/Data/Iterators/Lemmas/Producers/Repeat.lean

@@ -0,0 +1,55 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Init.Data.Option.Lemmas
+import Std.Data.Iterators.Producers.Repeat
+import Std.Data.Iterators.Consumers.Access
+import Std.Data.Iterators.Consumers.Collect
+import Std.Data.Iterators.Combinators.Take
+import Std.Data.Iterators.Lemmas.Combinators.Take
+
+namespace Std.Iterators
+
+variable {α : Type w} {f : α → α} {init : α}
+
+theorem Iter.step_repeat :
+    (Iter.repeat f init).step = .yield (Iter.repeat f (f init)) init ⟨rfl, rfl⟩ := by
+  rfl
+
+theorem Iter.atIdxSlow?_zero_repeat :
+    (Iter.repeat f init).atIdxSlow? 0 = some init := by
+  rw [atIdxSlow?, step_repeat]
+
+theorem Iter.atIdxSlow?_succ_repeat {k : Nat} :
+    (Iter.repeat f init).atIdxSlow? (k + 1) = (Iter.repeat f (f init)).atIdxSlow? k := by
+  rw [atIdxSlow?, step_repeat]
+
+theorem Iter.atIdxSlow?_succ_repeat_eq_map {k : Nat} :
+    (Iter.repeat f init).atIdxSlow? (k + 1) = f <$> ((Iter.repeat f init).atIdxSlow? k) := by
+  rw [atIdxSlow?, step_repeat]
+  simp only
+  induction k generalizing init
+  · simp [atIdxSlow?_zero_repeat, Functor.map]
+  · simp [*, atIdxSlow?_succ_repeat]
+
+@[simp]
+theorem Iter.atIdxSlow?_repeat {n : Nat} :
+    (Iter.repeat f init).atIdxSlow? n = some (Nat.repeat f n init) := by
+  induction n generalizing init
+  · apply atIdxSlow?_zero_repeat
+  · rename_i _ ih
+    simp [atIdxSlow?_succ_repeat_eq_map, ih, Nat.repeat]
+
+theorem Iter.isSome_atIdxSlow?_repeat {k : Nat} :
+    ((Iter.repeat f init).atIdxSlow? k).isSome := by
+  induction k generalizing init <;> simp [*, atIdxSlow?_succ_repeat]
+
+@[simp]
+theorem Iter.toList_take_repeat_succ {k : Nat} :
+    ((Iter.repeat f init).take (k + 1)).toList = init :: ((Iter.repeat f (f init)).take k).toList := by
+  rw [toList_eq_match_step, step_take, step_repeat]
+
+end Std.Iterators

src/Std/Data/Iterators/PostConditionMonad.lean

@@ -0,0 +1,179 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Init.Control.Lawful.Basic
+import Init.Data.Subtype
+import Init.PropLemmas
+
+namespace Std.Iterators
+
+/--
+`PostconditionT m α` represents an operation in the monad `m` together with a
+intrinsic proof that some postcondition holds for the `α` valued monadic result.
+It consists of a predicate `P` about `α` and an element of `m ({ a // P a })` and is a helpful tool
+for intrinsic verification, notably termination proofs, in the context of iterators.
+
+`PostconditionT m` is a monad if `m` is. However, note that `PostconditionT m α` is a structure,
+so that the compiler will generate inefficient code from recursive functions returning
+`PostconditionT m α`. Optimizations for `ReaderT`, `StateT` etc. aren't applicable for structures.
+
+Moreover, `PostconditionT m α` is not a well-behaved monad transformer because `PostconditionT.lift`
+neither commutes with `pure` nor with `bind`.
+-/
+@[unbox]
+structure PostconditionT (m : Type w → Type w') (α : Type w) where
+  /--
+  A predicate that holds for the return value(s) of the `m`-monadic operation.
+  -/
+  Property : α → Prop
+
+  /--
+  The actual monadic operation. Its return value is bundled together with a proof that
+  it satisfies `Property`.
+  -/
+  operation : m (Subtype Property)
+
+/--
+Lifts an operation from `m` to `PostconditionT m` without asserting any nontrivial postcondition.
+
+Caution: `lift` is not a lawful lift function.
+For example, `pure a : PostconditionT m α` is not the same as
+`PostconditionT.lift (pure a : m α)`.
+-/
+@[always_inline, inline]
+def PostconditionT.lift {α : Type w} {m : Type w → Type w'} [Functor m] (x : m α) :
+    PostconditionT m α :=
+  ⟨fun _ => True, (⟨·, .intro⟩) <$> x⟩
+
+/--
+Lifts a monadic value from `m { a : α // P a }` to a value `PostconditionT m α`.
+-/
+@[always_inline, inline]
+def PostconditionT.liftWithProperty {α : Type w} {m : Type w → Type w'} {P : α → Prop}
+    (x : m { α // P α }) : PostconditionT m α :=
+  ⟨P, x⟩
+
+/--
+Given a function `f : α → β`, returns a a function `PostconditionT m α → PostconditionT m β`,
+turning `PostconditionT m` into a functor.
+
+The postcondition of the `x.map f` states that the return value is the image under `f` of some
+`a : α` satisfying the `x.Property`.
+-/
+@[always_inline, inline]
+protected def PostconditionT.map {m : Type w → Type w'} [Functor m] {α : Type w} {β : Type w}
+    (f : α → β) (x : PostconditionT m α) : PostconditionT m β :=
+  ⟨fun b => ∃ a : Subtype x.Property, f a.1 = b,
+    (fun a => ⟨f a.val, _, rfl⟩) <$> x.operation⟩
+
+/--
+Given a function `α → PostconditionT m β`, returns a a function
+`PostconditionT m α → PostconditionT m β`, turning `PostconditionT m` into a monad.
+-/
+@[always_inline, inline]
+protected def PostconditionT.bind {m : Type w → Type w'} [Monad m] {α : Type w} {β : Type w}
+    (x : PostconditionT m α) (f : α → PostconditionT m β) : PostconditionT m β :=
+  ⟨fun b => ∃ a, x.Property a ∧ (f a).Property b,
+    x.operation >>= fun a =>
+      (fun b =>
+        ⟨b.val, a.val, a.property, b.property⟩) <$> (f a).operation⟩
+
+/--
+A version of `bind` that provides a proof of the previous postcondition to the mapping function.
+-/
+@[always_inline, inline]
+protected def PostconditionT.pbind {m : Type w → Type w'} [Monad m] {α : Type w} {β : Type w}
+    (x : PostconditionT m α) (f : Subtype x.Property → PostconditionT m β) : PostconditionT m β :=
+  ⟨fun b => ∃ a, (f a).Property b,
+    x.operation >>= fun a => (fun b => ⟨b.val, a, b.property⟩) <$> (f a).operation⟩
+
+/--
+Lifts an operation from `m` to `PostConditionT m` and then applies `PostconditionT.map`.
+-/
+@[always_inline, inline]
+protected def PostconditionT.liftMap {m : Type w → Type w'} [Monad m] {α : Type w} {β : Type w}
+    (f : α → β) (x : m α) : PostconditionT m β :=
+  ⟨fun b => ∃ a, f a = b, (fun a => ⟨f a, a, rfl⟩) <$> x⟩
+
+/--
+Converts an operation from `PostConditionT m` to `m`, discarding the postcondition.
+-/
+@[always_inline, inline]
+def PostconditionT.run {m : Type w → Type w'} [Monad m] {α : Type w} (x : PostconditionT m α) :
+    m α :=
+  (fun a => a.val) <$> x.operation
+
+instance {m : Type w → Type w'} [Functor m] : Functor (PostconditionT m) where
+  map f x := ⟨fun b => ∃ a, f a = b, (fun b => ⟨f b.1, b.1, rfl⟩) <$> x.operation ⟩
+
+instance {m : Type w → Type w'} [Monad m] : Monad (PostconditionT m) where
+  pure x := ⟨fun y => x = y, pure <| ⟨x, rfl⟩⟩
+  bind x f := ⟨fun b => ∃ a, (f a).Property b,
+      x.operation >>= fun a => (fun b => ⟨b.val, a, b.property⟩) <$> (f a).operation⟩
+
+@[simp]
+theorem PostconditionT.computation_pure {m : Type w → Type w'} [Monad m] {α : Type w}
+    {x : α} :
+    (pure x : PostconditionT m α).operation = pure ⟨x, rfl⟩ :=
+  rfl
+
+@[simp]
+theorem PostconditionT.property_pure {m : Type w → Type w'} [Monad m] {α : Type w}
+    {x : α} :
+    (pure x : PostconditionT m α).Property = (x = ·) :=
+  rfl
+
+private theorem congrArg₂ {α : Sort u} {β : α → Type v} {γ : (a : α) → (b : β a) → Sort w}
+    (f : (a : α) → (b : β a) → γ a b)
+    {α α' a a'} (h : α = α') (h' : HEq a a') : HEq (f α a) (f α' a') := by
+  cases h; cases h'; rfl
+
+private theorem congrArg₄ {α : Sort u} {β : (a : α) → Sort v} {γ : (a : α) → (b : β a) → Sort w}
+    {δ : (a : α) → (b : β a) → (c : γ a b) → Sort x} {ε : (a : α) → (b : β a) → (c : γ a b) →
+      (d : δ a b c) → Sort y}
+    (f : (a : α) → (b : β a) → (c : γ a b) → (d : δ a b c) → ε a b c d)
+    {a a' b b' c c' d d'} (h₁ : a = a') (h₂ : HEq b b') (h₃ : HEq c c') (h₄ : HEq d d') :
+    HEq (f a b c d) (f a' b' c' d') := by
+  cases h₁; cases h₂; cases h₃; cases h₄; rfl
+
+@[simp]
+protected theorem PostconditionT.map_pure {m : Type w → Type w'} [Monad m] [LawfulMonad m]
+    {α : Type w} {β : Type w} {f : α → β} {a : α} :
+    (pure a : PostconditionT m α).map f = pure (f a) := by
+  simp only [PostconditionT.map, pure, map_pure, mk.injEq, Subtype.exists, exists_prop,
+    exists_eq_left', true_and]
+  apply congrArg₂ (f := fun α (a : α) => (pure a : m _)) (by simp)
+  apply congrArg₂ (f := fun α (a : α) => a)
+  · simp
+  · apply congrArg₄ fun β (p : β → Prop) (x : β) (h : p x) => Subtype.mk x h
+    · rfl
+    · simp
+    · rfl
+    · simp
+
+@[simp]
+theorem PostconditionT.property_map {m : Type w → Type w'} [Functor m] {α : Type w} {β : Type w}
+    {x : PostconditionT m α} {f : α → β} {b : β} :
+    (x.map f).Property b ↔ (∃ a, f a = b ∧ x.Property a) := by
+  simp only [PostconditionT.map]
+  apply Iff.intro
+  · rintro ⟨⟨a, ha⟩, h⟩
+    exact ⟨a, h, ha⟩
+  · rintro ⟨a, h, ha⟩
+    exact ⟨⟨a, ha⟩, h⟩
+
+@[simp]
+theorem PostconditionT.operation_map {m : Type w → Type w'} [Functor m] {α : Type w} {β : Type w}
+    {x : PostconditionT m α} {f : α → β} :
+    (x.map f).operation = (fun a => ⟨_, a, rfl⟩) <$> x.operation :=
+  rfl
+
+@[simp]
+theorem PostconditionT.operation_lift {m : Type w →Type w'} [Functor m] {α : Type w}
+    {x : m α} : (lift x : PostconditionT m α).operation = (⟨·, True.intro⟩) <$> x :=
+  rfl
+
+end Std.Iterators

src/Std/Data/Iterators/Producers.lean

@@ -5,4 +5,6 @@ Authors: Paul Reichert
 -/
 prelude
 import Std.Data.Iterators.Producers.Monadic
+import Std.Data.Iterators.Producers.Array
 import Std.Data.Iterators.Producers.List
+import Std.Data.Iterators.Producers.Repeat

src/Std/Data/Iterators/Producers/Array.lean

@@ -0,0 +1,49 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Std.Data.Iterators.Producers.Monadic.Array
+
+/-!
+# Array iterator
+
+This module provides an iterator for arrays that is accessible via `Array.iter`.
+-/
+
+namespace Std.Iterators
+
+/--
+Returns a finite iterator for the given array starting at the given index.
+The iterator yields the elements of the array in order and then terminates.
+
+The monadic version of this iterator is `Array.iterFromIdxM`.
+
+**Termination properties:**
+
+* `Finite` instance: always
+* `Productive` instance: always
+-/
+@[always_inline, inline]
+def _root_.Array.iterFromIdx {α : Type w} (l : Array α) (pos : Nat) :
+    Iter (α := ArrayIterator α) α :=
+  ((l.iterFromIdxM Id pos).toIter : Iter α)
+
+/--
+Returns a finite iterator for the given array.
+The iterator yields the elements of the array in order and then terminates.
+
+The monadic version of this iterator is `Array.iterM`.
+
+**Termination properties:**
+
+* `Finite` instance: always
+* `Productive` instance: always
+-/
+@[always_inline, inline]
+def _root_.Array.iter {α : Type w} (l : Array α) :
+    Iter (α := ArrayIterator α) α :=
+  ((l.iterM Id).toIter : Iter α)
+
+end Std.Iterators

src/Std/Data/Iterators/Producers/Monadic.lean

@@ -4,4 +4,5 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Paul Reichert
 -/
 prelude
+import Std.Data.Iterators.Producers.Monadic.Array
 import Std.Data.Iterators.Producers.Monadic.List

src/Std/Data/Iterators/Producers/Monadic/Array.lean

@@ -0,0 +1,120 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Init.Data.Nat.Lemmas
+import Init.RCases
+import Std.Data.Iterators.Consumers
+import Std.Data.Iterators.Internal.Termination
+
+/-!
+# Array iterator
+
+This module provides an iterator for arrays that is accessible via `Array.iterM`.
+-/
+
+namespace Std.Iterators
+
+variable {α : Type w} {m : Type w → Type w'}
+
+/--
+The underlying state of a list iterator. Its contents are internal and should
+not be used by downstream users of the library.
+-/
+@[unbox]
+structure ArrayIterator (α : Type w) where
+  /-- Internal implementation detail of the iterator library. -/
+  array : Array α
+  /-- Internal implementation detail of the iterator library. -/
+  pos : Nat
+
+/--
+Returns a finite monadic iterator for the given array starting at the given index.
+The iterator yields the elements of the array in order and then terminates.
+
+The pure version of this iterator is `Array.iterFromIdx`.
+
+**Termination properties:**
+
+* `Finite` instance: always
+* `Productive` instance: always
+-/
+@[always_inline, inline]
+def _root_.Array.iterFromIdxM {α : Type w} (array : Array α) (m : Type w → Type w') (pos : Nat)
+    [Pure m] :
+    IterM (α := ArrayIterator α) m α :=
+  toIterM { array := array, pos := pos } m α
+
+/--
+Returns a finite monadic iterator for the given array.
+The iterator yields the elements of the array in order and then terminates. There are no side
+effects.
+
+The pure version of this iterator is `Array.iter`.
+
+**Termination properties:**
+
+* `Finite` instance: always
+* `Productive` instance: always
+-/
+@[always_inline, inline]
+def _root_.Array.iterM {α : Type w} (array : Array α) (m : Type w → Type w') [Pure m] :
+    IterM (α := ArrayIterator α) m α :=
+  array.iterFromIdxM m 0
+
+@[always_inline, inline]
+instance {α : Type w} [Pure m] : Iterator (ArrayIterator α) m α where
+  IsPlausibleStep it
+    | .yield it' out => it.internalState.array = it'.internalState.array ∧
+      it'.internalState.pos = it.internalState.pos + 1 ∧
+      ∃ _ : it.internalState.pos < it.internalState.array.size,
+      it.internalState.array[it.internalState.pos] = out
+    | .skip _ => False
+    | .done => it.internalState.pos ≥ it.internalState.array.size
+  step it := pure <| if h : it.internalState.pos < it.internalState.array.size then
+        .yield
+          ⟨⟨it.internalState.array, it.internalState.pos + 1⟩⟩
+          it.internalState.array[it.internalState.pos]
+          ⟨rfl, rfl, h, rfl⟩
+      else
+        .done (Nat.not_lt.mp h)
+
+private def ArrayIterator.finitenessRelation [Pure m] :
+    FinitenessRelation (ArrayIterator α) m where
+  rel := InvImage WellFoundedRelation.rel
+      (fun it => it.internalState.array.size - it.internalState.pos)
+  wf := InvImage.wf _ WellFoundedRelation.wf
+  subrelation {it it'} h := by
+    simp_wf
+    obtain ⟨step, h, h'⟩ := h
+    cases step
+    · cases h
+      obtain ⟨h, h', h'', rfl⟩ := h'
+      rw [h] at h''
+      rw [h, h']
+      omega
+    · cases h'
+    · cases h
+
+instance [Pure m] : Finite (ArrayIterator α) m :=
+  Finite.of_finitenessRelation ArrayIterator.finitenessRelation
+
+@[always_inline, inline]
+instance {α : Type w} [Monad m] [Monad n] : IteratorCollect (ArrayIterator α) m n :=
+  .defaultImplementation
+
+@[always_inline, inline]
+instance {α : Type w} [Monad m] [Monad n] : IteratorCollectPartial (ArrayIterator α) m n :=
+  .defaultImplementation
+
+@[always_inline, inline]
+instance {α : Type w} [Monad m] [Monad n] : IteratorLoop (ArrayIterator α) m n :=
+  .defaultImplementation
+
+@[always_inline, inline]
+instance {α : Type w} [Monad m] [Monad n] : IteratorLoopPartial (ArrayIterator α) m n :=
+  .defaultImplementation
+
+end Std.Iterators

src/Std/Data/Iterators/Producers/Monadic/List.lean

@@ -17,7 +17,7 @@ This module provides an iterator for lists that is accessible via `List.iterM`.
 
 namespace Std.Iterators
 
-variable {α : Type w} {m : Type w → Type w'}
+variable {α : Type w} {m : Type w → Type w'} {n : Type w → Type w''}
 
 /--
 The underlying state of a list iterator. Its contents are internal and should
@@ -58,11 +58,11 @@ instance [Pure m] : Finite (ListIterator α) m :=
   Finite.of_finitenessRelation ListIterator.finitenessRelation
 
 @[always_inline, inline]
-instance {α : Type w} [Monad m] : IteratorCollect (ListIterator α) m :=
+instance {α : Type w} [Monad m] [Monad n] : IteratorCollect (ListIterator α) m n :=
   .defaultImplementation
 
 @[always_inline, inline]
-instance {α : Type w} [Monad m] : IteratorCollectPartial (ListIterator α) m :=
+instance {α : Type w} [Monad m] [Monad n] : IteratorCollectPartial (ListIterator α) m n :=
   .defaultImplementation
 
 @[always_inline, inline]

src/Std/Data/Iterators/Producers/Repeat.lean

@@ -0,0 +1,83 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+prelude
+import Std.Data.Iterators.Consumers.Monadic
+import Std.Data.Iterators.Internal.Termination
+
+/-!
+# Function-unfolding iterator
+
+This module provides an infinite iterator that given an initial value `init`  function `f` emits
+the iterates `init`, `f init`, `f (f init)`, ... .
+-/
+
+namespace Std.Iterators
+
+universe u v
+
+variable {α : Type w} {m : Type w → Type w'} {f : α → α}
+
+/--
+Internal state of the `repeat` combinator. Do not depend on its internals.
+-/
+@[unbox]
+structure RepeatIterator (α : Type u) (f : α → α) where
+  /-- Internal implementation detail of the iterator library. -/
+  next : α
+
+@[always_inline, inline]
+instance : Iterator (RepeatIterator α f) Id α where
+  IsPlausibleStep it
+    | .yield it' out => out = it.internalState.next ∧ it' = ⟨⟨f it.internalState.next⟩⟩
+    | .skip _ => False
+    | .done => False
+  step it := pure <| .yield ⟨⟨f it.internalState.next⟩⟩ it.internalState.next (by simp)
+
+/--
+Creates an infinite iterator from an initial value `init` and a function `f : α → α`.
+First it yields `init`, and in each successive step, the iterator applies `f` to the previous value.
+So the iterator just emitted `a`, in the next step it will yield `f a`. In other words, the
+`n`-th value is `Nat.repeat f n init`.
+
+For example, if `f := (· + 1)` and `init := 0`, then the iterator emits all natural numbers in
+order.
+
+**Termination properties:**
+
+* `Finite` instance: not available and never possible
+* `Productive` instance: always
+-/
+@[always_inline, inline]
+def Iter.repeat {α : Type w} (f : α → α) (init : α) :=
+  (⟨RepeatIterator.mk (f := f) init⟩ : Iter α)
+
+private def RepeatIterator.instProductivenessRelation :
+    ProductivenessRelation (RepeatIterator α f) Id where
+  rel := emptyWf.rel
+  wf := emptyWf.wf
+  subrelation {it it'} h := by cases h
+
+instance RepeatIterator.instProductive :
+    Productive (RepeatIterator α f) Id :=
+  Productive.of_productivenessRelation instProductivenessRelation
+
+instance RepeatIterator.instIteratorLoop {α : Type w} {f : α → α} {n : Type w → Type w'} [Monad n] :
+    IteratorLoop (RepeatIterator α f) Id n :=
+  .defaultImplementation
+
+instance RepeatIterator.instIteratorLoopPartial {α : Type w} {f : α → α} {n : Type w → Type w'}
+    [Monad n] : IteratorLoopPartial (RepeatIterator α f) Id n :=
+  .defaultImplementation
+
+instance RepeatIterator.instIteratorCollect {α : Type w} {f : α → α} {n : Type w → Type w'}
+    [Monad n] : IteratorCollect (RepeatIterator α f) Id n :=
+  .defaultImplementation
+
+instance RepeatIterator.instIteratorCollectPartial {α : Type w} {f : α → α} {n : Type w → Type w'}
+    [Monad n] : IteratorCollectPartial (RepeatIterator α f) Id n :=
+  .defaultImplementation
+
+end Std.Iterators

src/kernel/expr.cpp

@@ -102,6 +102,29 @@ bool has_univ_param(expr const & e) { return lean_expr_has_level_param(e.to_obj_
 extern "C" unsigned lean_expr_loose_bvar_range(object * e);
 unsigned get_loose_bvar_range(expr const & e) { return lean_expr_loose_bvar_range(e.to_obj_arg()); }
 
+extern "C" LEAN_EXPORT uint64_t lean_expr_mk_data(uint64_t hash, object * bvarRange, uint32_t approxDepth, uint8_t hasFVar, uint8_t hasExprMVar, uint8_t hasLevelMVar, uint8_t hasLevelParam) {
+    if (approxDepth > 255) approxDepth = 255;
+    if (!is_scalar(bvarRange)) lean_internal_panic("too many bound variables");
+    size_t range = unbox(bvarRange);
+    if (range > 1048575) lean_internal_panic("too many bound variables");
+    uint32_t r = range;
+    uint32_t h = hash;
+    return ((uint64_t) h) + (((uint64_t) approxDepth) << 32) + (((uint64_t) hasFVar) << 40)
+    + (((uint64_t) hasExprMVar) << 41) + (((uint64_t) hasLevelMVar) << 42) + (((uint64_t) hasLevelParam) << 43)
+    + (((uint64_t) r) << 44);
+}
+
+inline uint16_t get_approx_depth(uint64_t data) { return (data >> 32) & 255; }
+inline uint32_t get_bvar_range(uint64_t data) { return data >> 44; }
+
+extern "C" LEAN_EXPORT uint64_t lean_expr_mk_app_data(uint64_t fData, uint64_t aData) {
+  uint16_t depth = std::max(get_approx_depth(fData), get_approx_depth(aData)) + 1;
+  if (depth > 255) depth = 255;
+  uint32_t range = std::max(get_bvar_range(fData), get_bvar_range(aData));
+  uint32_t h = hash(fData, aData);
+  return ((fData | aData) & (((uint64_t) 15) << 40)) | ((uint64_t) h) | (((uint64_t) depth) << 32) | (((uint64_t) range) << 44);
+}
+
 // =======================================
 // Constructors
 

src/kernel/level.cpp

@@ -41,6 +41,16 @@ unsigned get_depth(level const & l) { return lean_level_depth(l.to_obj_arg()); }
 bool has_param(level const & l) { return lean_level_has_param(l.to_obj_arg()); }
 bool has_mvar(level const & l) { return lean_level_has_mvar(l.to_obj_arg()); }
 
+extern "C" LEAN_EXPORT uint64_t lean_level_mk_data (uint64_t h, object * depth, uint8_t hasMVar, uint8_t hasParam) {
+    if (!is_scalar(depth))
+        lean_internal_panic("universe level depth is too big");
+    size_t d = unbox(depth);
+    if (d > 16777215)
+        lean_internal_panic("universe level depth is too big");
+    uint32_t h1 = h;
+    return ((uint64_t) h1) + (((uint64_t) hasMVar) << 32) + (((uint64_t) hasParam) << 33) + (((uint64_t)d) << 40);
+}
+
 bool is_explicit(level const & l) {
     switch (kind(l)) {
     case level_kind::Zero:

src/lake/Lake/Build/Actions.lean

@@ -7,6 +7,7 @@ prelude
 import Lake.Config.Dynlib
 import Lake.Util.Proc
 import Lake.Util.NativeLib
+import Lake.Util.FilePath
 import Lake.Util.IO
 
 /-! # Common Build Actions
@@ -19,7 +20,7 @@ open Lean hiding SearchPath
 namespace Lake
 
 def compileLeanModule
-  (leanFile : FilePath)
+  (leanFile relLeanFile : FilePath)
   (oleanFile? ileanFile? cFile? bcFile?: Option FilePath)
   (leanPath : SearchPath := []) (rootDir : FilePath := ".")
   (dynlibs plugins : Array Dynlib := #[])
@@ -57,6 +58,7 @@ def compileLeanModule
       if let .ok (msg : SerialMessage) := Json.parse ln >>= fromJson? then
         unless txt.isEmpty do
           logInfo s!"stdout:\n{txt}"
+        let msg := {msg with fileName := mkRelPathString relLeanFile}
         logSerialMessage msg
         return txt
       else if txt.isEmpty && ln.isEmpty then

src/lake/Lake/Build/Common.lean

@@ -451,8 +451,8 @@ def buildSharedLib
   (extraDepTrace : JobM _ := pure BuildTrace.nil)
   (plugin := false) (linkDeps := Platform.isWindows)
 : SpawnM (Job Dynlib) :=
-  (Job.collectArray linkObjs "linkObjs").bindM fun objs => do
-  (Job.collectArray linkLibs "linkLibs").mapM (sync := true) fun libs => do
+  (Job.collectArray linkObjs "linkObjs").bindM (sync := true) fun objs => do
+  (Job.collectArray linkLibs "linkLibs").mapM fun libs => do
     addPureTrace traceArgs "traceArgs"
     addPlatformTrace -- shared libraries are platform-dependent artifacts
     addTrace (← extraDepTrace)
@@ -472,8 +472,8 @@ def buildLeanSharedLib
   (weakArgs traceArgs : Array String := #[]) (plugin := false)
   (linkDeps := Platform.isWindows)
 : SpawnM (Job Dynlib) :=
-  (Job.collectArray linkObjs "linkObjs").bindM fun objs => do
-  (Job.collectArray linkLibs "linkLibs").mapM (sync := true) fun libs => do
+  (Job.collectArray linkObjs "linkObjs").bindM (sync := true) fun objs => do
+  (Job.collectArray linkLibs "linkLibs").mapM fun libs => do
     addLeanTrace
     addPureTrace traceArgs "traceArgs"
     addPlatformTrace -- shared libraries are platform-dependent artifacts
@@ -494,8 +494,8 @@ def buildLeanExe
   (linkObjs : Array (Job FilePath)) (linkLibs : Array (Job Dynlib))
   (weakArgs traceArgs : Array String := #[]) (sharedLean : Bool := false)
 : SpawnM (Job FilePath) :=
-  (Job.collectArray linkObjs "linkObjs").bindM fun objs => do
-  (Job.collectArray linkLibs "linkLibs").mapM (sync := true) fun libs => do
+  (Job.collectArray linkObjs "linkObjs").bindM (sync := true) fun objs => do
+  (Job.collectArray linkLibs "linkLibs").mapM fun libs => do
     addLeanTrace
     addPureTrace traceArgs "traceArgs"
     addPlatformTrace -- executables are platform-dependent artifacts

src/lake/Lake/Build/Imports.lean

@@ -36,9 +36,9 @@ def buildImportsAndDeps
     let impLibsJob ← fetchImportLibs precompileImports
     let dynlibsJob ← root.dynlibs.fetchIn root
     let pluginsJob ← root.plugins.fetchIn root
-    modJob.bindM fun _ =>
+    modJob.bindM (sync := true) fun _ =>
     impLibsJob.bindM (sync := true) fun impLibs =>
     dynlibsJob.bindM (sync := true) fun dynlibs =>
     pluginsJob.bindM (sync := true) fun plugins =>
-    externLibsJob.mapM (sync := true) fun externLibs => do
+    externLibsJob.mapM fun externLibs => do
       computeModuleDeps impLibs externLibs dynlibs plugins

src/lake/Lake/Build/Module.lean

@@ -105,11 +105,15 @@ def Module.precompileImportsFacetConfig : ModuleFacetConfig precompileImportsFac
 def fetchExternLibs (pkgs : Array Package) : FetchM (Job (Array Dynlib)) :=
   Job.collectArray <$> pkgs.flatMapM (·.externLibs.mapM (·.dynlib.fetch))
 
-private def Module.fetchImportLibsCore
+/--
+Computes the transitive dynamic libraries of a module's imports.
+Modules from the same library are loaded individually, while modules
+from other libraries are loaded as part of the whole library.
+-/
+private def Module.fetchImportLibs
   (self : Module) (imps : Array Module) (compileSelf : Bool)
-  (init : NameSet × Array (Job Dynlib))
-: FetchM (NameSet × Array (Job Dynlib)) :=
-  imps.foldlM (init := init) fun (libs, jobs) imp => do
+: FetchM (Array (Job Dynlib)) := do
+  let (_, jobs) ← imps.foldlM (init := (({} : NameSet), #[])) fun (libs, jobs) imp => do
     if libs.contains imp.lib.name then
       return (libs, jobs)
     else if compileSelf && self.lib.name = imp.lib.name then
@@ -120,28 +124,26 @@ private def Module.fetchImportLibsCore
       return (libs.insert imp.lib.name, jobs)
     else
       return (libs, jobs)
-/--
-Computes the transitive dynamic libraries of a module's imports.
-Modules from the same library are loaded individually, while modules
-from other libraries are loaded as part of the whole library.
--/
-@[inline] private def Module.fetchImportLibs
-  (self : Module) (imps : Array Module) (compileSelf : Bool)
-: FetchM (Array (Job Dynlib)) :=
-  (·.2) <$> self.fetchImportLibsCore imps compileSelf ({}, #[])
+  return jobs
 
-/-- Fetch the dynlibs of a list of imports. **For internal use.**  -/
-@[inline] def fetchImportLibs
+/--
+**For internal use.**
+
+Fetches the library dynlibs of a list of non-local imports.
+Modules are loaded as part of their whole library.
+-/
+def fetchImportLibs
   (mods : Array Module) : FetchM (Job (Array Dynlib))
 := do
-  let (_, jobs) ← mods.foldlM (init := ({}, #[])) fun s mod => do
-    let imports ← (← mod.imports.fetch).await
-    mod.fetchImportLibsCore imports mod.shouldPrecompile s
-  let jobs ← mods.foldlM (init := jobs) fun jobs mod => do
-    if mod.shouldPrecompile then
-      jobs.push <$> mod.dynlib.fetch
-    else return jobs
-  return Job.collectArray jobs
+  let (_, jobs) ← mods.foldlM (init := (({} : NameSet), #[])) fun (libs, jobs) imp => do
+    if libs.contains imp.lib.name then
+      return (libs, jobs)
+    else if imp.shouldPrecompile then
+      let jobs ← jobs.push <$> imp.lib.shared.fetch
+      return (libs.insert imp.lib.name, jobs)
+    else
+      return (libs, jobs)
+  return Job.collectArray jobs "import dynlibs"
 
 /--
 Topologically sorts the library dependency tree by name.
@@ -229,13 +231,13 @@ def Module.recBuildDeps (mod : Module) : FetchM (Job ModuleDeps) := ensureJob do
   let dynlibsJob ← mod.dynlibs.fetchIn mod.pkg "module dynlibs"
   let pluginsJob ← mod.plugins.fetchIn mod.pkg "module plugins"
 
-  extraDepJob.bindM fun _ => do
+  extraDepJob.bindM (sync := true) fun _ => do
   importJob.bindM (sync := true) fun _ => do
   let depTrace ← takeTrace
   impLibsJob.bindM (sync := true) fun impLibs => do
   externLibsJob.bindM (sync := true) fun externLibs => do
   dynlibsJob.bindM (sync := true) fun dynlibs => do
-  pluginsJob.mapM (sync := true) fun plugins => do
+  pluginsJob.mapM fun plugins => do
     let libTrace ← takeTrace
     setTraceCaption s!"{mod.name.toString}:deps"
     let depTrace := depTrace.withCaption "deps"
@@ -280,7 +282,7 @@ def Module.recBuildLean (mod : Module) : FetchM (Job Unit) := do
     addTrace srcTrace
     setTraceCaption s!"{mod.name.toString}:leanArts"
     let upToDate ← buildUnlessUpToDate? (oldTrace := srcTrace.mtime) mod (← getTrace) mod.traceFile do
-      compileLeanModule mod.leanFile mod.oleanFile mod.ileanFile mod.cFile mod.bcFile?
+      compileLeanModule mod.leanFile mod.relLeanFile mod.oleanFile mod.ileanFile mod.cFile mod.bcFile?
         (← getLeanPath) mod.rootDir dynlibs plugins
         (mod.weakLeanArgs ++ mod.leanArgs) (← getLean)
       mod.clearOutputHashes
@@ -419,7 +421,14 @@ Recursively build the shared library of a module
 -/
 def Module.recBuildDynlib (mod : Module) : FetchM (Job Dynlib) :=
   withRegisterJob s!"{mod.name}:dynlib" do
-  -- Fetch object files
+  /-
+  Fetch the module's object files.
+
+  NOTE: The `moreLinkObjs` of the module's library are not included
+  here because they would then be linked to the dynlib of each module of the library.
+  On Windows, were module dynlibs must be linked with those of their imports, this would
+  result in duplicate symbols when one library module imports another of the same library.
+  -/
   let objJobs ← (mod.nativeFacets true).mapM (·.fetch mod)
   -- Fetch dependencies' dynlibs
   let libJobs ← id do

src/lake/Lake/Config/Module.lean

@@ -82,6 +82,12 @@ abbrev pkg (self : Module) : Package :=
 @[inline] def leanFile (self : Module) : FilePath :=
   self.srcPath "lean"
 
+@[inline] def relLeanFile (self : Module) : FilePath :=
+  if let some relPath := self.leanFile.toString.dropPrefix? self.pkg.dir.toString then
+    FilePath.mk (relPath.drop 1).toString -- remove leading `/`
+  else
+    self.leanFile
+
 @[inline] def leanLibPath (ext : String) (self : Module) : FilePath :=
   self.filePath self.pkg.leanLibDir ext
 

src/lake/tests/8448/A.lean

@@ -0,0 +1,2 @@
+@[extern "increment8"]
+opaque A.increment8 : Int8 → Int8

src/lake/tests/8448/B.lean

@@ -0,0 +1,5 @@
+import A
+
+def B.increment8 := A.increment8
+
+#eval B.increment8 1

src/lake/tests/8448/C.lean

@@ -0,0 +1,5 @@
+import A
+
+def C.increment8 := A.increment8
+
+#eval C.increment8 1

src/lake/tests/8448/D.lean

@@ -0,0 +1,5 @@
+import B
+
+def D.increment8 := A.increment8
+
+#eval D.increment8 1

src/lake/tests/8448/a.c

@@ -0,0 +1,5 @@
+#include <stdint.h>
+
+extern int8_t increment8(int8_t num) {
+  return num + 1;
+}

src/lake/tests/8448/clean.sh

@@ -0,0 +1 @@
+rm -rf .lake lake-manifest.json produced.out

src/lake/tests/8448/lakefile.lean

@@ -0,0 +1,24 @@
+import Lake
+
+open Lake DSL System
+
+package ffi
+
+input_file a.c where
+  path := "a.c"
+  text := true
+
+target a.o pkg : FilePath := do
+  let srcJob ← a.c.fetch
+  let oFile := pkg.buildDir / "a" / "a.o"
+  let flags := #["-fPIC"]
+  buildO oFile srcJob flags
+
+@[default_target]
+lean_lib A where
+  precompileModules := true
+  moreLinkObjs := #[a.o]
+
+@[default_target]
+lean_lib B where
+  --precompileModules := true

src/lake/tests/8448/test.sh

@@ -0,0 +1,15 @@
+#!/usr/bin/env bash
+source ../common.sh
+
+./clean.sh
+
+# Tests FFI precompilation across multiple libraries.
+# https://github.com/leanprover/lean4/issues/8448
+
+test_run build
+test_out_pat '^2$' lean B.lean
+test_out_pat '^2$' lean C.lean
+test_out_pat '^2$' lean D.lean
+
+# Cleanup
+rm -f produced.out

src/lake/tests/common.sh

@@ -126,6 +126,17 @@ match_text() {
   fi
 }
 
+match_pat() {
+  echo "? grep -E \"$1\""
+  if grep --color -E -- "$1" $2; then
+    return 0
+  else
+    echo "No match found"
+    return 1
+  fi
+}
+
+
 no_match_text() {
   echo "! grep -F \"$1\""
   if grep --color -F -- "$1" $2; then
@@ -151,6 +162,13 @@ test_out() {
   return $rc
 }
 
+test_out_pat() {
+  expected=$1; shift
+  if lake_out "$@"; then rc=$?; else rc=$?; fi
+  match_pat "$expected" produced.out
+  return $rc
+}
+
 test_cmd_out() {
   expected=$1; shift
   if program_out "$@"; then rc=$?; else rc=$?; fi

src/runtime/object.cpp

@@ -73,8 +73,10 @@ static void abort_on_panic() {
     }
 }
 
+FILE * g_saved_stderr = stderr;
+
 extern "C" LEAN_EXPORT void lean_internal_panic(char const * msg) {
-    std::cerr << "INTERNAL PANIC: " << msg << "\n";
+    fprintf(g_saved_stderr, "INTERNAL PANIC: %s\n", msg);
     abort_on_panic();
     std::exit(1);
 }
@@ -2653,6 +2655,7 @@ extern "C" LEAN_EXPORT lean_external_class * lean_register_external_class(lean_e
 }
 
 void initialize_object() {
+    g_saved_stderr = stderr;  // Save original pointer early
     g_ext_classes       = new std::vector<external_object_class*>();
     g_ext_classes_mutex = new mutex();
     g_array_empty       = lean_alloc_array(0, 0);

tests/lean/grind/list_count.lean

@@ -1,32 +0,0 @@
-open List
-
-set_option grind.warning false
-
-variable [BEq α] [LawfulBEq α]
-
--- These tests should move back to `tests/lean/run/grind_list_count.lean` once fixed.
-
-theorem count_pos_iff {a : α} {l : List α} : 0 < count a l ↔ a ∈ l := by
-  induction l with grind -- fails, having proved `head = a` is false and `head == a` is true.
-
-theorem one_le_count_iff {a : α} {l : List α} : 1 ≤ count a l ↔ a ∈ l := by
-  induction l with grind -- fails, similarly
-
-theorem count_eq_zero_of_not_mem {a : α} {l : List α} (h : a ∉ l) : count a l = 0 := by
-  induction l with grind -- fails
-
-theorem count_eq_zero {l : List α} : count a l = 0 ↔ a ∉ l := by
-  induction l with grind -- fails
-
-theorem count_filter {l : List α} (h : p a) : count a (filter p l) = count a l := by
-  induction l with grind -- similarly
-
-theorem count_le_count_map {β} [BEq β] [LawfulBEq β] {l : List α} {f : α → β} {x : α} :
-    count x l ≤ count (f x) (map f l) := by
-  induction l with grind
-
-theorem count_erase {a b : α} {l : List α} : count a (l.erase b) = count a l - if b == a then 1 else 0 := by
-  induction l with grind [-List.count_erase]
-  -- fails with inconsistent equivalence clases:
-  -- [] {head == a, false}
-  -- [] {b == a, head == b, true}

tests/lean/grind/product_eta.lean

@@ -1,19 +0,0 @@
--- In nightly-2025-05-27 this leads to grind internal error "trying to assert equality c = (c.fst, c.snd) with proof Eq.refl c which has type c = c which is not definitionally equal with `reducible` transparency setting"
-
-set_option grind.warning false
-set_option grind.debug true
-
-
-def α : Type := Unit × Unit
-
-def p (_ : α) : Prop := False
-/--
-error: tactic 'grind.cases' failed, (non-recursive) inductive type expected at c
-  α
-case grind
-c : α
-h : p c
-⊢ False
--/
-#guard_msgs in
-example : p c → False := by grind

tests/lean/run/grind_bool_prop.lean

@@ -1,3 +1,4 @@
+set_option grind.warning false
 example (f : Bool → Nat) : f (a && b) = 0 → a = false → f false = 0 := by grind (splits := 0)
 example (f : Bool → Nat) : f (a && b) = 0 → b = false → f false = 0 := by grind (splits := 0)
 example (f : Bool → Nat) : f (a && b) = 0 → a = true → f b = 0 := by grind (splits := 0)
@@ -31,3 +32,7 @@ example (a b : Bool) : (a ^^ b, c) = d → d = (false, true) → a = b := by gri
 example (a b : Bool) : (a == b, c) = d → d = (true, true) → a = true → true = b := by grind (splits := 0)
 
 example (h : α = β) (a : α) (b : β) : h ▸ a = b → HEq a b := by grind
+
+example {α : Type u} [BEq α] [LawfulBEq α] (x : Nat) (a b : α)
+    : x = (if a == b then 2 else 1) → x = (if (b == a) then 1 else 2) → False := by
+  grind

tests/lean/run/grind_congr_hash_issue.lean

@@ -0,0 +1,26 @@
+set_option grind.warning false
+set_option grind.debug true
+
+opaque f : Nat → Nat
+opaque g : (Nat → Nat) → Prop
+
+example
+    : f a = x →
+      -- At this point `f` has not been internalized
+      g f →
+      -- Since `f` has now occurred as the argument of `f`, it is internalized
+      f b = y →
+      -- The congruence hash for `f a` must not depend on whether `f` has been internalized or not
+      b = a →
+      x = y := by
+  grind
+
+-- Same example with `a = b` to ensure the previous issue does not depend on how we break
+-- ties when merging equivalence classes of the same size
+example
+    : f a = x →
+      g f →
+      f b = y →
+      a = b →
+      x = y := by
+  grind

tests/lean/run/grind_fastEraseDups.lean

@@ -24,6 +24,10 @@ where
       eraseDupsBy.loop (· == ·) l seenl = fastEraseDups.go l seenl seen := by
     induction l generalizing seenl seen with
     | nil => grind [eraseDupsBy.loop, fastEraseDups.go]
-    | cons x => cases h : seenl.contains x <;> grind [eraseDupsBy.loop, fastEraseDups.go]
+    | cons x =>
+      -- In the following example `BEq` is not lawful. To complete the proof we need to add `BEq.comm`
+      -- TODO: add support for arbitrary partial equivalence and equivalence relations.
+      -- Remark: `BEq.comm` is noise when `BEq` is lawful.
+      cases h : seenl.contains x <;> grind [eraseDupsBy.loop, fastEraseDups.go, BEq.comm]
 
 end List

tests/lean/run/grind_ite_congr.lean

@@ -7,4 +7,4 @@ example : ((if (!false) = true then id else id) false) = false := by
   decide
 
 example : ((if (!false) = true then id else id) false) = false := by
-  grind -- fails
+  grind -- must not fail

tests/lean/run/grind_list2.lean

@@ -1288,3 +1288,5 @@ end Hidden
 
 example {xs : List α} {i : Nat} (h : i < xs.length) : xs.take i ++ xs[i] :: xs.drop (i + 1) = xs := by
   apply List.ext_getElem <;> grind (splits := 10)
+
+example : (List.range 1).sum = 0 := by grind

tests/lean/run/grind_list_count.lean

@@ -186,4 +186,26 @@ theorem count_erase_self {a : α} {l : List α} :
 theorem count_erase_of_ne (ab : a ≠ b) {l : List α} : count a (l.erase b) = count a l := by
   grind
 
+theorem count_pos_iff {a : α} {l : List α} : 0 < count a l ↔ a ∈ l := by
+  induction l with grind
+
+theorem one_le_count_iff {a : α} {l : List α} : 1 ≤ count a l ↔ a ∈ l := by
+  induction l with grind
+
+theorem count_eq_zero_of_not_mem {a : α} {l : List α} (h : a ∉ l) : count a l = 0 := by
+  induction l with grind
+
+theorem count_eq_zero {l : List α} : count a l = 0 ↔ a ∉ l := by
+  induction l with grind
+
+theorem count_filter {l : List α} (h : p a) : count a (filter p l) = count a l := by
+  induction l with grind
+
+theorem count_le_count_map {β} [BEq β] [LawfulBEq β] {l : List α} {f : α → β} {x : α} :
+    count x l ≤ count (f x) (map f l) := by
+  induction l with grind
+
+theorem count_erase {a b : α} {l : List α} : count a (l.erase b) = count a l - if b == a then 1 else 0 := by
+  induction l <;> grind [-List.count_erase]
+
 end count

tests/lean/run/grind_nested_proofs.lean

@@ -36,3 +36,17 @@ trace: [Meta.debug] [‹i < a.size›, ‹j < a.size›, ‹j < b.size›]
 #guard_msgs (trace) in
 example (i j : Nat) (a b : Array Nat) (h1 : j < a.size) (h : j < b.size) (h2 : i ≤ j) : a[i] < a[j] + b[j] → i = j → False := by
   grind -mbtc on_failure fallback
+
+namespace Test
+
+opaque p : Prop
+axiom hp : p
+opaque h : p → Prop
+
+example : h (@Lean.Grind.nestedProof p hp) → p := by
+  grind
+
+example : h hp → p := by
+  grind
+
+end Test

tests/lean/run/grind_offset_cnstr.lean

@@ -399,10 +399,5 @@ example (a : Nat) : a < 2 → a = 5 → False := by
 example (a : Nat) : a < 2 → a = b → b = c → c = 5 → False := by
   grind
 
-#guard_msgs (trace) in -- none of the numerals should be internalized by the offset module
-set_option trace.grind.offset.internalize true in
-example (a b c d e : Nat) : a = 1 → b = 2 → c = 3 → d = 4 → e = 5 → a ≠ e := by
-  grind
-
 example (a b : Nat) : a + 1 = b → b = 0 → False := by
   grind

tests/lean/run/grind_overapplied_ite.lean

@@ -0,0 +1,21 @@
+set_option grind.warning false
+
+example : (if (!false) = true then id else id) false = false := by
+  grind
+
+opaque q (h : ¬ (!false) = true) : Bool → Bool
+
+example : (if h : (!false) = true then id else q h) false = false := by
+  grind
+
+example [Decidable c] : (if c then id else id) false = false := by
+  grind
+
+opaque c : Prop
+opaque r (h : ¬ c) : Bool → Bool
+open Classical
+
+@[grind =] theorem rax : r h x = x := sorry
+
+example : (if h : c then id else r h) false = false := by
+  grind