102 lines
3.3 KiB
Text
102 lines
3.3 KiB
Text
universes u v w
|
||
|
||
structure lens (α : Type u) (β : Type v) :=
|
||
(get : α → β)
|
||
(modify : α → (β → β) → α)
|
||
(set : α → β → α := λ a b, modify a (λ _, b))
|
||
|
||
def lens.compose {α : Type u} {β : Type v} {σ : Type w} (t : lens β σ) (s : lens α β) : lens α σ :=
|
||
{ get := t^.get ∘ s^.get,
|
||
modify := λ a f, s^.modify a $ λ b, t^.modify b f,
|
||
set := λ a v, s^.modify a $ λ b, t^.set b v }
|
||
|
||
infix `∙`:1 := lens.compose
|
||
|
||
def fst {α β} : lens (α × β) α :=
|
||
{ get := prod.fst,
|
||
modify := λ ⟨a, b⟩ f, (f a, b),
|
||
set := λ ⟨a, b⟩ a', (a', b)}
|
||
|
||
def snd {α β} : lens (α × β) β :=
|
||
{ get := prod.snd,
|
||
modify := λ ⟨a, b⟩ f, (a, f b),
|
||
set := λ ⟨a, b⟩ b', (a, b') }
|
||
|
||
def idx {α} {n} (i : fin n) : lens (array α n) α :=
|
||
{ get := λ a, a^.read i,
|
||
modify := λ a f, a^.write i $ f $ a^.read i,
|
||
set := λ a b, a^.write i b }
|
||
|
||
def modify_ith {α} : nat → list α → (α → α) → list α
|
||
| _ [] f := []
|
||
| 0 (b::l) f := f b :: l
|
||
| (n+1) (b::l) f := b :: modify_ith n l f
|
||
|
||
def ith {α} [inhabited α] : nat → list α → α
|
||
| 0 (a::l) := a
|
||
| (n+1) (a::l) := ith n l
|
||
| _ _ := default α
|
||
|
||
def nth {α} [inhabited α] (i : nat) : lens (list α) α :=
|
||
{ get := ith i,
|
||
modify := modify_ith i }
|
||
|
||
set_option trace.array.update true
|
||
|
||
def f (a : array nat 10 × array bool 5) : array nat 10 × array bool 5 :=
|
||
(idx 2 ∙ snd)^.set ((idx 1 ∙ fst)^.set a 1) ff
|
||
|
||
#eval f (mk_array 10 0, mk_array 5 tt)
|
||
|
||
#eval (idx 2 ∙ snd)^.set ((idx 1 ∙ fst)^.set (mk_array 10 0, mk_array 5 tt) 1) ff
|
||
|
||
#eval let p₀ := (mk_array 10 0, mk_array 5 tt),
|
||
p₁ := (idx 1 ∙ fst)^.set p₀ 1,
|
||
p₂ := (idx 2 ∙ snd)^.set p₁ ff in
|
||
p₂
|
||
|
||
example : (fst ∙ nth 1)^.set [(1, 2), (3, 4), (0, 3)] 30 = [(1, 2), (30, 4), (0, 3)] :=
|
||
rfl
|
||
|
||
example : (snd ∙ nth 1)^.get [(1, 2), (3, 4), (0, 3)] = 4 :=
|
||
rfl
|
||
|
||
def micro_lens (f : Type u → Type w) [functor f] (α β : Type u) :=
|
||
(β → f β) → α → f α
|
||
|
||
def micro_lens.compose {f : Type u → Type w} [functor f] {α β δ: Type u} (l₁ : micro_lens f β δ) (l₂ : micro_lens f α β) : micro_lens f α δ :=
|
||
λ g a, l₂ (l₁ g) a
|
||
|
||
instance : applicative id :=
|
||
{pure := λ _ a, a,
|
||
seq := λ _ _ f a, f a}
|
||
|
||
def micro_lens.modify {α β : Type u} (l : micro_lens id α β) (a : α) (b : β → β) : α :=
|
||
l b a
|
||
|
||
def micro_lens.set {α β : Type u} (l : micro_lens id α β) (a : α) (b : β) : α :=
|
||
l (λ _, b) a
|
||
|
||
def fconst (α : Type v) (β : Type u) : Type v :=
|
||
α
|
||
|
||
instance (α : Type v) : functor (fconst α) :=
|
||
{map := λ (β δ : Type u) f a, a}
|
||
|
||
def micro_lens.get {α β : Type u} (l : micro_lens (fconst β) α β) (a : α) : β :=
|
||
l (λ b, b) a
|
||
|
||
def pi₁ {f : Type u → Type w} [functor f] {α β : Type u} : micro_lens f (α × β) α :=
|
||
λ g ⟨a, b⟩, (λ x, (x, b)) <$> g a
|
||
|
||
def pi₂ {f : Type u → Type w} [functor f] {α β : Type u} : micro_lens f (α × β) β :=
|
||
λ g ⟨a, b⟩, (λ x, (a, x)) <$> g b
|
||
|
||
#eval micro_lens.get pi₁ (10, 20)
|
||
#eval micro_lens.get pi₂ (10, 20)
|
||
#eval micro_lens.set pi₂ (10, 20) 100
|
||
#eval micro_lens.set (pi₁ ∘ pi₁) ((10, 20), 30) 1
|
||
#eval micro_lens.set (pi₁ ∘ pi₂) ((10, 20), 30) 1
|
||
#eval micro_lens.set pi₂ (((10, 20), 30) : (nat × nat) × nat) 1
|
||
#eval micro_lens.get (pi₁ ∘ pi₂) ((10, 20), 30)
|
||
#eval micro_lens.modify (pi₁ ∘ pi₂) ((10, 20), 30) (+1)
|