{-

The module CanThetaContinuation contains the continuation-passing
variant of Canθ, which is used as a tool to simplify Canθ-Can
expressions.

The lemmas are mainly about the function Canθ' defined by the equation

    unfold : ∀ sigs S'' p θ →
         Canθ sigs S'' p θ ≡ Canθ' sigs S'' (Can p) θ

The main property proved here is that the search function
Canθ is distributive over the environment:

    canθ'-←-distribute : ∀ sigs sigs' S'' r θ →
      Canθ (SigMap.union sigs sigs') S'' r θ ≡
      Canθ' sigs S'' (Canθ sigs' S'' r) θ

Other properties about how the search is performed are:

    canθ'-inner-shadowing-irr : ∀ sigs S'' sigs' p S status θ →
      S ∈ SigMap.keys sigs' →
        Canθ' sigs S'' (Canθ sigs' 0 p) (θ ← [ (S ₛ) ↦ status ]) ≡
        Canθ' sigs S'' (Canθ sigs' 0 p) θ

    canθ'-search-acc : ∀ sigs S κ θ →
      ∀ S'' status →
        S'' ∉ map (_+_ S)  (SigMap.keys sigs) →
        Canθ' sigs S  κ  (θ ← [ (S'' ₛ) ↦ status ]) ≡
        Canθ' sigs S (κ ∘ (_← [ (S'' ₛ) ↦ status ])) θ

-}
module Esterel.Lang.CanFunction.CanThetaContinuation where

open import utility

open import utility
  renaming (_U̬_ to _∪_ ; _|̌_ to _-_)

open import Esterel.Lang
open import Esterel.Lang.Binding
open import Esterel.Lang.CanFunction
open import Esterel.Lang.CanFunction.Base
open import Esterel.Context
  using (EvaluationContext1 ; EvaluationContext ; _⟦_⟧e ; _≐_⟦_⟧e)
open import Esterel.Context.Properties
  using (plug ; unplug)
open import Esterel.Environment as Env
  using (Env ; Θ ; _←_ ; Dom ; module SigMap ; module ShrMap ; module VarMap)
open import Esterel.CompletionCode as Code
  using () renaming (CompletionCode to Code)
open import Esterel.Variable.Signal as Signal
  using (Signal ; _ₛ)
open import Esterel.Variable.Shared as SharedVar
  using (SharedVar ; _ₛₕ)
open import Esterel.Variable.Sequential as SeqVar
  using (SeqVar)

open EvaluationContext1
open _≐_⟦_⟧e

open import Data.Bool
  using (Bool ; not ; if_then_else_)
open import Data.Empty
  using (⊥ ; ⊥-elim)
open import Data.List
  using (List ; [] ; _∷_ ; _++_ ; map ; concatMap ; foldr)
open import Data.List.Properties
  using (map-id)
open import Data.List.Any
  using (Any ; any ; here ; there)
open import Data.List.Any.Properties
  using ()
  renaming (++⁺ˡ to ++ˡ ; ++⁺ʳ to ++ʳ)
open import Data.Maybe
  using (Maybe ; maybe ; just ; nothing)
open import Data.Nat
  using (ℕ ; zero ; suc ; _≟_ ; _+_)
open import Data.Nat.Properties.Simple
  using (+-comm)
open import Data.Product
  using (Σ ; proj₁ ; proj₂ ; ∃ ; _,_ ; _,′_ ; _×_)
open import Data.Sum
  using (_⊎_ ; inj₁ ; inj₂)
open import Function
  using (_∘_ ; id ; _∋_)
open import Relation.Nullary
  using (¬_ ; Dec ; yes ; no)
open import Relation.Nullary.Decidable
  using (⌊_⌋)
open import Relation.Binary.PropositionalEquality
  using (_≡_ ; _≢_ ; refl ; trans ; sym ; cong ; subst ; module ≡-Reasoning)

open ListSet Data.Nat._≟_
  using (set-subtract ; set-subtract-[] ; set-subtract-split ; set-subtract-merge
       ; set-subtract-notin
       ; set-remove ; set-remove-mono-∈ ; set-remove-removed ; set-remove-not-removed
       ; set-subtract-[a]≡set-remove)

open import Data.OrderedListMap Signal Signal.unwrap Signal.Status as SigM
open import Data.OrderedListMap SharedVar SharedVar.unwrap (Σ SharedVar.Status (λ _ → ℕ)) as ShrM
open import Data.OrderedListMap SeqVar SeqVar.unwrap ℕ as SeqM

open ≡-Reasoning

-- equation: Canθ sig S'' p θ = Canθ' sig S'' (Can p) θ
Canθ'   : SigMap.Map Signal.Status → ℕ →
  (Env → SigSet.ST × CodeSet.ST × ShrSet.ST) →
  Env → SigSet.ST × CodeSet.ST × ShrSet.ST
Canθ' [] S κ θ = κ θ
Canθ' (nothing             ∷ sig') S κ θ = Canθ' sig' (suc S) κ θ
Canθ' (just Signal.present ∷ sig') S κ θ = Canθ' sig' (suc S) κ (θ ← [S]-env-present (S ₛ))
Canθ' (just Signal.absent  ∷ sig') S κ θ = Canθ' sig' (suc S) κ (θ ← [S]-env-absent (S ₛ))
Canθ' (just Signal.unknown ∷ sig') S κ θ with
  any (_≟_ S) (proj₁ (Canθ' sig' (suc S) κ (θ ← [S]-env (S ₛ))))
... | yes S∈can-p-θ←[S] = Canθ' sig' (suc S) κ (θ ← [S]-env (S ₛ))
... | no  S∉can-p-θ←[S] = Canθ' sig' (suc S) κ (θ ← [S]-env-absent (S ₛ))

unfold : ∀ sigs S'' p θ → Canθ sigs S'' p θ ≡ Canθ' sigs S'' (Can p) θ
unfold [] S'' p θ = refl
unfold (nothing ∷ sigs) S'' p θ = unfold sigs (suc S'') p θ
unfold (just Signal.present ∷ sigs) S'' p θ =
  unfold sigs (suc S'') p (θ ← [S]-env-present (S'' ₛ))
unfold (just Signal.absent ∷ sigs) S'' p θ =
  unfold sigs (suc S'') p (θ ← [S]-env-absent (S'' ₛ))
unfold (just Signal.unknown ∷ sigs) S'' p θ
  with any (_≟_ S'') (proj₁ (Canθ  sigs (suc S'') p       (θ ← [S]-env (S'' ₛ))))
     | any (_≟_ S'') (proj₁ (Canθ' sigs (suc S'') (Can p) (θ ← [S]-env (S'' ₛ))))
... | yes S''∈canθ-sigs-θ←[S''] | yes S''∈canθ'-sigs-θ←[S''] =
  unfold sigs (suc S'') p (θ ← [S]-env (S'' ₛ))
... | no  S''∉canθ-sigs-θ←[S''] | no  S''∉canθ'-sigs-θ←[S''] =
  unfold sigs (suc S'') p (θ ← [S]-env-absent (S'' ₛ))
... | yes S''∈canθ-sigs-θ←[S''] | no  S''∉canθ'-sigs-θ←[S'']
  rewrite unfold sigs (suc S'') p (θ ← [S]-env (S'' ₛ))
  = ⊥-elim (S''∉canθ'-sigs-θ←[S''] S''∈canθ-sigs-θ←[S''])
... | no  S''∉canθ-sigs-θ←[S''] | yes S''∈canθ'-sigs-θ←[S'']
  rewrite unfold sigs (suc S'') p (θ ← [S]-env (S'' ₛ))
  = ⊥-elim (S''∉canθ-sigs-θ←[S''] S''∈canθ'-sigs-θ←[S''])

canθ'-cong : ∀ sigs S'' κ κ' θ →
  (∀ θ* → κ θ* ≡ κ' θ*) →
  Canθ' sigs S'' κ θ ≡ Canθ' sigs S'' κ' θ
canθ'-cong [] S'' κ κ' θ κ≗κ' = κ≗κ' θ
canθ'-cong (nothing ∷ sigs) S'' κ κ' θ κ≗κ' =
  canθ'-cong sigs (suc S'') κ κ' θ κ≗κ'
canθ'-cong (just Signal.present ∷ sigs) S'' κ κ' θ κ≗κ' =
  canθ'-cong sigs (suc S'') κ κ' (θ ← [S]-env-present (S'' ₛ)) κ≗κ'
canθ'-cong (just Signal.absent ∷ sigs) S'' κ κ' θ κ≗κ' =
  canθ'-cong sigs (suc S'') κ κ' (θ ← [S]-env-absent (S'' ₛ)) κ≗κ'
canθ'-cong (just Signal.unknown ∷ sigs) S'' κ κ' θ κ≗κ'
  with any (_≟_ S'') (proj₁ (Canθ' sigs (suc S'') κ  (θ ← [S]-env (S'' ₛ))))
     | any (_≟_ S'') (proj₁ (Canθ' sigs (suc S'') κ' (θ ← [S]-env (S'' ₛ))))
... | yes S''∈canθ'-sigs-κ-θ←[S''] | yes S''∈canθ'-sigs-κ'-θ←[S''] =
  canθ'-cong sigs (suc S'') κ κ' (θ ← [S]-env (S'' ₛ)) κ≗κ'
... | no  S''∉canθ'-sigs-κ-θ←[S''] | no  S''∉canθ'-sigs-κ'-θ←[S''] =
  canθ'-cong sigs (suc S'') κ κ' (θ ← [S]-env-absent (S'' ₛ)) κ≗κ'
... | yes S''∈canθ'-sigs-κ-θ←[S''] | no  S''∉canθ'-sigs-κ'-θ←[S'']
  rewrite canθ'-cong sigs (suc S'') κ κ' (θ ← [S]-env (S'' ₛ)) κ≗κ'
  = ⊥-elim (S''∉canθ'-sigs-κ'-θ←[S''] S''∈canθ'-sigs-κ-θ←[S''])
... | no  S''∉canθ'-sigs-κ-θ←[S''] | yes S''∈canθ'-sigs-κ'-θ←[S'']
  rewrite canθ'-cong sigs (suc S'') κ κ' (θ ← [S]-env (S'' ₛ)) κ≗κ'
  = ⊥-elim (S''∉canθ'-sigs-κ-θ←[S''] S''∈canθ'-sigs-κ'-θ←[S''])

canθₛ'-cong : ∀ sigs S'' κ κ' θ →
  (∀ θ* → proj₁ (κ θ*) ≡ proj₁ (κ' θ*)) →
  proj₁ (Canθ' sigs S'' κ θ) ≡ proj₁ (Canθ' sigs S'' κ' θ)
canθₛ'-cong [] S'' κ κ' θ κ≗κ' = κ≗κ' θ
canθₛ'-cong (nothing ∷ sigs) S'' κ κ' θ κ≗κ' =
  canθₛ'-cong sigs (suc S'') κ κ' θ κ≗κ'
canθₛ'-cong (just Signal.present ∷ sigs) S'' κ κ' θ κ≗κ' =
  canθₛ'-cong sigs (suc S'') κ κ' (θ ← [S]-env-present (S'' ₛ)) κ≗κ'
canθₛ'-cong (just Signal.absent ∷ sigs) S'' κ κ' θ κ≗κ' =
  canθₛ'-cong sigs (suc S'') κ κ' (θ ← [S]-env-absent (S'' ₛ)) κ≗κ'
canθₛ'-cong (just Signal.unknown ∷ sigs) S'' κ κ' θ κ≗κ'
  with any (_≟_ S'') (proj₁ (Canθ' sigs (suc S'') κ  (θ ← [S]-env (S'' ₛ))))
     | any (_≟_ S'') (proj₁ (Canθ' sigs (suc S'') κ' (θ ← [S]-env (S'' ₛ))))
... | yes S''∈canθ'-sigs-κ-θ←[S''] | yes S''∈canθ'-sigs-κ'-θ←[S''] =
  canθₛ'-cong sigs (suc S'') κ κ' (θ ← [S]-env (S'' ₛ)) κ≗κ'
... | no  S''∉canθ'-sigs-κ-θ←[S''] | no  S''∉canθ'-sigs-κ'-θ←[S''] =
  canθₛ'-cong sigs (suc S'') κ κ' (θ ← [S]-env-absent (S'' ₛ)) κ≗κ'
... | yes S''∈canθ'-sigs-κ-θ←[S''] | no  S''∉canθ'-sigs-κ'-θ←[S'']
  rewrite canθₛ'-cong sigs (suc S'') κ κ' (θ ← [S]-env (S'' ₛ)) κ≗κ'
  = ⊥-elim (S''∉canθ'-sigs-κ'-θ←[S''] S''∈canθ'-sigs-κ-θ←[S''])
... | no  S''∉canθ'-sigs-κ-θ←[S''] | yes S''∈canθ'-sigs-κ'-θ←[S'']
  rewrite canθₛ'-cong sigs (suc S'') κ κ' (θ ← [S]-env (S'' ₛ)) κ≗κ'
  = ⊥-elim (S''∉canθ'-sigs-κ-θ←[S''] S''∈canθ'-sigs-κ'-θ←[S''])

canθ'-map-comm : ∀ f sigs S κ θ →
  Canθ' sigs S (map-second f ∘ κ) θ ≡ map-second f (Canθ' sigs S κ θ)
canθ'-map-comm f [] S κ θ = refl
canθ'-map-comm f (nothing ∷ sigs) S κ θ =
  canθ'-map-comm f sigs (suc S) κ θ
canθ'-map-comm f (just Signal.present ∷ sigs) S κ θ =
  canθ'-map-comm f sigs (suc S) κ (θ ← [S]-env-present (S ₛ))
canθ'-map-comm f (just Signal.absent ∷ sigs) S κ θ =
  canθ'-map-comm f sigs (suc S) κ (θ ← [S]-env-absent (S ₛ))
canθ'-map-comm f (just Signal.unknown ∷ sigs) S κ θ
  with any (_≟_ S) (proj₁ (Canθ' sigs (suc S) (map-second f ∘ κ) (θ ← [S]-env (S ₛ))))
     | any (_≟_ S) (proj₁ (Canθ' sigs (suc S) κ (θ ← [S]-env (S ₛ))))
... | yes S∈canθ'-sigs-f∘κ-θ←[S] | yes S∈canθ'-sigs-κ-θ←[S] =
  canθ'-map-comm f sigs (suc S) κ (θ ← [S]-env (S ₛ))
... | no  S∉canθ'-sigs-f∘κ-θ←[S] | no  S∉canθ'-sigs-κ-θ←[S] =
  canθ'-map-comm f sigs (suc S) κ (θ ← [S]-env-absent (S ₛ))
... | yes S∈canθ'-sigs-f∘κ-θ←[S] | no  S∉canθ'-sigs-κ-θ←[S]
  rewrite canθ'-map-comm f sigs (suc S) κ (θ ← [S]-env (S ₛ))
  = ⊥-elim (S∉canθ'-sigs-κ-θ←[S] S∈canθ'-sigs-f∘κ-θ←[S])
... | no  S∉canθ'-sigs-f∘κ-θ←[S] | yes S∈canθ'-sigs-κ-θ←[S]
  rewrite canθ'-map-comm f sigs (suc S) κ (θ ← [S]-env (S ₛ))
  = ⊥-elim (S∉canθ'-sigs-f∘κ-θ←[S] S∈canθ'-sigs-κ-θ←[S])

canθ'ₛ-add-sig-monotonic : ∀ sigs S'' κ θ S status →
  (∀ θ S status S' →
    S' ∈ proj₁ (κ (θ ← Θ SigMap.[ S ↦ status ] ShrMap.empty VarMap.empty)) →
    S' ∈ proj₁ (κ (θ ← [S]-env S))) →
  ∀ S' →
    S' ∈ proj₁ (Canθ' sigs S'' κ (θ ← Θ SigMap.[ S ↦ status ] ShrMap.empty VarMap.empty)) →
    S' ∈ proj₁ (Canθ' sigs S'' κ (θ ← [S]-env S))
canθ'ₛ-add-sig-monotonic [] S'' κ θ S status κ-add-sig-monotonic
  S' S'∈canθ'-sigs-p-θ←[S↦status] =
  κ-add-sig-monotonic θ S status S' S'∈canθ'-sigs-p-θ←[S↦status]
canθ'ₛ-add-sig-monotonic (nothing ∷ sigs) S'' κ θ S status
  κ-add-sig-monotonic S' S'∈canθ'-sigs-p-θ←[S↦status] =
  canθ'ₛ-add-sig-monotonic sigs (suc S'') κ θ S status
    κ-add-sig-monotonic S' S'∈canθ'-sigs-p-θ←[S↦status]
canθ'ₛ-add-sig-monotonic (just x ∷ sigs) S'' κ θ S status
  κ-add-sig-monotonic S' S'∈canθ'-sigs-p-θ←[S↦status] with Signal.unwrap S ≟ S''
canθ'ₛ-add-sig-monotonic (just Signal.present ∷ sigs) S'' κ θ S status
  κ-add-sig-monotonic S' S'∈canθ'-sigs-p-θ←[S↦status] | yes refl
  rewrite Env.sig-single-←-←-overwrite θ (S'' ₛ) Signal.unknown Signal.present
        | Env.sig-single-←-←-overwrite θ (S'' ₛ) status         Signal.present
  = S'∈canθ'-sigs-p-θ←[S↦status]
canθ'ₛ-add-sig-monotonic (just Signal.absent ∷ sigs) S'' κ θ S status
  κ-add-sig-monotonic S' S'∈canθ'-sigs-p-θ←[S↦status] | yes refl
  rewrite Env.sig-single-←-←-overwrite θ (S'' ₛ) Signal.unknown Signal.absent
        | Env.sig-single-←-←-overwrite θ (S'' ₛ) status         Signal.absent
  = S'∈canθ'-sigs-p-θ←[S↦status]
canθ'ₛ-add-sig-monotonic (just Signal.unknown ∷ sigs) S'' κ θ S status
  κ-add-sig-monotonic S' S'∈canθ'-sigs-p-θ←[S↦status] | yes refl
  with any (_≟_ S'') (proj₁ (Canθ' sigs (suc S'') κ ((θ ← [S]-env (S'' ₛ)) ← [S]-env (S'' ₛ))))
     | any (_≟_ S'') (proj₁ (Canθ' sigs (suc S'') κ ((θ ← [ (S'' ₛ) ↦ status ]) ← [S]-env (S'' ₛ))))
... | yes S''∈canθ'-sigs-κ-θ←[S''↦unknown]←[S''] | yes S''∈canθ'-sigs-κ-θ←[S''↦status]←[S'']
  rewrite Env.sig-single-←-←-overwrite θ (S'' ₛ) Signal.unknown Signal.unknown
        | Env.sig-single-←-←-overwrite θ (S'' ₛ) status         Signal.unknown
  = S'∈canθ'-sigs-p-θ←[S↦status]
... | no  S''∉canθ'-sigs-κ-θ←[S''↦unknown]←[S''] | no  S''∉canθ'-sigs-κ-θ←[S''↦status]←[S'']
  rewrite Env.sig-single-←-←-overwrite θ (S'' ₛ) Signal.unknown Signal.absent
        | Env.sig-single-←-←-overwrite θ (S'' ₛ) status         Signal.absent
  = S'∈canθ'-sigs-p-θ←[S↦status]
... | yes S''∈canθ'-sigs-κ-θ←[S''↦unknown]←[S''] | no  S''∉canθ'-sigs-κ-θ←[S''↦status]←[S'']
  rewrite Env.sig-single-←-←-overwrite θ (S'' ₛ) Signal.unknown Signal.unknown
        | Env.sig-single-←-←-overwrite θ (S'' ₛ) status         Signal.unknown
  = ⊥-elim (S''∉canθ'-sigs-κ-θ←[S''↦status]←[S'']
              S''∈canθ'-sigs-κ-θ←[S''↦unknown]←[S''])
... | no  S''∉canθ'-sigs-κ-θ←[S''↦unknown]←[S''] | yes S''∈canθ'-sigs-κ-θ←[S''↦status]←[S'']
  rewrite Env.sig-single-←-←-overwrite θ (S'' ₛ) Signal.unknown Signal.unknown
        | Env.sig-single-←-←-overwrite θ (S'' ₛ) status         Signal.unknown
  = ⊥-elim (S''∉canθ'-sigs-κ-θ←[S''↦unknown]←[S'']
              S''∈canθ'-sigs-κ-θ←[S''↦status]←[S''])
canθ'ₛ-add-sig-monotonic (just Signal.present ∷ sigs) S'' κ θ S status
  κ-add-sig-monotonic S' S'∈canθ'-sigs-p-θ←[S↦status] | no S≢S''
  rewrite Env.←-assoc-comm θ ([S]-env S) ([S]-env-present (S'' ₛ))
            (Env.sig-single-noteq-distinct S Signal.unknown
              (S'' ₛ) Signal.present S≢S'')
  = canθ'ₛ-add-sig-monotonic sigs (suc S'') κ
      (θ ← [S]-env-present (S'' ₛ)) S status κ-add-sig-monotonic S'
      (subst (S' ∈_)
        (cong (proj₁ ∘ Canθ' sigs (suc S'') κ)
          (Env.←-assoc-comm θ [ S ↦ status ] ([S]-env-present (S'' ₛ))
              (Env.sig-single-noteq-distinct S status
                (S'' ₛ) Signal.present S≢S'')))
        S'∈canθ'-sigs-p-θ←[S↦status])
canθ'ₛ-add-sig-monotonic (just Signal.absent ∷ sigs) S'' κ θ S status
  κ-add-sig-monotonic S' S'∈canθ'-sigs-p-θ←[S↦status] | no S≢S''
  rewrite Env.←-assoc-comm θ ([S]-env S) ([S]-env-absent (S'' ₛ))
            (Env.sig-single-noteq-distinct S Signal.unknown
              (S'' ₛ) Signal.absent S≢S'')
  = canθ'ₛ-add-sig-monotonic sigs (suc S'') κ
      (θ ← [S]-env-absent (S'' ₛ)) S status κ-add-sig-monotonic S'
      (subst (S' ∈_)
        (cong (proj₁ ∘ Canθ' sigs (suc S'') κ)
          (Env.←-assoc-comm θ [ S ↦ status ] ([S]-env-absent (S'' ₛ))
              (Env.sig-single-noteq-distinct S status
                (S'' ₛ) Signal.absent S≢S'')))
        S'∈canθ'-sigs-p-θ←[S↦status])
canθ'ₛ-add-sig-monotonic (just Signal.unknown ∷ sigs) S'' κ θ S status
  κ-add-sig-monotonic S' S'∈canθ'-sigs-p-θ←[S↦status] | no S≢S''
  with any (_≟_ S'') (proj₁ (Canθ' sigs (suc S'') κ ((θ ← [S]-env S) ← [S]-env (S'' ₛ))))
     | any (_≟_ S'') (proj₁ (Canθ' sigs (suc S'') κ ((θ ← [ S ↦ status ]) ← [S]-env (S'' ₛ))))
... | yes S''∈canθ'-sigs-κ-θ←[S↦unknown]←[S''] | yes S''∈canθ'-sigs-κ-θ←[S↦status]←[S'']
  rewrite Env.←-assoc-comm θ ([S]-env S) ([S]-env (S'' ₛ))
            (Env.sig-single-noteq-distinct S Signal.unknown
              (S'' ₛ) Signal.unknown S≢S'')
  = canθ'ₛ-add-sig-monotonic sigs (suc S'') κ
      (θ ← [S]-env (S'' ₛ)) S status κ-add-sig-monotonic S'
      (subst (S' ∈_)
        (cong (proj₁ ∘ Canθ' sigs (suc S'') κ)
          (Env.←-assoc-comm θ [ S ↦ status ] ([S]-env (S'' ₛ))
              (Env.sig-single-noteq-distinct S status
                (S'' ₛ) Signal.unknown S≢S'')))
        S'∈canθ'-sigs-p-θ←[S↦status])
... | no  S''∉canθ'-sigs-κ-θ←[S↦unknown]←[S''] | no  S''∉canθ'-sigs-κ-θ←[S↦status]←[S'']
  rewrite Env.←-assoc-comm θ ([S]-env S) ([S]-env-absent (S'' ₛ))
            (Env.sig-single-noteq-distinct S Signal.unknown
              (S'' ₛ) Signal.absent S≢S'')
  = canθ'ₛ-add-sig-monotonic sigs (suc S'') κ
      (θ ← [S]-env-absent (S'' ₛ)) S status κ-add-sig-monotonic S'
      (subst (S' ∈_)
        (cong (proj₁ ∘ Canθ' sigs (suc S'') κ)
          (Env.←-assoc-comm θ [ S ↦ status ] ([S]-env-absent (S'' ₛ))
              (Env.sig-single-noteq-distinct S status
                (S'' ₛ) Signal.absent S≢S'')))
        S'∈canθ'-sigs-p-θ←[S↦status])
... | yes S''∈canθ'-sigs-κ-θ←[S↦unknown]←[S''] | no  S''∉canθ'-sigs-κ-θ←[S↦status]←[S'']
  rewrite Env.←-assoc-comm θ ([S]-env S) ([S]-env (S'' ₛ))
            (Env.sig-single-noteq-distinct S Signal.unknown
              (S'' ₛ) Signal.unknown S≢S'')
  = canθ'ₛ-add-sig-monotonic sigs (suc S'') κ (θ ← [S]-env (S'' ₛ))
      S status κ-add-sig-monotonic S'
      (subst (S' ∈_)
        (cong (proj₁ ∘ Canθ' sigs (suc S'') κ)
          (Env.←-assoc-comm θ [ S ↦ status ] ([S]-env (S'' ₛ))
            (Env.sig-single-noteq-distinct S status
              (S'' ₛ) Signal.unknown S≢S'')))
        (canθ'ₛ-add-sig-monotonic sigs (suc S'') κ (θ ← [ S ↦ status ])
          (S'' ₛ) Signal.absent κ-add-sig-monotonic
            S' S'∈canθ'-sigs-p-θ←[S↦status]))
... | no  S''∉canθ'-sigs-κ-θ←[S↦unknown]←[S''] | yes S''∈canθ'-sigs-κ-θ←[S↦status]←[S'']
  rewrite Env.←-assoc-comm θ ([S]-env S) ([S]-env (S'' ₛ))
            (Env.sig-single-noteq-distinct S Signal.unknown
              (S'' ₛ) Signal.unknown S≢S'')
  = ⊥-elim
    (S''∉canθ'-sigs-κ-θ←[S↦unknown]←[S'']
      (canθ'ₛ-add-sig-monotonic sigs (suc S'') κ (θ ← [S]-env (S'' ₛ)) S
         status κ-add-sig-monotonic S''
         (subst (S'' ∈_)
           (cong (proj₁ ∘ Canθ' sigs (suc S'') κ)
             (Env.←-assoc-comm θ [ S ↦ status ] ([S]-env (S'' ₛ))
               (Env.sig-single-noteq-distinct S status
                 (S'' ₛ) Signal.unknown S≢S'')))
           S''∈canθ'-sigs-κ-θ←[S↦status]←[S''])))

canθ'ₛ-canθ-add-sig-monotonic : ∀ sigs S sigs' S' p θ S''' status →
  ∀ S'' →
    S'' ∈ proj₁ (Canθ' sigs S (Canθ sigs' S' p)
                  (θ ← Θ SigMap.[ S''' ↦ status ] ShrMap.empty VarMap.empty)) →
    S'' ∈ proj₁ (Canθ' sigs S (Canθ sigs' S' p)
                  (θ ← [S]-env S'''))
canθ'ₛ-canθ-add-sig-monotonic sigs S sigs' S' p θ S''' status
  S'' S''∈canθ'-sigs-p-θ←[S↦status] =
  canθ'ₛ-add-sig-monotonic sigs S (Canθ sigs' S' p) θ S''' status
    (canθₛ-add-sig-monotonic sigs' S' p)
    S'' S''∈canθ'-sigs-p-θ←[S↦status]

canθ'ₛ-subset-lemma : ∀ sigs S'' κ κ' θ →
  (∀ θ' S → S ∈ proj₁ (κ θ') → S ∈ proj₁ (κ' θ')) →
  (∀ θ S status S' →
    S' ∈ proj₁ (κ' (θ ← Θ SigMap.[ S ↦ status ] ShrMap.empty VarMap.empty)) →
    S' ∈ proj₁ (κ' (θ ← [S]-env S))) →
  ∀ S → S ∈ proj₁ (Canθ' sigs S'' κ θ) → S ∈ proj₁ (Canθ' sigs S'' κ' θ)
canθ'ₛ-subset-lemma [] S'' κ κ' θ κ⊆κ' κ'-add-sig-monotonic S S∈canθ'-κ-θ =
  κ⊆κ' θ S S∈canθ'-κ-θ
canθ'ₛ-subset-lemma (nothing ∷ sigs) S'' κ κ' θ
  κ⊆κ' κ'-add-sig-monotonic S S∈canθ'-κ-θ =
  canθ'ₛ-subset-lemma sigs (suc S'') κ κ' θ κ⊆κ' κ'-add-sig-monotonic S S∈canθ'-κ-θ
canθ'ₛ-subset-lemma (just Signal.present ∷ sigs) S'' κ κ' θ
  κ⊆κ' κ'-add-sig-monotonic S S∈canθ'-κ-θ =
  canθ'ₛ-subset-lemma sigs (suc S'') κ κ' (θ ← [S]-env-present (S'' ₛ))
    κ⊆κ' κ'-add-sig-monotonic S S∈canθ'-κ-θ
canθ'ₛ-subset-lemma (just Signal.absent ∷ sigs) S'' κ κ' θ
  κ⊆κ' κ'-add-sig-monotonic S S∈canθ'-κ-θ =
  canθ'ₛ-subset-lemma sigs (suc S'') κ κ' (θ ← [S]-env-absent (S'' ₛ)) κ⊆κ' κ'-add-sig-monotonic S S∈canθ'-κ-θ
canθ'ₛ-subset-lemma (just Signal.unknown ∷ sigs) S'' κ κ' θ
  κ⊆κ' κ'-add-sig-monotonic S S∈canθ'-κ-θ
  with any (_≟_ S'') (proj₁ (Canθ' sigs (suc S'') κ  (θ ← [S]-env (S'' ₛ))))
     | any (_≟_ S'') (proj₁ (Canθ' sigs (suc S'') κ' (θ ← [S]-env (S'' ₛ))))
... | yes S''∈canθ'-κ-θ' | yes S''∈canθ-κ'-θ' =
  canθ'ₛ-subset-lemma sigs (suc S'') κ κ' (θ ← [S]-env (S'' ₛ))
    κ⊆κ' κ'-add-sig-monotonic S S∈canθ'-κ-θ
... | no  S''∉canθ'-κ-θ' | no  S''∉canθ-q-θ' =
  canθ'ₛ-subset-lemma sigs (suc S'') κ κ' (θ ← [S]-env-absent (S'' ₛ))
    κ⊆κ' κ'-add-sig-monotonic S S∈canθ'-κ-θ
... | yes S''∈canθ'-κ-θ' | no  S''∉canθ-q-θ' =
  ⊥-elim
    (S''∉canθ-q-θ'
      (canθ'ₛ-subset-lemma sigs (suc S'') κ κ' (θ ← [S]-env (S'' ₛ)) κ⊆κ'
        κ'-add-sig-monotonic S'' S''∈canθ'-κ-θ'))
... | no  S''∉canθ'-κ-θ' | yes S''∈canθ-κ'-θ' =
  canθ'ₛ-add-sig-monotonic sigs (suc S'') κ' θ (S'' ₛ) Signal.absent
    κ'-add-sig-monotonic S
    (canθ'ₛ-subset-lemma sigs (suc S'') κ κ' (θ ← [S]-env-absent (S'' ₛ)) κ⊆κ'
      κ'-add-sig-monotonic S S∈canθ'-κ-θ)

canθ'-inner-shadowing-irr' : ∀ sigs S'' sigs' p S status θ θo →
  S ∈ SigMap.keys sigs' →
    Canθ' sigs S'' (Canθ sigs' 0 p) ((θ ← [ (S ₛ) ↦ status ]) ← θo) ≡
    Canθ' sigs S'' (Canθ sigs' 0 p) (θ ← θo)
canθ'-inner-shadowing-irr' [] S'' sigs' p S status θ θo S∈sigs'
  rewrite sym (map-id (SigMap.keys sigs'))
  = canθ-shadowing-irr' sigs' 0 p S status θ θo S∈sigs'
canθ'-inner-shadowing-irr' (nothing ∷ sigs) S'' sigs' p S status θ θo S∈sigs' = canθ'-inner-shadowing-irr' sigs (suc S'') sigs' p S status θ θo S∈sigs'
canθ'-inner-shadowing-irr' (just Signal.present ∷ sigs) S'' sigs' p S status θ θo S∈sigs'
  rewrite sym (Env.←-assoc (θ ← [ (S ₛ) ↦ status ]) θo ([S]-env-present (S'' ₛ)))
        | sym (Env.←-assoc θ θo ([S]-env-present (S'' ₛ)))
  = canθ'-inner-shadowing-irr' sigs (suc S'') sigs' p S status θ (θo ← ([S]-env-present (S'' ₛ))) S∈sigs'
canθ'-inner-shadowing-irr' (just Signal.absent ∷ sigs) S'' sigs' p S status θ θo S∈sigs'
  rewrite sym (Env.←-assoc (θ ← [ (S ₛ) ↦ status ]) θo ([S]-env-absent (S'' ₛ)))
        | sym (Env.←-assoc θ θo ([S]-env-absent (S'' ₛ)))
  = canθ'-inner-shadowing-irr' sigs (suc S'') sigs' p S status θ (θo ← ([S]-env-absent (S'' ₛ))) S∈sigs'
canθ'-inner-shadowing-irr' (just Signal.unknown ∷ sigs) S'' sigs' p S status θ θo S∈sigs'
  with any (_≟_ S'') (proj₁ (Canθ' sigs (suc S'') (Canθ sigs' 0 p) (((θ ← [ (S ₛ) ↦ status ]) ← θo) ← [S]-env (S'' ₛ))))
     | any (_≟_ S'') (proj₁ (Canθ' sigs (suc S'') (Canθ sigs' 0 p) ((θ ← θo) ← [S]-env (S'' ₛ))))
... | yes S''∈canθ'-sigs-Canθ-θ←[S]-absent←S←θo←[S''] | yes S''∈canθ'-sigs-Canθ-θ←[S]←S←θo←[S'']
  rewrite sym (Env.←-assoc (θ ← [ (S ₛ) ↦ status ]) θo ([S]-env (S'' ₛ)))
        | sym (Env.←-assoc θ θo ([S]-env (S'' ₛ)))
  = canθ'-inner-shadowing-irr' sigs (suc S'') sigs' p S status θ (θo ← ([S]-env (S'' ₛ))) S∈sigs'
... | no  S''∉canθ'-sigs-Canθ-θ←[S]-absent←S←θo←[S''] | no  S''∉canθ'-sigs-Canθ-θ←[S]←S←θo←[S'']
  rewrite sym (Env.←-assoc (θ ← [ (S ₛ) ↦ status ]) θo ([S]-env-absent (S'' ₛ)))
        | sym (Env.←-assoc θ θo ([S]-env-absent (S'' ₛ)))
  = canθ'-inner-shadowing-irr' sigs (suc S'') sigs' p S status θ (θo ← ([S]-env-absent (S'' ₛ))) S∈sigs'
... | yes S''∈canθ'-sigs-Canθ-θ←[S]-absent←S←θo←[S''] | no  S''∉canθ'-sigs-Canθ-θ←[S]←S←θo←[S'']
  rewrite sym (Env.←-assoc (θ ← [ (S ₛ) ↦ status ]) θo ([S]-env (S'' ₛ)))
        | sym (Env.←-assoc θ θo ([S]-env (S'' ₛ)))
        | canθ'-inner-shadowing-irr' sigs (suc S'') sigs' p S status θ (θo ← ([S]-env (S'' ₛ))) S∈sigs'
  = ⊥-elim (S''∉canθ'-sigs-Canθ-θ←[S]←S←θo←[S'']
              S''∈canθ'-sigs-Canθ-θ←[S]-absent←S←θo←[S''])
... | no  S''∉canθ'-sigs-Canθ-θ←[S]-absent←S←θo←[S''] | yes S''∈canθ'-sigs-Canθ-θ←[S]←S←θo←[S'']
  rewrite sym (Env.←-assoc (θ ← [ (S ₛ) ↦ status ]) θo ([S]-env (S'' ₛ)))
        | sym (Env.←-assoc θ θo ([S]-env (S'' ₛ)))
        | canθ'-inner-shadowing-irr' sigs (suc S'') sigs' p S status θ (θo ← ([S]-env (S'' ₛ))) S∈sigs'
  = ⊥-elim (S''∉canθ'-sigs-Canθ-θ←[S]-absent←S←θo←[S'']
              S''∈canθ'-sigs-Canθ-θ←[S]←S←θo←[S''])

canθ'-inner-shadowing-irr : ∀ sigs S'' sigs' p S status θ →
  S ∈ SigMap.keys sigs' →
    Canθ' sigs S'' (Canθ sigs' 0 p) (θ ← [ (S ₛ) ↦ status ]) ≡
    Canθ' sigs S'' (Canθ sigs' 0 p) θ
canθ'-inner-shadowing-irr sigs S'' sigs' p S status θ S∈sigs'
  rewrite cong (Canθ' sigs S'' (Canθ sigs' 0 p))
            (Env.←-comm Env.[]env θ distinct-empty-left)
        | cong (Canθ' sigs S'' (Canθ sigs' 0 p))
            (Env.←-comm Env.[]env (θ ← [ (S ₛ) ↦ status ]) distinct-empty-left)
  = canθ'-inner-shadowing-irr' sigs S'' sigs' p S status θ Env.[]env S∈sigs'

canθ'-search-acc : ∀ sigs S κ θ →
  ∀ S'' status →
    S'' ∉ map (_+_ S)  (SigMap.keys sigs) →
    Canθ' sigs S  κ  (θ ← [ (S'' ₛ) ↦ status ]) ≡
    Canθ' sigs S (κ ∘ (_← [ (S'' ₛ) ↦ status ])) θ
canθ'-search-acc [] S κ θ S'' status S''∉map-+-S-sigs =
  refl
canθ'-search-acc (nothing ∷ sigs) S κ θ S'' status S''∉map-+-S-sigs
  rewrite map-+-compose-suc S (SigMap.keys sigs)
  = canθ'-search-acc sigs (suc S) κ θ S'' status S''∉map-+-S-sigs
canθ'-search-acc (just Signal.present ∷ sigs) S κ θ S'' status S''∉map-+-S-sigs
  rewrite map-+-compose-suc S (SigMap.keys sigs)
        | +-comm S 0
        | Env.←-assoc-comm θ [ (S'' ₛ) ↦ status ] ([S]-env-present (S ₛ))
            (Env.sig-single-noteq-distinct (S'' ₛ) status (S ₛ) Signal.present (S''∉map-+-S-sigs ∘ here))
  = canθ'-search-acc sigs (suc S) κ (θ ← [S]-env-present (S ₛ)) S'' status
      (S''∉map-+-S-sigs ∘ there)
canθ'-search-acc (just Signal.absent ∷ sigs) S κ θ S'' status S''∉map-+-S-sigs
  rewrite map-+-compose-suc S (SigMap.keys sigs)
        | +-comm S 0
        | Env.←-assoc-comm θ [ (S'' ₛ) ↦ status ] ([S]-env-absent (S ₛ))
            (Env.sig-single-noteq-distinct (S'' ₛ) status (S ₛ) Signal.absent (S''∉map-+-S-sigs ∘ here))
  = canθ'-search-acc sigs (suc S) κ (θ ← [S]-env-absent (S ₛ)) S'' status
      (S''∉map-+-S-sigs ∘ there)
canθ'-search-acc (just Signal.unknown ∷ sigs) S κ θ S'' status S''∉map-+-S-sigs
  with any (_≟_ S) (proj₁ (Canθ' sigs (suc S) (λ θ* → κ (θ* ← [ (S'' ₛ) ↦ status ])) (θ ← [S]-env (S ₛ))))
     | any (_≟_ S) (proj₁ (Canθ' sigs (suc S) κ ((θ ← [ (S'' ₛ) ↦ status ]) ← [S]-env (S ₛ))))
... | yes S∈canθ'-⟨canθ-←[S'']⟩-θ←[S] | yes S∈canθ'-canθ-θ←[S'']←[S]
  rewrite map-+-compose-suc S (SigMap.keys sigs)
        | +-comm S 0
        | Env.←-assoc-comm θ [ (S'' ₛ) ↦ status ] ([S]-env (S ₛ))
            (Env.sig-single-noteq-distinct (S'' ₛ) status (S ₛ) Signal.unknown (S''∉map-+-S-sigs ∘ here))
  = canθ'-search-acc sigs (suc S) κ (θ ← [S]-env (S ₛ)) S'' status
      (S''∉map-+-S-sigs ∘ there)
... | no  S∉canθ'-⟨canθ-←[S'']⟩-θ←[S] | no  S∉canθ'-canθ-θ←[S'']←[S]
  rewrite map-+-compose-suc S (SigMap.keys sigs)
        | +-comm S 0
        | Env.←-assoc-comm θ [ (S'' ₛ) ↦ status ] ([S]-env-absent (S ₛ))
            (Env.sig-single-noteq-distinct (S'' ₛ) status (S ₛ) Signal.absent (S''∉map-+-S-sigs ∘ here))
  = canθ'-search-acc sigs (suc S) κ (θ ← [S]-env-absent (S ₛ)) S'' status
      (S''∉map-+-S-sigs ∘ there)
... | yes S∈canθ'-⟨canθ-←[S'']⟩-θ←[S] | no  S∉canθ'-canθ-θ←[S'']←[S]
  rewrite map-+-compose-suc S (SigMap.keys sigs)
        | +-comm S 0
        | Env.←-assoc-comm θ [ (S'' ₛ) ↦ status ] ([S]-env (S ₛ))
            (Env.sig-single-noteq-distinct (S'' ₛ) status (S ₛ) Signal.unknown (S''∉map-+-S-sigs ∘ here))
        | canθ'-search-acc sigs (suc S) κ (θ ← [S]-env (S ₛ)) S'' status
            (S''∉map-+-S-sigs ∘ there)
  = ⊥-elim (S∉canθ'-canθ-θ←[S'']←[S] S∈canθ'-⟨canθ-←[S'']⟩-θ←[S])
... | no  S∉canθ'-⟨canθ-←[S'']⟩-θ←[S] | yes S∈canθ'-canθ-θ←[S'']←[S]
  rewrite map-+-compose-suc S (SigMap.keys sigs)
        | +-comm S 0
        | Env.←-assoc-comm θ [ (S'' ₛ) ↦ status ] ([S]-env (S ₛ))
            (Env.sig-single-noteq-distinct (S'' ₛ) status (S ₛ) Signal.unknown (S''∉map-+-S-sigs ∘ here))
        | canθ'-search-acc sigs (suc S) κ (θ ← [S]-env (S ₛ)) S'' status
            (S''∉map-+-S-sigs ∘ there)
  = ⊥-elim (S∉canθ'-⟨canθ-←[S'']⟩-θ←[S] S∈canθ'-canθ-θ←[S'']←[S])

canθ'-search-acc-set-irr : ∀ sigs S κ θ →
  ∀ S'' status status' →
    S'' ∉ map (_+_ S)  (SigMap.keys sigs) →
    Canθ' sigs S κ (θ ← [ (S'' ₛ) ↦ status ]) ≡
    Canθ' sigs S (κ ∘ (_← [ (S'' ₛ) ↦ status ])) (θ ← [ (S'' ₛ) ↦ status' ])
canθ'-search-acc-set-irr [] S κ θ S'' status status' S''∉map-+-S-sigs
  rewrite sym (Env.←-assoc θ [ (S'' ₛ) ↦ status' ] [ (S'' ₛ) ↦ status ])
        | cong (θ ←_) (Env.←-single-overwrite-sig (S'' ₛ) status' [ (S'' ₛ) ↦ status ]
            (Env.sig-∈-single (S'' ₛ) status))
  = refl
canθ'-search-acc-set-irr (nothing ∷ sigs) S κ θ S'' status status' S''∉map-+-S-sigs
  rewrite map-+-compose-suc S (SigMap.keys sigs)
  = canθ'-search-acc-set-irr sigs (suc S) κ θ S'' status status' S''∉map-+-S-sigs
canθ'-search-acc-set-irr (just Signal.present ∷ sigs) S κ θ S'' status status' S''∉map-+-S-sigs
  rewrite map-+-compose-suc S (SigMap.keys sigs)
        | +-comm S 0
        | Env.←-assoc-comm θ [ (S'' ₛ) ↦ status ] ([S]-env-present (S ₛ))
            (Env.sig-single-noteq-distinct (S'' ₛ) status (S ₛ) Signal.present (S''∉map-+-S-sigs ∘ here))
        | Env.←-assoc-comm θ [ (S'' ₛ) ↦ status' ] ([S]-env-present (S ₛ))
            (Env.sig-single-noteq-distinct (S'' ₛ) status' (S ₛ) Signal.present (S''∉map-+-S-sigs ∘ here))
  = canθ'-search-acc-set-irr sigs (suc S) κ (θ ← [S]-env-present (S ₛ)) S'' status status'
      (S''∉map-+-S-sigs ∘ there)
canθ'-search-acc-set-irr (just Signal.absent ∷ sigs) S κ θ S'' status status' S''∉map-+-S-sigs
  rewrite map-+-compose-suc S (SigMap.keys sigs)
        | +-comm S 0
        | Env.←-assoc-comm θ [ (S'' ₛ) ↦ status ] ([S]-env-absent (S ₛ))
            (Env.sig-single-noteq-distinct (S'' ₛ) status (S ₛ) Signal.absent (S''∉map-+-S-sigs ∘ here))
        | Env.←-assoc-comm θ [ (S'' ₛ) ↦ status' ] ([S]-env-absent (S ₛ))
            (Env.sig-single-noteq-distinct (S'' ₛ) status' (S ₛ) Signal.absent (S''∉map-+-S-sigs ∘ here))
  = canθ'-search-acc-set-irr sigs (suc S) κ (θ ← [S]-env-absent (S ₛ)) S'' status status'
      (S''∉map-+-S-sigs ∘ there)
canθ'-search-acc-set-irr (just Signal.unknown ∷ sigs) S κ θ S'' status status' S''∉map-+-S-sigs
  with any (_≟_ S) (proj₁ (Canθ' sigs (suc S) (λ θ* → κ (θ* ← [ (S'' ₛ) ↦ status ])) ((θ ← [ (S'' ₛ) ↦ status' ]) ← [S]-env (S ₛ))))
     | any (_≟_ S) (proj₁ (Canθ' sigs (suc S) κ ((θ ← [ (S'' ₛ) ↦ status ]) ← [S]-env (S ₛ))))
... | yes S∈canθ'-⟨canθ-←[S'']⟩-θ←[S'']←[S] | yes S∈canθ'-canθ-θ←[S'']←[S]
  rewrite map-+-compose-suc S (SigMap.keys sigs)
        | +-comm S 0
        | Env.←-assoc-comm θ [ (S'' ₛ) ↦ status ] ([S]-env (S ₛ))
            (Env.sig-single-noteq-distinct (S'' ₛ) status (S ₛ) Signal.unknown (S''∉map-+-S-sigs ∘ here))
        | Env.←-assoc-comm θ [ (S'' ₛ) ↦ status' ] ([S]-env (S ₛ))
            (Env.sig-single-noteq-distinct (S'' ₛ) status' (S ₛ) Signal.unknown (S''∉map-+-S-sigs ∘ here))
  = canθ'-search-acc-set-irr sigs (suc S) κ (θ ← [S]-env (S ₛ)) S'' status status'
      (S''∉map-+-S-sigs ∘ there)
... | no  S∉canθ'-⟨canθ-←[S'']⟩-θ←[S'']←[S] | no  S∉canθ'-canθ-θ←[S'']←[S]
  rewrite map-+-compose-suc S (SigMap.keys sigs)
        | +-comm S 0
        | Env.←-assoc-comm θ [ (S'' ₛ) ↦ status ] ([S]-env-absent (S ₛ))
            (Env.sig-single-noteq-distinct (S'' ₛ) status (S ₛ) Signal.absent (S''∉map-+-S-sigs ∘ here))
        | Env.←-assoc-comm θ [ (S'' ₛ) ↦ status' ] ([S]-env-absent (S ₛ))
            (Env.sig-single-noteq-distinct (S'' ₛ) status' (S ₛ) Signal.absent (S''∉map-+-S-sigs ∘ here))
  = canθ'-search-acc-set-irr sigs (suc S) κ (θ ← [S]-env-absent (S ₛ)) S'' status status'
      (S''∉map-+-S-sigs ∘ there)
... | yes S∈canθ'-⟨canθ-←[S'']⟩-θ←[S'']←[S] | no  S∉canθ'-canθ-θ←[S'']←[S]
  rewrite map-+-compose-suc S (SigMap.keys sigs)
        | +-comm S 0
        | Env.←-assoc-comm θ [ (S'' ₛ) ↦ status ] ([S]-env (S ₛ))
            (Env.sig-single-noteq-distinct (S'' ₛ) status (S ₛ) Signal.unknown (S''∉map-+-S-sigs ∘ here))
        | Env.←-assoc-comm θ [ (S'' ₛ) ↦ status' ] ([S]-env (S ₛ))
            (Env.sig-single-noteq-distinct (S'' ₛ) status' (S ₛ) Signal.unknown (S''∉map-+-S-sigs ∘ here))
        | canθ'-search-acc-set-irr sigs (suc S) κ (θ ← [S]-env (S ₛ)) S'' status status'
            (S''∉map-+-S-sigs ∘ there)
  = ⊥-elim (S∉canθ'-canθ-θ←[S'']←[S] S∈canθ'-⟨canθ-←[S'']⟩-θ←[S'']←[S])
... | no  S∉canθ'-⟨canθ-←[S'']⟩-θ←[S'']←[S] | yes S∈canθ'-canθ-θ←[S'']←[S]
  rewrite map-+-compose-suc S (SigMap.keys sigs)
        | +-comm S 0
        | Env.←-assoc-comm θ [ (S'' ₛ) ↦ status ] ([S]-env (S ₛ))
            (Env.sig-single-noteq-distinct (S'' ₛ) status (S ₛ) Signal.unknown (S''∉map-+-S-sigs ∘ here))
        | Env.←-assoc-comm θ [ (S'' ₛ) ↦ status' ] ([S]-env (S ₛ))
            (Env.sig-single-noteq-distinct (S'' ₛ) status' (S ₛ) Signal.unknown (S''∉map-+-S-sigs ∘ here))
        | canθ'-search-acc-set-irr sigs (suc S) κ (θ ← [S]-env (S ₛ)) S'' status status'
            (S''∉map-+-S-sigs ∘ there)
  = ⊥-elim (S∉canθ'-⟨canθ-←[S'']⟩-θ←[S'']←[S] S∈canθ'-canθ-θ←[S'']←[S])

canθ'-canθ-propagate-up-in : ∀ sigs S r θ →
  ∀ sigs' S' S'' →
    S' ∈ proj₁ (Canθ' sigs S (λ θ* → Canθ sigs' (suc S') r (θ* ← [S]-env (S' ₛ))) θ) →
    S'' ∈ proj₁ (Canθ' sigs S (λ θ* → Canθ sigs' (suc S') r (θ* ← [S]-env (S' ₛ))) θ) →
    S'' ∈ proj₁ (Canθ' sigs S (λ θ* → Canθ (just Signal.unknown ∷ sigs') S' r θ*) θ)
canθ'-canθ-propagate-up-in [] S r θ sigs' S' S'' S'∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩ S''∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩
  with any (_≟_ S') (Canθₛ sigs' (suc S') r (θ ← [S]-env (S' ₛ)))
... | yes S'∈canθ-sigs'-r-θ*←[S'] =
  S''∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩
... | no  S'∉canθ-sigs'-r-θ*←[S'] =
  ⊥-elim (S'∉canθ-sigs'-r-θ*←[S'] S'∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩)
canθ'-canθ-propagate-up-in (nothing ∷ sigs) S r θ sigs' S' S'' S'∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩ S''∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩ =
  canθ'-canθ-propagate-up-in sigs (suc S) r θ sigs' S' S'' S'∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩ S''∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩
canθ'-canθ-propagate-up-in (just Signal.present ∷ sigs) S r θ sigs' S' S'' S'∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩ S''∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩ =
  canθ'-canθ-propagate-up-in sigs (suc S) r (θ ← [S]-env-present (S ₛ)) sigs' S' S'' S'∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩ S''∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩
canθ'-canθ-propagate-up-in (just Signal.absent ∷ sigs) S r θ sigs' S' S'' S'∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩ S''∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩ =
  canθ'-canθ-propagate-up-in sigs (suc S) r (θ ← [S]-env-absent (S ₛ)) sigs' S' S'' S'∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩ S''∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩
canθ'-canθ-propagate-up-in (just Signal.unknown ∷ sigs) S r θ sigs' S' S'' S'∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩ S''∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩
  with any (_≟_ S)
         (proj₁
           (Canθ' sigs (suc S) (Canθ (just Signal.unknown ∷ sigs') S' r) (θ ← [S]-env (S ₛ))))
     | any (_≟_ S)
         (proj₁
           (Canθ' sigs (suc S) (λ θ* → Canθ sigs' (suc S') r (θ* ← [S]-env (S' ₛ))) (θ ← [S]-env (S ₛ))))
... | yes S∈canθ'-sigs-⟨canθ-u∷sigs'-r⟩-θ←[S] | yes S∈canθ'-sigs-⟨canθ-sigs'-θ*←[S']⟩-θ←[S] =
  canθ'-canθ-propagate-up-in sigs (suc S) r (θ ← [S]-env (S ₛ)) sigs' S' S'' S'∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩ S''∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩
... | no  S∉canθ'-sigs-⟨canθ-u∷sigs'-r⟩-θ←[S] | no  S∉canθ'-sigs-⟨canθ-sigs'-θ*←[S']⟩-θ←[S] =
  canθ'-canθ-propagate-up-in sigs (suc S) r (θ ← [S]-env-absent (S ₛ)) sigs' S' S'' S'∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩ S''∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩
... | yes S∈canθ'-sigs-⟨canθ-u∷sigs'-r⟩-θ←[S] | no  S∉canθ'-sigs-⟨canθ-sigs'-θ*←[S']⟩-θ←[S] =
  canθ'ₛ-canθ-add-sig-monotonic sigs (suc S) (just Signal.unknown ∷ sigs') S' r θ
    (S ₛ) Signal.absent S''
    (canθ'-canθ-propagate-up-in sigs (suc S) r (θ ← [S]-env-absent (S ₛ)) sigs' S' S''
      S'∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩
      S''∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩)
... | no  S∉canθ'-sigs-⟨canθ-u∷sigs'-r⟩-θ←[S] | yes S∈canθ'-sigs-⟨canθ-sigs'-θ*←[S']⟩-θ←[S] =
  ⊥-elim
    (S∉canθ'-sigs-⟨canθ-u∷sigs'-r⟩-θ←[S]
      (canθ'-canθ-propagate-up-in sigs (suc S) r (θ ← [S]-env (S ₛ)) sigs' S' S
        S'∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩
        S∈canθ'-sigs-⟨canθ-sigs'-θ*←[S']⟩-θ←[S]))

canθₛ-a∷s⊆canθₛ-u∷s : ∀ sigs r S' θ S →
  S ∈ Canθₛ (just Signal.absent ∷ sigs) S' r θ →
  S ∈ Canθₛ (just Signal.unknown ∷ sigs) S' r θ
canθₛ-a∷s⊆canθₛ-u∷s sigs r S' θ S S∈can-sigs-r-θ←[S↦absent]
  with any (_≟_ S') (Canθₛ sigs (suc S') r (θ ← [S]-env (S' ₛ)))
... | yes a = canθₛ-add-sig-monotonic sigs (suc S') r θ (S' ₛ) Signal.absent S
                S∈can-sigs-r-θ←[S↦absent]
... | no na = S∈can-sigs-r-θ←[S↦absent]

canθ'-canθ-propagate-down-not-in : ∀ sigs S r θ →
  ∀ S' sigs' →
    S' ∉ proj₁ (Canθ' sigs S (λ θ* → Canθ (just Signal.unknown ∷ sigs') S' r θ*) θ) →
    Canθ' sigs S (λ θ* → Canθ (just Signal.unknown ∷ sigs') S' r θ*) θ ≡
    Canθ' sigs S (λ θ* → Canθ sigs' (suc S') r (θ* ← [S]-env-absent (S' ₛ))) θ
canθ'-canθ-propagate-down-not-in [] S r θ S' sigs' S'∉canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩
  with any (_≟_ S') (Canθₛ sigs' (suc S') r (θ ← [S]-env (S' ₛ)))
... | yes S'∈canθ-sigs'-r-θ←[S'] =
  ⊥-elim (S'∉canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩ S'∈canθ-sigs'-r-θ←[S'])
... | no  S'∉canθ-sigs'-r-θ←[S'] = refl
canθ'-canθ-propagate-down-not-in (nothing ∷ sigs) S r θ S' sigs' S'∉canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩ =
  canθ'-canθ-propagate-down-not-in sigs (suc S) r θ S' sigs' S'∉canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩
canθ'-canθ-propagate-down-not-in (just Signal.present ∷ sigs) S r θ S' sigs' S'∉canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩ =
  canθ'-canθ-propagate-down-not-in sigs (suc S) r (θ ← [S]-env-present (S ₛ)) S' sigs' S'∉canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩
canθ'-canθ-propagate-down-not-in (just Signal.absent ∷ sigs) S r θ S' sigs' S'∉canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩ =
  canθ'-canθ-propagate-down-not-in sigs (suc S) r (θ ← [S]-env-absent (S ₛ)) S' sigs' S'∉canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩
canθ'-canθ-propagate-down-not-in (just Signal.unknown ∷ sigs) S r θ S' sigs' S'∉canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩
  with any (_≟_ S)
          (proj₁
            (Canθ' sigs (suc S)
              (λ θ* → Canθ (just Signal.unknown ∷ sigs') S' r θ*)
              (θ ← [S]-env (S ₛ))))
     | any (_≟_ S)
          (proj₁
            (Canθ' sigs (suc S)
              (λ θ* → Canθ sigs' (suc S') r (θ* ← [S]-env-absent (S' ₛ)))
              (θ ← [S]-env (S ₛ))))
... | yes a | yes b =
  canθ'-canθ-propagate-down-not-in sigs (suc S) r (θ ← [S]-env (S ₛ)) S' sigs' S'∉canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩
... | no na | no nb =
  canθ'-canθ-propagate-down-not-in sigs (suc S) r (θ ← [S]-env-absent (S ₛ)) S' sigs' S'∉canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩
... | yes a | no nb
  rewrite sym (canθ'-canθ-propagate-down-not-in sigs (suc S) r (θ ← [S]-env (S ₛ)) S' sigs' S'∉canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩)
  = ⊥-elim (nb a)
... | no na | yes b
  = ⊥-elim (na (canθ'ₛ-subset-lemma sigs (suc S) (Canθ (just Signal.absent ∷ sigs') S' r) (Canθ (just Signal.unknown ∷ sigs') S' r) (θ ← [S]-env (S ₛ)) (canθₛ-a∷s⊆canθₛ-u∷s sigs' r S') (canθₛ-add-sig-monotonic (just Signal.unknown ∷ sigs') S' r) S b))

canθ'-canθ-propagate-down-in : ∀ sigs S r θ →
  ∀ S' sigs' →
    S' ∈ proj₁ (Canθ' sigs S (λ θ* → Canθ (just Signal.unknown ∷ sigs') S' r θ*) θ) →
    Canθ' sigs S (λ θ* → Canθ (just Signal.unknown ∷ sigs') S' r θ*) θ ≡
    Canθ' sigs S (λ θ* → Canθ sigs' (suc S') r (θ* ← [S]-env (S' ₛ))) θ
canθ'-canθ-propagate-down-in [] S r θ S' sigs' S'∈canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩
  with any (_≟_ S') (Canθₛ sigs' (suc S') r (θ ← [S]-env (S' ₛ)))
... | yes S'∈canθ-sigs'-r-θ←[S'] = refl
... | no  S'∉canθ-sigs'-r-θ←[S'] =
  ⊥-elim
    (S'∉canθ-sigs'-r-θ←[S']
      (canθₛ-add-sig-monotonic sigs' (suc S') r θ (S' ₛ) Signal.absent S'
         S'∈canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩))
canθ'-canθ-propagate-down-in (nothing ∷ sigs) S r θ S' sigs' S'∈canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩ =
  canθ'-canθ-propagate-down-in sigs (suc S) r θ S' sigs' S'∈canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩
canθ'-canθ-propagate-down-in (just Signal.present ∷ sigs) S r θ S' sigs' S'∈canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩ =
  canθ'-canθ-propagate-down-in sigs (suc S) r (θ ← [S]-env-present (S ₛ)) S' sigs' S'∈canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩
canθ'-canθ-propagate-down-in (just Signal.absent ∷ sigs) S r θ S' sigs' S'∈canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩ =
  canθ'-canθ-propagate-down-in sigs (suc S) r (θ ← [S]-env-absent (S ₛ)) S' sigs' S'∈canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩
canθ'-canθ-propagate-down-in (just Signal.unknown ∷ sigs) S r θ S' sigs' S'∈canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩
  with any (_≟_ S)
         (proj₁
           (Canθ' sigs (suc S)
             (Canθ (just Signal.unknown ∷ sigs') S' r)
             (θ ← [S]-env (S ₛ))))
     | any (_≟_ S)
         (proj₁
           (Canθ' sigs (suc S)
             (λ θ* → Canθ sigs' (suc S') r (θ* ← [S]-env (S' ₛ)))
             (θ ← [S]-env (S ₛ))))
... | yes S∈canθ'-sigs-⟨canθ-u∷sigs'-r⟩-θ←[S] | yes S∈canθ'-sigs-⟨canθ-sigs'-θ*←[S']⟩-θ←[S] =
  canθ'-canθ-propagate-down-in sigs (suc S) r (θ ← [S]-env (S ₛ)) S' sigs' S'∈canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩
... | no  S∉canθ'-sigs-⟨canθ-u∷sigs'-r⟩-θ←[S] | no  S∉canθ'-sigs-⟨canθ-sigs'-θ*←[S']⟩-θ←[S] =
  canθ'-canθ-propagate-down-in sigs (suc S) r (θ ← [S]-env-absent (S ₛ)) S' sigs' S'∈canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩
... | yes S∈canθ'-sigs-⟨canθ-u∷sigs'-r⟩-θ←[S] | no  S∉canθ'-sigs-⟨canθ-sigs'-θ*←[S']⟩-θ←[S]
  = ⊥-elim
      (S∉canθ'-sigs-⟨canθ-sigs'-θ*←[S']⟩-θ←[S]
        (subst (S ∈_)
          (cong proj₁
            (canθ'-canθ-propagate-down-in sigs (suc S) r (θ ← [S]-env (S ₛ)) S' sigs'
              S'∈canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩))
          S∈canθ'-sigs-⟨canθ-u∷sigs'-r⟩-θ←[S]))
... | no  S∉canθ'-sigs-⟨canθ-u∷sigs'-r⟩-θ←[S] | yes S∈canθ'-sigs-⟨canθ-sigs'-θ*←[S']⟩-θ←[S]
  = ⊥-elim
    (S∉canθ'-sigs-⟨canθ-u∷sigs'-r⟩-θ←[S]
      (subst (S ∈_)
        (cong proj₁
          (sym (canθ'-canθ-propagate-down-in sigs (suc S) r (θ ← [S]-env (S ₛ)) S' sigs'
            (canθ'ₛ-canθ-add-sig-monotonic sigs (suc S) (just Signal.unknown ∷ sigs') S'
              r θ (S ₛ) Signal.absent S'
              S'∈canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩))))
        S∈canθ'-sigs-⟨canθ-sigs'-θ*←[S']⟩-θ←[S]))

canθ'-canθ-propagate-up-in-set-irr : ∀ sigs S r θ status →
  ∀ sigs' S' S'' →
    S' ∈ proj₁ (Canθ' sigs S (λ θ* → Canθ sigs' (suc S') r (θ* ← [S]-env (S' ₛ))) θ) →
    S'' ∈ proj₁ (Canθ' sigs S (λ θ* → Canθ sigs' (suc S') r (θ* ← [S]-env (S' ₛ))) θ) →
    S'' ∈ proj₁ (Canθ' sigs S (λ θ* → Canθ (just Signal.unknown ∷ sigs') S' r (θ* ← [ (S' ₛ) ↦ status ])) θ)
canθ'-canθ-propagate-up-in-set-irr [] S r θ status sigs' S' S'' S'∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩ S''∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩
  with any (_≟_ S') (Canθₛ sigs' (suc S') r ((θ ← [ (S' ₛ) ↦ status ]) ← [S]-env (S' ₛ)))
... | yes S'∈canθ-sigs'-r-θ*←[S']
  rewrite Env.sig-single-←-←-overwrite θ (S' ₛ) status Signal.unknown
  = S''∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩
... | no  S'∉canθ-sigs'-r-θ*←[S']
  rewrite Env.sig-single-←-←-overwrite θ (S' ₛ) status Signal.unknown
  = ⊥-elim (S'∉canθ-sigs'-r-θ*←[S'] S'∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩)
canθ'-canθ-propagate-up-in-set-irr (nothing ∷ sigs) S r θ status sigs' S' S'' S'∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩ S''∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩ =
  canθ'-canθ-propagate-up-in-set-irr sigs (suc S) r θ status sigs' S' S'' S'∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩ S''∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩
canθ'-canθ-propagate-up-in-set-irr (just Signal.present ∷ sigs) S r θ status sigs' S' S'' S'∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩ S''∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩ =
  canθ'-canθ-propagate-up-in-set-irr sigs (suc S) r (θ ← [S]-env-present (S ₛ)) status sigs' S' S'' S'∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩ S''∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩
canθ'-canθ-propagate-up-in-set-irr (just Signal.absent ∷ sigs) S r θ status sigs' S' S'' S'∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩ S''∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩ =
  canθ'-canθ-propagate-up-in-set-irr sigs (suc S) r (θ ← [S]-env-absent (S ₛ)) status sigs' S' S'' S'∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩ S''∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩
canθ'-canθ-propagate-up-in-set-irr (just Signal.unknown ∷ sigs) S r θ status sigs' S' S'' S'∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩ S''∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩
  with any (_≟_ S)
         (proj₁
           (Canθ' sigs (suc S) (λ θ* → Canθ (just Signal.unknown ∷ sigs') S' r (θ* ← [ (S' ₛ) ↦ status ])) (θ ← [S]-env (S ₛ))))
     | any (_≟_ S)
         (proj₁
           (Canθ' sigs (suc S) (λ θ* → Canθ sigs' (suc S') r (θ* ← [S]-env (S' ₛ))) (θ ← [S]-env (S ₛ))))
... | yes S∈canθ'-sigs-⟨canθ-u∷sigs'-r⟩-θ←[S] | yes S∈canθ'-sigs-⟨canθ-sigs'-θ*←[S']⟩-θ←[S] =
  canθ'-canθ-propagate-up-in-set-irr sigs (suc S) r (θ ← [S]-env (S ₛ)) status sigs' S' S'' S'∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩ S''∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩
... | no  S∉canθ'-sigs-⟨canθ-u∷sigs'-r⟩-θ←[S] | no  S∉canθ'-sigs-⟨canθ-sigs'-θ*←[S']⟩-θ←[S] =
  canθ'-canθ-propagate-up-in-set-irr sigs (suc S) r (θ ← [S]-env-absent (S ₛ)) status sigs' S' S'' S'∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩ S''∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩
... | yes S∈canθ'-sigs-⟨canθ-u∷sigs'-r⟩-θ←[S] | no  S∉canθ'-sigs-⟨canθ-sigs'-θ*←[S']⟩-θ←[S]
  = canθ'ₛ-add-sig-monotonic sigs (suc S)
       (Canθ (just Signal.unknown ∷ sigs') S' r ∘ (_← [ (S' ₛ) ↦ status ]))
       θ (S ₛ) Signal.absent
       (λ θ* S* status* S'' S''∈ →
         canθₛ-cong-←-add-sig-monotonic (just Signal.unknown ∷ sigs') S' r
         θ* [ (S' ₛ) ↦ status ] S* status* S'' S''∈) S''
       (canθ'-canθ-propagate-up-in-set-irr sigs (suc S) r (θ ← [S]-env-absent (S ₛ))
         status sigs' S' S''
         S'∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩
         S''∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩)
... | no  S∉canθ'-sigs-⟨canθ-u∷sigs'-r⟩-θ←[S] | yes S∈canθ'-sigs-⟨canθ-sigs'-θ*←[S']⟩-θ←[S] =
  ⊥-elim
    (S∉canθ'-sigs-⟨canθ-u∷sigs'-r⟩-θ←[S]
      (canθ'-canθ-propagate-up-in-set-irr sigs (suc S) r (θ ← [S]-env (S ₛ)) status sigs' S' S
        S'∈canθ'-sigs-⟨canθ-sigs'-r-θ*←[S']⟩
        S∈canθ'-sigs-⟨canθ-sigs'-θ*←[S']⟩-θ←[S]))

canθ'-canθ-propagate-down-in-set-irr : ∀ sigs S r θ status →
  ∀ S' sigs' →
    S' ∈ proj₁ (Canθ' sigs S (λ θ* → Canθ (just Signal.unknown ∷ sigs') S' r (θ* ← [ (S' ₛ) ↦ status ])) θ) →
    Canθ' sigs S (λ θ* → Canθ (just Signal.unknown ∷ sigs') S' r (θ* ← [ (S' ₛ) ↦ status ])) θ ≡
    Canθ' sigs S (λ θ* → Canθ sigs' (suc S') r (θ* ← [S]-env (S' ₛ))) θ
canθ'-canθ-propagate-down-in-set-irr [] S r θ status S' sigs' S'∈canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩
  with any (_≟_ S') (Canθₛ sigs' (suc S') r ((θ ← [ (S' ₛ) ↦ status ]) ← [S]-env (S' ₛ)))
... | yes S'∈canθ-sigs'-r-θ←[S'] rewrite Env.sig-single-←-←-overwrite θ (S' ₛ) status Signal.unknown = refl
... | no  S'∉canθ-sigs'-r-θ←[S'] =
  ⊥-elim
    (S'∉canθ-sigs'-r-θ←[S']
      (canθₛ-add-sig-monotonic sigs' (suc S') r (θ ← [ (S' ₛ) ↦ status ]) (S' ₛ) Signal.absent S'
         S'∈canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩))
canθ'-canθ-propagate-down-in-set-irr (nothing ∷ sigs) S r θ status S' sigs' S'∈canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩ =
  canθ'-canθ-propagate-down-in-set-irr sigs (suc S) r θ status S' sigs' S'∈canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩
canθ'-canθ-propagate-down-in-set-irr (just Signal.present ∷ sigs) S r θ status S' sigs' S'∈canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩ =
  canθ'-canθ-propagate-down-in-set-irr sigs (suc S) r (θ ← [S]-env-present (S ₛ)) status S' sigs' S'∈canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩
canθ'-canθ-propagate-down-in-set-irr (just Signal.absent ∷ sigs) S r θ status S' sigs' S'∈canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩ =
  canθ'-canθ-propagate-down-in-set-irr sigs (suc S) r (θ ← [S]-env-absent (S ₛ)) status S' sigs' S'∈canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩
canθ'-canθ-propagate-down-in-set-irr (just Signal.unknown ∷ sigs) S r θ status S' sigs' S'∈canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩
  with any (_≟_ S)
         (proj₁
           (Canθ' sigs (suc S)
             (λ θ* → Canθ (just Signal.unknown ∷ sigs') S' r (θ* ← [ (S' ₛ) ↦ status ]))
             (θ ← [S]-env (S ₛ))))
     | any (_≟_ S)
         (proj₁
           (Canθ' sigs (suc S)
             (λ θ* → Canθ sigs' (suc S') r (θ* ← [S]-env (S' ₛ)))
             (θ ← [S]-env (S ₛ))))
... | yes S∈canθ'-sigs-⟨canθ-u∷sigs'-r⟩-θ←[S] | yes S∈canθ'-sigs-⟨canθ-sigs'-θ*←[S']⟩-θ←[S] =
  canθ'-canθ-propagate-down-in-set-irr sigs (suc S) r (θ ← [S]-env (S ₛ)) status S' sigs' S'∈canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩
... | no  S∉canθ'-sigs-⟨canθ-u∷sigs'-r⟩-θ←[S] | no  S∉canθ'-sigs-⟨canθ-sigs'-θ*←[S']⟩-θ←[S] =
  canθ'-canθ-propagate-down-in-set-irr sigs (suc S) r (θ ← [S]-env-absent (S ₛ)) status S' sigs' S'∈canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩
... | yes S∈canθ'-sigs-⟨canθ-u∷sigs'-r⟩-θ←[S] | no  S∉canθ'-sigs-⟨canθ-sigs'-θ*←[S']⟩-θ←[S]
  = ⊥-elim
      (S∉canθ'-sigs-⟨canθ-sigs'-θ*←[S']⟩-θ←[S]
        (subst (S ∈_)
          (cong proj₁
            (canθ'-canθ-propagate-down-in-set-irr sigs (suc S) r (θ ← [S]-env (S ₛ)) status S' sigs'
              S'∈canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩))
          S∈canθ'-sigs-⟨canθ-u∷sigs'-r⟩-θ←[S]))
... | no  S∉canθ'-sigs-⟨canθ-u∷sigs'-r⟩-θ←[S] | yes S∈canθ'-sigs-⟨canθ-sigs'-θ*←[S']⟩-θ←[S]
  = ⊥-elim
    (S∉canθ'-sigs-⟨canθ-u∷sigs'-r⟩-θ←[S]
      (subst (S ∈_)
        (cong proj₁
          (sym (canθ'-canθ-propagate-down-in-set-irr sigs (suc S) r (θ ← [S]-env (S ₛ)) status S' sigs'
            (canθ'ₛ-add-sig-monotonic sigs (suc S)
               (Canθ (just Signal.unknown ∷ sigs') S' r ∘
                (λ section → section ← [ (S' ₛ) ↦ status ]))
               θ (S ₛ) Signal.absent
               (λ θ* S* status* →
                 canθₛ-cong-←-add-sig-monotonic (just Signal.unknown ∷ sigs') S' r
                   θ* [ (S' ₛ) ↦ status ] S* status*)
               S' S'∈canθ'-sigs-⟨Canθ-u∷sigs'-θ*⟩))))
        S∈canθ'-sigs-⟨canθ-sigs'-θ*←[S']⟩-θ←[S]))

canθ'-←-distribute : ∀ sigs sigs' S'' r θ →
  Canθ (SigMap.union sigs sigs') S'' r θ ≡
  Canθ' sigs S'' (Canθ sigs' S'' r) θ
canθ'-←-distribute [] sigs' S'' r θ = refl
canθ'-←-distribute sigs [] S'' r θ
  rewrite SigMap.union-comm sigs SigMap.empty (λ _ _ ())
        | unfold sigs S'' r θ
  = refl
canθ'-←-distribute (nothing ∷ sigs) (nothing ∷ sigs') S'' r θ =
  canθ'-←-distribute sigs sigs' (suc S'') r θ
canθ'-←-distribute (just Signal.present ∷ sigs) (nothing ∷ sigs') S'' r θ =
  canθ'-←-distribute sigs sigs' (suc S'') r
    (θ ← [S]-env-present (S'' ₛ))
canθ'-←-distribute (just Signal.absent ∷ sigs) (nothing ∷ sigs') S'' r θ =
  canθ'-←-distribute sigs sigs' (suc S'') r
    (θ ← [S]-env-absent (S'' ₛ))
canθ'-←-distribute (just Signal.unknown ∷ sigs) (nothing ∷ sigs') S'' r θ
  with any (_≟_ S'') (proj₁ (Canθ (SigMap.union sigs sigs') (suc S'') r (θ ← [S]-env (S'' ₛ))))
     | any (_≟_ S'') (proj₁ (Canθ' sigs (suc S'') (Canθ sigs' (suc S'') r) (θ ← [S]-env (S'' ₛ))))
... | yes S''∈canθ'-sigs←sigs'-r-θ←[S''] | yes S''∈canθ'-sigs-⟨canθ-sigs'⟩-θ←[S''] =
  canθ'-←-distribute sigs sigs' (suc S'') r
    (θ ← [S]-env (S'' ₛ))
... | no  S''∉canθ'-sigs←sigs'-r-θ←[S''] | no  S''∉canθ'-sigs-⟨canθ-sigs'⟩-θ←[S''] =
  canθ'-←-distribute sigs sigs' (suc S'') r
    (θ ← [S]-env-absent (S'' ₛ))
... | yes S''∈canθ'-sigs←sigs'-r-θ←[S''] | no  S''∉canθ'-sigs-⟨canθ-sigs'⟩-θ←[S'']
  rewrite canθ'-←-distribute sigs sigs' (suc S'') r (θ ← [S]-env (S'' ₛ))
  = ⊥-elim (S''∉canθ'-sigs-⟨canθ-sigs'⟩-θ←[S''] S''∈canθ'-sigs←sigs'-r-θ←[S''])
... | no  S''∉canθ'-sigs←sigs'-r-θ←[S''] | yes S''∈canθ'-sigs-⟨canθ-sigs'⟩-θ←[S'']
  rewrite canθ'-←-distribute sigs sigs' (suc S'') r (θ ← [S]-env (S'' ₛ))
  = ⊥-elim (S''∉canθ'-sigs←sigs'-r-θ←[S''] S''∈canθ'-sigs-⟨canθ-sigs'⟩-θ←[S''])
canθ'-←-distribute (nothing ∷ sigs) (just Signal.present ∷ sigs') S'' r θ =
  trans
    (canθ'-←-distribute sigs sigs' (suc S'') r
     (θ ← [S]-env-present (S'' ₛ)))
    (canθ'-search-acc sigs (suc S'') (Canθ sigs' (suc S'') r) θ S'' Signal.present
      (n∉map-suc-n-+ S'' (SigMap.keys sigs)))
canθ'-←-distribute (nothing ∷ sigs) (just Signal.absent ∷ sigs') S'' r θ =
  trans
    (canθ'-←-distribute sigs sigs' (suc S'') r
     (θ ← [S]-env-absent (S'' ₛ)))
    (canθ'-search-acc sigs (suc S'') (Canθ sigs' (suc S'') r) θ S'' Signal.absent
      (n∉map-suc-n-+ S'' (SigMap.keys sigs)))
canθ'-←-distribute (nothing ∷ sigs) (just Signal.unknown ∷ sigs') S'' r θ
  with any (_≟_ S'') (proj₁ (Canθ (SigMap.union sigs sigs') (suc S'') r (θ ← [S]-env (S'' ₛ))))
     | any (_≟_ S'') (proj₁ (Canθ' sigs (suc S'') (Canθ (just Signal.unknown ∷ sigs') S'' r) θ))
... | yes S''∈canθ'-sigs←sigs'-r-θ←[S''] | yes S''∈canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
  rewrite canθ'-canθ-propagate-down-in sigs (suc S'') r θ S'' sigs' S''∈canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
  = trans
      (canθ'-←-distribute sigs sigs' (suc S'') r
       (θ ← [S]-env (S'' ₛ)))
      (canθ'-search-acc sigs (suc S'') (Canθ sigs' (suc S'') r) θ S'' Signal.unknown
        (n∉map-suc-n-+ S'' (SigMap.keys sigs)))
... | no  S''∉canθ'-sigs←sigs'-r-θ←[S''] | no  S''∉canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
  rewrite canθ'-canθ-propagate-down-not-in sigs (suc S'') r θ S'' sigs' S''∉canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
  = trans
      (canθ'-←-distribute sigs sigs' (suc S'') r
       (θ ← [S]-env-absent (S'' ₛ)))
      (canθ'-search-acc sigs (suc S'') (Canθ sigs' (suc S'') r) θ S'' Signal.absent
        (n∉map-suc-n-+ S'' (SigMap.keys sigs)))
... | yes S''∈canθ'-sigs←sigs'-r-θ←[S''] | no  S''∉canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
  rewrite trans
            (canθ'-←-distribute sigs sigs' (suc S'') r
              (θ ← [S]-env (S'' ₛ)))
            (canθ'-search-acc sigs (suc S'') (Canθ sigs' (suc S'') r) θ S'' Signal.unknown
              (n∉map-suc-n-+ S'' (SigMap.keys sigs)))
  = ⊥-elim
      (S''∉canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
        (canθ'-canθ-propagate-up-in sigs (suc S'') r θ sigs' S'' S'' S''∈canθ'-sigs←sigs'-r-θ←[S''] S''∈canθ'-sigs←sigs'-r-θ←[S'']))
... | no  S''∉canθ'-sigs←sigs'-r-θ←[S''] | yes S''∈canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
  rewrite trans
            (canθ'-←-distribute sigs sigs' (suc S'') r
              (θ ← [S]-env (S'' ₛ)))
            (canθ'-search-acc sigs (suc S'') (Canθ sigs' (suc S'') r) θ S'' Signal.unknown
              (n∉map-suc-n-+ S'' (SigMap.keys sigs)))
  = ⊥-elim
      (S''∉canθ'-sigs←sigs'-r-θ←[S'']
        (subst (S'' ∈_)
          (cong proj₁
            (canθ'-canθ-propagate-down-in sigs (suc S'') r θ S'' sigs' S''∈canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩))
          S''∈canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩))
canθ'-←-distribute (just Signal.present ∷ sigs) (just Signal.present ∷ sigs') S'' r θ =
  trans
    (canθ'-←-distribute sigs sigs' (suc S'') r
     (θ ← [S]-env-present (S'' ₛ)))
    (canθ'-search-acc-set-irr sigs (suc S'') (Canθ sigs' (suc S'') r) θ S'' Signal.present Signal.present
      (n∉map-suc-n-+ S'' (SigMap.keys sigs)))
canθ'-←-distribute (just Signal.absent ∷ sigs)  (just Signal.present ∷ sigs') S'' r θ =
  trans
    (canθ'-←-distribute sigs sigs' (suc S'') r
     (θ ← [S]-env-present (S'' ₛ)))
    (canθ'-search-acc-set-irr sigs (suc S'') (Canθ sigs' (suc S'') r) θ S'' Signal.present Signal.absent
      (n∉map-suc-n-+ S'' (SigMap.keys sigs)))
canθ'-←-distribute (just Signal.unknown ∷ sigs) (just Signal.present ∷ sigs') S'' r θ
  with any (_≟_ S'')
         (proj₁
           (Canθ' sigs (suc S'')
             (λ θ* → Canθ sigs' (suc S'') r (θ* ← [S]-env-present (S'' ₛ)))
             (θ ← [S]-env (S'' ₛ))))
... | yes S''∈canθ'-sigs-⟨Canθ-sigs'-r-θ*←[S'']⟩-θ←[S''] =
  trans
    (canθ'-←-distribute sigs sigs' (suc S'') r
     (θ ← [S]-env-present (S'' ₛ)))
    (canθ'-search-acc-set-irr sigs (suc S'') (Canθ sigs' (suc S'') r) θ S'' Signal.present Signal.unknown
      (n∉map-suc-n-+ S'' (SigMap.keys sigs)))
... | no  S''∉canθ'-sigs-⟨Canθ-sigs'-r-θ*←[S'']⟩-θ←[S''] =
  trans
    (canθ'-←-distribute sigs sigs' (suc S'') r
     (θ ← [S]-env-present (S'' ₛ)))
    (canθ'-search-acc-set-irr sigs (suc S'') (Canθ sigs' (suc S'') r) θ S'' Signal.present Signal.absent
      (n∉map-suc-n-+ S'' (SigMap.keys sigs)))
canθ'-←-distribute (just Signal.present ∷ sigs) (just Signal.absent ∷ sigs') S'' r θ =
  trans
    (canθ'-←-distribute sigs sigs' (suc S'') r
     (θ ← [S]-env-absent (S'' ₛ)))
    (canθ'-search-acc-set-irr sigs (suc S'') (Canθ sigs' (suc S'') r) θ S'' Signal.absent Signal.present
      (n∉map-suc-n-+ S'' (SigMap.keys sigs)))
canθ'-←-distribute (just Signal.absent ∷ sigs)  (just Signal.absent ∷ sigs') S'' r θ =
  trans
    (canθ'-←-distribute sigs sigs' (suc S'') r
     (θ ← [S]-env-absent (S'' ₛ)))
    (canθ'-search-acc-set-irr sigs (suc S'') (Canθ sigs' (suc S'') r) θ S'' Signal.absent Signal.absent
      (n∉map-suc-n-+ S'' (SigMap.keys sigs)))
canθ'-←-distribute (just Signal.unknown ∷ sigs) (just Signal.absent ∷ sigs') S'' r θ
  with any (_≟_ S'')
         (proj₁
           (Canθ' sigs (suc S'')
             (λ θ* → Canθ sigs' (suc S'') r (θ* ← [S]-env-absent (S'' ₛ)))
             (θ ← [S]-env (S'' ₛ))))
... | yes S''∈canθ'-sigs-⟨Canθ-sigs'-r-θ*←[S'']⟩-θ←[S''] =
  trans
    (canθ'-←-distribute sigs sigs' (suc S'') r
     (θ ← [S]-env-absent (S'' ₛ)))
    (canθ'-search-acc-set-irr sigs (suc S'') (Canθ sigs' (suc S'') r) θ S'' Signal.absent Signal.unknown
      (n∉map-suc-n-+ S'' (SigMap.keys sigs)))
... | no  S''∉canθ'-sigs-⟨Canθ-sigs'-r-θ*←[S'']⟩-θ←[S''] =
  trans
    (canθ'-←-distribute sigs sigs' (suc S'') r
     (θ ← [S]-env-absent (S'' ₛ)))
    (canθ'-search-acc-set-irr sigs (suc S'') (Canθ sigs' (suc S'') r) θ S'' Signal.absent Signal.absent
      (n∉map-suc-n-+ S'' (SigMap.keys sigs)))
canθ'-←-distribute (just Signal.present ∷ sigs) (just Signal.unknown ∷ sigs') S'' r θ
  with any (_≟_ S'') (proj₁ (Canθ (SigMap.union sigs sigs') (suc S'') r (θ ← [S]-env (S'' ₛ))))
     | any (_≟_ S'') (proj₁ (Canθ' sigs (suc S'') (Canθ (just Signal.unknown ∷ sigs') S'' r) (θ ← [S]-env-present (S'' ₛ))))
... | yes S''∈canθ'-sigs←sigs'-r-θ←[S''] | yes S''∈canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
  rewrite canθ'-canθ-propagate-down-in sigs (suc S'') r (θ ← [S]-env-present (S'' ₛ)) S'' sigs' S''∈canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
  = trans
      (canθ'-←-distribute sigs sigs' (suc S'') r
       (θ ← [S]-env (S'' ₛ)))
      (canθ'-search-acc-set-irr sigs (suc S'') (Canθ sigs' (suc S'') r) θ S'' Signal.unknown Signal.present
        (n∉map-suc-n-+ S'' (SigMap.keys sigs)))
... | no  S''∉canθ'-sigs←sigs'-r-θ←[S''] | no  S''∉canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
  rewrite canθ'-canθ-propagate-down-not-in sigs (suc S'') r (θ ← [S]-env-present (S'' ₛ)) S'' sigs' S''∉canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
  = trans
      (canθ'-←-distribute sigs sigs' (suc S'') r
       (θ ← [S]-env-absent (S'' ₛ)))
      (canθ'-search-acc-set-irr sigs (suc S'') (Canθ sigs' (suc S'') r) θ S'' Signal.absent Signal.present
        (n∉map-suc-n-+ S'' (SigMap.keys sigs)))
... | yes S''∈canθ'-sigs←sigs'-r-θ←[S''] | no  S''∉canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
  rewrite trans
            (canθ'-←-distribute sigs sigs' (suc S'') r
              (θ ← [S]-env (S'' ₛ)))
            (canθ'-search-acc sigs (suc S'') (Canθ sigs' (suc S'') r) θ S'' Signal.unknown
              (n∉map-suc-n-+ S'' (SigMap.keys sigs)))
  = ⊥-elim
      (S''∉canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
        (subst (S'' ∈_)
          (sym
            (cong proj₁
              (canθ'-search-acc sigs (suc S'') (Canθ (just Signal.unknown ∷ sigs') S'' r) θ
                S'' Signal.present
                (n∉map-suc-n-+ S'' (SigMap.keys sigs)))))
          (canθ'-canθ-propagate-up-in-set-irr sigs (suc S'') r θ Signal.present sigs' S'' S'' S''∈canθ'-sigs←sigs'-r-θ←[S''] S''∈canθ'-sigs←sigs'-r-θ←[S''])))
... | no  S''∉canθ'-sigs←sigs'-r-θ←[S''] | yes S''∈canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
  rewrite trans
            (canθ'-←-distribute sigs sigs' (suc S'') r
              (θ ← [S]-env (S'' ₛ)))
            (canθ'-search-acc sigs (suc S'') (Canθ sigs' (suc S'') r) θ S'' Signal.unknown
              (n∉map-suc-n-+ S'' (SigMap.keys sigs)))
        | canθ'-search-acc sigs (suc S'') (Canθ (just Signal.unknown ∷ sigs') S'' r) θ
                S'' Signal.present
                (n∉map-suc-n-+ S'' (SigMap.keys sigs))
  = ⊥-elim
      (S''∉canθ'-sigs←sigs'-r-θ←[S'']
        (subst (S'' ∈_)
          (cong proj₁
            (canθ'-canθ-propagate-down-in-set-irr sigs (suc S'') r θ Signal.present S'' sigs' S''∈canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩))
          S''∈canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩))
canθ'-←-distribute (just Signal.absent ∷ sigs)  (just Signal.unknown ∷ sigs') S'' r θ
  with any (_≟_ S'') (proj₁ (Canθ (SigMap.union sigs sigs') (suc S'') r (θ ← [S]-env (S'' ₛ))))
     | any (_≟_ S'') (proj₁ (Canθ' sigs (suc S'') (Canθ (just Signal.unknown ∷ sigs') S'' r) (θ ← [S]-env-absent (S'' ₛ))))
... | yes S''∈canθ'-sigs←sigs'-r-θ←[S''] | yes S''∈canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
  rewrite canθ'-canθ-propagate-down-in sigs (suc S'') r (θ ← [S]-env-absent (S'' ₛ)) S'' sigs' S''∈canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
  = trans
      (canθ'-←-distribute sigs sigs' (suc S'') r
       (θ ← [S]-env (S'' ₛ)))
      (canθ'-search-acc-set-irr sigs (suc S'') (Canθ sigs' (suc S'') r) θ S'' Signal.unknown Signal.absent
        (n∉map-suc-n-+ S'' (SigMap.keys sigs)))
... | no  S''∉canθ'-sigs←sigs'-r-θ←[S''] | no  S''∉canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
  rewrite canθ'-canθ-propagate-down-not-in sigs (suc S'') r (θ ← [S]-env-absent (S'' ₛ)) S'' sigs' S''∉canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
  = trans
      (canθ'-←-distribute sigs sigs' (suc S'') r
       (θ ← [S]-env-absent (S'' ₛ)))
      (canθ'-search-acc-set-irr sigs (suc S'') (Canθ sigs' (suc S'') r) θ S'' Signal.absent Signal.absent
        (n∉map-suc-n-+ S'' (SigMap.keys sigs)))
... | yes S''∈canθ'-sigs←sigs'-r-θ←[S''] | no  S''∉canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
  rewrite trans
            (canθ'-←-distribute sigs sigs' (suc S'') r
              (θ ← [S]-env (S'' ₛ)))
            (canθ'-search-acc sigs (suc S'') (Canθ sigs' (suc S'') r) θ S'' Signal.unknown
              (n∉map-suc-n-+ S'' (SigMap.keys sigs)))
  = ⊥-elim
      (S''∉canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
        (subst (S'' ∈_)
          (sym
            (cong proj₁
              (canθ'-search-acc sigs (suc S'') (Canθ (just Signal.unknown ∷ sigs') S'' r) θ
                S'' Signal.absent
                (n∉map-suc-n-+ S'' (SigMap.keys sigs)))))
          (canθ'-canθ-propagate-up-in-set-irr sigs (suc S'') r θ Signal.absent sigs' S'' S'' S''∈canθ'-sigs←sigs'-r-θ←[S''] S''∈canθ'-sigs←sigs'-r-θ←[S''])))
... | no  S''∉canθ'-sigs←sigs'-r-θ←[S''] | yes S''∈canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
  rewrite trans
            (canθ'-←-distribute sigs sigs' (suc S'') r
              (θ ← [S]-env (S'' ₛ)))
            (canθ'-search-acc sigs (suc S'') (Canθ sigs' (suc S'') r) θ S'' Signal.unknown
              (n∉map-suc-n-+ S'' (SigMap.keys sigs)))
        | canθ'-search-acc sigs (suc S'') (Canθ (just Signal.unknown ∷ sigs') S'' r) θ
                S'' Signal.absent
                (n∉map-suc-n-+ S'' (SigMap.keys sigs))
  = ⊥-elim
      (S''∉canθ'-sigs←sigs'-r-θ←[S'']
        (subst (S'' ∈_)
          (cong proj₁
            (canθ'-canθ-propagate-down-in-set-irr sigs (suc S'') r θ Signal.absent S'' sigs' S''∈canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩))
          S''∈canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩))
canθ'-←-distribute (just Signal.unknown ∷ sigs) (just Signal.unknown ∷ sigs') S'' r θ
  with any (_≟_ S'') (proj₁ (Canθ' sigs (suc S'') (λ θ* → Canθ (just Signal.unknown ∷ sigs') S'' r θ*) (θ ← [S]-env (S'' ₛ))))
canθ'-←-distribute (just Signal.unknown ∷ sigs) (just Signal.unknown ∷ sigs') S'' r θ | yes p
  with any (_≟_ S'') (proj₁ (Canθ (SigMap.union sigs sigs') (suc S'') r (θ ← [S]-env (S'' ₛ))))
     | any (_≟_ S'') (proj₁ (Canθ' sigs (suc S'') (Canθ (just Signal.unknown ∷ sigs') S'' r) (θ ← [S]-env (S'' ₛ))))
... | yes S''∈canθ'-sigs←sigs'-r-θ←[S''] | yes S''∈canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
  rewrite canθ'-canθ-propagate-down-in sigs (suc S'') r (θ ← [S]-env (S'' ₛ)) S'' sigs' S''∈canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
  = trans
      (canθ'-←-distribute sigs sigs' (suc S'') r
       (θ ← [S]-env (S'' ₛ)))
      (canθ'-search-acc-set-irr sigs (suc S'') (Canθ sigs' (suc S'') r) θ S'' Signal.unknown Signal.unknown
        (n∉map-suc-n-+ S'' (SigMap.keys sigs)))
... | no  S''∉canθ'-sigs←sigs'-r-θ←[S''] | no  S''∉canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
  rewrite canθ'-canθ-propagate-down-not-in sigs (suc S'') r (θ ← [S]-env (S'' ₛ)) S'' sigs' S''∉canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
  = trans
      (canθ'-←-distribute sigs sigs' (suc S'') r
       (θ ← [S]-env-absent (S'' ₛ)))
      (canθ'-search-acc-set-irr sigs (suc S'') (Canθ sigs' (suc S'') r) θ S'' Signal.absent Signal.unknown
        (n∉map-suc-n-+ S'' (SigMap.keys sigs)))
... | yes S''∈canθ'-sigs←sigs'-r-θ←[S''] | no  S''∉canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
  rewrite trans
            (canθ'-←-distribute sigs sigs' (suc S'') r
              (θ ← [S]-env (S'' ₛ)))
            (canθ'-search-acc sigs (suc S'') (Canθ sigs' (suc S'') r) θ S'' Signal.unknown
              (n∉map-suc-n-+ S'' (SigMap.keys sigs)))
  = ⊥-elim
      (S''∉canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
        (subst (S'' ∈_)
          (sym
            (cong proj₁
              (canθ'-search-acc sigs (suc S'') (Canθ (just Signal.unknown ∷ sigs') S'' r) θ
                S'' Signal.unknown
                (n∉map-suc-n-+ S'' (SigMap.keys sigs)))))
          (canθ'-canθ-propagate-up-in-set-irr sigs (suc S'') r θ Signal.unknown sigs' S'' S'' S''∈canθ'-sigs←sigs'-r-θ←[S''] S''∈canθ'-sigs←sigs'-r-θ←[S''])))
... | no  S''∉canθ'-sigs←sigs'-r-θ←[S''] | yes S''∈canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
  rewrite trans
            (canθ'-←-distribute sigs sigs' (suc S'') r
              (θ ← [S]-env (S'' ₛ)))
            (canθ'-search-acc sigs (suc S'') (Canθ sigs' (suc S'') r) θ S'' Signal.unknown
              (n∉map-suc-n-+ S'' (SigMap.keys sigs)))
        | canθ'-search-acc sigs (suc S'') (Canθ (just Signal.unknown ∷ sigs') S'' r) θ
                S'' Signal.unknown
                (n∉map-suc-n-+ S'' (SigMap.keys sigs))
  = ⊥-elim
      (S''∉canθ'-sigs←sigs'-r-θ←[S'']
        (subst (S'' ∈_)
          (cong proj₁
            (canθ'-canθ-propagate-down-in-set-irr sigs (suc S'') r θ Signal.unknown S'' sigs' S''∈canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩))
          S''∈canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩))
canθ'-←-distribute (just Signal.unknown ∷ sigs) (just Signal.unknown ∷ sigs') S'' r θ | no ¬p
  with any (_≟_ S'') (proj₁ (Canθ (SigMap.union sigs sigs') (suc S'') r (θ ← [S]-env (S'' ₛ))))
     | any (_≟_ S'') (proj₁ (Canθ' sigs (suc S'') (Canθ (just Signal.unknown ∷ sigs') S'' r) (θ ← [S]-env-absent (S'' ₛ))))
... | yes S''∈canθ'-sigs←sigs'-r-θ←[S''] | yes S''∈canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
  rewrite canθ'-canθ-propagate-down-in sigs (suc S'') r (θ ← [S]-env-absent (S'' ₛ)) S'' sigs' S''∈canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
  = trans
      (canθ'-←-distribute sigs sigs' (suc S'') r
       (θ ← [S]-env (S'' ₛ)))
      (canθ'-search-acc-set-irr sigs (suc S'') (Canθ sigs' (suc S'') r) θ S'' Signal.unknown Signal.absent
        (n∉map-suc-n-+ S'' (SigMap.keys sigs)))
... | no  S''∉canθ'-sigs←sigs'-r-θ←[S''] | no  S''∉canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
  rewrite canθ'-canθ-propagate-down-not-in sigs (suc S'') r (θ ← [S]-env-absent (S'' ₛ)) S'' sigs' S''∉canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
  = trans
      (canθ'-←-distribute sigs sigs' (suc S'') r
       (θ ← [S]-env-absent (S'' ₛ)))
      (canθ'-search-acc-set-irr sigs (suc S'') (Canθ sigs' (suc S'') r) θ S'' Signal.absent Signal.absent
        (n∉map-suc-n-+ S'' (SigMap.keys sigs)))
... | yes S''∈canθ'-sigs←sigs'-r-θ←[S''] | no  S''∉canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
  rewrite trans
            (canθ'-←-distribute sigs sigs' (suc S'') r
              (θ ← [S]-env (S'' ₛ)))
            (canθ'-search-acc sigs (suc S'') (Canθ sigs' (suc S'') r) θ S'' Signal.unknown
              (n∉map-suc-n-+ S'' (SigMap.keys sigs)))
  = ⊥-elim
      (S''∉canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
        (subst (S'' ∈_)
          (sym
            (cong proj₁
              (canθ'-search-acc sigs (suc S'') (Canθ (just Signal.unknown ∷ sigs') S'' r) θ
                S'' Signal.absent
                (n∉map-suc-n-+ S'' (SigMap.keys sigs)))))
          (canθ'-canθ-propagate-up-in-set-irr sigs (suc S'') r θ Signal.absent sigs' S'' S'' S''∈canθ'-sigs←sigs'-r-θ←[S''] S''∈canθ'-sigs←sigs'-r-θ←[S''])))
... | no  S''∉canθ'-sigs←sigs'-r-θ←[S''] | yes S''∈canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩
  rewrite trans
            (canθ'-←-distribute sigs sigs' (suc S'') r
              (θ ← [S]-env (S'' ₛ)))
            (canθ'-search-acc sigs (suc S'') (Canθ sigs' (suc S'') r) θ S'' Signal.unknown
              (n∉map-suc-n-+ S'' (SigMap.keys sigs)))
        | canθ'-search-acc sigs (suc S'') (Canθ (just Signal.unknown ∷ sigs') S'' r) θ
                S'' Signal.absent
                (n∉map-suc-n-+ S'' (SigMap.keys sigs))
  = ⊥-elim
      (S''∉canθ'-sigs←sigs'-r-θ←[S'']
        (subst (S'' ∈_)
          (cong proj₁
            (canθ'-canθ-propagate-down-in-set-irr sigs (suc S'') r θ Signal.absent S'' sigs' S''∈canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩))
          S''∈canθ'-sigs-⟨Canθ-u∷sigs'-r-θ⟩))


module Languages.ILL.TypeCheck where

open import bool
open import maybe

open import Languages.ILL.TypeSyntax
open import Languages.ILL.Syntax
open import Utils.HaskellTypes
open import Utils.HaskellFunctions
open import Utils.Exception

data StateT (s : Set) (m : Set → Set) (a : Set) : Set where
  stateT : (s → m (Prod a s)) → StateT s m a

runStateT : ∀{s m a} → StateT s m a → (s → m (Prod a s))
runStateT (stateT f) = f

returnSTE : ∀{s A} → A → StateT s (Either Exception) A
returnSTE x = stateT (λ y → right (x , y))

infixl 20 _>>=STE_
_>>=STE_ : ∀{s A B} → StateT s (Either Exception) A → (A → StateT s (Either Exception) B) → StateT s (Either Exception) B
(stateT st) >>=STE f = stateT (λ y → st y >>=E (λ p → runStateT (f (fst p)) (snd p)))

infixl 20 _>>STE_
_>>STE_ : ∀{s A B} → StateT s (Either Exception) A → StateT s (Either Exception) B → StateT s (Either Exception) B
c₁ >>STE c₂ = c₁ >>=STE (λ _ → c₂)

throw : ∀{s A} → Exception → StateT s (Either Exception) A
throw x = stateT (λ _ → error x)

lift : ∀{s A} → Either Exception A → StateT s (Either Exception) A
lift (Left x) = stateT (λ _ → error x)
lift (Right x) = stateT (λ y → right (x , y))

get : ∀{S} → StateT S (Either Exception) S
get = stateT (λ x → right (x , x))

put : ∀{S} → S → StateT S (Either Exception) Unit
put s = stateT (λ x → Right (triv , s))

CTXEl : Set
CTXEl = Prod String Type

CTX : Set
CTX = List CTXEl

CTXV-eq : CTXEl → CTXEl → 𝔹
CTXV-eq (x , ty) (y , ty') = x str-eq y

TC : Set → Set
TC = StateT CTX (Either Exception)

_isDisjointWith_ : CTX → CTX → TC Unit
ctx₁ isDisjointWith ctx₂ with disjoint CTXV-eq ctx₁ ctx₂
... | tt = returnSTE triv
... | ff = throw TypeErrorDuplicatedFreeVar

getTypeCTX : String → CTX → maybe Type
getTypeCTX x ctx = lookup _str-eq_ x ctx

{-# TERMINATING #-}
subctxFV : CTX → Term → Either Exception CTX
subctxFV ctx Triv = right []
subctxFV ctx t@(FVar x) with getTypeCTX x ctx
... | just ty = right ((x , ty) :: [])
... | nothing = error VarNotInCtx
subctxFV ctx (BVar _ _ _) = right []
subctxFV ctx (Let t₁ _ _ t₂) =
  (subctxFV ctx t₁) >>=E
    (λ l₁ → (subctxFV ctx t₂) >>=E
       λ l₂ → right (l₁ ++ l₂))
subctxFV ctx (Lam _ _ t) = subctxFV ctx t
subctxFV ctx (App t₁ t₂) =
  (subctxFV ctx t₁) >>=E
    (λ l₁ → (subctxFV ctx t₂) >>=E
       λ l₂ → right (l₁ ++ l₂))
subctxFV ctx (Tensor t₁ t₂) =
  (subctxFV ctx t₁) >>=E
    (λ l₁ → (subctxFV ctx t₂) >>=E
       λ l₂ → right (l₁ ++ l₂))
subctxFV ctx (Promote ms t) =
  mctx₁ >>=E
    (λ ctx₁ → (subctxFV ctx t) >>=E
      (λ ctx₂ → right (ctx₁ ++ ctx₂)))
 where
  aux = (λ m r →
    (subctxFV ctx (fstT m)) >>=E
      (λ l₁ → r >>=E
        (λ l₂ → right (l₁ ++ l₂))))
  mctx₁ = foldr aux (right []) ms
subctxFV ctx (Discard t₁ t₂) =
  (subctxFV ctx t₁) >>=E
    (λ l₁ → (subctxFV ctx t₂) >>=E
       λ l₂ → right (l₁ ++ l₂))
subctxFV ctx (Copy t₁ _ t₂) =
  (subctxFV ctx t₁) >>=E
    (λ l₁ → (subctxFV ctx t₂) >>=E
       λ l₂ → right (l₁ ++ l₂))
subctxFV ctx (Derelict t) = subctxFV ctx t

isTop : Type → TC Type
isTop Top = returnSTE Top
isTop _ = throw TypeErrorLetNotTop

isTensor : Type → TC (Prod Type Type)
isTensor (Tensor x y) = returnSTE (x , y)
isTensor _ = throw TypeErrorLetNotTensor

isBang : Type → TC Type
isBang (Bang ty) = returnSTE ty
isBang _ = throw TypeErrorPromoteNotBang

isImp : Type → TC (Prod Type Type)
isImp (Imp A B) = returnSTE (A , B)
isImp _ = throw TypeErrorAppNotImp

_tyEq_ : Type → Type → TC Unit
_tyEq_ ty₁ ty₂ with ty₁ eq-type ty₂
... | tt = returnSTE triv
... | ff = throw TypeErrorTypesNotEqual

{-# TERMINATING #-}
typeCheck' : Term → TC Type
typeCheck' Triv = get >>=STE checkCTX
 where
   checkCTX : CTX → TC Type
   checkCTX [] = returnSTE Top
   checkCTX _ = throw NonEmptyCtx
typeCheck' (FVar x) = get >>=STE checkCtx
 where
   checkCtx : CTX → TC Type
   checkCtx ((y , ty) :: []) with x str-eq y
   ... | tt = returnSTE ty
   ... | ff = throw VarNotInCtx
   checkCtx _ = throw NonLinearCtx
typeCheck' (BVar _ _ _) = throw NonlocallyClosed
typeCheck' (Let t₁ ty PTriv t₂) =
 get >>=STE
   (λ ctx → lift (subctxFV ctx t₁) >>=STE
     (λ ctx₁ → lift (subctxFV ctx t₂) >>=STE
       λ ctx₂ → (ctx₁ isDisjointWith ctx₂) >>STE
         ((put ctx₁) >>STE typeCheck' t₁) >>=STE
           (λ ty₁ → isTop ty₁ >>STE
             (put ctx₂ >>STE typeCheck' t₂))))
typeCheck' (Let t₁ ty (PTensor x y) t₂) =
  get >>=STE
    (λ ctx → lift (subctxFV ctx t₁) >>=STE
     (λ ctx₁ → lift (subctxFV ctx t₂) >>=STE
      (λ ctx₂ → (ctx₁ isDisjointWith ctx₂) >>STE
        ((put ctx₁) >>STE
          typeCheck' t₁) >>=STE
            (λ ty₁ → (isTensor ty₁) >>=STE
              (λ tys → let A = fst tys
                           B = snd tys
                           t₂' = open-t 0 y RLPV (FVar y) (open-t 0 x LLPV (FVar x) t₂)
                        in put ((x , A) :: (y , B) :: ctx₂) >>STE typeCheck' t₂')))))
typeCheck' (Lam x ty t) =
  get >>=STE
    (λ ctx → (put ((x , ty) :: ctx)) >>STE
      typeCheck' (open-t 0 x BV (FVar x) t) >>=STE
        (λ ty₂ → returnSTE (Imp ty ty₂)))
typeCheck' (App t₁ t₂) =
  get >>=STE
    (λ ctx → lift (subctxFV ctx t₁) >>=STE
      (λ ctx₁ → lift (subctxFV ctx t₂) >>=STE
        (λ ctx₂ → (ctx₁ isDisjointWith ctx₂) >>STE
          (put ctx₁) >>STE (typeCheck' t₁) >>=STE
            (λ ty₁ → isImp ty₁ >>=STE
              (λ tys → (put ctx₂) >>STE (typeCheck' t₂) >>=STE
                (λ ty₂ → ((fst tys) tyEq ty₂) >>STE returnSTE (snd tys)))))))
typeCheck' (Tensor t₁ t₂) =
  get >>=STE
    (λ ctx → lift (subctxFV ctx t₁) >>=STE
      (λ ctx₁ → lift (subctxFV ctx t₂) >>=STE
        (λ ctx₂ → (ctx₁ isDisjointWith ctx₂) >>STE
          (put ctx₁) >>STE typeCheck' t₁ >>=STE
            (λ ty₁ → (put ctx₂) >>STE typeCheck' t₂ >>=STE
              (λ ty₂ → returnSTE (Tensor ty₁ ty₂))))))
typeCheck' (Promote ms t) =
  put [] >>STE getSubctxs ms
         >>=STE areDisjointCtxs
         >>STE checkVectorOpenTerm ms t
         >>=STE typeCheck'
         >>=STE (λ ty → returnSTE (Bang ty))
 where
   getSubctxs : List (Triple Term String Type) → TC (List CTX)
   getSubctxs ((triple t _ _) :: rest) =
     get >>=STE
       (λ ctx → (lift (subctxFV ctx t)) >>=STE
         (λ ctx' → (getSubctxs rest) >>=STE
           (λ r → returnSTE (ctx' :: r))))
   getSubctxs l = returnSTE []

   areDisjointCtxs : List CTX → TC Unit
   areDisjointCtxs [] = returnSTE triv
   areDisjointCtxs (ctx₁ :: rest) = aux ctx₁ rest >>STE areDisjointCtxs rest
     where
       aux : CTX → List CTX → TC Unit
       aux ctx₁ (ctx₂ :: rest) = (ctx₁ isDisjointWith ctx₂) >>STE aux ctx₁ rest
       aux _ [] = returnSTE triv

   checkVectorTerm : Term → TC Type
   checkVectorTerm t =
     get >>=STE
       (λ ctx → lift (subctxFV ctx t) >>=STE
         (λ ctx₁ → (put ctx₁) >>STE
           typeCheck' t))

   checkVectorOpenTerm : List (Triple Term String Type) → Term → TC Term
   checkVectorOpenTerm [] t = throw IllformedPromote
   checkVectorOpenTerm (triple t₁ x₁ ty₁ :: rest) t =
     get >>=STE
       (λ ctx → checkVectorTerm t₁ >>=STE
         (λ ty₁' → (isBang ty₁' >>STE (ty₁ tyEq ty₁')) >>STE
           (put ((x₁ , ty₁) :: ctx) >>STE
             ((checkVectorOpenTerm rest t) >>=STE
               (λ t' → returnSTE (open-t 0 x₁ PBV (FVar x₁) t'))))))
typeCheck' (Discard t₁ t₂) = get >>=STE
   (λ ctx → lift (subctxFV ctx t₁) >>=STE
     (λ ctx₁ → lift (subctxFV ctx t₂) >>=STE
       (λ ctx₂ → (ctx₁ isDisjointWith ctx₂) >>STE
         (put ctx₁) >>STE typeCheck' t₁
                    >>=STE isBang
                    >>STE (put ctx₂)
                    >>STE typeCheck' t₂)))
typeCheck' (Copy t₁ (x , y) t₂) =
  get >>=STE
       (λ ctx → lift (subctxFV ctx t₁) >>=STE
         (λ ctx₁ → lift (subctxFV ctx t₂) >>=STE
           (λ ctx₂ → (ctx₁ isDisjointWith ctx₂) >>STE
             (put ctx₁) >>STE typeCheck' t₁ >>=STE
               (λ ty₁ → isBang ty₁ >>STE
                 (put ((x , ty₁) :: (y , ty₁) :: ctx₂) >>STE typeCheck' t₂')))))
 where
   t₂' = open-t 0 y RCPV (FVar y) (open-t 0 x LCPV (FVar x) t₂)
typeCheck' (Derelict t) = typeCheck' t >>=STE isBang

typeCheck : Term → Either Exception Type
typeCheck t with runStateT (typeCheck' t) []
... | Left e = Left e
... | Right (ty , _) = right ty


module Esterel.Context.Properties where

open import Esterel.Lang
open import Esterel.Environment as Env
  using (Env ; Θ ; _←_ ; module SigMap ; module ShrMap ; module VarMap)
open import Esterel.Context
  using (EvaluationContext ; EvaluationContext1 ; _⟦_⟧e ; _≐_⟦_⟧e ;
         Context ; Context1 ; _⟦_⟧c ; _≐_⟦_⟧c)
open import Esterel.Variable.Signal as Signal
  using (Signal)
open import Esterel.Variable.Shared as SharedVar
  using (SharedVar)
open import Esterel.Variable.Sequential as SeqVar
  using (SeqVar)

open import Data.List
  using (List ; _∷_ ; [] ; map ; _++_)
open import Data.Product
  using (Σ-syntax ; Σ ; _,_ ; proj₁ ; proj₂ ; _×_ ; _,′_)
open import Data.Sum
  using (_⊎_ ; inj₁ ; inj₂)
open import Relation.Binary.PropositionalEquality
  using (_≡_ ; refl ; sym ; cong ; subst ; trans)

open _≐_⟦_⟧e
open _≐_⟦_⟧c
open EvaluationContext1
open Context1

plug : ∀{p E q} → E ⟦ q ⟧e ≡ p → p ≐ E ⟦ q ⟧e
plug {E = []}             refl = dehole
plug {E = epar₁ q ∷ E}    refl = depar₁    (plug {E = E} refl)
plug {E = epar₂ p₁ ∷ E}   refl = depar₂    (plug {E = E} refl)
plug {E = eseq q ∷ E}     refl = deseq     (plug {E = E} refl)
plug {E = eloopˢ q ∷ E}   refl = deloopˢ   (plug {E = E} refl)
plug {E = esuspend S ∷ E} refl = desuspend (plug {E = E} refl)
plug {E = etrap ∷ E}      refl = detrap    (plug {E = E} refl)

unplug : ∀{p E q} → p ≐ E ⟦ q ⟧e → E ⟦ q ⟧e ≡ p
unplug dehole                           = refl
unplug (depar₁ eq)    rewrite unplug eq = refl
unplug (depar₂ eq)    rewrite unplug eq = refl
unplug (deseq eq)     rewrite unplug eq = refl
unplug (deloopˢ eq)   rewrite unplug eq = refl
unplug (desuspend eq) rewrite unplug eq = refl
unplug (detrap eq)    rewrite unplug eq = refl

plugc : ∀ {C q p} → C ⟦ q ⟧c ≡ p → p ≐ C ⟦ q ⟧c
plugc {[]}                     refl = dchole
plugc {ceval (epar₁ q) ∷ C}    refl = dcpar₁     (plugc {C} refl)
plugc {ceval (epar₂ p) ∷ C}    refl = dcpar₂     (plugc {C} refl)
plugc {ceval (eseq q) ∷ C}     refl = dcseq₁     (plugc {C} refl)
plugc {ceval (eloopˢ q) ∷ C}   refl = dcloopˢ₁   (plugc {C} refl)
plugc {ceval (esuspend S) ∷ C} refl = dcsuspend  (plugc {C} refl)
plugc {ceval etrap ∷ C}        refl = dctrap     (plugc {C} refl)
plugc {csignl S ∷ C}           refl = dcsignl    (plugc {C} refl)
plugc {cpresent₁ S q ∷ C}      refl = dcpresent₁ (plugc {C} refl)
plugc {cpresent₂ S p ∷ C}      refl = dcpresent₂ (plugc {C} refl)
plugc {cloop ∷ C}              refl = dcloop     (plugc {C} refl)
plugc {cloopˢ₂ p ∷ C}          refl = dcloopˢ₂   (plugc {C} refl)
plugc {cseq₂ p ∷ C}            refl = dcseq₂     (plugc {C} refl)
plugc {cshared s e ∷ C}        refl = dcshared   (plugc {C} refl)
plugc {cvar x e ∷ C}           refl = dcvar      (plugc {C} refl)
plugc {cif₁ x q ∷ C}           refl = dcif₁      (plugc {C} refl)
plugc {cif₂ x p ∷ C}           refl = dcif₂      (plugc {C} refl)
plugc {cenv θ A ∷ C}           refl = dcenv      (plugc {C} refl)

unplugc : ∀{p C q} → p ≐ C ⟦ q ⟧c → C ⟦ q ⟧c ≡ p
unplugc dchole                             = refl
unplugc (dcpar₁ eq)     rewrite unplugc eq = refl
unplugc (dcpar₂ eq)     rewrite unplugc eq = refl
unplugc (dcseq₁ eq)     rewrite unplugc eq = refl
unplugc (dcseq₂ eq)     rewrite unplugc eq = refl
unplugc (dcsuspend eq)  rewrite unplugc eq = refl
unplugc (dctrap eq)     rewrite unplugc eq = refl
unplugc (dcsignl eq)    rewrite unplugc eq = refl
unplugc (dcpresent₁ eq) rewrite unplugc eq = refl
unplugc (dcpresent₂ eq) rewrite unplugc eq = refl
unplugc (dcloop eq)     rewrite unplugc eq = refl
unplugc (dcloopˢ₁ eq)   rewrite unplugc eq = refl
unplugc (dcloopˢ₂ eq)   rewrite unplugc eq = refl
unplugc (dcshared eq)   rewrite unplugc eq = refl
unplugc (dcvar eq)      rewrite unplugc eq = refl
unplugc (dcif₁ eq)      rewrite unplugc eq = refl
unplugc (dcif₂ eq)      rewrite unplugc eq = refl
unplugc (dcenv eq)      rewrite unplugc eq = refl

plug-sym : ∀{E E' p q} → E ⟦ p ⟧e ≐ E' ⟦ q ⟧e → E' ⟦ q ⟧e ≐ E ⟦ p ⟧e
plug-sym eq = plug (sym (unplug eq))

unplug-eq : ∀{p q r E} → p ≐ E ⟦ q ⟧e → p ≐ E ⟦ r ⟧e → q ≡ r
unplug-eq dehole          dehole          = refl
unplug-eq (depar₁ qeq)    (depar₁ req)    = unplug-eq qeq req
unplug-eq (depar₂ qeq)    (depar₂ req)    = unplug-eq qeq req
unplug-eq (deseq qeq)     (deseq req)     = unplug-eq qeq req
unplug-eq (deloopˢ qeq)   (deloopˢ req)   = unplug-eq qeq req
unplug-eq (desuspend qeq) (desuspend req) = unplug-eq qeq req
unplug-eq (detrap qeq)    (detrap req)    = unplug-eq qeq req

plug-eq : ∀{p q r E} → p ≐ E ⟦ r ⟧e → q ≐ E ⟦ r ⟧e → p ≡ q
plug-eq peq qeq = trans (sym (unplug peq)) (unplug qeq)

Erefl : ∀{E p} → E ⟦ p ⟧e ≐ E ⟦ p ⟧e
Erefl = plug refl

Crefl : ∀{C p} → C ⟦ p ⟧c ≐ C ⟦ p ⟧c
Crefl = plugc refl

⟦⟧e-to-⟦⟧c : ∀ {E p q} -> p ≐ E ⟦ q ⟧e -> p ≐ (map ceval E) ⟦ q ⟧c
⟦⟧e-to-⟦⟧c dehole             = dchole
⟦⟧e-to-⟦⟧c (depar₁ decomp)    = dcpar₁    (⟦⟧e-to-⟦⟧c decomp)
⟦⟧e-to-⟦⟧c (depar₂ decomp)    = dcpar₂    (⟦⟧e-to-⟦⟧c decomp)
⟦⟧e-to-⟦⟧c (deseq decomp)     = dcseq₁    (⟦⟧e-to-⟦⟧c decomp)
⟦⟧e-to-⟦⟧c (deloopˢ decomp)   = dcloopˢ₁  (⟦⟧e-to-⟦⟧c decomp)
⟦⟧e-to-⟦⟧c (desuspend decomp) = dcsuspend (⟦⟧e-to-⟦⟧c decomp)
⟦⟧e-to-⟦⟧c (detrap decomp)    = dctrap    (⟦⟧e-to-⟦⟧c decomp)

⟦⟧c-to-⟦⟧e : ∀ {E p q} → p ≐ (map ceval E) ⟦ q ⟧c → p ≐ E ⟦ q ⟧e
⟦⟧c-to-⟦⟧e {[]}    dchole             = dehole
⟦⟧c-to-⟦⟧e {_ ∷ _} (dcpar₁ p≐E⟦q⟧)    = depar₁    (⟦⟧c-to-⟦⟧e p≐E⟦q⟧)
⟦⟧c-to-⟦⟧e {_ ∷ _} (dcpar₂ p≐E⟦q⟧)    = depar₂    (⟦⟧c-to-⟦⟧e p≐E⟦q⟧)
⟦⟧c-to-⟦⟧e {_ ∷ _} (dcseq₁ p≐E⟦q⟧)    = deseq     (⟦⟧c-to-⟦⟧e p≐E⟦q⟧)
⟦⟧c-to-⟦⟧e {_ ∷ _} (dcloopˢ₁ p≐E⟦q⟧)  = deloopˢ   (⟦⟧c-to-⟦⟧e p≐E⟦q⟧)
⟦⟧c-to-⟦⟧e {_ ∷ _} (dcsuspend p≐E⟦q⟧) = desuspend (⟦⟧c-to-⟦⟧e p≐E⟦q⟧)
⟦⟧c-to-⟦⟧e {_ ∷ _} (dctrap p≐E⟦q⟧)    = detrap    (⟦⟧c-to-⟦⟧e p≐E⟦q⟧)

C++ : ∀ {C1 C2 p1 p2 p3} ->
  p1 ≐ C1 ⟦ p2 ⟧c ->
  p2 ≐ C2 ⟦ p3 ⟧c ->
  p1 ≐ C1 ++ C2 ⟦ p3 ⟧c
C++ dchole p2C = p2C
C++ (dcpar₁ p1C) p2C = dcpar₁ (C++ p1C p2C)
C++ (dcpar₂ p1C) p2C = dcpar₂ (C++ p1C p2C)
C++ (dcseq₁ p1C) p2C = dcseq₁ (C++ p1C p2C)
C++ (dcseq₂ p1C) p2C = dcseq₂ (C++ p1C p2C)
C++ (dcsuspend p1C) p2C = dcsuspend (C++ p1C p2C)
C++ (dctrap p1C) p2C = dctrap (C++ p1C p2C)
C++ (dcsignl p1C) p2C = dcsignl (C++ p1C p2C)
C++ (dcpresent₁ p1C) p2C = dcpresent₁ (C++ p1C p2C)
C++ (dcpresent₂ p1C) p2C = dcpresent₂ (C++ p1C p2C)
C++ (dcloop p1C) p2C = dcloop (C++ p1C p2C)
C++ (dcloopˢ₁ p1C) p2C = dcloopˢ₁ (C++ p1C p2C)
C++ (dcloopˢ₂ p1C) p2C = dcloopˢ₂ (C++ p1C p2C)
C++ (dcshared p1C) p2C = dcshared (C++ p1C p2C)
C++ (dcvar p1C) p2C = dcvar (C++ p1C p2C)
C++ (dcif₁ p1C) p2C = dcif₁ (C++ p1C p2C)
C++ (dcif₂ p1C) p2C = dcif₂ (C++ p1C p2C)
C++ (dcenv p1C) p2C = dcenv (C++ p1C p2C)

++-is-nesting : ∀ C′ C q ->
 (C′ ++ C) ⟦ q ⟧c ≐ C′ ⟦ C ⟦ q ⟧c ⟧c
++-is-nesting [] C q = dchole
++-is-nesting (ceval (epar₁ q) ∷ C′) C q₁ = dcpar₁ (++-is-nesting C′ C q₁)
++-is-nesting (ceval (epar₂ p) ∷ C′) C q = dcpar₂ (++-is-nesting C′ C q)
++-is-nesting (ceval (eseq q) ∷ C′) C q₁ = dcseq₁ (++-is-nesting C′ C q₁)
++-is-nesting (ceval (eloopˢ q) ∷ C′) C q₁ = dcloopˢ₁ (++-is-nesting C′ C q₁)
++-is-nesting (ceval (esuspend S) ∷ C′) C q = dcsuspend (++-is-nesting C′ C q)
++-is-nesting (ceval etrap ∷ C′) C q = dctrap (++-is-nesting C′ C q)
++-is-nesting (csignl S ∷ C′) C q = dcsignl (++-is-nesting C′ C q)
++-is-nesting (cpresent₁ S q ∷ C′) C q₁ = dcpresent₁ (++-is-nesting C′ C q₁)
++-is-nesting (cpresent₂ S p ∷ C′) C q = dcpresent₂ (++-is-nesting C′ C q)
++-is-nesting (cloop ∷ C′) C q = dcloop (++-is-nesting C′ C q)
++-is-nesting (cloopˢ₂ p ∷ C′) C q = dcloopˢ₂ (++-is-nesting C′ C q)
++-is-nesting (cseq₂ p ∷ C′) C q = dcseq₂ (++-is-nesting C′ C q)
++-is-nesting (cshared s e ∷ C′) C q = dcshared (++-is-nesting C′ C q)
++-is-nesting (cvar x e ∷ C′) C q = dcvar (++-is-nesting C′ C q)
++-is-nesting (cif₁ x q ∷ C′) C q₁ = dcif₁ (++-is-nesting C′ C q₁)
++-is-nesting (cif₂ x p ∷ C′) C q = dcif₂ (++-is-nesting C′ C q)
++-is-nesting (cenv θ A ∷ C′) C q = dcenv (++-is-nesting C′ C q)


{-# OPTIONS --without-K --rewriting #-}

open import HoTT renaming (pt to ⊙pt)
open import homotopy.Bouquet
open import homotopy.FinWedge
open import homotopy.LoopSpaceCircle
open import homotopy.SphereEndomorphism
open import groups.SphereEndomorphism
open import cw.CW
open import cw.FinCW
open import cw.WedgeOfCells
open import cw.DegreeByProjection {lzero}
open import homotopy.DisjointlyPointedSet
open import cohomology.Theory

module cw.cohomology.cochainequiv.FirstCoboundaryAbstractDefs (OT : OrdinaryTheory lzero)
  (⊙fin-skel : ⊙FinSkeleton 1) where

open OrdinaryTheory OT
open import cohomology.Bouquet OT

private
  ⊙skel = ⊙FinSkeleton-realize ⊙fin-skel
  fin-skel = ⊙FinSkeleton.skel ⊙fin-skel
  I = AttachedFinSkeleton.numCells fin-skel
  skel = ⊙Skeleton.skel ⊙skel
  dec = FinSkeleton-has-cells-with-dec-eq fin-skel

  endpoint = attaching-last skel
  I₋₁ = AttachedFinSkeleton.skel fin-skel
  ⊙head = ⊙cw-head ⊙skel
  pt = ⊙pt ⊙head

open import cw.cohomology.reconstructed.TipCoboundary OT ⊙skel

⊙head-is-separable : is-separable ⊙head
⊙head-is-separable = Fin-has-dec-eq pt

⊙head-separate = separate-pt ⊙head-is-separable

⊙head-separate-equiv = (unite-pt ⊙head , separable-has-disjoint-pt ⊙head-is-separable)⁻¹

MinusPoint-⊙head-has-choice : has-choice 0 (MinusPoint ⊙head) lzero
MinusPoint-⊙head-has-choice = MinusPoint-has-choice ⊙head-is-separable (Fin-has-choice 0 lzero)

MinusPoint-⊙head-has-dec-eq : has-dec-eq (MinusPoint ⊙head)
MinusPoint-⊙head-has-dec-eq = MinusPoint-has-dec-eq Fin-has-dec-eq

⊙function₀ : ⊙FinBouquet I 1 ⊙→ ⊙Susp (⊙Bouquet (MinusPoint ⊙head) 0)
⊙function₀ = ⊙Susp-fmap (⊙<– (Bouquet-⊙equiv-X ⊙head-is-separable))
          ⊙∘ ⊙cw-∂-head'-before-Susp
          ⊙∘ ⊙–> (Bouquet-⊙equiv-Xₙ/Xₙ₋₁ skel)

function₁ : Fin I → MinusPoint ⊙head → Sphere-endo 0
function₁ <I b x with Fin-has-dec-eq (fst b) (endpoint <I x)
function₁ <I b x | inl _ = false
function₁ <I b x | inr _ = true

abstract
  ⊙function₀' : ⊙FinBouquet I 1 ⊙→ ⊙Susp (⊙Bouquet (MinusPoint ⊙head) 0)
  ⊙function₀' = ⊙function₀

  ⊙function₀'-β : ⊙function₀' == ⊙function₀
  ⊙function₀'-β = idp

  function₁' : Fin I → MinusPoint ⊙head → Sphere-endo 0
  function₁' = function₁

  function₁'-β : ∀ <I b → function₁' <I b == function₁ <I b
  function₁'-β _ _ = idp

  private
    mega-reduction-cases : ∀ <I b x
      →  bwproj MinusPoint-⊙head-has-dec-eq b (<– (Bouquet-equiv-X ⊙head-is-separable) (endpoint <I x))
      == function₁ <I b x
    mega-reduction-cases <I b x with Fin-has-dec-eq pt (endpoint <I x)
    mega-reduction-cases <I b x | inl _ with Fin-has-dec-eq (fst b) (endpoint <I x)
    mega-reduction-cases <I b x | inl pt=end | inl b=end = ⊥-rec (snd b (pt=end ∙ ! b=end))
    mega-reduction-cases <I b x | inl _ | inr _ = idp
    mega-reduction-cases <I b x | inr _ with Fin-has-dec-eq (fst b) (endpoint <I x)
    mega-reduction-cases <I b x | inr _ | inl b=end =
      bwproj MinusPoint-⊙head-has-dec-eq b (bwin (endpoint <I x , _) false)
        =⟨ ap (λ b' → bwproj MinusPoint-⊙head-has-dec-eq b (bwin b' false)) $ ! $
            Subtype=-out (MinusPoint-prop ⊙head) b=end ⟩
      bwproj MinusPoint-⊙head-has-dec-eq b (bwin b false)
        =⟨ bwproj-bwin-diag MinusPoint-⊙head-has-dec-eq b false ⟩
      false
        =∎
    mega-reduction-cases <I b x | inr _ | inr b≠end =
      bwproj-bwin-≠ MinusPoint-⊙head-has-dec-eq (b≠end ∘ ap fst) false

  mega-reduction : ∀ <I b →
      Susp-fmap (bwproj MinusPoint-⊙head-has-dec-eq b) ∘ fst ⊙function₀' ∘ fwin <I
    ∼ Susp-fmap (function₁' <I b)
  mega-reduction <I b = Susp-elim idp idp λ x → ↓-='-in' $ ! $
    ap (Susp-fmap (bwproj MinusPoint-⊙head-has-dec-eq b) ∘ fst ⊙function₀ ∘ fwin <I) (merid x)
      =⟨ ap-∘
          ( Susp-fmap (bwproj MinusPoint-⊙head-has-dec-eq b)
          ∘ Susp-fmap (<– (Bouquet-equiv-X ⊙head-is-separable))
          ∘ cw-∂-head'-before-Susp)
          (Bouquet-to-Xₙ/Xₙ₋₁ skel ∘ fwin <I)
          (merid x) ⟩
    ap ( Susp-fmap (bwproj MinusPoint-⊙head-has-dec-eq b)
       ∘ Susp-fmap (<– (Bouquet-equiv-X ⊙head-is-separable))
       ∘ cw-∂-head'-before-Susp)
       (ap (Bouquet-to-Xₙ/Xₙ₋₁ skel ∘ fwin <I) (merid x))
      =⟨ ap (ap ( Susp-fmap (bwproj MinusPoint-⊙head-has-dec-eq b)
                ∘ Susp-fmap (<– (Bouquet-equiv-X ⊙head-is-separable))
                ∘ cw-∂-head'-before-Susp))
            (Bouquet-to-Xₙ/Xₙ₋₁-in-merid-β skel <I x) ⟩
    ap ( Susp-fmap (bwproj MinusPoint-⊙head-has-dec-eq b)
       ∘ Susp-fmap (<– (Bouquet-equiv-X ⊙head-is-separable))
       ∘ cw-∂-head'-before-Susp)
       (cfglue (endpoint <I x) ∙' ap cfcod (spoke <I x))
      =⟨ ap-∘
          ( Susp-fmap (bwproj MinusPoint-⊙head-has-dec-eq b)
          ∘ Susp-fmap (<– (Bouquet-equiv-X ⊙head-is-separable)))
          cw-∂-head'-before-Susp
          (cfglue (endpoint <I x) ∙' ap cfcod (spoke <I x)) ⟩
    ap ( Susp-fmap (bwproj MinusPoint-⊙head-has-dec-eq b)
       ∘ Susp-fmap (<– (Bouquet-equiv-X ⊙head-is-separable)))
       (ap cw-∂-head'-before-Susp
         (cfglue (endpoint <I x) ∙' ap cfcod (spoke <I x)))
      =⟨ ap (ap ( Susp-fmap (bwproj MinusPoint-⊙head-has-dec-eq b)
                ∘ Susp-fmap (<– (Bouquet-equiv-X ⊙head-is-separable))))
            ( ap-∙' cw-∂-head'-before-Susp (cfglue (endpoint <I x)) (ap cfcod (spoke <I x))
            ∙ ap2 _∙'_
                (cw-∂-head'-before-Susp-glue-β (endpoint <I x))
                ( ∘-ap cw-∂-head'-before-Susp cfcod (spoke <I x)
                ∙ ap-cst south (spoke <I x))) ⟩
    ap ( Susp-fmap (bwproj MinusPoint-⊙head-has-dec-eq b)
       ∘ Susp-fmap (<– (Bouquet-equiv-X ⊙head-is-separable)))
       (merid (endpoint <I x))
      =⟨ ap-∘
          (Susp-fmap (bwproj MinusPoint-⊙head-has-dec-eq b))
          (Susp-fmap (<– (Bouquet-equiv-X ⊙head-is-separable)))
          (merid (endpoint <I x)) ⟩
    ap (Susp-fmap (bwproj MinusPoint-⊙head-has-dec-eq b))
       (ap (Susp-fmap (<– (Bouquet-equiv-X ⊙head-is-separable)))
           (merid (endpoint <I x)))
      =⟨ ap
          (ap (Susp-fmap (bwproj MinusPoint-⊙head-has-dec-eq b)))
          (SuspFmap.merid-β
            (<– (Bouquet-equiv-X ⊙head-is-separable))
            (endpoint <I x)) ⟩
    ap (Susp-fmap (bwproj MinusPoint-⊙head-has-dec-eq b))
       (merid (<– (Bouquet-equiv-X ⊙head-is-separable) (endpoint <I x)))
      =⟨ SuspFmap.merid-β (bwproj MinusPoint-⊙head-has-dec-eq b)
          (<– (Bouquet-equiv-X ⊙head-is-separable) (endpoint <I x)) ⟩
    merid (bwproj MinusPoint-⊙head-has-dec-eq b (<– (Bouquet-equiv-X ⊙head-is-separable) (endpoint <I x)))
      =⟨ ap merid (mega-reduction-cases <I b x) ⟩
    merid (function₁ <I b x)
      =⟨ ! $ SuspFmap.merid-β (function₁ <I b) x ⟩
    ap (Susp-fmap (function₁ <I b)) (merid x)
      =∎

  open DegreeAtOne skel dec

  degree-matches' : ∀ <I b
    →  merid (function₁' <I b false) ∙ ! (merid (function₁' <I b true))
    == loop^ (degree <I (fst b))
  degree-matches' <I b with Fin-has-dec-eq (fst b) (endpoint <I false)
  degree-matches' <I b | inl _ with Fin-has-dec-eq (fst b) (endpoint <I true)
  degree-matches' <I b | inl _ | inl _ = !-inv-r (merid false)
  degree-matches' <I b | inl _ | inr _ = idp
  degree-matches' <I b | inr _ with Fin-has-dec-eq (fst b) (endpoint <I true)
  degree-matches' <I b | inr _ | inl _ = ap (_∙ ! (merid false)) (! (!-! (merid true))) ∙ ∙-! (! (merid true)) (merid false)
  degree-matches' <I b | inr _ | inr _ = !-inv-r (merid true)

  degree-matches : ∀ <I b
    →  ⊙SphereS-endo-degree 0 (Susp-fmap (function₁' <I b) , idp)
    == degree <I (fst b)
  degree-matches <I b = equiv-adj' ΩS¹-equiv-ℤ $
    ap (Susp-fmap (function₁ <I b)) loop
      =⟨ ap-∙ (Susp-fmap (function₁ <I b)) (merid false) (! (merid true))  ⟩
    ap (Susp-fmap (function₁ <I b)) (merid false)
    ∙ ap (Susp-fmap (function₁ <I b)) (! (merid true))
      =⟨ ap2 _∙_
          (SuspFmap.merid-β (function₁ <I b) false)
            ( ap-! (Susp-fmap (function₁ <I b)) (merid true)
            ∙ ap ! (SuspFmap.merid-β (function₁ <I b) true)) ⟩
    merid (function₁ <I b false) ∙ ! (merid (function₁ <I b true))
      =⟨ degree-matches' <I b ⟩
    loop^ (degree <I (fst b))
      =∎