Cleanup after merge, these plug lemmas are hell on eartch

parent 1a427415
\begin{code}
module Data.Vec.Extra where
open import Function using (id; _∘_)
open import Function using (id; _∘_; _∘′_)
open import Data.Nat.Base using (ℕ; suc; _+_; _*_)
open import Data.Product using (∃₂; _×_; proj₁; proj₂; map)
open import Data.Vec using (Vec; splitAt; _++_; group; initLast; applicative)
......@@ -49,6 +49,24 @@ splitAt′ m v = map id proj₁ (splitAt m v)
%</splitAt-noproof>
%<*₁∘split1′>
\AgdaTarget{₁∘split1′}
\begin{code}
₁∘split1′ : ∀ {n ℓ} {α : Set ℓ} → Vec α (1 + n) → Vec α 1
₁∘split1′ = proj₁ ∘′ splitAt′ 1
\end{code}
%</₁∘split1′>
%<*₂∘split1′>
\AgdaTarget{₂∘split1′}
\begin{code}
₂∘split1′ : ∀ {n ℓ} {α : Set ℓ} → Vec α (1 + n) → Vec α n
₂∘split1′ = proj₂ ∘′ splitAt′ 1
\end{code}
%</₂∘split1′>
%<*group-ignore-eq>
\AgdaTarget{group′}
\begin{code}
......
......@@ -5,7 +5,7 @@ open import Function using (_∘′_)
open import Data.Product using (proj₂)
open import Data.Nat.Base using (zero; suc; _+_; _*_)
open import Data.Nat.Properties.Simple using (+-right-identity)
open import Data.Bool.Base using (not; _∧_; _∨_; _xor_; true; false)
open import Data.Bool.Base using (not; _∧_; _∨_; _xor_) renaming (false to 𝔽; true to 𝕋)
open import Data.Vec using ([]; _∷_; [_]; replicate)
open import Relation.Binary.PropositionalEquality using (_≡_; refl; cong)
open import Data.Bool.Properties using (commutativeSemiring-∨-∧)
......@@ -132,7 +132,7 @@ ripple (suc n) = id⤨ {1 + 1} ∥ swap⤨ {n} {1 + n}
\AgdaTarget{∧ℂ-proof-func}
\begin{code}
∧ℂ-proof-func : ∧ℂ ⫃ ∧-func
∧ℂ-proof-func (x ∷ y ∷ []) = refl
∧ℂ-proof-func (_ ∷ _ ∷ []) = refl
\end{code}
%</and-proof-func>
......@@ -141,10 +141,10 @@ ripple (suc n) = id⤨ {1 + 1} ∥ swap⤨ {n} {1 + n}
\AgdaTarget{⊻-table}
\begin{code}
⊻-table : W⟶W 2 1
⊻-table (false ∷ false ∷ []) = [ false ]
⊻-table (false ∷ true ∷ []) = [ true ]
⊻-table (true ∷ false ∷ []) = [ true ]
⊻-table (true ∷ true ∷ []) = [ false ]
⊻-table (𝔽 ∷ 𝔽 ∷ []) = [ 𝔽 ]
⊻-table (𝔽 ∷ 𝕋 ∷ []) = [ 𝕋 ]
⊻-table (𝕋 ∷ 𝔽 ∷ []) = [ 𝕋 ]
⊻-table (𝕋 ∷ 𝕋 ∷ []) = [ 𝔽 ]
\end{code}
%</xor-table>
......@@ -153,10 +153,10 @@ ripple (suc n) = id⤨ {1 + 1} ∥ swap⤨ {n} {1 + n}
\AgdaTarget{⊻ℂ-proof-table}
\begin{code}
⊻ℂ-proof-table : ⊻ℂ ⫃ ⊻-table
⊻ℂ-proof-table (false ∷ false ∷ []) = refl
⊻ℂ-proof-table (false ∷ true ∷ []) = refl
⊻ℂ-proof-table (true ∷ false ∷ []) = refl
⊻ℂ-proof-table (true ∷ true ∷ []) = refl
⊻ℂ-proof-table (𝔽 ∷ 𝔽 ∷ []) = refl
⊻ℂ-proof-table (𝔽 ∷ 𝕋 ∷ []) = refl
⊻ℂ-proof-table (𝕋 ∷ 𝔽 ∷ []) = refl
⊻ℂ-proof-table (𝕋 ∷ 𝕋 ∷ []) = refl
\end{code}
%</xor-proof-table>
......@@ -174,8 +174,8 @@ ripple (suc n) = id⤨ {1 + 1} ∥ swap⤨ {n} {1 + n}
\AgdaTarget{⊻-proof-func}
\begin{code}
⊻ℂ-proof-func : ⊻ℂ ⫃ ⊻-func
⊻ℂ-proof-func (true ∷ _ ∷ []) = refl
⊻ℂ-proof-func (false ∷ y ∷ []) = cong [_] ((proj₂ ∨-identity) y)
⊻ℂ-proof-func (𝕋 ∷ _ ∷ []) = refl
⊻ℂ-proof-func (𝔽 ∷ y ∷ []) = cong [_] ((proj₂ ∨-identity) y)
\end{code}
%</xor-proof-func>
......@@ -193,8 +193,8 @@ hadd-func (x ∷ y ∷ []) = (x xor y) ∷ (x ∧ y) ∷ []
\AgdaTarget{⊻-lemma}
\begin{code}
⊻-lemma : ∀ a b → (not a ∧ b) ∨ (a ∧ not b) ≡ a xor b
⊻-lemma true _ = refl
⊻-lemma false b = (proj₂ ∨-identity) b
⊻-lemma 𝕋 _ = refl
⊻-lemma 𝔽 b = (proj₂ ∨-identity) b
\end{code}
%</xor-lemma>
......@@ -211,14 +211,14 @@ hadd-proof-func (x ∷ y ∷ []) = cong (_∷ [ x ∧ y ]) (⊻-lemma x y)
\AgdaTarget{fadd-table}
\begin{code}
fadd-table : W⟶W 3 2
fadd-table (false ∷ false ∷ false ∷ []) = false ∷ false ∷ []
fadd-table (false ∷ false ∷ true ∷ []) = true ∷ false ∷ []
fadd-table (false ∷ true ∷ false ∷ []) = true ∷ false ∷ []
fadd-table (false ∷ true ∷ true ∷ []) = false ∷ true ∷ []
fadd-table (true ∷ false ∷ false ∷ []) = true ∷ false ∷ []
fadd-table (true ∷ false ∷ true ∷ []) = false ∷ true ∷ []
fadd-table (true ∷ true ∷ false ∷ []) = false ∷ true ∷ []
fadd-table (true ∷ true ∷ true ∷ []) = true ∷ true ∷ []
fadd-table (𝔽 ∷ 𝔽 ∷ 𝔽 ∷ []) = 𝔽 ∷ 𝔽 ∷ []
fadd-table (𝔽 ∷ 𝔽 ∷ 𝕋 ∷ []) = 𝕋 ∷ 𝔽 ∷ []
fadd-table (𝔽 ∷ 𝕋 ∷ 𝔽 ∷ []) = 𝕋 ∷ 𝔽 ∷ []
fadd-table (𝔽 ∷ 𝕋 ∷ 𝕋 ∷ []) = 𝔽 ∷ 𝕋 ∷ []
fadd-table (𝕋 ∷ 𝔽 ∷ 𝔽 ∷ []) = 𝕋 ∷ 𝔽 ∷ []
fadd-table (𝕋 ∷ 𝔽 ∷ 𝕋 ∷ []) = 𝔽 ∷ 𝕋 ∷ []
fadd-table (𝕋 ∷ 𝕋 ∷ 𝔽 ∷ []) = 𝔽 ∷ 𝕋 ∷ []
fadd-table (𝕋 ∷ 𝕋 ∷ 𝕋 ∷ []) = 𝕋 ∷ 𝕋 ∷ []
\end{code}
%</fadd-table>
......@@ -227,14 +227,14 @@ fadd-table (true ∷ true ∷ true ∷ []) = true ∷ true ∷ []
\AgdaTarget{fadd-proof-table}
\begin{code}
fadd-proof-table : fadd ⫃ fadd-table
fadd-proof-table (true ∷ true ∷ true ∷ []) = refl
fadd-proof-table (true ∷ true ∷ false ∷ []) = refl
fadd-proof-table (true ∷ false ∷ true ∷ []) = refl
fadd-proof-table (true ∷ false ∷ false ∷ []) = refl
fadd-proof-table (false ∷ true ∷ true ∷ []) = refl
fadd-proof-table (false ∷ true ∷ false ∷ []) = refl
fadd-proof-table (false ∷ false ∷ true ∷ []) = refl
fadd-proof-table (false ∷ false ∷ false ∷ []) = refl
fadd-proof-table (𝕋 ∷ 𝕋 ∷ 𝕋 ∷ []) = refl
fadd-proof-table (𝕋 ∷ 𝕋 ∷ 𝔽 ∷ []) = refl
fadd-proof-table (𝕋 ∷ 𝔽 ∷ 𝕋 ∷ []) = refl
fadd-proof-table (𝕋 ∷ 𝔽 ∷ 𝔽 ∷ []) = refl
fadd-proof-table (𝔽 ∷ 𝕋 ∷ 𝕋 ∷ []) = refl
fadd-proof-table (𝔽 ∷ 𝕋 ∷ 𝔽 ∷ []) = refl
fadd-proof-table (𝔽 ∷ 𝔽 ∷ 𝕋 ∷ []) = refl
fadd-proof-table (𝔽 ∷ 𝔽 ∷ 𝔽 ∷ []) = refl
\end{code}
%</fadd-proof-table>
......@@ -242,8 +242,8 @@ fadd-proof-table (false ∷ false ∷ false ∷ []) = refl
%<*proof-andN-alltrue>
\AgdaTarget{proof-andN-alltrue}
\begin{code}
proof-andN-alltrue : ∀ n → ⟦ andN n ⟧ (replicate true) ≡ [ true ]
proof-andN-alltrue : ∀ n → ⟦ andN n ⟧ (replicate 𝕋) ≡ [ 𝕋 ]
proof-andN-alltrue zero = refl
proof-andN-alltrue (suc n) = cong (spec-∧ℂ ∘′ (true ∷_)) (proof-andN-alltrue n)
proof-andN-alltrue (suc n) = cong (spec-∧ℂ ∘′ (𝕋 ∷_)) (proof-andN-alltrue n)
\end{code}
%</proof-andN-alltrue>
......@@ -23,18 +23,28 @@ open WithGates spec-B₃ using (⟦_⟧)
decoder1 : C B₃ 1 2
decoder1 = fork×⤨
⟫ ¬ℂ ∥ id⤨₁
\end{code}
postulate decoder8 : C B₃ 3 8
\begin{code}
postulate decoder8 : C B₃ 3 8
\end{code}
\begin{code}
false8 = replicate {n = 8} false
\end{code}
\begin{code}
Bool⇒Fin2 : Bool → Fin 2
Bool⇒Fin2 false = Fz
Bool⇒Fin2 true = Fs Fz
\end{code}
\begin{code}
postulate ⊥ : ∀ {ℓ} {α : Set ℓ} → α
\end{code}
postulate decoder8-lookup : (input : W 3) → ⟦ decoder8 ⟧ input ≡ (false8 [ fromℕ≤ {m = fromDigits (map Bool⇒Fin2 (toList input))} ⊥ ]≔ true)
\begin{code}
postulate decoder8-lookup : (x : W 3) → ⟦ decoder8 ⟧ x ≡ (false8 [ fromℕ≤ {m = fromDigits (map Bool⇒Fin2 (toList x))} ⊥ ]≔ true)
\end{code}
\begin{code}
module PiWare.Samples.RegN' where
open import Function using (_∘′_; id; flip)
open import Function using (_∘′_; id; flip; _$_)
open import Coinduction using (♯_)
open import Data.Fin using (#_; raise) renaming (suc to Fs)
open import Data.Bool.Base using (Bool) renaming (false to 𝔽; true to 𝕋)
......@@ -13,6 +13,7 @@ open import Data.Vec.Properties using (lookup∘tabulate; tabulate∘lookup)
open import Data.Vec.Extra using (splitAt′)
open import Data.Vec.Properties.Extra using (tabulate-cong)
open import Data.Stream using (Stream; _∷_; zipWith; repeat; _≈_; map; zipWith-cong)
open import Data.Stream.Extra using (zip)
open import Data.Stream.Properties using (module EqReasoningₛ; module Setoidₛ; map-repeat; map-compose; map-cong-fun; map-id)
open import Data.Stream.Equality.WithTrans using (_≈ₚ_; _∷ₚ_; transₚ; reflₚ; ≈ₚ-to-≈)
open EqReasoningₛ using (_≈⟨_⟩_) renaming (begin_ to beginₛ_; _∎ to _∎ₛ)
......@@ -21,11 +22,11 @@ open import Relation.Binary.PropositionalEquality using (_≡_; _≗_; refl; con
open ≡-Reasoning using (begin_; _≡⟨_⟩_; _∎)
open import Data.CausalStream using (runᶜ′; runᶜ-const)
open import PiWare.Atomic.Bool using (Atomic-Bool)
open import PiWare.Gates.BoolTrio using () renaming (BoolTrio to B₃)
open import PiWare.Circuit using (ℂ; C; Plug; _⟫_; _∥_)
open import PiWare.Plugs using (nil⤨)
open import PiWare.Semantics.Simulation Atomic-Bool using (module WithGates)
open import PiWare.Atomic.Bool using (Atomic-Bool)
open import PiWare.Semantics.Simulation Atomic-Bool using (module WithGates; W)
open import PiWare.Semantics.Simulation.BoolTrio using () renaming (spec to spec-B₃)
open WithGates spec-B₃ using (⟦_⟧ω; ⟦_⟧ᶜ; ⟦_⟧)
open import PiWare.Semantics.Simulation.Properties.SequentialCongruence Atomic-Bool using (⟦⟧ω[_]-cong)
......@@ -64,15 +65,16 @@ regn (suc n) = regn-plug {n} ⟫ (reg ∥ regn n)
%<*lemma>
\AgdaTarget{lemma}
-- TODO: this holds for any serializable product
%<*map⇓²-zip-map⇑¹-repeat>
\AgdaTarget{map⇓²-zip-map⇑¹-repeat}
\begin{code}
lemma : ∀ {xs v} → zipWith _++_ xs (repeat [ v ]) ≈ map ⇓² (zipWith _,_ (map ⇑¹ xs) (repeat v))
lemma {x ∷ xs} {v} = reduce x ∷ ♯ lemma
where reduce : ∀ x → x ++ v ∷ [] ≡ head x ∷ v ∷ []
reduce (x ∷ []) = refl
map⇓²-zip-map⇑¹-repeat : ∀ {xs y} → zipWith _++_ xs (repeat [ y ]) ≈ map ⇓² (zip (map ⇑¹ xs) (repeat y))
map⇓²-zip-map⇑¹-repeat {x ∷ _} {y} = append-headCons x ∷ ♯ map⇓²-zip-map⇑¹-repeat
where append-headCons : ∀ (z : W 1) → z ++ [ y ] ≡ (head z) ∷ [ y ]
append-headCons (_ ∷ []) = refl
\end{code}
%</lemma>
%</map⇓²-zip-map⇑¹-repeat>
%<*proofReg-never-plain>
......@@ -81,7 +83,7 @@ lemma {x ∷ xs} {v} = reduce x ∷ ♯ lemma
proofReg-never-plain : ∀ {xs} → ⟦ reg ⟧ω (zipWith _++_ xs (repeat [ 𝔽 ])) ≈ repeat [ 𝔽 ]
proofReg-never-plain {xs} = beginₛ
⟦ reg ⟧ω (zipWith _++_ xs (repeat [ 𝔽 ]))
≈⟨ ⟦⟧ω[_]-cong {c = reg} spec-B₃ (lemma {xs = xs}) ⟩
≈⟨ ⟦⟧ω[_]-cong {c = reg} spec-B₃ (map⇓²-zip-map⇑¹-repeat {xs = xs}) ⟩
⟦ reg ⟧ω (map ⇓² (zipWith _,_ (map ⇑¹ xs) (repeat 𝔽)))
≈⟨ proofReg-never {xs = map ⇑¹ xs} ⟩
map ⇓¹ (repeat 𝔽)
......@@ -91,70 +93,83 @@ proofReg-never-plain {xs} = beginₛ
%</proofReg-never-plain>
-- TODO: move to Data.Vec.Properties.Extra
%<*head∘[x]-involutive-Vec1>
\AgdaTarget{head∘[x]-involutive-Vec1}
\begin{code}
head∘[x]-involutive-Vec1 : ∀ {ℓ} {α : Set ℓ} (xs : Vec α 1) → [_] (head xs) ≡ xs
head∘[x]-involutive-Vec1 (x ∷ []) = refl
\end{code}
%</head∘[x]-involutive-Vec1>
%<*proofReg-always-plain>
\AgdaTarget{proofReg-always-plain}
\begin{code}
proofReg-always-plain : ∀ {xs} → ⟦ reg ⟧ω (zipWith _++_ xs (repeat [ 𝕋 ])) ≈ xs
proofReg-always-plain {xs} = beginₛ
⟦ reg ⟧ω (zipWith _++_ xs (repeat [ 𝕋 ]))
≈⟨ ⟦⟧ω[_]-cong {c = reg} spec-B₃ (lemma {xs = xs}) ⟩
≈⟨ ⟦⟧ω[_]-cong {c = reg} spec-B₃ (map⇓²-zip-map⇑¹-repeat {xs = xs}) ⟩
⟦ reg ⟧ω (map ⇓² (zipWith _,_ (map ⇑¹ xs) (repeat 𝕋)))
≈⟨ proofReg-always {xs = map ⇑¹ xs} ⟩
map ⇓¹ (map ⇑¹ xs)
≈⟨ symₛ map-compose ⟩
map (⇓¹ ∘′ ⇑¹) xs
≈⟨ map-cong-fun
≈⟨ map-cong-fun head∘[x]-involutive-Vec1
map id xs
≈⟨ map-id ⟩
xs ∎ₛ
where postulate ⊥ : _
\end{code}
%</proofReg-always-plain>
%<*lemma-plug''>
\AgdaTarget{lemma-plug''}
-- TODO: move?
%<*regn-plug-tabulates-lookups>
\AgdaTarget{regn-plug-tabulates-lookups}
\begin{code}
lemma-plug'' : ∀ {ℓ} {α : Set ℓ} {n} {x1 x2} {xs : Vec α n}
→ tabulate (λ x → lookup (lookup x (tabulate (Fs ∘′ Fs))) (x1 ∷ x2 ∷ xs)) ≡ xs
lemma-plug''{x1 = x1} {x2} {xs} = begin
tabulate (λ x → lookup (lookup x (tabulate (Fs ∘′ Fs))) (x1 ∷ x2 ∷ xs))
≡⟨ tabulate-cong (λ x → cong (λ z → lookup z (x1 ∷ x2 ∷ xs)) (lookup∘tabulate (Fs ∘′ Fs) x)) ⟩
tabulate (flip lookup xs)
≡⟨ tabulate∘lookup xs ⟩
xs ∎
regn-plug-tabulates-lookups : ∀ {n ℓ} {α : Set ℓ} {x y} {zs : Vec α n}
→ tabulate (λ k → lookup (lookup k (tabulate (Fs ∘′ Fs))) (x ∷ y ∷ zs)) ≡ zs
regn-plug-tabulates-lookups {x = x} {y} {zs} = begin
tabulate (λ k → lookup (lookup k (tabulate (Fs ∘′ Fs))) (x ∷ y ∷ zs))
≡⟨ tabulate-cong (λ k₁ → cong (λ k₂ → lookup k₂ (x ∷ y ∷ zs)) (lookup∘tabulate (Fs ∘′ Fs) k₁)) ⟩
tabulate (flip lookup zs)
≡⟨ tabulate∘lookup zs ⟩
zs ∎
\end{code}
%</lemma-plug''>
%</regn-plug-tabulates-lookups>
%<*lemma-plug'>
\AgdaTarget{lemma-plug'}
%<*regn-plug-runᶜ′>
\AgdaTarget{regn-plug-runᶜ′}
\begin{code}
lemma-plug' : ∀ {n v x cs xs} → runᶜ′ ⟦ regn-plug {n} ⟧ᶜ ((v ∷ x) ∷ cs) (zipWith _∷_ (repeat v) xs) ≈ₚ
zipWith _++_ (zipWith _++_ (map (proj₁ ∘′ splitAt′ 1) (x ∷ ♯ xs)) (repeat [ v ])) (zipWith _∷_ (repeat v) (map (proj₂ ∘′ splitAt′ 1) (x ∷ ♯ xs)))
lemma-plug' {x = x} {xs = x₁ ∷ xs₁} with splitAt 1 x
lemma-plug' {v = v} {x = ._} {xs = x₁ ∷ xs₁} | xh ∷ [] , xt , refl = cong (λ z → xh ∷ v ∷ v ∷ z) lemma-plug'' ∷ₚ (♯ transₚ lemma-plug' (refl ∷ₚ (♯ reflₚ)))
regn-plug-runᶜ′ : ∀ {n v x cs xs} → runᶜ′ ⟦ regn-plug {n} ⟧ᶜ ((v ∷ x) ∷ cs) (zipWith _∷_ (repeat v) xs)
≈ₚ zipWith _++_ (zipWith _++_ (map (proj₁ ∘′ splitAt′ 1) (x ∷ ♯ xs)) (repeat [ v ]))
(zipWith _∷_ (repeat v) (map (proj₂ ∘′ splitAt′ 1) (x ∷ ♯ xs)))
regn-plug-runᶜ′ {x = x} {xs = _ ∷ _} with splitAt 1 x
regn-plug-runᶜ′ {v = v} {xs = _ ∷ _} | xh ∷ [] , _ , refl =
cong (λ z → xh ∷ v ∷ v ∷ z) regn-plug-tabulates-lookups ∷ₚ ♯ transₚ regn-plug-runᶜ′ (refl ∷ₚ ♯ reflₚ)
\end{code}
%</lemma-plug'>
%</regn-plug-runᶜ′>
%<*lemma-plug>
\AgdaTarget{lemma-plug}
%<*regn-plug-ω>
\AgdaTarget{regn-plug-ω}
\begin{code}
lemma-plug : ∀ {n v xs} → ⟦ regn-plug {n} ⟧ω (zipWith _∷_ (repeat v) xs) ≈
zipWith _++_ (zipWith _++_ (map (proj₁ ∘′ splitAt′ 1) xs) (repeat [ v ])) (zipWith _∷_ (repeat v) (map (proj₂ ∘′ splitAt′ 1) xs))
lemma-plug {xs = x ∷ xs} = transₛ (≈ₚ-to-≈ lemma-plug') (refl ∷ (♯ reflₛ))
regn-plug-ω : ∀ {n v xs} → ⟦ regn-plug {n} ⟧ω (zipWith _∷_ (repeat v) xs)
≈ zipWith _++_ (zipWith _++_ (map (proj₁ ∘′ splitAt′ 1) xs) (repeat [ v ]))
(zipWith _∷_ (repeat v) (map (proj₂ ∘′ splitAt′ 1) xs))
regn-plug-ω {xs = _ ∷ _} = ≈ₚ-to-≈ $ transₚ regn-plug-runᶜ′ (refl ∷ₚ ♯ reflₚ)
\end{code}
%</lemma-plug>
%</regn-plug-ω>
%<*lemmaRegN-never>
\AgdaTarget{lemmaRegN-never}
%<*regN-never-data𝔽>
\AgdaTarget{regN-never-data𝔽}
\begin{code}
lemmaRegN-never : ∀ {n} → zipWith _++_ (repeat [ 𝔽 ]) (repeat (replicate 𝔽)) ≈ repeat (replicate {n = suc n} 𝔽)
lemmaRegN-never = refl ∷ ♯ lemmaRegN-never
regN-never-data𝔽 : ∀ {n} → zipWith _++_ (repeat [ 𝔽 ]) (repeat (replicate 𝔽)) ≈ repeat (replicate {n = suc n} 𝔽)
regN-never-data𝔽 = refl ∷ ♯ regN-never-data𝔽
\end{code}
%</lemmaRegN-never>
%</regN-never-data𝔽>
%<*proofRegN-never>
......@@ -168,57 +183,57 @@ proofRegN-never {suc n} {xs} = beginₛ
⟦ regn-plug {n} ⟫ (reg ∥ regn n) ⟧ω (zipWith _∷_ (repeat 𝔽) xs)
≈⟨ proofSeq {c = regn-plug {n}} {d = reg ∥ regn n} {ins = zipWith _∷_ (repeat 𝔽) xs} ⟩
⟦ reg ∥ regn n ⟧ω (⟦ regn-plug {n} ⟧ω (zipWith _∷_ (repeat 𝔽) xs))
≈⟨ ⟦⟧ω[_]-cong {c = reg ∥ regn n} spec-B₃ (lemma-plug {xs = xs}) ⟩
≈⟨ ⟦⟧ω[_]-cong {c = reg ∥ regn n} spec-B₃ (regn-plug-ω {xs = xs}) ⟩
⟦ reg ∥ regn n ⟧ω (zipWith _++_ (zipWith _++_ (map (proj₁ ∘′ splitAt′ 1) xs) (repeat [ 𝔽 ])) (zipWith _∷_ (repeat 𝔽) (map (proj₂ ∘′ splitAt′ 1) xs)))
≈⟨ proofPar {c = reg} {d = regn n}
{ins₁ = (zipWith _++_ (map (proj₁ ∘′ splitAt′ 1) xs) (repeat [ 𝔽 ]))} {ins₂ = zipWith _∷_ (repeat 𝔽) (map (proj₂ ∘′ splitAt′ 1) xs)} ⟩
{(zipWith _++_ (map (proj₁ ∘′ splitAt′ 1) xs) (repeat [ 𝔽 ]))} {zipWith _∷_ (repeat 𝔽) (map (proj₂ ∘′ splitAt′ 1) xs)} ⟩
zipWith _++_ (⟦ reg ⟧ω (zipWith _++_ (map (proj₁ ∘′ splitAt′ 1) xs) (repeat [ 𝔽 ]))) (⟦ regn n ⟧ω (zipWith _∷_ (repeat 𝔽) (map (proj₂ ∘′ splitAt′ 1) xs)))
≈⟨ zipWith-cong _++_ (proofReg-never-plain {xs = map (proj₁ ∘′ splitAt′ 1) xs}) (proofRegN-never {n = n} {xs = map (proj₂ ∘′ splitAt′ 1) xs}) ⟩
≈⟨ zipWith-cong _++_ (proofReg-never-plain {map (proj₁ ∘′ splitAt′ 1) xs}) (proofRegN-never {n} {map (proj₂ ∘′ splitAt′ 1) xs}) ⟩
zipWith _++_ (repeat [ 𝔽 ]) (repeat (replicate 𝔽))
≈⟨ lemmaRegN-never {n = n} ⟩
≈⟨ regN-never-data𝔽 {n} ⟩
repeat (replicate 𝔽) ∎ₛ
\end{code}
%</proofRegN-never>
%<*lemma-repeat-empty>
\AgdaTarget{lemma-repeat-empty}
%<*repeat[]≈xs-Vec0>
\AgdaTarget{repeat[]≈xs-Vec0}
\begin{code}
lemma-repeat-empty : ∀ {A} {xs : Stream (Vec A 0)} → repeat [] ≈ xs
lemma-repeat-empty {xs = [] ∷ xs} = refl ∷ (♯ lemma-repeat-empty)
repeat[]≈xs-Vec0 : ∀ {α} {xs : Stream (Vec α zero)} → repeat [] ≈ xs
repeat[]≈xs-Vec0 {xs = [] ∷ xs} = refl ∷ ♯ repeat[]≈xs-Vec0
\end{code}
%</lemma-repeat-empty>
%</repeat[]≈xs-Vec0>
%<*lemmaRegN-always>
\AgdaTarget{lemmaRegN-always}
%<*zipWith++-map-splitAt>
\AgdaTarget{zipWith++-map-splitAt}
\begin{code}
lemmaRegN-always : ∀ {A} {n} {xs : Stream (Vec A (suc n))} → zipWith _++_ (map (proj₁ ∘′ splitAt′ 1) xs) (map (proj₂ ∘′ splitAt′ 1) xs) ≈ xs
lemmaRegN-always {xs = x ∷ xs} with splitAt 1 x
lemmaRegN-always {xs = .(xh ++ xt) ∷ xs} | xh , xt , refl = refl ∷ ♯ lemmaRegN-always
zipWith++-map-splitAt : ∀ {n α} {xs : Stream (Vec α (suc n))} → zipWith _++_ (map (proj₁ ∘′ splitAt′ 1) xs) (map (proj₂ ∘′ splitAt′ 1) xs) ≈ xs
zipWith++-map-splitAt {xs = x ∷ _} with splitAt 1 x
zipWith++-map-splitAt {xs = .(xh ++ xt) ∷ _} | xh , xt , refl = refl ∷ ♯ zipWith++-map-splitAt
\end{code}
%</lemmaRegN-always>
%</zipWith++-map-splitAt>
%<*proofRegN-always>
\AgdaTarget{proofRegN-always}
\begin{code}
proofRegN-always : ∀ {n xs} → ⟦ regn n ⟧ω (zipWith _∷_ (repeat 𝕋) xs) ≈ xs
proofRegN-always {zero} {xs} = transₛ (runᶜ-const {xs = zipWith _∷_ (repeat 𝕋) xs} []) lemma-repeat-empty
proofRegN-always {zero} {xs} = transₛ (runᶜ-const {xs = zipWith _∷_ (repeat 𝕋) xs} []) repeat[]≈xs-Vec0
proofRegN-always {suc n} {xs} = beginₛ
⟦ regn (suc n) ⟧ω (zipWith _∷_ (repeat 𝕋) xs)
≈⟨ reflₛ ⟩
⟦ regn-plug {n} ⟫ (reg ∥ regn n) ⟧ω (zipWith _∷_ (repeat 𝕋) xs)
≈⟨ proofSeq {c = regn-plug {n}} {d = reg ∥ regn n} {ins = zipWith _∷_ (repeat 𝕋) xs} ⟩
⟦ reg ∥ regn n ⟧ω (⟦ regn-plug {n} ⟧ω (zipWith _∷_ (repeat 𝕋) xs))
≈⟨ ⟦⟧ω[_]-cong {c = reg ∥ regn n} spec-B₃ (lemma-plug {xs = xs}) ⟩
≈⟨ ⟦⟧ω[_]-cong {c = reg ∥ regn n} spec-B₃ (regn-plug-ω {xs = xs}) ⟩
⟦ reg ∥ regn n ⟧ω (zipWith _++_ (zipWith _++_ (map (proj₁ ∘′ splitAt′ 1) xs) (repeat [ 𝕋 ])) (zipWith _∷_ (repeat 𝕋) (map (proj₂ ∘′ splitAt′ 1) xs)))
≈⟨ proofPar {c = reg} {d = regn n}
{ins₁ = (zipWith _++_ (map (proj₁ ∘′ splitAt′ 1) xs) (repeat [ 𝕋 ]))} {ins₂ = zipWith _∷_ (repeat 𝕋) (map (proj₂ ∘′ splitAt′ 1) xs)} ⟩
zipWith _++_ (⟦ reg ⟧ω (zipWith _++_ (map (proj₁ ∘′ splitAt′ 1) xs) (repeat [ 𝕋 ]))) (⟦ regn n ⟧ω (zipWith _∷_ (repeat 𝕋) (map (proj₂ ∘′ splitAt′ 1) xs)))
≈⟨ zipWith-cong _++_ (proofReg-always-plain {xs = map (proj₁ ∘′ splitAt′ 1) xs}) (proofRegN-always {n = n} {xs = map (proj₂ ∘′ splitAt′ 1) xs}) ⟩
zipWith _++_ (map (proj₁ ∘′ splitAt′ 1) xs) (map (proj₂ ∘′ splitAt′ 1) xs)
≈⟨ lemmaRegN-always
≈⟨ zipWith++-map-splitAt
xs ∎ₛ
\end{code}
%</proofRegN-always>
......@@ -3,6 +3,15 @@ module PiWare.Samples.RegN'Properties where
open import Function using (_∘′_; flip)
open import Coinduction using (♯_; ♭)
open import Data.Bool.Base using (true; false)
open import Data.Fin using () renaming (suc to Fs)
open import Data.List.NonEmpty using (_∷_)
open import Data.Nat.Base using (zero; suc; _+_)
open import Data.Product using (proj₁; _×_; proj₂; _,_)
open import Data.Vec using (Vec; _∷_; []; [_]; head; tail; _∷ʳ_; _++_; splitAt; tabulate; lookup) renaming (zipWith to zipWithᵥ)
open import Data.Vec.Properties using (tabulate∘lookup; lookup∘tabulate)
open import Data.Vec.Extra using (splitAt′; ₁∘split1′; ₂∘split1′)
open import Data.Vec.Properties.Extra using (tabulate-cong; ++-injective)
open import Data.CausalStream using (runᶜ′; runᶜ-const)
open import Data.Stream using (Stream; take; drop; map; zipWith; _≈_; head-cong; _∷_) renaming (head to headₛ)
open import Data.Stream.Equality.WithTrans using (_≈ₚ_; _∷ₚ_; ≈ₚ-to-≈; ≈-to-≈ₚ; reflₚ; transₚ)
......@@ -11,23 +20,13 @@ open Setoidₛ using () renaming (refl to reflₛ; trans to transₛ; sym to sym
open EqReasoningₛ using (_≈⟨_⟩_) renaming (begin_ to beginₛ_; _∎ to _∎ₛ)
open import Relation.Binary.PropositionalEquality using (_≡_; refl; sym; cong; cong₂; module ≡-Reasoning)
open ≡-Reasoning using (begin_; _≡⟨_⟩_; _∎)
open import Data.Bool.Base using (true; false)
open import Data.Fin using () renaming (suc to Fs)
open import Data.List.NonEmpty using (_∷_)
open import Data.Nat using (zero; suc; _+_)
open import Data.Product using (proj₁; _×_; proj₂; _,_)
open import Data.Vec using (Vec; _∷_; []; [_]; head; tail; _∷ʳ_; _++_; splitAt; tabulate; lookup) renaming (zipWith to zipWithᵥ)
open import Data.Vec.Properties using (tabulate∘lookup; lookup∘tabulate)
open import Data.Vec.Extra using (splitAt′)
open import Data.Vec.Properties.Extra using (tabulate-cong; ++-injective)
open import PiWare.Atomic.Bool using (Atomic-Bool)
open import PiWare.Circuit using (Plug; _⟫_; _∥_)
open import PiWare.Atomic.Bool using (Atomic-Bool)
open import PiWare.Semantics.Simulation Atomic-Bool using (delay′; module WithGates)
open import PiWare.Semantics.Simulation.BoolTrio using () renaming (spec to spec-B₃)
open WithGates spec-B₃ using (⟦_⟧ᶜ; ⟦_⟧ω)
open import PiWare.Samples.BoolTrioSeq using (reg)
open import PiWare.Samples.RegN using (p₁∘split1; p₂∘split1)
open import PiWare.Samples.RegN' using (regn-plug; regn)
open import PiWare.Samples.RegProperties using (regW,R-I⇒O; regR,R-I⇒O)
open import PiWare.Semantics.Simulation.Properties.SequentialCongruence Atomic-Bool using (⟦⟧ω[_]-cong)
......@@ -37,7 +36,7 @@ open import PiWare.Semantics.Simulation.Properties.SequentialSequencing Atomic-B
lemma-deconstruct-split : ∀ {α n d} {y z : α} {ys zs : Vec α n} {xs}
→ take 2 (drop d xs) ≡ (y ∷ ys) ∷ (z ∷ zs) ∷ []
→ take 2 (drop d (map p₁∘split1 xs)) ≡ [ y ] ∷ [ z ] ∷ [] × take 2 (drop d (map p₂∘split1 xs)) ≡ ys ∷ zs ∷ []
→ take 2 (drop d (map ₁∘split1′ xs)) ≡ [ y ] ∷ [ z ] ∷ [] × take 2 (drop d (map ₂∘split1′ xs)) ≡ ys ∷ zs ∷ []
lemma-deconstruct-split {d = zero} {xs = _ ∷ xs′} p with ♭ xs′
lemma-deconstruct-split {d = zero} {y} {z} {ys} {zs} {.(y ∷ ys) ∷ xs′} refl | .(z ∷ zs) ∷ xs₁ = refl , refl
lemma-deconstruct-split {d = suc d′} {xs = _ ∷ _} p = lemma-deconstruct-split {d = d′} p
......@@ -101,8 +100,8 @@ lemma-plug'' {x₀ = x₀} {x₁} {xs} = begin
lemma-plug' : ∀ {n l x cs ls xs}
→ runᶜ′ ⟦ regn-plug {n} ⟧ᶜ ((l ∷ x) ∷ cs) (zipWith _∷_ ls xs)
≈ₚ zipWith _++_ (zipWith _∷ʳ_ (map p₁∘split1 (x ∷ ♯ xs)) (l ∷ ♯ ls))
(zipWith _∷_ (l ∷ ♯ ls) (map p₂∘split1 (x ∷ ♯ xs)))
≈ₚ zipWith _++_ (zipWith _∷ʳ_ (map ₁∘split1′ (x ∷ ♯ xs)) (l ∷ ♯ ls))
(zipWith _∷_ (l ∷ ♯ ls) (map ₂∘split1′ (x ∷ ♯ xs)))
lemma-plug' {x = x} {ls = l₁ ∷ ls₁} {xs = x₁ ∷ xs₁} with splitAt 1 x
lemma-plug' {l = l} {x = ._} {ls = l₁ ∷ ls₁} {xs = x₁ ∷ xs₁} | xh ∷ [] , xt , refl =
cong (λ z → xh ∷ l ∷ l ∷ z) lemma-plug'' ∷ₚ (♯ transₚ lemma-plug' (refl ∷ₚ ♯ reflₚ))
......@@ -110,7 +109,7 @@ lemma-plug' {l = l} {x = ._} {ls = l₁ ∷ ls₁} {xs = x₁ ∷ xs₁} | xh
lemma-plug : ∀ {n ls xs}
→ ⟦ regn-plug {n} ⟧ω (zipWith _∷_ ls xs)
≈ zipWith _++_ (zipWith _∷ʳ_ (map p₁∘split1 xs) ls) (zipWith _∷_ ls (map p₂∘split1 xs))
≈ zipWith _++_ (zipWith _∷ʳ_ (map ₁∘split1′ xs) ls) (zipWith _∷_ ls (map ₂∘split1′ xs))
lemma-plug {ls = l ∷ ls} {xs = x ∷ xs} = transₛ (≈ₚ-to-≈ lemma-plug') (refl ∷ (♯ reflₛ))
......@@ -125,22 +124,22 @@ proofNWriteRead {suc n} {d} {wh ∷ wt} {c1h ∷ c1t} {ins} p | pls , pvs | pvhs
≡⟨ take-cong (drop-cong {n = d} (proofSeq {c = regn-plug} {d = reg ∥ regn n} {ins = zipWith _∷_ (map head ins) (map tail ins)})) ⟩
take 2 (drop d (⟦ reg ∥ regn n ⟧ω (⟦ regn-plug ⟧ω (zipWith _∷_ (map head ins) (map tail ins)))))
≡⟨ take-cong (drop-cong {n = d} (⟦⟧ω[_]-cong {c = reg ∥ regn n} spec-B₃ (lemma-plug {ls = map head ins} {xs = map tail ins}))) ⟩
take 2 (drop d (⟦ reg ∥ regn n ⟧ω (zipWith _++_ (zipWith _∷ʳ_ (map p₁∘split1 (map tail ins)) (map head ins))
(zipWith _∷_ (map head ins) (map p₂∘split1 (map tail ins))))))
take 2 (drop d (⟦ reg ∥ regn n ⟧ω (zipWith _++_ (zipWith _∷ʳ_ (map ₁∘split1′ (map tail ins)) (map head ins))
(zipWith _∷_ (map head ins) (map ₂∘split1′ (map tail ins))))))
≡⟨ take-cong (drop-cong {n = d} (proofPar {c = reg} {d = regn n}
{ins₁ = zipWith _∷ʳ_ (map p₁∘split1 (map tail ins)) (map head ins)}
{ins₂ = zipWith _∷_ (map head ins) (map p₂∘split1 (map tail ins))})) ⟩
take 2 (drop d (zipWith _++_ (⟦ reg ⟧ω (zipWith _∷ʳ_ (map p₁∘split1 (map tail ins)) (map head ins)))
(⟦ regn n ⟧ω (zipWith _∷_ (map head ins) (map p₂∘split1 (map tail ins))))))
{ins₁ = zipWith _∷ʳ_ (map ₁∘split1′ (map tail ins)) (map head ins)}
{ins₂ = zipWith _∷_ (map head ins) (map ₂∘split1′ (map tail ins))})) ⟩
take 2 (drop d (zipWith _++_ (⟦ reg ⟧ω (zipWith _∷ʳ_ (map ₁∘split1′ (map tail ins)) (map head ins)))
(⟦ regn n ⟧ω (zipWith _∷_ (map head ins) (map ₂∘split1′ (map tail ins))))))
≡⟨ take-cong (lemma-drop-zipWith {d = d}) ⟩
take 2 (zipWith _++_ (drop d (⟦ reg ⟧ω (zipWith _∷ʳ_ (map p₁∘split1 (map tail ins)) (map head ins))))
(drop d (⟦ regn n ⟧ω (zipWith _∷_ (map head ins) (map p₂∘split1 (map tail ins))))))
take 2 (zipWith _++_ (drop d (⟦ reg ⟧ω (zipWith _∷ʳ_ (map ₁∘split1′ (map tail ins)) (map head ins))))
(drop d (⟦ regn n ⟧ω (zipWith _∷_ (map head ins) (map ₂∘split1′ (map tail ins))))))
≡⟨ lemma-take-zipWith ⟩
zipWithᵥ _++_ (take 2 (drop d (⟦ reg ⟧ω (zipWith _∷ʳ_ (map p₁∘split1 (map tail ins)) (map head ins)))))
(take 2 (drop d (⟦ regn n ⟧ω (zipWith _∷_ (map head ins) (map p₂∘split1 (map tail ins))))))
zipWithᵥ _++_ (take 2 (drop d (⟦ reg ⟧ω (zipWith _∷ʳ_ (map ₁∘split1′ (map tail ins)) (map head ins)))))
(take 2 (drop d (⟦ regn n ⟧ω (zipWith _∷_ (map head ins) (map ₂∘split1′ (map tail ins))))))
≡⟨ cong₂ (zipWithᵥ _++_)
(regW,R-I⇒O {n = d} {d¹ = c1h} {xs = zipWith _∷ʳ_ (map p₁∘split1 (map tail ins)) (map head ins)} (lemma-construct-snoc {d = d} pvhs pls))
(proofNWriteRead {d = d} {ins = zipWith _∷_ (map head ins) (map p₂∘split1 (map tail ins))} (lemma-construct-cons {d = d} pls pvts)) ⟩
(regW,R-I⇒O {n = d} {d¹ = c1h} {xs = zipWith _∷ʳ_ (map ₁∘split1′ (map tail ins)) (map head ins)} (lemma-construct-snoc {d = d} pvhs pls))
(proofNWriteRead {d = d} {ins = zipWith _∷_ (map head ins) (map ₂∘split1′ (map tail ins))} (lemma-construct-cons {d = d} pls pvts)) ⟩
zipWithᵥ _++_ ([ wh ] ∷ [ wh ] ∷ []) (wt ∷ wt ∷ [])
≡⟨ refl ⟩
(wh ∷ wt) ∷ (wh ∷ wt) ∷ [] ∎
......@@ -148,8 +147,8 @@ proofNWriteRead {suc n} {d} {wh ∷ wt} {c1h ∷ c1t} {ins} p | pls , pvs | pvhs
lemma-unfold-regn' : ∀ {n ins} →
⟦ regn (suc n) ⟧ω ins ≈ zipWith _++_
(⟦ reg ⟧ω (zipWith _∷ʳ_ (map p₁∘split1 (map tail ins)) (map head ins)))
(⟦ regn n ⟧ω (zipWith _∷_ (map head ins) (map p₂∘split1 (map tail ins))))
(⟦ reg ⟧ω (zipWith _∷ʳ_ (map ₁∘split1′ (map tail ins)) (map head ins)))
(⟦ regn n ⟧ω (zipWith _∷_ (map head ins) (map ₂∘split1′ (map tail ins))))
lemma-unfold-regn' {n} {ins} = beginₛ
⟦ regn (suc n) ⟧ω ins
≈⟨ reflₛ ⟩
......@@ -160,14 +159,14 @@ lemma-unfold-regn' {n} {ins} = beginₛ
⟦ reg ∥ regn n ⟧ω (⟦ regn-plug ⟧ω (zipWith _∷_ (map head ins) (map tail ins)))
≈⟨ ⟦⟧ω[_]-cong {c = reg ∥ regn n} spec-B₃ (lemma-plug {ls = map head ins} {xs = map tail ins}) ⟩
⟦ reg ∥ regn n ⟧ω (zipWith _++_
(zipWith _∷ʳ_ (map p₁∘split1 (map tail ins)) (map head ins))
(zipWith _∷_ (map head ins) (map p₂∘split1 (map tail ins))))
(zipWith _∷ʳ_ (map ₁∘split1′ (map tail ins)) (map head ins))
(zipWith _∷_ (map head ins) (map ₂∘split1′ (map tail ins))))
≈⟨ proofPar {c = reg} {d = regn n}
{ins₁ = zipWith _∷ʳ_ (map p₁∘split1 (map tail ins)) (map head ins)}
{ins₂ = zipWith _∷_ (map head ins) (map p₂∘split1 (map tail ins))} ⟩
{ins₁ = zipWith _∷ʳ_ (map ₁∘split1′ (map tail ins)) (map head ins)}
{ins₂ = zipWith _∷_ (map head ins) (map ₂∘split1′ (map tail ins))} ⟩
zipWith _++_
(⟦ reg ⟧ω (zipWith _∷ʳ_ (map p₁∘split1 (map tail ins)) (map head ins)))
(⟦ regn n ⟧ω (zipWith _∷_ (map head ins) (map p₂∘split1 (map tail ins)))) ∎ₛ
(⟦ reg ⟧ω (zipWith _∷ʳ_ (map ₁∘split1′ (map tail ins)) (map head ins)))
(⟦ regn n ⟧ω (zipWith _∷_ (map head ins) (map ₂∘split1′ (map tail ins)))) ∎ₛ
lemma-head-zipWith : ∀ {A} {n m} {xs : Stream (Vec A n)} {ys : Stream (Vec A m)} → headₛ (zipWith _++_ xs ys) ≡ headₛ xs ++ headₛ ys
......@@ -176,23 +175,23 @@ lemma-head-zipWith {xs = x ∷ xs} {ys = y ∷ ys} = refl
lemma-unfold-regn : ∀ {n d wh wt ins} →
headₛ (drop d (⟦ regn (suc n) ⟧ω ins)) ≡ wh ∷ wt →
headₛ (drop d (⟦ reg ⟧ω (zipWith _∷ʳ_ (map p₁∘split1 (map tail ins)) (map head ins)))) ≡ wh ∷ []
headₛ (drop d (⟦ reg ⟧ω (zipWith _∷ʳ_ (map ₁∘split1′ (map tail ins)) (map head ins)))) ≡ wh ∷ []
×
headₛ (drop d (⟦ regn n ⟧ω (zipWith _∷_ (map head ins) (map p₂∘split1 (map tail ins))))) ≡ wt
headₛ (drop d (⟦ regn n ⟧ω (zipWith _∷_ (map head ins) (map ₂∘split1′ (map tail ins))))) ≡ wt
lemma-unfold-regn {n} {d} {wh} {wt} {ins} p = ++-injective (begin
headₛ (drop d (⟦ reg ⟧ω (zipWith _∷ʳ_ (map p₁∘split1 (map tail ins)) (map head ins))))
headₛ (drop d (⟦ reg ⟧ω (zipWith _∷ʳ_ (map ₁∘split1′ (map tail ins)) (map head ins))))
++
headₛ (drop d (⟦ regn n ⟧ω (zipWith _∷_ (map head ins) (map p₂∘split1 (map tail ins)))))
headₛ (drop d (⟦ regn n ⟧ω (zipWith _∷_ (map head ins) (map ₂∘split1′ (map tail ins)))))
≡⟨ sym (lemma-head-zipWith
{xs = drop d (⟦ reg ⟧ω (zipWith _∷ʳ_ (map p₁∘split1 (map tail ins)) (map head ins)))}
{ys = drop d (⟦ regn n ⟧ω (zipWith _∷_ (map head ins) (map p₂∘split1 (map tail ins))))}) ⟩
{xs = drop d (⟦ reg ⟧ω (zipWith _∷ʳ_ (map ₁∘split1′ (map tail ins)) (map head ins)))}
{ys = drop d (⟦ regn n ⟧ω (zipWith _∷_ (map head ins) (map ₂∘split1′ (map tail ins))))}) ⟩
headₛ (zipWith _++_
(drop d (⟦ reg ⟧ω (zipWith _∷ʳ_ (map p₁∘split1 (map tail ins)) (map head ins))))
(drop d (⟦ regn n ⟧ω (zipWith _∷_ (map head ins) (map p₂∘split1 (map tail ins))))))
(drop d (⟦ reg ⟧ω (zipWith _∷ʳ_ (map ₁∘split1′ (map tail ins)) (map head ins))))
(drop d (⟦ regn n ⟧ω (zipWith _∷_ (map head ins) (map ₂∘split1′ (map tail ins))))))
≡⟨ head-cong (symₛ (lemma-drop-zipWith {d = d})) ⟩
headₛ (drop d (zipWith _++_
(⟦ reg ⟧ω (zipWith _∷ʳ_ (map p₁∘split1 (map tail ins)) (map head ins)))
(⟦ regn n ⟧ω (zipWith _∷_ (map head ins) (map p₂∘split1 (map tail ins))))))
(⟦ reg ⟧ω (zipWith _∷ʳ_ (map ₁∘split1′ (map tail ins)) (map head ins)))
(⟦ regn n ⟧ω (zipWith _∷_ (map head ins) (map ₂∘split1′ (map tail ins))))))
≡⟨ head-cong (drop-cong {n = d} (symₛ (lemma-unfold-regn' {ins = ins}))) ⟩
headₛ (drop d (⟦ regn (suc n) ⟧ω ins))
≡⟨ p ⟩
......@@ -213,26 +212,26 @@ proofNReadRead {suc n} {d} {wh ∷ wt} {c1h ∷ c1t} {c2h ∷ c2t} {ins} pp ph |
≡⟨ take-cong (drop-cong {n = d} (proofSeq {c = regn-plug} {d = reg ∥ regn n} {ins = zipWith _∷_ (map head ins) (map tail ins)})) ⟩
take 2 (drop d (⟦ reg ∥ regn n ⟧ω (⟦ regn-plug ⟧ω (zipWith _∷_ (map head ins) (map tail ins)))))
≡⟨ take-cong (drop-cong {n = d} (⟦⟧ω[_]-cong {c = reg ∥ regn n} spec-B₃ (lemma-plug {ls = map head ins} {xs = map tail ins}))) ⟩
take 2 (drop d (⟦ reg ∥ regn n ⟧ω (zipWith _++_ (zipWith _∷ʳ_ (map p₁∘split1 (map tail ins)) (map head ins))
(zipWith _∷_ (map head ins) (map p₂∘split1 (map tail ins))))))
take 2 (drop d (⟦ reg ∥ regn n ⟧ω (zipWith _++_ (zipWith _∷ʳ_ (map ₁∘split1′ (map tail ins)) (map head ins))
(zipWith _∷_ (map head ins) (map ₂∘split1′ (map tail ins))))))
≡⟨ take-cong (drop-cong {n = d} (proofPar {c = reg} {d = regn n}
{ins₁ = zipWith _∷ʳ_ (map p₁∘split1 (map tail ins)) (map head ins)}
{ins₂ = zipWith _∷_ (map head ins) (map p₂∘split1 (map tail ins))})) ⟩
{ins₁ = zipWith _∷ʳ_ (map ₁∘split1′ (map tail ins)) (map head ins)}
{ins₂ = zipWith _∷_ (map head ins) (map ₂∘split1′ (map tail ins))})) ⟩
take 2 (drop d (zipWith _++_
(⟦ reg ⟧ω (zipWith _∷ʳ_ (map p₁∘split1 (map tail ins)) (map head ins)))
(⟦ regn n ⟧ω (zipWith _∷_ (map head ins) (map p₂∘split1 (map tail ins))))))
(⟦ reg ⟧ω (zipWith _∷ʳ_ (map ₁∘split1′ (map tail ins)) (map head ins)))
(⟦ regn n ⟧ω (zipWith _∷_ (map head ins) (map ₂∘split1′ (map tail ins))))))
≡⟨ take-cong (lemma-drop-zipWith {d = d}) ⟩
take 2 (zipWith _++_
(drop d (⟦ reg ⟧ω (zipWith _∷ʳ_ (map p₁∘split1 (map tail ins)) (map head ins))))
(drop d (⟦ regn n ⟧ω (zipWith _∷_ (map head ins) (map p₂∘split1 (map tail ins))))))
(drop d (⟦ reg ⟧ω (zipWith _∷ʳ_ (map ₁∘split1′ (map tail ins)) (map head ins))))