mirror of
https://github.com/leanprover/lean4.git
synced 2026-03-21 20:34:07 +00:00
Compare commits
31 Commits
cutsat_pro
...
grind_offs
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
9d75976b15 | ||
|
|
adc7b1ed87 | ||
|
|
837193b5ec | ||
|
|
6940d2c4ff | ||
|
|
ed4252f8c9 | ||
|
|
8883ca0965 | ||
|
|
999fcd2d95 | ||
|
|
a8ab3f230c | ||
|
|
4f77e05225 | ||
|
|
90462e2551 | ||
|
|
a12f89aefa | ||
|
|
2d5e8ca311 | ||
|
|
d60cb88e62 | ||
|
|
d2e01bbd09 | ||
|
|
069fb4351c | ||
|
|
f54a65f72f | ||
|
|
3817dd57bd | ||
|
|
e68c6a38fb | ||
|
|
b7ec369863 | ||
|
|
3fdaf24b49 | ||
|
|
77e16407e4 | ||
|
|
efd8d149ea | ||
|
|
4316629119 | ||
|
|
020da5bffb | ||
|
|
bc8189b61d | ||
|
|
e30303e33c | ||
|
|
1879a2bafc | ||
|
|
3b72c7d193 | ||
|
|
22d4c1d803 | ||
|
|
0fe23b7fd6 | ||
|
|
72141b05fd |
@@ -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
|
||||
|
||||
11
src/Init/Control/Lawful/MonadLift.lean
Normal file
11
src/Init/Control/Lawful/MonadLift.lean
Normal file
@@ -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
|
||||
52
src/Init/Control/Lawful/MonadLift/Basic.lean
Normal file
52
src/Init/Control/Lawful/MonadLift/Basic.lean
Normal file
@@ -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
|
||||
137
src/Init/Control/Lawful/MonadLift/Instances.lean
Normal file
137
src/Init/Control/Lawful/MonadLift/Instances.lean
Normal file
@@ -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
|
||||
63
src/Init/Control/Lawful/MonadLift/Lemmas.lean
Normal file
63
src/Init/Control/Lawful/MonadLift/Lemmas.lean
Normal file
@@ -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 _ _
|
||||
@@ -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
|
||||
|
||||
@@ -142,17 +142,36 @@ private structure WorkItem where
|
||||
indent : Int
|
||||
activeTags : Nat
|
||||
|
||||
/--
|
||||
A directive indicating whether a given work group is able to be flattened.
|
||||
|
||||
- `allow` indicates that the group is allowed to be flattened; its argument is `true` if
|
||||
there is sufficient space for it to be flattened (and so it should be), or `false` if not.
|
||||
- `disallow` means that this group should not be flattened irrespective of space concerns.
|
||||
This is used at levels of a `Format` outside of any flattening groups. It is necessary to track
|
||||
this so that, after a hard line break, we know whether to try to flatten the next line.
|
||||
-/
|
||||
inductive FlattenAllowability where
|
||||
| allow (fits : Bool)
|
||||
| disallow
|
||||
deriving BEq
|
||||
|
||||
/-- Whether the given directive indicates that flattening should occur. -/
|
||||
def FlattenAllowability.shouldFlatten : FlattenAllowability → Bool
|
||||
| allow true => true
|
||||
| _ => false
|
||||
|
||||
private structure WorkGroup where
|
||||
flatten : Bool
|
||||
flb : FlattenBehavior
|
||||
items : List WorkItem
|
||||
fla : FlattenAllowability
|
||||
flb : FlattenBehavior
|
||||
items : List WorkItem
|
||||
|
||||
private partial def spaceUptoLine' : List WorkGroup → Nat → Nat → SpaceResult
|
||||
| [], _, _ => {}
|
||||
| { items := [], .. }::gs, col, w => spaceUptoLine' gs col w
|
||||
| g@{ items := i::is, .. }::gs, col, w =>
|
||||
merge w
|
||||
(spaceUptoLine i.f g.flatten (w + col - i.indent) w)
|
||||
(spaceUptoLine i.f g.fla.shouldFlatten (w + col - i.indent) w)
|
||||
(spaceUptoLine' ({ g with items := is }::gs) col)
|
||||
|
||||
/-- A monad in which we can pretty-print `Format` objects. -/
|
||||
@@ -169,11 +188,11 @@ open MonadPrettyFormat
|
||||
private def pushGroup (flb : FlattenBehavior) (items : List WorkItem) (gs : List WorkGroup) (w : Nat) [Monad m] [MonadPrettyFormat m] : m (List WorkGroup) := do
|
||||
let k ← currColumn
|
||||
-- Flatten group if it + the remainder (gs) fits in the remaining space. For `fill`, measure only up to the next (ungrouped) line break.
|
||||
let g := { flatten := flb == FlattenBehavior.allOrNone, flb := flb, items := items : WorkGroup }
|
||||
let g := { fla := .allow (flb == FlattenBehavior.allOrNone), flb := flb, items := items : WorkGroup }
|
||||
let r := spaceUptoLine' [g] k (w-k)
|
||||
let r' := merge (w-k) r (spaceUptoLine' gs k)
|
||||
-- Prevent flattening if any item contains a hard line break, except within `fill` if it is ungrouped (=> unflattened)
|
||||
return { g with flatten := !r.foundFlattenedHardLine && r'.space <= w-k }::gs
|
||||
return { g with fla := .allow (!r.foundFlattenedHardLine && r'.space <= w-k) }::gs
|
||||
|
||||
private partial def be (w : Nat) [Monad m] [MonadPrettyFormat m] : List WorkGroup → m Unit
|
||||
| [] => pure ()
|
||||
@@ -200,11 +219,15 @@ private partial def be (w : Nat) [Monad m] [MonadPrettyFormat m] : List WorkGrou
|
||||
pushNewline i.indent.toNat
|
||||
let is := { i with f := text (s.extract (s.next p) s.endPos) }::is
|
||||
-- after a hard line break, re-evaluate whether to flatten the remaining group
|
||||
pushGroup g.flb is gs w >>= be w
|
||||
-- note that we shouldn't start flattening after a hard break outside a group
|
||||
if g.fla == .disallow then
|
||||
be w (gs' is)
|
||||
else
|
||||
pushGroup g.flb is gs w >>= be w
|
||||
| line =>
|
||||
match g.flb with
|
||||
| FlattenBehavior.allOrNone =>
|
||||
if g.flatten then
|
||||
if g.fla.shouldFlatten then
|
||||
-- flatten line = text " "
|
||||
pushOutput " "
|
||||
endTags i.activeTags
|
||||
@@ -220,10 +243,10 @@ private partial def be (w : Nat) [Monad m] [MonadPrettyFormat m] : List WorkGrou
|
||||
endTags i.activeTags
|
||||
pushGroup FlattenBehavior.fill is gs w >>= be w
|
||||
-- if preceding fill item fit in a single line, try to fit next one too
|
||||
if g.flatten then
|
||||
if g.fla.shouldFlatten then
|
||||
let gs'@(g'::_) ← pushGroup FlattenBehavior.fill is gs (w - " ".length)
|
||||
| panic "unreachable"
|
||||
if g'.flatten then
|
||||
if g'.fla.shouldFlatten then
|
||||
pushOutput " "
|
||||
endTags i.activeTags
|
||||
be w gs' -- TODO: use `return`
|
||||
@@ -232,7 +255,7 @@ private partial def be (w : Nat) [Monad m] [MonadPrettyFormat m] : List WorkGrou
|
||||
else
|
||||
breakHere
|
||||
| align force =>
|
||||
if g.flatten && !force then
|
||||
if g.fla.shouldFlatten && !force then
|
||||
-- flatten (align false) = nil
|
||||
endTags i.activeTags
|
||||
be w (gs' is)
|
||||
@@ -247,7 +270,7 @@ private partial def be (w : Nat) [Monad m] [MonadPrettyFormat m] : List WorkGrou
|
||||
endTags i.activeTags
|
||||
be w (gs' is)
|
||||
| group f flb =>
|
||||
if g.flatten then
|
||||
if g.fla.shouldFlatten then
|
||||
-- flatten (group f) = flatten f
|
||||
be w (gs' ({ i with f }::is))
|
||||
else
|
||||
@@ -256,7 +279,7 @@ private partial def be (w : Nat) [Monad m] [MonadPrettyFormat m] : List WorkGrou
|
||||
/-- Render the given `f : Format` with a line width of `w`.
|
||||
`indent` is the starting amount to indent each line by. -/
|
||||
def prettyM (f : Format) (w : Nat) (indent : Nat := 0) [Monad m] [MonadPrettyFormat m] : m Unit :=
|
||||
be w [{ flb := FlattenBehavior.allOrNone, flatten := false, items := [{ f := f, indent, activeTags := 0 }]}]
|
||||
be w [{ flb := FlattenBehavior.allOrNone, fla := .disallow, items := [{ f := f, indent, activeTags := 0 }]}]
|
||||
|
||||
/-- Create a format `l ++ f ++ r` with a flatten group.
|
||||
FlattenBehaviour is `allOrNone`; for `fill` use `bracketFill`. -/
|
||||
|
||||
@@ -1564,8 +1564,8 @@ protected def erase {α} [BEq α] : List α → α → List α
|
||||
| true => as
|
||||
| false => a :: List.erase as b
|
||||
|
||||
@[simp] theorem erase_nil [BEq α] (a : α) : [].erase a = [] := rfl
|
||||
theorem erase_cons [BEq α] {a b : α} {l : List α} :
|
||||
@[simp, grind =] theorem erase_nil [BEq α] (a : α) : [].erase a = [] := rfl
|
||||
@[grind =] theorem erase_cons [BEq α] {a b : α} {l : List α} :
|
||||
(b :: l).erase a = if b == a then l else b :: l.erase a := by
|
||||
simp only [List.erase]; split <;> simp_all
|
||||
|
||||
@@ -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' -/
|
||||
|
||||
|
||||
@@ -10,6 +10,9 @@ import Init.Data.List.Sublist
|
||||
|
||||
/-!
|
||||
# Lemmas about `List.countP` and `List.count`.
|
||||
|
||||
Because we mark `countP_eq_length_filter` and `count_eq_countP` with `@[grind _=_]`,
|
||||
we don't need many other `@[grind]` annotations here.
|
||||
-/
|
||||
|
||||
set_option linter.listVariables true -- Enforce naming conventions for `List`/`Array`/`Vector` variables.
|
||||
@@ -61,6 +64,7 @@ theorem length_eq_countP_add_countP (p : α → Bool) {l : List α} : length l =
|
||||
· rfl
|
||||
· simp [h]
|
||||
|
||||
@[grind =]
|
||||
theorem countP_eq_length_filter {l : List α} : countP p l = length (filter p l) := by
|
||||
induction l with
|
||||
| nil => rfl
|
||||
@@ -69,6 +73,7 @@ theorem countP_eq_length_filter {l : List α} : countP p l = length (filter p l)
|
||||
then rw [countP_cons_of_pos h, ih, filter_cons_of_pos h, length]
|
||||
else rw [countP_cons_of_neg h, ih, filter_cons_of_neg h]
|
||||
|
||||
@[grind =]
|
||||
theorem countP_eq_length_filter' : countP p = length ∘ filter p := by
|
||||
funext l
|
||||
apply countP_eq_length_filter
|
||||
@@ -97,6 +102,7 @@ theorem countP_replicate {p : α → Bool} {a : α} {n : Nat} :
|
||||
simp only [countP_eq_length_filter, filter_replicate]
|
||||
split <;> simp
|
||||
|
||||
@[grind]
|
||||
theorem boole_getElem_le_countP {p : α → Bool} {l : List α} {i : Nat} (h : i < l.length) :
|
||||
(if p l[i] then 1 else 0) ≤ l.countP p := by
|
||||
induction l generalizing i with
|
||||
@@ -120,6 +126,7 @@ theorem IsInfix.countP_le (s : l₁ <:+: l₂) : countP p l₁ ≤ countP p l₂
|
||||
|
||||
-- See `Init.Data.List.Nat.Count` for `Sublist.le_countP : countP p l₂ - (l₂.length - l₁.length) ≤ countP p l₁`.
|
||||
|
||||
@[grind]
|
||||
theorem countP_tail_le (l) : countP p l.tail ≤ countP p l :=
|
||||
(tail_sublist l).countP_le
|
||||
|
||||
@@ -198,18 +205,21 @@ variable [BEq α]
|
||||
|
||||
@[simp] theorem count_nil {a : α} : count a [] = 0 := rfl
|
||||
|
||||
@[grind]
|
||||
theorem count_cons {a b : α} {l : List α} :
|
||||
count a (b :: l) = count a l + if b == a then 1 else 0 := by
|
||||
simp [count, countP_cons]
|
||||
|
||||
theorem count_eq_countP {a : α} {l : List α} : count a l = countP (· == a) l := rfl
|
||||
@[grind =] theorem count_eq_countP {a : α} {l : List α} : count a l = countP (· == a) l := rfl
|
||||
theorem count_eq_countP' {a : α} : count a = countP (· == a) := by
|
||||
funext l
|
||||
apply count_eq_countP
|
||||
|
||||
theorem count_tail : ∀ {l : List α} (h : l ≠ []) (a : α),
|
||||
l.tail.count a = l.count a - if l.head h == a then 1 else 0
|
||||
| _ :: _, a, _ => by simp [count_cons]
|
||||
@[grind]
|
||||
theorem count_tail : ∀ {l : List α} {a : α},
|
||||
l.tail.count a = l.count a - if l.head? == some a then 1 else 0
|
||||
| [], a => by simp
|
||||
| _ :: _, a => by simp [count_cons]
|
||||
|
||||
theorem count_le_length {a : α} {l : List α} : count a l ≤ l.length := countP_le_length
|
||||
|
||||
@@ -241,6 +251,7 @@ theorem count_flatten {a : α} {l : List (List α)} : count a l.flatten = (l.map
|
||||
@[simp] theorem count_reverse {a : α} {l : List α} : count a l.reverse = count a l := by
|
||||
simp only [count_eq_countP, countP_eq_length_filter, filter_reverse, length_reverse]
|
||||
|
||||
@[grind]
|
||||
theorem boole_getElem_le_count {a : α} {l : List α} {i : Nat} (h : i < l.length) :
|
||||
(if l[i] == a then 1 else 0) ≤ l.count a := by
|
||||
rw [count_eq_countP]
|
||||
@@ -329,6 +340,7 @@ theorem count_filterMap {α} [BEq β] {b : β} {f : α → Option β} {l : List
|
||||
theorem count_flatMap {α} [BEq β] {l : List α} {f : α → List β} {x : β} :
|
||||
count x (l.flatMap f) = sum (map (count x ∘ f) l) := countP_flatMap
|
||||
|
||||
@[grind]
|
||||
theorem count_erase {a b : α} :
|
||||
∀ {l : List α}, count a (l.erase b) = count a l - if b == a then 1 else 0
|
||||
| [] => by simp
|
||||
|
||||
@@ -1252,7 +1252,7 @@ theorem tailD_map {f : α → β} {l l' : List α} :
|
||||
theorem getLastD_map {f : α → β} {l : List α} {a : α} : (map f l).getLastD (f a) = f (l.getLastD a) := by
|
||||
simp
|
||||
|
||||
@[simp] theorem map_map {g : β → γ} {f : α → β} {l : List α} :
|
||||
@[simp, grind _=_] theorem map_map {g : β → γ} {f : α → β} {l : List α} :
|
||||
map g (map f l) = map (g ∘ f) l := by induction l <;> simp_all
|
||||
|
||||
/-! ### filter -/
|
||||
@@ -1337,7 +1337,7 @@ theorem foldr_filter {p : α → Bool} {f : α → β → β} {l : List α} {ini
|
||||
simp only [filter_cons, foldr_cons]
|
||||
split <;> simp [ih]
|
||||
|
||||
theorem filter_map {f : β → α} {p : α → Bool} {l : List β} :
|
||||
@[grind _=_] theorem filter_map {f : β → α} {p : α → Bool} {l : List β} :
|
||||
filter p (map f l) = map f (filter (p ∘ f) l) := by
|
||||
induction l with
|
||||
| nil => rfl
|
||||
@@ -1879,7 +1879,7 @@ theorem eq_nil_or_concat : ∀ l : List α, l = [] ∨ ∃ l' b, l = concat l' b
|
||||
|
||||
/-! ### flatten -/
|
||||
|
||||
@[simp] theorem length_flatten {L : List (List α)} : L.flatten.length = (L.map length).sum := by
|
||||
@[simp, grind _=_] theorem length_flatten {L : List (List α)} : L.flatten.length = (L.map length).sum := by
|
||||
induction L with
|
||||
| nil => rfl
|
||||
| cons =>
|
||||
@@ -2049,7 +2049,7 @@ theorem eq_iff_flatten_eq : ∀ {L L' : List (List α)},
|
||||
|
||||
/-! ### flatMap -/
|
||||
|
||||
theorem flatMap_def {l : List α} {f : α → List β} : l.flatMap f = flatten (map f l) := rfl
|
||||
@[grind _=_] theorem flatMap_def {l : List α} {f : α → List β} : l.flatMap f = flatten (map f l) := rfl
|
||||
|
||||
@[simp] theorem flatMap_id {L : List (List α)} : L.flatMap id = L.flatten := by simp [flatMap_def]
|
||||
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -96,9 +96,15 @@ theorem eq_nil_of_subset_nil {l : List α} : l ⊆ [] → l = [] := subset_nil.m
|
||||
theorem map_subset {l₁ l₂ : List α} (f : α → β) (h : l₁ ⊆ l₂) : map f l₁ ⊆ map f l₂ :=
|
||||
fun x => by simp only [mem_map]; exact .imp fun a => .imp_left (@h _)
|
||||
|
||||
grind_pattern map_subset => l₁ ⊆ l₂, map f l₁
|
||||
grind_pattern map_subset => l₁ ⊆ l₂, map f l₂
|
||||
|
||||
theorem filter_subset {l₁ l₂ : List α} (p : α → Bool) (H : l₁ ⊆ l₂) : filter p l₁ ⊆ filter p l₂ :=
|
||||
fun x => by simp_all [mem_filter, subset_def.1 H]
|
||||
|
||||
grind_pattern filter_subset => l₁ ⊆ l₂, filter p l₁
|
||||
grind_pattern filter_subset => l₁ ⊆ l₂, filter p l₂
|
||||
|
||||
theorem filterMap_subset {l₁ l₂ : List α} (f : α → Option β) (H : l₁ ⊆ l₂) :
|
||||
filterMap f l₁ ⊆ filterMap f l₂ := by
|
||||
intro x
|
||||
@@ -106,6 +112,9 @@ theorem filterMap_subset {l₁ l₂ : List α} (f : α → Option β) (H : l₁
|
||||
rintro ⟨a, h, w⟩
|
||||
exact ⟨a, H h, w⟩
|
||||
|
||||
grind_pattern filterMap_subset => l₁ ⊆ l₂, filterMap f l₁
|
||||
grind_pattern filterMap_subset => l₁ ⊆ l₂, filterMap f l₂
|
||||
|
||||
theorem subset_append_left (l₁ l₂ : List α) : l₁ ⊆ l₁ ++ l₂ := fun _ => mem_append_left _
|
||||
|
||||
theorem subset_append_right (l₁ l₂ : List α) : l₂ ⊆ l₁ ++ l₂ := fun _ => mem_append_right _
|
||||
@@ -261,15 +270,24 @@ protected theorem Sublist.map (f : α → β) {l₁ l₂} (s : l₁ <+ l₂) : m
|
||||
| cons₂ a s ih =>
|
||||
simpa using cons₂ (f a) ih
|
||||
|
||||
grind_pattern Sublist.map => l₁ <+ l₂, map f l₁
|
||||
grind_pattern Sublist.map => l₁ <+ l₂, map f l₂
|
||||
|
||||
@[grind]
|
||||
protected theorem Sublist.filterMap (f : α → Option β) (s : l₁ <+ l₂) :
|
||||
filterMap f l₁ <+ filterMap f l₂ := by
|
||||
induction s <;> simp [filterMap_cons] <;> split <;> simp [*, cons, cons₂]
|
||||
|
||||
grind_pattern Sublist.filterMap => l₁ <+ l₂, filterMap f l₁
|
||||
grind_pattern Sublist.filterMap => l₁ <+ l₂, filterMap f l₂
|
||||
|
||||
@[grind]
|
||||
protected theorem Sublist.filter (p : α → Bool) {l₁ l₂} (s : l₁ <+ l₂) : filter p l₁ <+ filter p l₂ := by
|
||||
rw [← filterMap_eq_filter]; apply s.filterMap
|
||||
|
||||
grind_pattern Sublist.filter => l₁ <+ l₂, l₁.filter p
|
||||
grind_pattern Sublist.filter => l₁ <+ l₂, l₂.filter p
|
||||
|
||||
theorem head_filter_mem (xs : List α) (p : α → Bool) (h) : (xs.filter p).head h ∈ xs :=
|
||||
filter_sublist.head_mem h
|
||||
|
||||
@@ -728,12 +746,21 @@ theorem IsInfix.ne_nil {xs ys : List α} (h : xs <:+: ys) (hx : xs ≠ []) : ys
|
||||
theorem IsInfix.length_le (h : l₁ <:+: l₂) : l₁.length ≤ l₂.length :=
|
||||
h.sublist.length_le
|
||||
|
||||
grind_pattern IsInfix.length_le => l₁ <:+: l₂, l₁.length
|
||||
grind_pattern IsInfix.length_le => l₁ <:+: l₂, l₂.length
|
||||
|
||||
theorem IsPrefix.length_le (h : l₁ <+: l₂) : l₁.length ≤ l₂.length :=
|
||||
h.sublist.length_le
|
||||
|
||||
grind_pattern IsPrefix.length_le => l₁ <+: l₂, l₁.length
|
||||
grind_pattern IsPrefix.length_le => l₁ <+: l₂, l₂.length
|
||||
|
||||
theorem IsSuffix.length_le (h : l₁ <:+ l₂) : l₁.length ≤ l₂.length :=
|
||||
h.sublist.length_le
|
||||
|
||||
grind_pattern IsSuffix.length_le => l₁ <:+ l₂, l₁.length
|
||||
grind_pattern IsSuffix.length_le => l₁ <:+ l₂, l₂.length
|
||||
|
||||
theorem IsPrefix.getElem {xs ys : List α} (h : xs <+: ys) {i} (hi : i < xs.length) :
|
||||
xs[i] = ys[i]'(Nat.le_trans hi h.length_le) := by
|
||||
obtain ⟨_, rfl⟩ := h
|
||||
@@ -1148,44 +1175,71 @@ theorem dropLast_subset (l : List α) : l.dropLast ⊆ l :=
|
||||
obtain ⟨r, rfl⟩ := h
|
||||
rw [map_append]; apply prefix_append
|
||||
|
||||
grind_pattern IsPrefix.map => l₁ <+: l₂, l₁.map f
|
||||
grind_pattern IsPrefix.map => l₁ <+: l₂, l₂.map f
|
||||
|
||||
@[grind] theorem IsSuffix.map {β} (f : α → β) ⦃l₁ l₂ : List α⦄ (h : l₁ <:+ l₂) : l₁.map f <:+ l₂.map f := by
|
||||
obtain ⟨r, rfl⟩ := h
|
||||
rw [map_append]; apply suffix_append
|
||||
|
||||
grind_pattern IsSuffix.map => l₁ <:+ l₂, l₁.map f
|
||||
grind_pattern IsSuffix.map => l₁ <:+ l₂, l₂.map f
|
||||
|
||||
@[grind] theorem IsInfix.map {β} (f : α → β) ⦃l₁ l₂ : List α⦄ (h : l₁ <:+: l₂) : l₁.map f <:+: l₂.map f := by
|
||||
obtain ⟨r₁, r₂, rfl⟩ := h
|
||||
rw [map_append, map_append]; apply infix_append
|
||||
|
||||
grind_pattern IsInfix.map => l₁ <:+: l₂, l₁.map f
|
||||
grind_pattern IsInfix.map => l₁ <:+: l₂, l₂.map f
|
||||
|
||||
@[grind] theorem IsPrefix.filter (p : α → Bool) ⦃l₁ l₂ : List α⦄ (h : l₁ <+: l₂) :
|
||||
l₁.filter p <+: l₂.filter p := by
|
||||
obtain ⟨xs, rfl⟩ := h
|
||||
rw [filter_append]; apply prefix_append
|
||||
|
||||
grind_pattern IsPrefix.filter => l₁ <+: l₂, l₁.filter p
|
||||
grind_pattern IsPrefix.filter => l₁ <+: l₂, l₂.filter p
|
||||
|
||||
@[grind] theorem IsSuffix.filter (p : α → Bool) ⦃l₁ l₂ : List α⦄ (h : l₁ <:+ l₂) :
|
||||
l₁.filter p <:+ l₂.filter p := by
|
||||
obtain ⟨xs, rfl⟩ := h
|
||||
rw [filter_append]; apply suffix_append
|
||||
|
||||
grind_pattern IsSuffix.filter => l₁ <:+ l₂, l₁.filter p
|
||||
grind_pattern IsSuffix.filter => l₁ <:+ l₂, l₂.filter p
|
||||
|
||||
@[grind] theorem IsInfix.filter (p : α → Bool) ⦃l₁ l₂ : List α⦄ (h : l₁ <:+: l₂) :
|
||||
l₁.filter p <:+: l₂.filter p := by
|
||||
obtain ⟨xs, ys, rfl⟩ := h
|
||||
rw [filter_append, filter_append]; apply infix_append _
|
||||
|
||||
grind_pattern IsInfix.filter => l₁ <:+: l₂, l₁.filter p
|
||||
grind_pattern IsInfix.filter => l₁ <:+: l₂, l₂.filter p
|
||||
|
||||
@[grind] theorem IsPrefix.filterMap {β} (f : α → Option β) ⦃l₁ l₂ : List α⦄ (h : l₁ <+: l₂) :
|
||||
filterMap f l₁ <+: filterMap f l₂ := by
|
||||
obtain ⟨xs, rfl⟩ := h
|
||||
rw [filterMap_append]; apply prefix_append
|
||||
|
||||
grind_pattern IsPrefix.filterMap => l₁ <+: l₂, filterMap f l₁
|
||||
grind_pattern IsPrefix.filterMap => l₁ <+: l₂, filterMap f l₂
|
||||
|
||||
@[grind] theorem IsSuffix.filterMap {β} (f : α → Option β) ⦃l₁ l₂ : List α⦄ (h : l₁ <:+ l₂) :
|
||||
filterMap f l₁ <:+ filterMap f l₂ := by
|
||||
obtain ⟨xs, rfl⟩ := h
|
||||
rw [filterMap_append]; apply suffix_append
|
||||
|
||||
grind_pattern IsSuffix.filterMap => l₁ <:+ l₂, filterMap f l₁
|
||||
grind_pattern IsSuffix.filterMap => l₁ <:+ l₂, filterMap f l₂
|
||||
|
||||
@[grind] theorem IsInfix.filterMap {β} (f : α → Option β) ⦃l₁ l₂ : List α⦄ (h : l₁ <:+: l₂) :
|
||||
filterMap f l₁ <:+: filterMap f l₂ := by
|
||||
obtain ⟨xs, ys, rfl⟩ := h
|
||||
rw [filterMap_append, filterMap_append]; apply infix_append
|
||||
|
||||
grind_pattern IsInfix.filterMap => l₁ <:+: l₂, filterMap f l₁
|
||||
grind_pattern IsInfix.filterMap => l₁ <:+: l₂, filterMap f l₂
|
||||
|
||||
@[simp, grind =] theorem isPrefixOf_iff_prefix [BEq α] [LawfulBEq α] {l₁ l₂ : List α} :
|
||||
l₁.isPrefixOf l₂ ↔ l₁ <+: l₂ := by
|
||||
induction l₁ generalizing l₂ with
|
||||
|
||||
@@ -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]
|
||||
|
||||
@@ -118,7 +118,7 @@ def addDecl (decl : Declaration) : CoreM Unit := do
|
||||
let async ← env.addConstAsync (reportExts := false) name kind
|
||||
(exportedKind := exportedInfo?.map (.ofConstantInfo) |>.getD kind)
|
||||
-- report preliminary constant info immediately
|
||||
async.commitConst async.asyncEnv (some info) exportedInfo?
|
||||
async.commitConst async.asyncEnv (some info) (exportedInfo? <|> info)
|
||||
setEnv async.mainEnv
|
||||
let cancelTk ← IO.CancelToken.new
|
||||
let checkAct ← Core.wrapAsyncAsSnapshot (cancelTk? := cancelTk) fun _ => do
|
||||
|
||||
@@ -63,7 +63,7 @@ partial def shouldExtractLetValue (isRoot : Bool) (v : LetValue) : M Bool := do
|
||||
| .lit (.nat v) =>
|
||||
-- The old compiler's implementation used the runtime's `is_scalar` function, which
|
||||
-- introduces a dependency on the architecture used by the compiler.
|
||||
return v >= Nat.pow 2 63
|
||||
return !isRoot || v >= Nat.pow 2 63
|
||||
| .lit _ | .erased => return !isRoot
|
||||
| .const name _ args =>
|
||||
if (← read).sccDecls.any (·.name == name) then
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -318,12 +318,12 @@ def SnapshotTree.getAll (s : SnapshotTree) : Array Snapshot :=
|
||||
Id.run <| s.foldM (pure <| ·.push ·) #[]
|
||||
|
||||
/-- Returns a task that waits on all snapshots in the tree. -/
|
||||
def SnapshotTree.waitAll : SnapshotTree → BaseIO (Task Unit)
|
||||
partial def SnapshotTree.waitAll : SnapshotTree → BaseIO (Task Unit)
|
||||
| mk _ children => go children.toList
|
||||
where
|
||||
go : List (SnapshotTask SnapshotTree) → BaseIO (Task Unit)
|
||||
| [] => return .pure ()
|
||||
| t::ts => BaseIO.bindTask t.task fun _ => go ts
|
||||
| t::ts => BaseIO.bindTask (sync := true) t.task fun t => go (t.children.toList ++ ts)
|
||||
|
||||
/-- Context of an input processing invocation. -/
|
||||
structure ProcessingContext extends Parser.InputContext
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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 ()
|
||||
|
||||
/--
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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 }
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
74
src/Std/Data/Internal/LawfulMonadLiftFunction.lean
Normal file
74
src/Std/Data/Internal/LawfulMonadLiftFunction.lean
Normal file
@@ -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
|
||||
@@ -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
|
||||
|
||||
@@ -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⟩
|
||||
|
||||
12
src/Std/Data/Iterators/Combinators.lean
Normal file
12
src/Std/Data/Iterators/Combinators.lean
Normal file
@@ -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
|
||||
59
src/Std/Data/Iterators/Combinators/DropWhile.lean
Normal file
59
src/Std/Data/Iterators/Combinators/DropWhile.lean
Normal file
@@ -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
|
||||
304
src/Std/Data/Iterators/Combinators/FilterMap.lean
Normal file
304
src/Std/Data/Iterators/Combinators/FilterMap.lean
Normal file
@@ -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
|
||||
11
src/Std/Data/Iterators/Combinators/Monadic.lean
Normal file
11
src/Std/Data/Iterators/Combinators/Monadic.lean
Normal file
@@ -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
|
||||
289
src/Std/Data/Iterators/Combinators/Monadic/DropWhile.lean
Normal file
289
src/Std/Data/Iterators/Combinators/Monadic/DropWhile.lean
Normal file
@@ -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
|
||||
600
src/Std/Data/Iterators/Combinators/Monadic/FilterMap.lean
Normal file
600
src/Std/Data/Iterators/Combinators/Monadic/FilterMap.lean
Normal file
@@ -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
|
||||
198
src/Std/Data/Iterators/Combinators/Monadic/Take.lean
Normal file
198
src/Std/Data/Iterators/Combinators/Monadic/Take.lean
Normal file
@@ -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
|
||||
289
src/Std/Data/Iterators/Combinators/Monadic/TakeWhile.lean
Normal file
289
src/Std/Data/Iterators/Combinators/Monadic/TakeWhile.lean
Normal file
@@ -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
|
||||
395
src/Std/Data/Iterators/Combinators/Monadic/Zip.lean
Normal file
395
src/Std/Data/Iterators/Combinators/Monadic/Zip.lean
Normal file
@@ -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
|
||||
39
src/Std/Data/Iterators/Combinators/Take.lean
Normal file
39
src/Std/Data/Iterators/Combinators/Take.lean
Normal file
@@ -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
|
||||
45
src/Std/Data/Iterators/Combinators/TakeWhile.lean
Normal file
45
src/Std/Data/Iterators/Combinators/TakeWhile.lean
Normal file
@@ -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
|
||||
47
src/Std/Data/Iterators/Combinators/Zip.lean
Normal file
47
src/Std/Data/Iterators/Combinators/Zip.lean
Normal file
@@ -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
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
/--
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
12
src/Std/Data/Iterators/Lemmas/Combinators.lean
Normal file
12
src/Std/Data/Iterators/Lemmas/Combinators.lean
Normal file
@@ -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
|
||||
124
src/Std/Data/Iterators/Lemmas/Combinators/DropWhile.lean
Normal file
124
src/Std/Data/Iterators/Lemmas/Combinators/DropWhile.lean
Normal file
@@ -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
|
||||
317
src/Std/Data/Iterators/Lemmas/Combinators/FilterMap.lean
Normal file
317
src/Std/Data/Iterators/Lemmas/Combinators/FilterMap.lean
Normal file
@@ -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
|
||||
11
src/Std/Data/Iterators/Lemmas/Combinators/Monadic.lean
Normal file
11
src/Std/Data/Iterators/Lemmas/Combinators/Monadic.lean
Normal file
@@ -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
|
||||
172
src/Std/Data/Iterators/Lemmas/Combinators/Monadic/DropWhile.lean
Normal file
172
src/Std/Data/Iterators/Lemmas/Combinators/Monadic/DropWhile.lean
Normal file
@@ -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
|
||||
411
src/Std/Data/Iterators/Lemmas/Combinators/Monadic/FilterMap.lean
Normal file
411
src/Std/Data/Iterators/Lemmas/Combinators/Monadic/FilterMap.lean
Normal file
@@ -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
|
||||
38
src/Std/Data/Iterators/Lemmas/Combinators/Monadic/Take.lean
Normal file
38
src/Std/Data/Iterators/Lemmas/Combinators/Monadic/Take.lean
Normal file
@@ -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
|
||||
@@ -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
|
||||
88
src/Std/Data/Iterators/Lemmas/Combinators/Monadic/Zip.lean
Normal file
88
src/Std/Data/Iterators/Lemmas/Combinators/Monadic/Zip.lean
Normal file
@@ -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
|
||||
95
src/Std/Data/Iterators/Lemmas/Combinators/Take.lean
Normal file
95
src/Std/Data/Iterators/Lemmas/Combinators/Take.lean
Normal file
@@ -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
|
||||
134
src/Std/Data/Iterators/Lemmas/Combinators/TakeWhile.lean
Normal file
134
src/Std/Data/Iterators/Lemmas/Combinators/TakeWhile.lean
Normal file
@@ -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
|
||||
398
src/Std/Data/Iterators/Lemmas/Combinators/Zip.lean
Normal file
398
src/Std/Data/Iterators/Lemmas/Combinators/Zip.lean
Normal file
@@ -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
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
170
src/Std/Data/Iterators/Lemmas/Consumers/Loop.lean
Normal file
170
src/Std/Data/Iterators/Lemmas/Consumers/Loop.lean
Normal file
@@ -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
|
||||
@@ -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
|
||||
|
||||
236
src/Std/Data/Iterators/Lemmas/Consumers/Monadic/Loop.lean
Normal file
236
src/Std/Data/Iterators/Lemmas/Consumers/Monadic/Loop.lean
Normal file
@@ -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
|
||||
@@ -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
|
||||
|
||||
87
src/Std/Data/Iterators/Lemmas/Producers/Array.lean
Normal file
87
src/Std/Data/Iterators/Lemmas/Producers/Array.lean
Normal file
@@ -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
|
||||
@@ -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]
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
120
src/Std/Data/Iterators/Lemmas/Producers/Monadic/Array.lean
Normal file
120
src/Std/Data/Iterators/Lemmas/Producers/Monadic/Array.lean
Normal file
@@ -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
|
||||
@@ -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]
|
||||
|
||||
55
src/Std/Data/Iterators/Lemmas/Producers/Repeat.lean
Normal file
55
src/Std/Data/Iterators/Lemmas/Producers/Repeat.lean
Normal file
@@ -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
|
||||
179
src/Std/Data/Iterators/PostConditionMonad.lean
Normal file
179
src/Std/Data/Iterators/PostConditionMonad.lean
Normal file
@@ -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
|
||||
@@ -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
|
||||
|
||||
49
src/Std/Data/Iterators/Producers/Array.lean
Normal file
49
src/Std/Data/Iterators/Producers/Array.lean
Normal file
@@ -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
|
||||
@@ -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
|
||||
|
||||
120
src/Std/Data/Iterators/Producers/Monadic/Array.lean
Normal file
120
src/Std/Data/Iterators/Producers/Monadic/Array.lean
Normal file
@@ -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
|
||||
@@ -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]
|
||||
|
||||
83
src/Std/Data/Iterators/Producers/Repeat.lean
Normal file
83
src/Std/Data/Iterators/Producers/Repeat.lean
Normal file
@@ -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
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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:
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -113,7 +113,7 @@ protected def LeanLib.recBuildShared (self : LeanLib) : FetchM (Job Dynlib) := d
|
||||
(·.push <$> ·.dynlib.fetch) jobs
|
||||
return jobs
|
||||
buildLeanSharedLib self.libName self.sharedLibFile objJobs libJobs
|
||||
self.weakLinkArgs self.linkArgs (plugin := self.roots.size == 1)
|
||||
self.weakLinkArgs self.linkArgs self.isPlugin
|
||||
|
||||
/-- The `LibraryFacetConfig` for the builtin `sharedFacet`. -/
|
||||
def LeanLib.sharedFacetConfig : LibraryFacetConfig sharedFacet :=
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -73,6 +73,10 @@ The names of the library's root modules
|
||||
@[inline] def sharedLibFile (self : LeanLib) : FilePath :=
|
||||
self.pkg.sharedLibDir / self.sharedLibFileName
|
||||
|
||||
/-- Whether the shared binary of this library is a valid plugin. -/
|
||||
def isPlugin (self : LeanLib) : Bool :=
|
||||
self.roots == #[self.name] && self.libName == self.name.mangle ""
|
||||
|
||||
/-- The library's `extraDepTargets` configuration. -/
|
||||
@[inline] def extraDepTargets (self : LeanLib) :=
|
||||
self.config.extraDepTargets
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
2
src/lake/tests/8448/A.lean
Normal file
2
src/lake/tests/8448/A.lean
Normal file
@@ -0,0 +1,2 @@
|
||||
@[extern "increment8"]
|
||||
opaque A.increment8 : Int8 → Int8
|
||||
5
src/lake/tests/8448/B.lean
Normal file
5
src/lake/tests/8448/B.lean
Normal file
@@ -0,0 +1,5 @@
|
||||
import A
|
||||
|
||||
def B.increment8 := A.increment8
|
||||
|
||||
#eval B.increment8 1
|
||||
5
src/lake/tests/8448/C.lean
Normal file
5
src/lake/tests/8448/C.lean
Normal file
@@ -0,0 +1,5 @@
|
||||
import A
|
||||
|
||||
def C.increment8 := A.increment8
|
||||
|
||||
#eval C.increment8 1
|
||||
5
src/lake/tests/8448/D.lean
Normal file
5
src/lake/tests/8448/D.lean
Normal file
@@ -0,0 +1,5 @@
|
||||
import B
|
||||
|
||||
def D.increment8 := A.increment8
|
||||
|
||||
#eval D.increment8 1
|
||||
5
src/lake/tests/8448/a.c
Normal file
5
src/lake/tests/8448/a.c
Normal file
@@ -0,0 +1,5 @@
|
||||
#include <stdint.h>
|
||||
|
||||
extern int8_t increment8(int8_t num) {
|
||||
return num + 1;
|
||||
}
|
||||
1
src/lake/tests/8448/clean.sh
Executable file
1
src/lake/tests/8448/clean.sh
Executable file
@@ -0,0 +1 @@
|
||||
rm -rf .lake lake-manifest.json produced.out
|
||||
24
src/lake/tests/8448/lakefile.lean
Normal file
24
src/lake/tests/8448/lakefile.lean
Normal file
@@ -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
|
||||
15
src/lake/tests/8448/test.sh
Executable file
15
src/lake/tests/8448/test.sh
Executable file
@@ -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
|
||||
@@ -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
|
||||
|
||||
@@ -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);
|
||||
|
||||
@@ -11,4 +11,7 @@
|
||||
?a = ?a
|
||||
with
|
||||
Ordering.eq = Ordering.lt
|
||||
[Meta.Tactic.simp.rewrite] imp_self:10000: False → False ==> True
|
||||
[Meta.Tactic.simp.rewrite] imp_self:10000:
|
||||
False → False
|
||||
==>
|
||||
True
|
||||
|
||||
@@ -1,5 +1,6 @@
|
||||
973b.lean:5:8-5:10: warning: declaration uses 'sorry'
|
||||
[Meta.Tactic.simp.discharge] ex discharge ❌️
|
||||
?p x
|
||||
[Meta.Tactic.simp.discharge] ex discharge ❌️ ?p (f x)
|
||||
[Meta.Tactic.simp.discharge] ex discharge ❌️
|
||||
?p (f x)
|
||||
973b.lean:9:8-9:11: warning: declaration uses 'sorry'
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user