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

open import HoTT
import homotopy.RelativelyConstantToSetExtendsViaSurjection as SurjExt

module homotopy.vankampen.Code {i j k l}
  (span : Span {i} {j} {k})
  {D : Type l} (h : D → Span.C span) (h-is-surj : is-surj h) where

  open Span span
  open import homotopy.vankampen.CodeAP span h h-is-surj
  open import homotopy.vankampen.CodeBP span h h-is-surj

  pcAA-to-pcBA : ∀ d₀ {a} → precodeAA (f (h d₀)) a → precodeBA (g (h d₀)) a
  pcAB-to-pcBB : ∀ d₀ {b} → precodeAB (f (h d₀)) b → precodeBB (g (h d₀)) b
  pcAA-to-pcBA d₀ (pc-a pA) = pc-bba d₀ (pc-b idp₀) pA
  pcAA-to-pcBA d₀ (pc-aba d pc pA) = pc-bba d (pcAB-to-pcBB d₀ pc) pA
  pcAB-to-pcBB d₀ (pc-aab d pc pB) = pc-bab d (pcAA-to-pcBA d₀ pc) pB

  abstract
    pcAA-to-pcBA-rel : ∀ d₀ {a} {pcAA₁ pcAA₂ : precodeAA (f (h d₀)) a}
      → precodeAA-rel pcAA₁ pcAA₂
      → precodeBA-rel (pcAA-to-pcBA d₀ pcAA₁) (pcAA-to-pcBA d₀ pcAA₂)
    pcAB-to-pcBB-rel : ∀ d₀ {a} {pcAB₁ pcAB₂ : precodeAB (f (h d₀)) a}
      → precodeAB-rel pcAB₁ pcAB₂
      → precodeBB-rel (pcAB-to-pcBB d₀ pcAB₁) (pcAB-to-pcBB d₀ pcAB₂)
    pcAA-to-pcBA-rel d₀ (pcAAr-idp₀-idp₀ pcAA) = pcBAr-idp₀-idp₀ (pcAA-to-pcBA d₀ pcAA)
    pcAA-to-pcBA-rel d₀ (pcAAr-cong r pA) = pcBAr-cong (pcAB-to-pcBB-rel d₀ r) pA
    pcAB-to-pcBB-rel d₀ (pcABr-idp₀-idp₀ pcAB) = pcBBr-idp₀-idp₀ (pcAB-to-pcBB d₀ pcAB)
    pcAB-to-pcBB-rel d₀ (pcABr-switch pcAB pC) = pcBBr-switch (pcAB-to-pcBB d₀ pcAB) pC
    pcAB-to-pcBB-rel d₀ (pcABr-cong r pB) = pcBBr-cong (pcAA-to-pcBA-rel d₀ r) pB

  cAA-to-cBA : ∀ d₀ {a} → codeAA (f (h d₀)) a → codeBA (g (h d₀)) a
  cAA-to-cBA d₀ = SetQuot-rec SetQuot-level (q[_] ∘ pcAA-to-pcBA d₀) (quot-rel ∘ pcAA-to-pcBA-rel d₀)
  cAB-to-cBB : ∀ d₀ {b} → codeAB (f (h d₀)) b → codeBB (g (h d₀)) b
  cAB-to-cBB d₀ = SetQuot-rec SetQuot-level (q[_] ∘ pcAB-to-pcBB d₀) (quot-rel ∘ pcAB-to-pcBB-rel d₀)

  -- BX to AX
  pcBA-to-pcAA : ∀ d₀ {a} → precodeBA (g (h d₀)) a → precodeAA (f (h d₀)) a
  pcBB-to-pcAB : ∀ d₀ {b} → precodeBB (g (h d₀)) b → precodeAB (f (h d₀)) b
  pcBA-to-pcAA d₀ (pc-bba d pc pA) = pc-aba d (pcBB-to-pcAB d₀ pc) pA
  pcBB-to-pcAB d₀ (pc-b pB) = pc-aab d₀ (pc-a idp₀) pB
  pcBB-to-pcAB d₀ (pc-bab d pc pB) = pc-aab d (pcBA-to-pcAA d₀ pc) pB

  abstract
    pcBA-to-pcAA-rel : ∀ d₀ {a} {pcBA₁ pcBA₂ : precodeBA (g (h d₀)) a}
      → precodeBA-rel pcBA₁ pcBA₂
      → precodeAA-rel (pcBA-to-pcAA d₀ pcBA₁) (pcBA-to-pcAA d₀ pcBA₂)
    pcBB-to-pcAB-rel : ∀ d₀ {a} {pcBB₁ pcBB₂ : precodeBB (g (h d₀)) a}
      → precodeBB-rel pcBB₁ pcBB₂
      → precodeAB-rel (pcBB-to-pcAB d₀ pcBB₁) (pcBB-to-pcAB d₀ pcBB₂)
    pcBA-to-pcAA-rel d₀ (pcBAr-idp₀-idp₀ pcBA) = pcAAr-idp₀-idp₀ (pcBA-to-pcAA d₀ pcBA)
    pcBA-to-pcAA-rel d₀ (pcBAr-cong r pA) = pcAAr-cong (pcBB-to-pcAB-rel d₀ r) pA
    pcBB-to-pcAB-rel d₀ (pcBBr-idp₀-idp₀ pcBB) = pcABr-idp₀-idp₀ (pcBB-to-pcAB d₀ pcBB)
    pcBB-to-pcAB-rel d₀ (pcBBr-switch pcBB pC) = pcABr-switch (pcBB-to-pcAB d₀ pcBB) pC
    pcBB-to-pcAB-rel d₀ (pcBBr-cong r pB) = pcABr-cong (pcBA-to-pcAA-rel d₀ r) pB

  cBA-to-cAA : ∀ d₀ {a} → codeBA (g (h d₀)) a → codeAA (f (h d₀)) a
  cBA-to-cAA d₀ = SetQuot-rec SetQuot-level (q[_] ∘ pcBA-to-pcAA d₀) (quot-rel ∘ pcBA-to-pcAA-rel d₀)
  cBB-to-cAB : ∀ d₀ {b} → codeBB (g (h d₀)) b → codeAB (f (h d₀)) b
  cBB-to-cAB d₀ = SetQuot-rec SetQuot-level (q[_] ∘ pcBB-to-pcAB d₀) (quot-rel ∘ pcBB-to-pcAB-rel d₀)

  -- roundtrips
  abstract
    pcBA-to-pcAA-to-pcBA : ∀ d₀ {a} (pcBA : precodeBA _ a)
      → q[ pcAA-to-pcBA d₀ (pcBA-to-pcAA d₀ pcBA) ] == q[ pcBA ] :> codeBA _ a
    pcBB-to-pcAB-to-pcBB : ∀ d₀ {b} (pcBB : precodeBB _ b)
      → q[ pcAB-to-pcBB d₀ (pcBB-to-pcAB d₀ pcBB) ] == q[ pcBB ] :> codeBB _ b
    pcBA-to-pcAA-to-pcBA d₀ (pc-bba d pc pA) = pcBB-to-pcAB-to-pcBB d₀ pc |in-ctx λ c → c-bba d c pA
    pcBB-to-pcAB-to-pcBB d₀ (pc-b pB) = pcBB-idp₀-idp₀-head pB
    pcBB-to-pcAB-to-pcBB d₀ (pc-bab d pc pB) = pcBA-to-pcAA-to-pcBA d₀ pc |in-ctx λ c → c-bab d c pB

    pcAA-to-pcBA-to-pcAA : ∀ d₀ {a} (pcAA : precodeAA _ a)
      → q[ pcBA-to-pcAA d₀ (pcAA-to-pcBA d₀ pcAA) ] == q[ pcAA ] :> codeAA _ a
    pcAB-to-pcBB-to-pcAB : ∀ d₀ {b} (pcAB : precodeAB _ b)
      → q[ pcBB-to-pcAB d₀ (pcAB-to-pcBB d₀ pcAB) ] == q[ pcAB ] :> codeAB _ b
    pcAA-to-pcBA-to-pcAA d₀ (pc-aba d pc pA) = pcAB-to-pcBB-to-pcAB d₀ pc |in-ctx λ c → c-aba d c pA
    pcAA-to-pcBA-to-pcAA d₀ (pc-a pA) = pcAA-idp₀-idp₀-head pA
    pcAB-to-pcBB-to-pcAB d₀ (pc-aab d pc pB) = pcAA-to-pcBA-to-pcAA d₀ pc |in-ctx λ c → c-aab d c pB

  private
    pcAA-lemma : ∀ d₁ d₂ {a₁} (p : h d₂ == h d₁) (pcAA : precodeAA _ a₁)
      →  q[ pcBA-prepend d₁ [ ap g p ] (pcAA-to-pcBA d₁ pcAA) ]
      == q[ pcAA-to-pcBA d₂ (pcAA-prepend d₁ [ ap f p ] pcAA) ]
    pcAB-lemma : ∀ d₁ d₂ {b₁} (p : h d₂ == h d₁) (pcAB : precodeAB _ b₁)
      →  q[ pcBB-prepend d₁ [ ap g p ] (pcAB-to-pcBB d₁ pcAB) ]
      == q[ pcAB-to-pcBB d₂ (pcAB-prepend d₁ [ ap f p ] pcAB) ]
    pcAA-lemma d₁ d₂ p (pc-a pA) = ap (λ c → c-bba d₁ c pA) $ ! $
      q[ ⟧b idp₀ bb⟦ _ ⟧a [ ap f p ] ba⟦ _ ⟧b idp₀ ]
        =⟨ quot-rel (pcBBr-switch (⟧b idp₀) [ p ]) ⟩
      q[ ⟧b idp₀ bb⟦ _ ⟧a idp₀ ba⟦ _ ⟧b [ ap g p ] ]
        =⟨ pcBB-idp₀-idp₀-head [ ap g p ] ⟩
      q[ ⟧b [ ap g p ] ]
        =⟨ ! (quot-rel (pcBBr-idp₀-idp₀ (pc-b [ ap g p ]))) ⟩
      q[ ⟧b [ ap g p ] bb⟦ _ ⟧a idp₀ ba⟦ _ ⟧b idp₀ ]
        =∎
    pcAA-lemma d₁ d₂ p (pc-aba d pc pA) = pcAB-lemma d₁ d₂ p pc |in-ctx (λ c → c-bba d c pA)
    pcAB-lemma d₁ d₂ p (pc-aab d pc pB) = pcAA-lemma d₁ d₂ p pc |in-ctx (λ c → c-bab d c pB)

  module CodeAAEquivCodeBA (a₁ : A) where

    eqv-on-image : (d₀ : D) → codeAA (f (h d₀)) a₁ ≃ codeBA (g (h d₀)) a₁
    eqv-on-image d₀ = equiv to from to-from from-to where
      to : codeAA (f (h d₀)) a₁ → codeBA (g (h d₀)) a₁
      to = cAA-to-cBA d₀

      from : codeBA (g (h d₀)) a₁ → codeAA (f (h d₀)) a₁
      from = cBA-to-cAA d₀

      abstract
        to-from : ∀ cBA → to (from cBA) == cBA
        to-from = SetQuot-elim
          (λ _ → =-preserves-set SetQuot-is-set)
          (pcBA-to-pcAA-to-pcBA d₀)
          (λ _ → prop-has-all-paths-↓ (SetQuot-is-set _ _))

        from-to : ∀ cAA → from (to cAA) == cAA
        from-to = SetQuot-elim
          (λ _ → =-preserves-set SetQuot-is-set)
          (pcAA-to-pcBA-to-pcAA d₀)
          (λ _ → prop-has-all-paths-↓ (SetQuot-is-set _ _))

    abstract
      eqv-is-const : ∀ d₁ d₂ (p : h d₁ == h d₂)
        → eqv-on-image d₁ == eqv-on-image d₂
        [ (λ c → codeAA (f c) a₁ ≃ codeBA (g c) a₁) ↓ p ]
      eqv-is-const d₁ d₂ p = ↓-Subtype-in (λ d → is-equiv-prop) $
        ↓-→-from-transp $ λ= $
          SetQuot-elim (λ _ → =-preserves-set SetQuot-is-set)
            (λ pcAA →
              transport (λ c → codeBA (g c) a₁) p q[ pcAA-to-pcBA d₁ pcAA ]
                =⟨ ap-∘ (λ b → codeBA b a₁) g p |in-ctx (λ p → coe p q[ pcAA-to-pcBA d₁ pcAA ]) ⟩
              transport (λ b → codeBA b a₁) (ap g p) q[ pcAA-to-pcBA d₁ pcAA ]
                =⟨ transp-cBA-l d₁ (ap g p) (pcAA-to-pcBA d₁ pcAA) ⟩
              q[ pcBA-prepend d₁ [ ! $ ap g p ] (pcAA-to-pcBA d₁ pcAA) ]
                =⟨ !-ap g p |in-ctx (λ p → q[ pcBA-prepend d₁ [ p ] (pcAA-to-pcBA d₁ pcAA) ]) ⟩
              q[ pcBA-prepend d₁ [ ap g (! p) ] (pcAA-to-pcBA d₁ pcAA) ]
                =⟨ pcAA-lemma d₁ d₂ (! p) pcAA ⟩
              q[ pcAA-to-pcBA d₂ (pcAA-prepend d₁ [ ap f (! p) ] pcAA) ]
                =⟨ ap-! f p |in-ctx (λ p → q[ pcAA-to-pcBA d₂ (pcAA-prepend d₁ [ p ] pcAA) ]) ⟩
              q[ pcAA-to-pcBA d₂ (pcAA-prepend d₁ [ ! $ ap f p ] pcAA) ]
                =⟨ ! $ transp-cAA-l d₁ (ap f p) pcAA |in-ctx cAA-to-cBA d₂ ⟩
              cAA-to-cBA d₂ (transport (λ a → codeAA a a₁) (ap f p) q[ pcAA ])
                =⟨ ∘-ap (λ c → codeAA c a₁) f p |in-ctx (λ p → coe p q[ pcAA ]) |in-ctx cAA-to-cBA d₂ ⟩
              cAA-to-cBA d₂ (transport (λ c → codeAA (f c) a₁) p q[ pcAA ])
                =∎)
            (λ _ → prop-has-all-paths-↓ (SetQuot-is-set _ _))

    module SE = SurjExt
      (λ c → ≃-is-set SetQuot-is-set SetQuot-is-set)
      h h-is-surj
      eqv-on-image
      eqv-is-const

    abstract
      eqv : ∀ c → codeAA (f c) a₁ ≃ codeBA (g c) a₁
      eqv = SE.ext

      eqv-β : ∀ d → eqv (h d) == eqv-on-image d
      eqv-β = SE.β

  module CodeABEquivCodeBB (b₁ : B) where

    eqv-on-image : (d₀ : D) → codeAB (f (h d₀)) b₁ ≃ codeBB (g (h d₀)) b₁
    eqv-on-image d₀ = equiv to from to-from from-to where
      to : codeAB (f (h d₀)) b₁ → codeBB (g (h d₀)) b₁
      to = cAB-to-cBB d₀

      from : codeBB (g (h d₀)) b₁ → codeAB (f (h d₀)) b₁
      from = cBB-to-cAB d₀

      abstract
        to-from : ∀ cBB → to (from cBB) == cBB
        to-from = SetQuot-elim
          (λ _ → =-preserves-set SetQuot-is-set)
          (pcBB-to-pcAB-to-pcBB d₀)
          (λ _ → prop-has-all-paths-↓ (SetQuot-is-set _ _))

        from-to : ∀ cAB → from (to cAB) == cAB
        from-to = SetQuot-elim
          (λ _ → =-preserves-set SetQuot-is-set)
          (pcAB-to-pcBB-to-pcAB d₀)
          (λ _ → prop-has-all-paths-↓ (SetQuot-is-set _ _))

    abstract
      eqv-is-const : ∀ d₁ d₂ (p : h d₁ == h d₂)
        → eqv-on-image d₁ == eqv-on-image d₂
        [ (λ c → codeAB (f c) b₁ ≃ codeBB (g c) b₁) ↓ p ]
      eqv-is-const d₁ d₂ p = ↓-Subtype-in (λ d → is-equiv-prop) $
        ↓-→-from-transp $ λ= $
          SetQuot-elim (λ _ → =-preserves-set SetQuot-is-set)
            (λ pcAB →
              transport (λ c → codeBB (g c) b₁) p q[ pcAB-to-pcBB d₁ pcAB ]
                =⟨ ap-∘ (λ b → codeBB b b₁) g p |in-ctx (λ p → coe p q[ pcAB-to-pcBB d₁ pcAB ]) ⟩
              transport (λ b → codeBB b b₁) (ap g p) q[ pcAB-to-pcBB d₁ pcAB ]
                =⟨ transp-cBB-l d₁ (ap g p) (pcAB-to-pcBB d₁ pcAB) ⟩
              q[ pcBB-prepend d₁ [ ! $ ap g p ] (pcAB-to-pcBB d₁ pcAB) ]
                =⟨ !-ap g p |in-ctx (λ p → q[ pcBB-prepend d₁ [ p ] (pcAB-to-pcBB d₁ pcAB) ]) ⟩
              q[ pcBB-prepend d₁ [ ap g (! p) ] (pcAB-to-pcBB d₁ pcAB) ]
                =⟨ pcAB-lemma d₁ d₂ (! p) pcAB ⟩
              q[ pcAB-to-pcBB d₂ (pcAB-prepend d₁ [ ap f (! p) ] pcAB) ]
                =⟨ ap-! f p |in-ctx (λ p → q[ pcAB-to-pcBB d₂ (pcAB-prepend d₁ [ p ] pcAB) ]) ⟩
              q[ pcAB-to-pcBB d₂ (pcAB-prepend d₁ [ ! $ ap f p ] pcAB) ]
                =⟨ ! $ transp-cAB-l d₁ (ap f p) pcAB |in-ctx cAB-to-cBB d₂ ⟩
              cAB-to-cBB d₂ (transport (λ a → codeAB a b₁) (ap f p) q[ pcAB ])
                =⟨ ∘-ap (λ c → codeAB c b₁) f p |in-ctx (λ p → coe p q[ pcAB ]) |in-ctx cAB-to-cBB d₂ ⟩
              cAB-to-cBB d₂ (transport (λ c → codeAB (f c) b₁) p q[ pcAB ])
                =∎)
            (λ _ → prop-has-all-paths-↓ (SetQuot-is-set _ _))

    module SE = SurjExt
      (λ c → ≃-is-set SetQuot-is-set SetQuot-is-set)
      h h-is-surj
      eqv-on-image
      eqv-is-const

    abstract
      eqv : ∀ c → codeAB (f c) b₁ ≃ codeBB (g c) b₁
      eqv = SE.ext

      eqv-β : ∀ d → eqv (h d) == eqv-on-image d
      eqv-β = SE.β

  module EqvPAIdEqvPB where
    abstract
      path-on-image : ∀ d₀ d₁
        →  CodeAAEquivCodeBA.eqv (f (h d₁)) (h d₀)
        == CodeABEquivCodeBB.eqv (g (h d₁)) (h d₀)
        [ (λ p → codeAP (f (h d₀)) p ≃ codeBP (g (h d₀)) p) ↓ glue (h d₁) ]
      path-on-image d₀ d₁ =
        CodeAAEquivCodeBA.eqv-β (f (h d₁)) d₀
        ∙ᵈ lemma
        ∙'ᵈ ! (CodeABEquivCodeBB.eqv-β (g (h d₁)) d₀) where
        lemma : CodeAAEquivCodeBA.eqv-on-image (f (h d₁)) d₀
             == CodeABEquivCodeBB.eqv-on-image (g (h d₁)) d₀
             [ (λ p → codeAP (f (h d₀)) p ≃ codeBP (g (h d₀)) p) ↓ glue (h d₁) ]
        lemma = ↓-Subtype-in (λ d → is-equiv-prop) $
          ↓-→-from-transp $ λ= $ SetQuot-elim
            (λ _ → =-preserves-set SetQuot-is-set)
            (λ pcAA →
              transport (λ p → codeBP (g (h d₀)) p) (glue (h d₁)) q[ pcAA-to-pcBA d₀ pcAA ]
                =⟨ transp-cBP-glue d₁ (pcAA-to-pcBA d₀ pcAA) ⟩
              q[ pcAA-to-pcBA d₀ pcAA ba⟦ d₁ ⟧b idp₀ ]
                =⟨ ! $ transp-cAP-glue d₁ pcAA |in-ctx cAB-to-cBB d₀ ⟩
              cAB-to-cBB d₀ (transport (λ p → codeAP (f (h d₀)) p) (glue (h d₁)) q[ pcAA ])
                =∎)
            (λ _ → prop-has-all-paths-↓ $ SetQuot-is-set _ _)

    abstract
      path : ∀ c₀ c₁
        →  CodeAAEquivCodeBA.eqv (f c₁) c₀
        == CodeABEquivCodeBB.eqv (g c₁) c₀
        [ (λ p → codeAP (f c₀) p ≃ codeBP (g c₀) p) ↓ glue c₁ ]
      path = SurjExt.ext
        (λ c₀ → Π-is-set λ c₁ → ↓-preserves-level $ ≃-is-set SetQuot-is-set SetQuot-is-set)
        h h-is-surj
        (λ d₀ → SurjExt.ext
          (λ c₁ → ↓-preserves-level $ ≃-is-set SetQuot-is-set SetQuot-is-set)
          h h-is-surj
          (λ d₁ → path-on-image d₀ d₁)
          (λ _ _ _ → prop-has-all-paths-↓ $ ↓-level $ ≃-is-set SetQuot-is-set SetQuot-is-set))
        (λ _ _ _ → prop-has-all-paths-↓ $ Π-is-prop λ _ → ↓-level $ ≃-is-set SetQuot-is-set SetQuot-is-set)

  cAP-equiv-cBP : ∀ c₀ p₁ → codeAP (f c₀) p₁ ≃ codeBP (g c₀) p₁
  cAP-equiv-cBP c₀ = Pushout-elim
    {P = λ p₁ → codeAP (f c₀) p₁ ≃ codeBP (g c₀) p₁}
    (λ a₁ → CodeAAEquivCodeBA.eqv a₁ c₀)
    (λ b₁ → CodeABEquivCodeBB.eqv b₁ c₀)
    (λ c₁ → EqvPAIdEqvPB.path c₀ c₁)

  module Code = PushoutRec
    {D = Pushout span → Type (lmax (lmax (lmax i j) k) l)}
    codeAP codeBP (λ c₀ → λ= $ ua ∘ cAP-equiv-cBP c₀)

  code : Pushout span → Pushout span → Type (lmax (lmax (lmax i j) k) l)
  code = Code.f

  abstract
    code-level : ∀ {p₀ p₁} → is-set (code p₀ p₁)
    code-level {p₀} {p₁} = Pushout-elim
      {P = λ p₀ → ∀ p₁ → is-set (code p₀ p₁)}
      (λ a₀ p₁ → codeAP-level {a₀} {p₁})
      (λ b₀ p₁ → codeBP-level {b₀} {p₁})
      (λ c₀ → prop-has-all-paths-↓ $ Π-is-prop λ p₁ → is-set-is-prop)
      p₀ p₁
  code-is-set = code-level

  abstract
    transp-cPA-glue : ∀ d₀ {a₁} (pcAA : precodeAA (f (h d₀)) a₁)
      → transport (λ p₀ → code p₀ (left a₁)) (glue (h d₀)) q[ pcAA  ] == q[ pcAA-to-pcBA d₀ pcAA ]
    transp-cPA-glue d₀ {a₁} pcAA =
      transport (λ p₀ → code p₀ (left a₁)) (glue (h d₀)) q[ pcAA  ]
        =⟨ ap (λ e → coe e q[ pcAA ])
            ( ap-∘ (_$ left a₁) code (glue (h d₀))
            ∙ ap (ap (_$ left a₁)) (Code.glue-β (h d₀))
            ∙ app=-β (ua ∘ cAP-equiv-cBP (h d₀)) (left a₁)
            ∙ ap ua (CodeAAEquivCodeBA.eqv-β a₁ d₀)) ⟩
      coe (ua (CodeAAEquivCodeBA.eqv-on-image a₁ d₀)) q[ pcAA  ]
        =⟨ coe-β (CodeAAEquivCodeBA.eqv-on-image a₁ d₀) q[ pcAA ] ⟩
      q[ pcAA-to-pcBA d₀ pcAA ]
        =∎

    transp-cPB-glue : ∀ d₀ {b₁} (pcAB : precodeAB (f (h d₀)) b₁)
      → transport (λ p₀ → code p₀ (right b₁)) (glue (h d₀)) q[ pcAB  ] == q[ pcAB-to-pcBB d₀ pcAB ]
    transp-cPB-glue d₀ {b₁} pcAB =
      transport (λ p₀ → code p₀ (right b₁)) (glue (h d₀)) q[ pcAB  ]
        =⟨ ap (λ e → coe e q[ pcAB ])
            ( ap-∘ (_$ right b₁) code (glue (h d₀))
            ∙ ap (ap (_$ right b₁)) (Code.glue-β (h d₀))
            ∙ app=-β (ua ∘ cAP-equiv-cBP (h d₀)) (right b₁)
            ∙ ap ua (CodeABEquivCodeBB.eqv-β b₁ d₀)) ⟩
      coe (ua (CodeABEquivCodeBB.eqv-on-image b₁ d₀)) q[ pcAB  ]
        =⟨ coe-β (CodeABEquivCodeBB.eqv-on-image b₁ d₀) q[ pcAB ] ⟩
      q[ pcAB-to-pcBB d₀ pcAB ]
        =∎

  -- code to path
  abstract
    pcAA-to-pcBA-to-path : ∀ d₀ {a₁} (pcAA : precodeAA _ a₁) →
         pcBA-to-path (pcAA-to-pcBA d₀ pcAA)
      == !₀ [ glue (h d₀) ] ∙₀' pcAA-to-path pcAA
    pcAB-to-pcBB-to-path : ∀ d₀ {b₁} (pcAB : precodeAB _ b₁) →
         pcBB-to-path (pcAB-to-pcBB d₀ pcAB)
      == !₀ [ glue (h d₀) ] ∙₀' pcAB-to-path pcAB
    pcAA-to-pcBA-to-path d₀ (pc-a pA) = ∙₀'-unit-l (!₀ [ glue (h d₀) ] ∙₀' ap₀ left pA)
    pcAA-to-pcBA-to-path d₀ (pc-aba d pc pA) =
        ap (λ p → p ∙₀' !₀ [ glue (h d) ] ∙₀' ap₀ left pA) (pcAB-to-pcBB-to-path d₀ pc)
      ∙ ∙₀'-assoc (!₀ [ glue (h d₀) ]) (pcAB-to-path pc) (!₀ [ glue (h d) ] ∙₀' ap₀ left pA)
    pcAB-to-pcBB-to-path d₀ (pc-aab d pc pB) =
        ap (λ p → p ∙₀' [ glue (h d) ] ∙₀' ap₀ right pB) (pcAA-to-pcBA-to-path d₀ pc)
      ∙ ∙₀'-assoc (!₀ [ glue (h d₀) ]) (pcAA-to-path pc) ([ glue (h d) ] ∙₀' ap₀ right pB)

  abstract
    decodeAA-is-decodeBA : ∀ {a₁} c₀ →
      decodeAA {f c₀} {a₁} == decodeBA {g c₀} {a₁}
      [ (λ p₀ → code p₀ (left a₁) → p₀ =₀ left a₁) ↓ glue c₀ ]
    decodeAA-is-decodeBA {a₁ = a₁} = SurjExt.ext
      (λ _ → ↓-preserves-level $ Π-is-set λ _ → Trunc-level) h h-is-surj
      (λ d₀ → ↓-→-from-transp $ λ= $ SetQuot-elim
        {P = λ cAA → transport (_=₀ left a₁) (glue (h d₀)) (decodeAA cAA)
                  == decodeBA (transport (λ p₀ → code p₀ (left a₁)) (glue (h d₀)) cAA)}
        (λ _ → =-preserves-set Trunc-level)
        (λ pcAA →
          transport (_=₀ left a₁) (glue (h d₀)) (pcAA-to-path pcAA)
            =⟨ transp₀-idf=₀cst [ glue (h d₀) ] (pcAA-to-path pcAA) ⟩
          !₀ [ glue (h d₀) ] ∙₀ pcAA-to-path pcAA
            =⟨ ∙₀=∙₀' [ ! (glue (h d₀)) ] (pcAA-to-path pcAA) ⟩
          !₀ [ glue (h d₀) ] ∙₀' pcAA-to-path pcAA
            =⟨ ! $ pcAA-to-pcBA-to-path d₀ pcAA ⟩
          pcBA-to-path (pcAA-to-pcBA d₀ pcAA)
            =⟨ ! $ ap (λ e → decodeBA (–> e q[ pcAA ])) (CodeAAEquivCodeBA.eqv-β a₁ d₀) ⟩
          decodeBA (–> (CodeAAEquivCodeBA.eqv a₁ (h d₀)) q[ pcAA ])
            =⟨ ! $ ap decodeBA (coe-β (CodeAAEquivCodeBA.eqv a₁ (h d₀)) q[ pcAA ]) ⟩
          decodeBA (coe (ua (CodeAAEquivCodeBA.eqv a₁ (h d₀))) q[ pcAA ])
            =⟨ ! $ ap (λ p → decodeBA (coe p q[ pcAA ])) (app=-β (ua ∘ cAP-equiv-cBP (h d₀)) (left a₁)) ⟩
          decodeBA (coe (app= (λ= λ p₁ → ua (cAP-equiv-cBP (h d₀) p₁)) (left a₁)) q[ pcAA ])
            =⟨ ! $ ap (λ p → decodeBA (coe (app= p (left a₁)) q[ pcAA ])) (Code.glue-β (h d₀)) ⟩
          decodeBA (coe (app= (ap code (glue (h d₀))) (left a₁)) q[ pcAA ])
            =⟨ ap (λ p → decodeBA (coe p q[ pcAA ])) (∘-ap (λ f₁ → f₁ (left a₁)) code (glue (h d₀))) ⟩
          decodeBA (transport (λ p₀ → code p₀ (left a₁)) (glue (h d₀)) q[ pcAA ])
            =∎)
        (λ _ → prop-has-all-paths-↓ $ Trunc-level {n = 0} _ _))
      (λ _ _ _ → prop-has-all-paths-↓ $ ↓-level $ Π-is-set λ _ → Trunc-level)

  abstract
    decodeAB-is-decodeBB : ∀ {b₁} c₀ →
      decodeAB {f c₀} {b₁} == decodeBB {g c₀} {b₁}
      [ (λ p₀ → code p₀ (right b₁) → p₀ =₀ right b₁) ↓ glue c₀ ]
    decodeAB-is-decodeBB {b₁ = b₁} = SurjExt.ext
      (λ _ → ↓-preserves-level $ Π-is-set λ _ → Trunc-level) h h-is-surj
      (λ d₀ → ↓-→-from-transp $ λ= $ SetQuot-elim
        {P = λ cAB → transport (_=₀ right b₁) (glue (h d₀)) (decodeAB cAB)
                  == decodeBB (transport (λ p₀ → code p₀ (right b₁)) (glue (h d₀)) cAB)}
        (λ _ → =-preserves-set Trunc-level)
        (λ pcAB →
          transport (_=₀ right b₁) (glue (h d₀)) (pcAB-to-path pcAB)
            =⟨ transp₀-idf=₀cst [ glue (h d₀) ] (pcAB-to-path pcAB) ⟩
          !₀ [ glue (h d₀) ] ∙₀ pcAB-to-path pcAB
            =⟨ ∙₀=∙₀' [ ! (glue (h d₀)) ] (pcAB-to-path pcAB) ⟩
          !₀ [ glue (h d₀) ] ∙₀' pcAB-to-path pcAB
            =⟨ ! $ pcAB-to-pcBB-to-path d₀ pcAB ⟩
          pcBB-to-path (pcAB-to-pcBB d₀ pcAB)
            =⟨ ! $ ap (λ e → decodeBB (–> e q[ pcAB ])) (CodeABEquivCodeBB.eqv-β b₁ d₀) ⟩
          decodeBB (–> (CodeABEquivCodeBB.eqv b₁ (h d₀)) q[ pcAB ])
            =⟨ ! $ ap decodeBB (coe-β (CodeABEquivCodeBB.eqv b₁ (h d₀)) q[ pcAB ]) ⟩
          decodeBB (coe (ua (CodeABEquivCodeBB.eqv b₁ (h d₀))) q[ pcAB ])
            =⟨ ! $ ap (λ p → decodeBB (coe p q[ pcAB ])) (app=-β (ua ∘ cAP-equiv-cBP (h d₀)) (right b₁)) ⟩
          decodeBB (coe (app= (λ= λ p₁ → ua (cAP-equiv-cBP (h d₀) p₁)) (right b₁)) q[ pcAB ])
            =⟨ ! $ ap (λ p → decodeBB (coe (app= p (right b₁)) q[ pcAB ])) (Code.glue-β (h d₀)) ⟩
          decodeBB (coe (app= (ap code (glue (h d₀))) (right b₁)) q[ pcAB ])
            =⟨ ap (λ p → decodeBB (coe p q[ pcAB ])) (∘-ap (λ f₁ → f₁ (right b₁)) code (glue (h d₀))) ⟩
          decodeBB (transport (λ p₀ → code p₀ (right b₁)) (glue (h d₀)) q[ pcAB ])
            =∎)
        (λ _ → prop-has-all-paths-↓ $ Trunc-level {n = 0} _ _))
      (λ _ _ _ → prop-has-all-paths-↓ $ ↓-level $ Π-is-set λ _ → Trunc-level)

  abstract
    decodeAP-is-decodeBP : ∀ c₀ p₁
      → decodeAP {f c₀} {p₁} == decodeBP {g c₀} {p₁}
        [ (λ p₀ → code p₀ p₁ → p₀ =₀ p₁) ↓ glue c₀ ]
    decodeAP-is-decodeBP c₀ = Pushout-elim
      {P = λ p₁ → decodeAP {f c₀} {p₁} == decodeBP {g c₀} {p₁}
        [ (λ p₀ → code p₀ p₁ → p₀ =₀ p₁) ↓ glue c₀ ]}
      (λ a₁ → decodeAA-is-decodeBA {a₁ = a₁} c₀)
      (λ b₁ → decodeAB-is-decodeBB {b₁ = b₁} c₀)
      (λ _ → prop-has-all-paths-↓ $ ↓-level $ Π-is-set λ _ → Trunc-level)

  decode : ∀ {p₀ p₁} → code p₀ p₁ → p₀ =₀ p₁
  decode {p₀} {p₁} = Pushout-elim
    {P = λ p₀ → code p₀ p₁ → p₀ =₀ p₁}
    (λ a₀ → decodeAP {a₀} {p₁})
    (λ b₀ → decodeBP {b₀} {p₁})
    (λ c₀ → decodeAP-is-decodeBP c₀ p₁)
    p₀


open import Nat
open import Prelude
open import List
open import core
open import contexts
open import typed-expansion
open import lemmas-freevars

module livelit-reasoning-principles where
  record reasoning-principles (Φ : livelitctx)
                              (Γ : tctx)
                              (a : livelitname)
                              (dm : iexp)
                              (τsplice : typ)
                              (êsplice : uexp)
                              (eresult : eexp)
                              (τresult : typ) : Set where
    field
      π   : livelitdef
      domain : dom (Φ ₁) a
      eexpanded : eexp
      esplice : eexp

      expanded-application-form : eresult == (eexpanded ·: τsplice ==> τresult) ∘ esplice
      expansion-typing          : (Γ ⊢ eresult => τresult) × (τresult == livelitdef.expansion-type π)
      responsibility            : Σ[ denc ∈ iexp ] (((livelitdef.expand π) ∘ dm) ⇓ denc × denc ↑ eexpanded)
      splice-typing             : Φ , Γ ⊢ êsplice ~~> esplice ⇐ τsplice × Γ ⊢ esplice <= τsplice
      context-independence      : free-vars (eexpanded ·: τsplice ==> τresult) == []

  livelit-reasoning-principles : ∀{Φ Γ a dm τsplice psplice eresult τresult u} →
        Φ , Γ ⊢ ＄ a ⟨ dm ⁏ (τsplice , psplice) :: [] ⟩[ u ] ~~> eresult ⇒ τresult →
        reasoning-principles Φ Γ a dm τsplice psplice eresult τresult
  livelit-reasoning-principles h@(SPEApLivelit {dm = dm} {π} {denc} {eexpanded} {esplice = esplice} x x₁ x₂ x₃ x₄ x₅ x₆ x₇) =
       record
         { π                         = π
         ; domain                    = _ , x₂
         ; eexpanded                 = eexpanded
         ; esplice                   = esplice
         ; expanded-application-form = refl
         ; expansion-typing          = typed-expansion-synth h , refl
         ; responsibility            = denc , x₄ , x₅
         ; splice-typing             = x₆ , typed-expansion-ana x₆
         ; context-independence      = ∅∈l→l==[] (λ x → fv-lemma-ana refl x₇)
         }


module GUIgeneric.GUIExampleBankAccount   where

open import GUIgeneric.Prelude renaming (inj₁ to firstBtn; inj₂ to secondBtn; WxColor to Color;_∸_ to _-_) hiding (addButton; _>>_ ; show)

open import GUIgeneric.GUIDefinitions renaming (add to add'; add' to add)
open import GUIgeneric.GUI
open import GUIgeneric.GUIExampleLib renaming (addButton to addButton')
open import GUIgeneric.GUIExample  hiding (main; changeGUI)

open import Data.Nat.Show
open import heap.libraryNat renaming (_≧ℕb_ to _≧_)

guifullToReturnType : ∀ {i} {g} → GUI {i} → returnType g
guifullToReturnType f = changedGUI (f .defFrame) (f .property)

guifullToReturnType' : ∀ {i} {g} → GUI {i} →
                       Σ[ r ∈ returnType g ]
                       (IOObjectˢ GuiLev1Interface handlerInterface i
                           (nextStateFrame g r))
guifullToReturnType' {i} {g} f = guifullToReturnType f , f .obj

changeGUI : ∀ {i} {g} → GUI {i} →
                       IO GuiLev1Interface ∞ (Σ[ r ∈ returnType g ]
                       (IOObjectˢ GuiLev1Interface handlerInterface i
                           (nextStateFrame g r)))
changeGUI  f = return (guifullToReturnType' f)

threeBtnFrame : (s s' s'' : String) → Frame
threeBtnFrame s s'  s'' = addButton s  (addButton s'
                             (addButton s'' create-frame))

propThreeBtn : ∀{s s' s''} → properties (threeBtnFrame s s' s'')
propThreeBtn = black , black , black , oneColumnLayout

mutual
 atm :  ∀{i} → ℕ → GUI {i}
 atm n   .defFrame  =
      addButton  "Withdraw 10"
     (addButton  "Withdraw 1"
     (addTxtBox  (show n) create-frame))
 atm n   .property =
   black , black , black , oneColumnLayout
 atm n   .obj .method (firstBtn x) =
    if n ≧ 10  then  changeGUI  (atm (n - 10))
               else  changeGUI  (invalid n)

 atm n  .obj .method (secondBtn b) =
     if n ≧ 1  then  changeGUI  (atm (n - 1))
               else  changeGUI  (invalid n)

 invalid : ∀{i} → ℕ → GUI {i}
 invalid n .defFrame =
     addButton "Not enough money" create-frame
 invalid n .property       =  black , oneColumnLayout
 invalid n .obj .method m  =  changeGUI (atm n)

main : NativeIO Unit
main = compileGUI (atm 55)


{-# OPTIONS --safe --sized-types #-}
module STLC.Operational where

open import STLC.Operational.Base


-- Andreas, 2020-09-09, issue #4880
-- Parse all interleavings of hiding and irrelevance in non-dependent function space

module Issue4880 (A B : Set) where

postulate
  -- dependent
  -- * visible
  _ : A →   (_ : B) → A
  _ : A →  .(_ : B) → A
  _ : A → ..(_ : B) → A
  -- * hidden
  _ : A →   {_ : B} → A
  _ : A →  .{_ : B} → A
  _ : A → ..{_ : B} → A
  -- * instance
  _ : A →   ⦃ _ : B ⦄ → A
  _ : A →  .⦃ _ : B ⦄ → A
  _ : A → ..⦃ _ : B ⦄ → A

  -- non-dependent
  -- * visible
  _ : A →   B → A
  _ : A →  .B → A
  _ : A → ..B → A
  -- * visible, parenthesized
  _ : A →  .(B) → A
  _ : A → ..(B) → A
  _ : A →  (.B) → A
  _ : A → (..B) → A
  -- * hidden
  _ : A →   {B} → A
  _ : A →  .{B} → A
  _ : A → ..{B} → A
  _ : A →  {.B} → A
  _ : A → {..B} → A
  -- * instance
  _ : A →   ⦃ B ⦄ → A
  _ : A →  .⦃ B ⦄ → A
  _ : A → ..⦃ B ⦄ → A
  _ : A →  ⦃ .B ⦄ → A
  _ : A → ⦃ ..B ⦄ → A


-- Andreas, 2019-02-25, issue #3588
-- C-c C-r (refine) produces unqualified constructor, but only
-- a qualified constructor is accepted in this place.

-- {-# OPTIONS -v interaction.intro:100 #-}
-- {-# OPTIONS -v scope.inverse:100 #-}
-- {-# OPTIONS -v toConcrete:50 #-}

module Issue3588 where

module M (_ : Set₁) where

  data D : Set where
    c : D

  data P : D → Set where
    c : P c

open M Set using (D; P)
open M.D

test : P c
test = {!!}  -- C-c C-r

  -- "c" suggested by refine, but rejected by reload or give
  -- correct: P.c


module noetherian where

open import sn-calculus
open import Esterel.Lang
open import Esterel.Lang.Properties
open import Esterel.Context
open import Esterel.Context.Properties
open import Esterel.Environment
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.Nat as Nat
  using (ℕ ; zero ; suc ; _+_ ; _>_ ; _≤′_ ; _≤_ ; _*_ ; ≤′-refl)
open import Data.Nat.Properties
  using (s≤′s ; z≤′n ; m≤′m+n ; n≤′m+n ; ≤⇒pred≤)
open import Data.Nat.Properties.Simple using (+-comm ; +-assoc ; +-suc)
open import Data.MoreNatProp
open import Data.Sum as Sum using (inj₁ ; inj₂ ; _⊎_)
open import Data.Maybe using (just ; nothing)
open import Data.Product using (_×_ ; _,_ ; _,′_ ; proj₁)
open import Agda.Builtin.Equality using (refl ; _≡_)
open import Data.List using (List ; _∷_ ; [])
open import Data.Bool using (Bool ; true ; false)
open import Relation.Nullary.Decidable using (⌊_⌋)
open import Relation.Nullary
  using (Dec ; yes ; no ; ¬_)
open import Relation.Binary.PropositionalEquality
  using (sym ; inspect ; Reveal_·_is_ ; trans ; cong)
open import Data.Empty using (⊥-elim ; ⊥)

SM = SigMap.Map Signal.Status
ShM = ShrMap.Map (SharedVar.Status × ℕ)

is-unknownp : Signal.Status -> Bool
is-unknownp x = ⌊ x Signal.≟ₛₜ Signal.unknown ⌋

is-notreadyp : SharedVar.Status × ℕ -> Bool
is-notreadyp (SharedVar.ready , _) = false
is-notreadyp (SharedVar.new   , _) = true
is-notreadyp (SharedVar.old   , _) = true

is-notreadyp-status : SharedVar.Status -> Bool
is-notreadyp-status SharedVar.ready = false
is-notreadyp-status SharedVar.new = true
is-notreadyp-status SharedVar.old = true

is-notreadyp' : SharedVar.Status × ℕ -> Bool
is-notreadyp' x = is-notreadyp-status (proj₁ x)

hunch : ∀ x -> is-notreadyp x ≡ is-notreadyp' x
hunch (SharedVar.ready , proj₃) = refl
hunch (SharedVar.new , proj₃) = refl
hunch (SharedVar.old , proj₃) = refl

numstepsSig : SM -> ℕ
numstepsSig m = SigMap.count is-unknownp m

numstepsShr : ShM -> ℕ
numstepsShr m = ShrMap.count is-notreadyp m

numstepsθ : Env -> ℕ
numstepsθ (Θ sig₁ shr₁ var₁) = (numstepsSig sig₁) + (numstepsShr shr₁)

∥_∥s : Term -> ℕ
∥ nothin ∥s = 0
∥ pause ∥s = 0

{- one for stepping to ρ θ p
   one for (maybe) setting S to absent
   one for (maybe) this ρ mergeing with another one
   (same idea for `shared` and `var`) -}
∥ (signl S p) ∥s = suc (suc (suc (∥ p ∥s)))

∥ (present S ∣⇒ p ∣⇒ q) ∥s = suc (∥ p ∥s + ∥ q ∥s)
∥ (emit S) ∥s = 1
∥ (p ∥ q) ∥s = suc (∥ p ∥s + ∥ q ∥s)
∥ (loop p) ∥s = suc (suc (∥ p ∥s + ∥ p ∥s))
∥ (loopˢ p q) ∥s = suc (∥ p ∥s + ∥ q ∥s)
∥ (p >> q) ∥s = suc (∥ p ∥s + ∥ q ∥s)
∥ (suspend p S) ∥s = suc (∥ p ∥s)
∥ (trap p) ∥s = suc (∥ p ∥s)
∥ (exit x) ∥s = 0
∥ (shared s ≔ e in: p) ∥s = suc (suc (suc (∥ p ∥s)))
∥ (s ⇐ e) ∥s = 1
∥ (var x ≔ e in: p) ∥s = suc (suc (∥ p ∥s))
∥ (x ≔ e) ∥s = 1
∥ (if x ∣⇒ p ∣⇒ q) ∥s = suc (∥ p ∥s + ∥ q ∥s)
∥ (ρ⟨ θ , A ⟩· p) ∥s = suc (numstepsθ θ + ∥ p ∥s)

arith1 : ∀ a b c -> suc b ≤′ c -> suc (suc (a + b)) ≤′ suc (a + c)
arith1 a b c sucb≤′c rewrite sym (+-suc a b) = s≤′s (≤′+r {z = a} sucb≤′c)

arith2 : ∀ x y z -> suc x ≤′ y -> suc (suc (x + z)) ≤′ suc (y + z)
arith2 x y z sucx≤′y = s≤′s (≤′+l{z = z} sucx≤′y)

arith3 : ∀ x y z -> suc x ≤′ y -> suc (suc (z + x)) ≤′ suc (z + y)
arith3 x y z sucx≤′y rewrite sym (+-suc z x) = s≤′s (≤′+r {z = z} sucx≤′y)

arith4 : ∀ x y z -> suc (suc x + y + z) ≤′ suc (x + suc y + z)
arith4 x y z rewrite +-suc x y = s≤′s ≤′-refl

arith5 : ∀ x y -> suc x ≤′ y -> suc (suc (suc (x + x))) ≤′ suc (suc (y + y))
arith5 x y sucx≤′y rewrite sym (+-suc x x) =
  s≤′s (s≤′s (≤′+b x (suc x) y y (suc≤′⇒≤′ x y sucx≤′y)  sucx≤′y))

decompose∥∥s : ∀ E p -> ∥ E ⟦ p ⟧e ∥s ≡ ∥ E ⟦ nothin ⟧e ∥s + ∥ p ∥s
decompose∥∥s [] p = refl
decompose∥∥s (x ∷ E) p with decompose∥∥s E
decompose∥∥s (epar₁ q ∷ E) p | R
  rewrite R p
  | +-assoc (∥ E ⟦ nothin ⟧e ∥s) ∥ p ∥s  ∥ q ∥s
  | +-assoc (∥ E ⟦ nothin ⟧e ∥s) ∥ q ∥s  ∥ p ∥s
  | +-comm (∥ p ∥s) (∥ q ∥s)
  = cong suc refl
decompose∥∥s (epar₂ p ∷ E) p₁ | R
  rewrite R p₁
  | +-assoc ∥ p ∥s ∥ E ⟦ nothin ⟧e ∥s ∥ p₁ ∥s
  = cong suc refl
decompose∥∥s (eseq q ∷ E) p | R
  rewrite R p
  | +-assoc (∥ E ⟦ nothin ⟧e ∥s) ∥ p ∥s  ∥ q ∥s
  | +-assoc (∥ E ⟦ nothin ⟧e ∥s) ∥ q ∥s  ∥ p ∥s
  | +-comm (∥ p ∥s) (∥ q ∥s)
  = cong suc refl
decompose∥∥s (eloopˢ q ∷ E) p | R
  rewrite R p
  | +-assoc (∥ E ⟦ nothin ⟧e ∥s) ∥ p ∥s  ∥ q ∥s
  | +-assoc (∥ E ⟦ nothin ⟧e ∥s) ∥ q ∥s  ∥ p ∥s
  | +-comm (∥ p ∥s) (∥ q ∥s)
  = cong suc refl
decompose∥∥s (esuspend S ∷ E) p | R rewrite R p = refl
decompose∥∥s (etrap ∷ E) p | R rewrite R p = refl

eplug≤ : ∀ p q E ->
  ∥ p ∥s ≤′ ∥ q ∥s ->
  ∥ E ⟦ p ⟧e ∥s ≤′ ∥ E ⟦ q ⟧e ∥s
eplug≤ p q E ∥p∥s≤′∥q∥s
  rewrite decompose∥∥s E p | decompose∥∥s E q
  = ≤′+r{z = ∥ E ⟦ nothin ⟧e ∥s} ∥p∥s≤′∥q∥s

eplug< : ∀ p q E ->
  suc ∥ p ∥s ≤′ ∥ q ∥s ->
  suc (∥ (E ⟦ p ⟧e) ∥s) ≤′ (∥ (E ⟦ q ⟧e) ∥s)
eplug< p q E ∥p∥s<∥q∥s
  rewrite decompose∥∥s E p | decompose∥∥s E q
        | sym (+-suc ∥ E ⟦ nothin ⟧e ∥s  ∥ p ∥s)
  = ≤′+r{z = ∥ E ⟦ nothin ⟧e ∥s} ∥p∥s<∥q∥s

valuemax-norm : ∀ {p q} ->
  (donep : done p) -> (doneq : done q) ->
  (haltedporq : halted p ⊎ halted q) ->
  ∥ value-max donep doneq haltedporq ∥s ≤′ ∥ p ∥s + ∥ q ∥s
valuemax-norm (dhalted hnothin) (dhalted p/halted₁) _ = ≤′-refl
valuemax-norm (dhalted (hexit n)) (dhalted hnothin) _ = ≤′-refl
valuemax-norm (dhalted (hexit n)) (dhalted (hexit m)) _ = ≤′-refl
valuemax-norm (dhalted hnothin) (dpaused p/paused) _ = ≤′-refl
valuemax-norm{q = q} (dhalted (hexit n)) (dpaused p/paused) _ = m≤′m+n 0 ∥ q ∥s
valuemax-norm{p = p} (dpaused p/paused) (dhalted hnothin) _ = m≤′m+n ∥ p ∥s 0
valuemax-norm (dpaused p/paused) (dhalted (hexit n)) _ = z≤′n
valuemax-norm (dpaused p/paused) (dpaused p/paused₁) (inj₁ x) =
  ⊥-elim (halted-paused-disjoint x p/paused)
valuemax-norm (dpaused p/paused) (dpaused p/paused₁) (inj₂ y) =
  ⊥-elim (halted-paused-disjoint y p/paused₁)

halted-norm : ∀ {p} -> (haltedp : halted p) ->  ∥ ↓ haltedp ∥s ≡ 0
halted-norm hnothin = refl
halted-norm (hexit zero) = refl
halted-norm (hexit (suc n)) = refl

noetherian₁ :
  ∀ {p q} ->
  p sn⟶₁ q ->
  (suc (∥ q ∥s)) ≤′ (∥ p ∥s)
noetherian₁ (rpar-done-right{p}{q} haltedp doneq) =
  s≤′s (valuemax-norm (dhalted haltedp) doneq (inj₁ haltedp))
noetherian₁ (rpar-done-left{p}{q} donep haltedq) =
  s≤′s (valuemax-norm donep (dhalted haltedq) (inj₂ haltedq))
noetherian₁ (ris-present{θ}{S = S}{p = p}{q = q}{E = E} S∈ x x₁) with unplug x₁
... | refl =
  arith1 (numstepsθ θ)
         ∥ E ⟦ p ⟧e ∥s
         ∥ E ⟦ present S ∣⇒ p ∣⇒ q ⟧e ∥s
         (eplug< p (present S ∣⇒ p ∣⇒ q) E (s≤′s (m≤′m+n ∥ p ∥s ∥ q ∥s)))

noetherian₁ (ris-absent{θ}{S}{p = p}{q = q}{E = E} S∈ x x₁) with unplug x₁
... | refl =
  arith1 (numstepsθ θ)
         ∥ E ⟦ q ⟧e ∥s
         ∥ E ⟦ present S ∣⇒ p ∣⇒ q ⟧e ∥s
         (eplug< q (present S ∣⇒ p ∣⇒ q) E (s≤′s (n≤′m+n ∥ p ∥s ∥ q ∥s)))

noetherian₁ (remit {θ} {_} {S} {E} S∈ ¬S≡a x) with unplug x
noetherian₁ (remit {θ} {_} {S} {E} S∈ ¬S≡a x) | refl with
    is-unknownp (SigMap.lookup{k = S} (sig θ) S∈)
  | inspect is-unknownp (SigMap.lookup{k = S} (sig θ) S∈)
  | SigMap.lookup{k = S} (sig θ) S∈
  | inspect (SigMap.lookup{k = S} (sig θ)) S∈
... | true  | Reveal_·_is_.[ eq1 ] | Signal.present | Reveal_·_is_.[ eq ]
  rewrite eq = ⊥-elim (false-not-true eq1) where
  false-not-true : false ≡ true -> ⊥
  false-not-true ()
... | false | Reveal_·_is_.[ eq1 ] | Signal.absent  | Reveal_·_is_.[ eq ]
  = ⊥-elim (¬S≡a refl)
... | true  | Reveal_·_is_.[ eq1 ] | Signal.absent  | Reveal_·_is_.[ eq ]
  = ⊥-elim (¬S≡a refl)
... | false | Reveal_·_is_.[ eq1 ] | Signal.unknown | Reveal_·_is_.[ eq ]
  rewrite eq = ⊥-elim (true-not-false eq1) where
  true-not-false : true ≡ false -> ⊥
  true-not-false ()
noetherian₁ (remit {θ} {.(E ⟦ emit S ⟧e)} {S} {E} S∈ ¬S≡a x)
   | refl | false | Reveal_·_is_.[ eq1 ] | Signal.present | Reveal_·_is_.[ eq ]
   with sym (SigMap.getput-m S (sig θ) S∈)
... | updateθ-S-to-present≡θ rewrite eq | updateθ-S-to-present≡θ =
  arith1 (numstepsθ θ)
         ∥ E ⟦ nothin ⟧e ∥s
         ∥ E ⟦ emit S ⟧e ∥s
         (eplug< nothin (emit S) E ≤′-refl)
noetherian₁ (remit {θ} {.(E ⟦ emit S ⟧e)} {S} {E} S∈ ¬S≡a x)
  | refl | true  | Reveal_·_is_.[ eq1 ] | Signal.unknown | Reveal_·_is_.[ eq ]
  rewrite SigMap.change-one-count-goes-down
   (sig θ) is-unknownp
   S S∈ eq1 Signal.present refl =
   s≤′s (s≤′s (≤′+r {z = numstepsθ (set-sig{S} θ S∈ Signal.present)}
                    (eplug≤ nothin (emit S) E (Nat.≤′-step ≤′-refl))))

noetherian₁ rloop-unroll = ≤′-refl
noetherian₁ rseq-done = ≤′-refl
noetherian₁ (rseq-exit{q}) = s≤′s z≤′n
noetherian₁ (rloopˢ-exit{q}) = s≤′s z≤′n
noetherian₁ (rsuspend-done x) = ≤′-refl
noetherian₁ (rtrap-done{p} haltedp)
  rewrite halted-norm haltedp =
  s≤′s z≤′n
noetherian₁ (rraise-signal{p}{S}) = ans where
  oneunknown≡1 : ∀ S ->
     numstepsθ (Θ SigMap.[ S ↦ Signal.unknown ] [] []) ≡ 1
  oneunknown≡1 (zero Signal.ₛ) = refl
  oneunknown≡1 (suc n Signal.ₛ) = oneunknown≡1 (n Signal.ₛ)

  ans : suc (suc (numstepsθ (Θ SigMap.[ S ↦ Signal.unknown ] [] []) +  ∥ p ∥s))
     ≤′ suc (suc (suc ∥ p ∥s))
  ans rewrite oneunknown≡1 S = ≤′-refl

noetherian₁ (rraise-shared{θ}{_}{s}{e}{p}{E} e' x) with unplug x
... | refl =
  arith1 (numstepsθ θ)
         ∥ E ⟦ ρ⟨ [s,δe]-env  s (δ e') , WAIT ⟩· p ⟧e ∥s
         ∥ E ⟦ shared s ≔ e in: p ⟧e ∥s
         (eplug< (ρ⟨ [s,δe]-env s (δ e') , WAIT ⟩· p)
                 (shared s ≔ e in: p) E newθ≡1) where

   silly : ∀ s -> numstepsθ ([s,δe]-env s (δ e')) ≡ 1
   silly (zero SharedVar.ₛₕ) = refl
   silly (suc x₁ SharedVar.ₛₕ) = silly (x₁ SharedVar.ₛₕ)

   newθ≡1 : suc (suc (numstepsθ ([s,δe]-env s (δ e')) + ∥ p ∥s)) ≤′
            suc (suc (suc ∥ p ∥s))
   newθ≡1 rewrite silly s = ≤′-refl

noetherian₁ (rset-shared-value-old{θ}{_}{s}{e}{E} e' s∈ θ[s]≡old x) with unplug x
... | refl  = ans where

  snotready : is-notreadyp (ShrMap.lookup{k = s} (shr θ) s∈) ≡ true
  snotready rewrite hunch (ShrMap.lookup{k = s} (shr θ) s∈)
            | θ[s]≡old = refl

  θsame : numstepsθ (set-shr{s} θ s∈ (SharedVar.new) (δ e'))
        ≡ numstepsθ θ
  θsame rewrite
     ShrMap.change-nothing-count-stays-same
       (shr θ) is-notreadyp s s∈
       (SharedVar.new , δ e') snotready = refl

  ans : suc ∥ (ρ⟨ (set-shr{s} θ s∈ (SharedVar.new) (δ e')) , GO ⟩·
                 E ⟦ nothin ⟧e) ∥s ≤′
        ∥ ρ⟨ θ , GO ⟩· E ⟦ s ⇐ e ⟧e ∥s
  ans rewrite θsame =
    arith1 (numstepsθ θ)
            ∥ E ⟦ nothin ⟧e ∥s
            ∥ E ⟦ s ⇐ e ⟧e ∥s
            (eplug< nothin (s ⇐ e) E ≤′-refl)

noetherian₁ (rset-shared-value-new{θ}{_}{s}{e}{E} e' s∈ θ[s]≡new x) with unplug x
... | refl = ans where

  snotready : is-notreadyp (ShrMap.lookup{k = s} (shr θ) s∈) ≡ true
  snotready rewrite hunch (ShrMap.lookup{k = s} (shr θ) s∈)
            | θ[s]≡new = refl

  θsame : numstepsθ (set-shr{s} θ s∈ (SharedVar.new) (shr-vals{s} θ s∈ + δ e'))
        ≡ numstepsθ θ
  θsame rewrite
     ShrMap.change-nothing-count-stays-same
       (shr θ) is-notreadyp s s∈
       (SharedVar.new , shr-vals{s} θ s∈ + δ e') snotready = refl

  ans : suc ∥ (ρ⟨ (set-shr{s} θ s∈ (SharedVar.new) (shr-vals{s} θ s∈ + δ e')) , GO ⟩·
                 E ⟦ nothin ⟧e) ∥s ≤′
        ∥ ρ⟨ θ , GO ⟩· E ⟦ s ⇐ e ⟧e ∥s
  ans rewrite θsame =
     arith1 (numstepsθ θ)
            ∥ E ⟦ nothin ⟧e ∥s
            ∥ E ⟦ s ⇐ e ⟧e ∥s
            (eplug< nothin (s ⇐ e) E ≤′-refl)

noetherian₁ (rraise-var{θ}{r}{x}{p}{e}{E} e' x₁) with unplug x₁
... | refl =
  arith1 (numstepsθ θ)
         ∥ E ⟦ ρ⟨ [x,δe]-env x (δ e') , WAIT ⟩· p ⟧e ∥s
         ∥ E ⟦ var x ≔ e in: p ⟧e ∥s
         (eplug< (ρ⟨ [x,δe]-env x (δ e') , WAIT ⟩· p)
                 (var x ≔ e in: p)
                 E
                 ≤′-refl)
noetherian₁ (rset-var{θ}{_}{x}{e}{E} x∈ e' x₁) with unplug x₁
... | refl =
  arith1 (numstepsθ θ)
          ∥ E ⟦ nothin ⟧e ∥s
          ∥ E ⟦ x ≔ e ⟧e ∥s
          (eplug< nothin (x ≔ e) E ≤′-refl)
noetherian₁ (rif-false{θ}{p = p}{q = q}{x = x}{E = E} x∈ x₁ x₂) with unplug x₂
... | refl = arith1 (numstepsθ θ)
                    ∥ E ⟦ q ⟧e ∥s
                    ∥ E ⟦ if x ∣⇒ p ∣⇒ q ⟧e ∥s
                    (eplug< q (if x ∣⇒ p ∣⇒ q) E (s≤′s (n≤′m+n ∥ p ∥s ∥ q ∥s)))
noetherian₁ (rif-true{θ}{p = p}{q = q}{x = x}{E = E} x∈ x₁ x₂) with unplug x₂
... | refl = arith1 (numstepsθ θ)
                    ∥ E ⟦ p ⟧e ∥s
                    ∥ E ⟦ if x ∣⇒ p ∣⇒ q ⟧e ∥s
                    (eplug< p (if x ∣⇒ p ∣⇒ q) E (s≤′s (m≤′m+n ∥ p ∥s ∥ q ∥s)))
noetherian₁ (rabsence{θ = θ}{S = S} S∈ θ[S]≡unk S̸S∉Canθ)
    with is-unknownp (SigMap.lookup{k = S} (sig θ) S∈)
       | inspect is-unknownp (SigMap.lookup{k = S} (sig θ) S∈)
... | false | Reveal_·_is_.[ eq ] rewrite θ[S]≡unk
  = ⊥-elim (absurd eq) where
      absurd : true ≡ false -> ⊥
      absurd ()
... | true  | Reveal_·_is_.[ eq ] with
   SigMap.change-one-count-goes-down
     (sig θ) is-unknownp
     S S∈ eq Signal.absent refl
... | thing rewrite thing = ≤′-refl

noetherian₁ (rreadyness {θ}{p}{s} s∈ (inj₁ θs=old) s∉Canθ)
  with is-notreadyp (ShrMap.lookup{k = s} (shr θ) s∈)
     | inspect is-notreadyp (ShrMap.lookup{k = s} (shr θ) s∈)
... | false | Reveal_·_is_.[ eq ]
  rewrite hunch (ShrMap.lookup{k = s} (shr θ) s∈) |  θs=old
  = ⊥-elim (absurd eq) where
       absurd : true ≡ false -> ⊥
       absurd ()
... | true  | Reveal_·_is_.[ eq ] rewrite θs=old with
  ShrMap.change-one-count-goes-down
     (shr θ) is-notreadyp
     s s∈ eq (SharedVar.ready ,′ shr-vals{s} θ s∈) refl
... | thing rewrite thing =
    arith4 (numstepsSig (sig θ))
           (numstepsShr (shr (set-shr{s} θ s∈ (SharedVar.ready)
                                         (shr-vals{s} θ s∈))))
           (∥ p ∥s)

noetherian₁ (rreadyness {θ}{p}{s} s∈ (inj₂ θs=new) s∉Canθ)
  with is-notreadyp (ShrMap.lookup{k = s} (shr θ) s∈)
     | inspect is-notreadyp (ShrMap.lookup{k = s} (shr θ) s∈)
... | false | Reveal_·_is_.[ eq ]
  rewrite hunch (ShrMap.lookup{k = s} (shr θ) s∈) |  θs=new
  = ⊥-elim (absurd eq) where
       absurd : true ≡ false -> ⊥
       absurd ()
... | true  | Reveal_·_is_.[ eq ] rewrite θs=new with
  ShrMap.change-one-count-goes-down
     (shr θ) is-notreadyp
     s s∈ eq (SharedVar.ready ,′ shr-vals{s} θ s∈) refl
... | thing rewrite thing =
    arith4 (numstepsSig (sig θ))
           (numstepsShr (shr (set-shr{s} θ s∈ (SharedVar.ready)
                                         (shr-vals{s} θ s∈))))
           (∥ p ∥s)

noetherian₁ (rmerge{θ₁}{θ₂}{_}{p}{E}{A₁}{A₂} x) with unplug x
... | refl rewrite decompose∥∥s E (ρ⟨ θ₂ , A₂ ⟩· p)
                 | decompose∥∥s E p
  = s≤′s
    (rearrange-things
      (numstepsSig (SigMap.union (sig θ₁) (sig θ₂)))
      (numstepsShr (ShrMap.union (shr θ₁) (shr θ₂)))
      ∥ E ⟦ nothin ⟧e ∥s
      ∥ p ∥s
      (numstepsSig (sig θ₁))
      (numstepsShr (shr θ₁))
      (numstepsSig (sig θ₂))
      (numstepsShr (shr θ₂))
      (≤′+b (numstepsSig (SigMap.union (sig θ₁) (sig θ₂)))
            (numstepsShr (ShrMap.union (shr θ₁) (shr θ₂)))
            (numstepsSig (sig θ₁) + numstepsSig (sig θ₂))
            (numstepsShr (shr θ₁) + numstepsShr (shr θ₂))
            (SigMap.count-merge≤′sum-count
             (sig θ₁) (sig θ₂) is-unknownp)
            (ShrMap.count-merge≤′sum-count
             (shr θ₁) (shr θ₂) is-notreadyp))) where

  rearrange-more :
    ∀ ab cd a b c d ->
      ab + cd ≤′ a + b + (c + d) ->
      ab + cd ≤′ a + c + (b + d)
  rearrange-more ab cd a b c d simple rewrite
     sym (+-assoc (a + c) b d)
   | +-assoc a c b
   | +-comm c b
   | sym (+-assoc a b c)
   | +-assoc (a + b) c d
   = simple

  rearrange-things : ∀ ab cd n p a c b d ->
    ab + cd ≤′ (a + b) + (c + d) ->
    suc (ab + cd + (n + p)) ≤′ a + c + (n + (suc (b + d + p)))
  rearrange-things ab cd n p a c b d simple rewrite
     +-suc n (b + d + p)
   | +-suc (a + c) (n + (b + d + p))
   | +-comm (b + d) p
   | sym (+-assoc n p (b + d))
   | +-comm (n + p) (b + d)
   | sym (+-assoc (a + c) (b + d) (n + p))
   = s≤′s (≤′+l {z = n + p} (rearrange-more ab cd a b c d simple))

csteps : ∀ {p q C C⟦p⟧ C⟦q⟧} ->
  (suc (∥ q ∥s)) ≤′ (∥ p ∥s) ->
  C⟦p⟧ ≐ C ⟦ p ⟧c ->
  C⟦q⟧ ≐ C ⟦ q ⟧c ->
  (suc ∥ C⟦q⟧ ∥s) ≤′ ∥ C⟦p⟧ ∥s
csteps sq≤p dchole dchole = sq≤p
csteps sq≤p (dcpar₁{pp}{pr}{pq} C⟦p⟧=C⟦p⟧c) (dcpar₁{qp}{qr}{qq} C⟦q⟧=C⟦q⟧c)
  with csteps sq≤p C⟦p⟧=C⟦p⟧c C⟦q⟧=C⟦q⟧c
... | sucnsp≰sp₁ = arith2 ∥ qp ∥s ∥ pp ∥s  ∥ pq ∥s sucnsp≰sp₁
csteps sq≤p (dcpar₂{pp}{pr}{pq} C⟦p⟧=C⟦p⟧c) (dcpar₂{qp}{qr}{qq} C⟦q⟧=C⟦q⟧c)
  with csteps sq≤p C⟦p⟧=C⟦p⟧c C⟦q⟧=C⟦q⟧c
... | sucnsp≰sp₁ = arith1 ∥ qp ∥s ∥ qq ∥s  ∥ pq ∥s sucnsp≰sp₁
csteps sq≤p (dcseq₁{pp}{pr}{pq} C⟦p⟧=C⟦p⟧c) (dcseq₁{qp}{qr}{qq} C⟦q⟧=C⟦q⟧c)
  with csteps sq≤p C⟦p⟧=C⟦p⟧c C⟦q⟧=C⟦q⟧c
... | sucnsp≰sp₁ = arith2 ∥ qp ∥s ∥ pp ∥s ∥ pq ∥s sucnsp≰sp₁
csteps sq≤p (dcseq₂{pp}{pr}{pq} C⟦p⟧=C⟦p⟧c) (dcseq₂{qp}{qr}{qq} C⟦q⟧=C⟦q⟧c)
  with csteps sq≤p C⟦p⟧=C⟦p⟧c C⟦q⟧=C⟦q⟧c
... | sucnsp≰sp₁ = arith1 ∥ pp ∥s ∥ qq ∥s ∥ pq ∥s sucnsp≰sp₁
csteps sq≤p (dcsuspend{p} C⟦p⟧=C⟦p⟧c) (dcsuspend{q} C⟦q⟧=C⟦q⟧c)
  with csteps sq≤p C⟦p⟧=C⟦p⟧c C⟦q⟧=C⟦q⟧c
... | sucnsp≰sp₁ = s≤′s sucnsp≰sp₁
csteps sq≤p (dctrap{p} C⟦p⟧=C⟦p⟧c) (dctrap{q} C⟦q⟧=C⟦q⟧c)
  with csteps sq≤p C⟦p⟧=C⟦p⟧c C⟦q⟧=C⟦q⟧c
... | sucnsp≰sp₁ = s≤′s sucnsp≰sp₁
csteps sq≤p (dcsignl{p} C⟦p⟧=C⟦p⟧c) (dcsignl{q} C⟦q⟧=C⟦q⟧c)
  with csteps sq≤p C⟦p⟧=C⟦p⟧c C⟦q⟧=C⟦q⟧c
... | sucnsp≰sp₁ = s≤′s (s≤′s (s≤′s sucnsp≰sp₁))
csteps sq≤p (dcpresent₁{pp}{pr}{pq} C⟦p⟧=C⟦p⟧c) (dcpresent₁{qp}{qr}{qq} C⟦q⟧=C⟦q⟧c)
  with csteps sq≤p C⟦p⟧=C⟦p⟧c C⟦q⟧=C⟦q⟧c
... | sucnsp≰sp₁ = arith2 ∥ qp ∥s  ∥ pp ∥s  ∥ pq ∥s  sucnsp≰sp₁
csteps sq≤p (dcpresent₂{pp}{pr}{pq} C⟦p⟧=C⟦p⟧c) (dcpresent₂{qp}{qr}{qq} C⟦q⟧=C⟦q⟧c)
  with csteps sq≤p C⟦p⟧=C⟦p⟧c C⟦q⟧=C⟦q⟧c
... | sucnsp≰sp₁ = arith1 ∥ pp ∥s ∥ qq ∥s ∥ pq ∥s sucnsp≰sp₁
csteps sq≤p (dcloop{p} C⟦p⟧=C⟦p⟧c) (dcloop{q} C⟦q⟧=C⟦q⟧c)
  with csteps sq≤p C⟦p⟧=C⟦p⟧c C⟦q⟧=C⟦q⟧c
... | sucnsp≰sp₁ = arith5 ∥ q ∥s ∥ p ∥s sucnsp≰sp₁
csteps sq≤p (dcloopˢ₁{pp}{pq} C⟦p⟧=C⟦p⟧c) (dcloopˢ₁{qp}{qq} C⟦q⟧=C⟦q⟧c)
  with csteps sq≤p C⟦p⟧=C⟦p⟧c C⟦q⟧=C⟦q⟧c
... | sucnsp≰sp₁ =  arith2  ∥ qp ∥s  ∥ pp ∥s  ∥ pq ∥s sucnsp≰sp₁
csteps sq≤p (dcloopˢ₂{pp}{pq} C⟦p⟧=C⟦p⟧c) (dcloopˢ₂{qp}{qq} C⟦q⟧=C⟦q⟧c)
  with csteps sq≤p C⟦p⟧=C⟦p⟧c C⟦q⟧=C⟦q⟧c
... | sucnsp≰sp₁ = arith1 ∥ pp ∥s  ∥ qq ∥s ∥ pq ∥s sucnsp≰sp₁
csteps sq≤p (dcshared{p} C⟦p⟧=C⟦p⟧c) (dcshared{q} C⟦q⟧=C⟦q⟧c)
  with csteps sq≤p C⟦p⟧=C⟦p⟧c C⟦q⟧=C⟦q⟧c
... | sucnsp≰sp₁ = s≤′s (s≤′s (s≤′s sucnsp≰sp₁))
csteps sq≤p (dcvar{p} C⟦p⟧=C⟦p⟧c) (dcvar{q} C⟦q⟧=C⟦q⟧c)
  with csteps sq≤p C⟦p⟧=C⟦p⟧c C⟦q⟧=C⟦q⟧c
... | sucnsp≰sp₁ = s≤′s (s≤′s sucnsp≰sp₁)
csteps sq≤p (dcif₁{pp}{pr}{pq} C⟦p⟧=C⟦p⟧c) (dcif₁{qp}{qr}{qq} C⟦q⟧=C⟦q⟧c)
  with csteps sq≤p C⟦p⟧=C⟦p⟧c C⟦q⟧=C⟦q⟧c
... | sucnsp≰sp₁ = arith2 ∥ qp ∥s  ∥ pp ∥s  ∥ pq ∥s  sucnsp≰sp₁
csteps sq≤p (dcif₂{pp}{pr}{pq} C⟦p⟧=C⟦p⟧c) (dcif₂{qp}{qr}{qq} C⟦q⟧=C⟦q⟧c)
  with csteps sq≤p C⟦p⟧=C⟦p⟧c C⟦q⟧=C⟦q⟧c
... | sucnsp≰sp₁ = arith1 ∥ pp ∥s  ∥ qq ∥s  ∥ pq ∥s sucnsp≰sp₁
csteps sq≤p (dcenv{p = p1}{θ = θ} C⟦p⟧=C⟦p⟧c) (dcenv{p = p2} C⟦q⟧=C⟦q⟧c)
  with csteps sq≤p C⟦p⟧=C⟦p⟧c C⟦q⟧=C⟦q⟧c
... | sucnsp≰sp₁ = arith3  ∥ p2 ∥s  ∥ p1 ∥s (numstepsθ θ) sucnsp≰sp₁

noetherian : ∀ {p q} ->
  p sn⟶ q ->
  (suc (∥ q ∥s)) ≤′ (∥ p ∥s)
noetherian (rcontext C dc pinsn⟶₁qin) =
  csteps (noetherian₁ pinsn⟶₁qin) dc Crefl


module lob--2015-06-14--III where

data ℕ : Set where
  zero : ℕ
  suc  : ℕ → ℕ

{-# BUILTIN NATURAL ℕ    #-}

record Σ {X : Set} (F : X → Set) : Set where
  constructor _,_
  field fst : X
        snd : F fst

data ⊤ : Set where
  unit : ⊤

data Tree (X : Set) : Set where
  br : Tree X → Tree X → Tree X
  leaf : X → Tree X

indtree : {X : Set} → (P : Tree X → Set)
        → ((s t : Tree X) → P s → P t → P (br s t))
        → ((x : X) → P (leaf x))
        → (t : Tree X) → P t
indtree P b l (br s t) = b s t (indtree P b l s) (indtree P b l t)
indtree P b l (leaf x) = l x

data Preterm : Set where
  type : ℕ → Preterm
  pi : Preterm → Preterm → Preterm
  sig : Preterm → Preterm → Preterm
  bot : Preterm
  top : Preterm
  unit : Preterm
  var : ℕ → Preterm
  lam : Preterm → Preterm → Preterm
  app : Preterm → Preterm → Preterm
  tree : Preterm → Preterm
  br : Preterm → Preterm → Preterm → Preterm
  leaf : Preterm → Preterm → Preterm
  ind : Preterm → Preterm → Preterm → Preterm → Preterm → Preterm

‘λ→’ = lam

data _::_ : Preterm → Preterm → Set where
  ::type : (ℓ : ℕ) → type ℓ :: type (suc ℓ)
  -- ...

□ : Preterm → Set
□ T = Σ \(t : Preterm) → t :: T

num : ℕ → Preterm
num 0 = leaf top unit
num (suc n) = br top unit (num n)

data List (X : Set) : Set where
  nil : List X
  _,_ : X → List X → List X

infixr 1 _,_

list : List Preterm → Preterm
list nil = leaf top unit
list (x , xs) = br top x (list xs)

cons : ℕ → List Preterm → Preterm
cons n xs = br top (num n) (list xs)

‘type’ : Preterm → Preterm
‘type’ n = cons 0 (n , nil)

‘pi’ : Preterm → Preterm → Preterm
‘pi’ x f = cons 1 (x , f , nil)

‘sig’ : Preterm → Preterm → Preterm
‘sig’ x f = cons 2 (x , f , nil)

‘bot’ : Preterm
‘bot’ = cons 3 nil

‘top’ : Preterm
‘top’ = cons 4 nil

‘unit’ : Preterm
‘unit’ = cons 5 nil

‘var’ : Preterm → Preterm
‘var’ n = cons 6 (n , nil)

‘lam’ : Preterm → Preterm → Preterm
‘lam’ t b = cons 7 (t , b , nil)

‘app’ : Preterm → Preterm → Preterm
‘app’ f x = cons 8 (f , x , nil)

‘tree’ : Preterm → Preterm
‘tree’ x = cons 9 (x , nil)

‘br’ : Preterm → Preterm → Preterm → Preterm
‘br’ x l r = cons 10 (x , l , r , nil)

‘leaf’ : Preterm → Preterm → Preterm
‘leaf’ x y = cons 11 (x , y , nil)

‘ind’ : Preterm → Preterm → Preterm → Preterm → Preterm → Preterm
‘ind’ x p b l t = cons 12 (x , p , b , l , t , nil)

‘Preterm’ : Preterm
‘Preterm’ = tree top

‘Preterm’::type₀ : ‘Preterm’ :: type 0
‘Preterm’::type₀ = {!!}

‘□’ : Preterm
‘□’ = {!!}

_‘→’_ : Preterm → Preterm → Preterm
A ‘→’ B = pi A {!!}

quot : Preterm → Preterm
quot (type n) = ‘type’ (num n)
quot (pi x f) = ‘pi’ (quot x) (quot f)
quot (sig x f) = ‘sig’ (quot x) (quot f)
quot bot = ‘bot’
quot top = ‘top’
quot unit = ‘unit’
quot (var n) = ‘var’ (num n)
quot (lam x b) = ‘lam’ (quot x) (quot b)
quot (app f x) = ‘app’ (quot f) (quot x)
quot (tree x) = ‘tree’ (quot x)
quot (br x l r) = ‘br’ (quot x) (quot l) (quot r)
quot (leaf x y) = ‘leaf’ (quot x) (quot y)
quot (ind x p b l t) = ‘ind’ (quot x) (quot p) (quot b) (quot l) (quot t)

‘quot’ : Preterm
‘quot’ = {!!}

‘‘→’’ : Preterm
‘‘→’’ = {!!}

⌜_⌝ = quot

_‘’_ = app

infixl 1 _‘’_

postulate
  X        : Set
  ‘X’       : Preterm
  ‘X’::type₀ : ‘X’ :: type 0

App : {‘A’ ‘B’ : Preterm}
      → □ (‘A’ ‘→’ ‘B’)
      → □ ‘A’
      → □ ‘B’
App □‘A→B’ □‘A’ = {!!}

‘App’ : Preterm
‘App’ = {!!}

Quot : {‘T’ : Preterm}
       → □ ‘T’
       → □ (‘□’ ‘’ ⌜ ‘T’ ⌝)
Quot □T = {!!}

‘Quot’ : Preterm
‘Quot’ = {!!}

‘L₀’ : Preterm
‘L₀’ = (‘λ→’ ‘Preterm’ ((‘app’ ⌜ ‘□’ ⌝ (‘app’ (var 0) (‘quot’ ‘’ (var 0)))) ‘’ ‘‘→’’ ‘’ ⌜ ‘X’ ⌝ ))

L : Preterm
L = (λ (h : Preterm) → (app ‘□’ (app h (⌜ h ⌝))) ‘→’ ‘X’) ‘L₀’

‘L’ = app ‘L₀’ ⌜ ‘L₀’ ⌝

Conv : □ (‘□’ ‘’ ⌜ L ⌝) → □ (‘□’ ‘’ ‘L’)
Conv = {!!}

‘Conv’ : Preterm
‘Conv’ = {!!}

postulate
  f    : □ ‘X’ → X
  ‘f’  : Preterm
  d‘f’ : ‘f’ :: (app ‘□’ (quot ‘X’) ‘→’ ‘X’)

y : X
y = (λ (ℓ : □ L) → f (App ℓ (Conv (Quot ℓ))))
      ( ‘λ→’ (‘□’ ‘’ ‘L’) (‘f’ ‘’ (‘App’ ‘’ (var 0) ‘’ (‘Conv’ ‘’ (‘Quot’ ‘’ var 0))))
      , {!!})


------------------------------------------------------------------------
-- The Agda standard library
--
-- Core definitions for Functions
------------------------------------------------------------------------

-- The contents of this file should usually be accessed from `Function`.

{-# OPTIONS --without-K --safe #-}

module Function.Core where

------------------------------------------------------------------------
-- Types

Fun₁ : ∀ {a} → Set a → Set a
Fun₁ A = A → A

Fun₂ : ∀ {a} → Set a → Set a
Fun₂ A = A → A → A


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

module Music where

open import Data.Nat     using (ℕ; zero; suc; _+_; _*_)
open import Data.Integer using (ℤ; +_)
open import Data.List    using (List; foldr; []; _∷_; reverse)
open import Data.Product using (_×_; _,_)
open import Data.Vec     using (Vec; []; _∷_; replicate; concat; map; zipWith; toList; _++_; sum; foldr₁)
open import Function     using (_∘_)

open import Note
open import Pitch
open import Interval

-- A point in the music grid, which can either be a tone,
-- a continuation of a previous tone, or a rest.
data Point : Set where
  tone : Pitch → Point
  hold : Pitch → Point
  rest : Point

data Melody (n : ℕ) : Set where
  melody : Vec Point n → Melody n

unmelody : {n : ℕ} → Melody n → Vec Point n
unmelody (melody ps) = ps

note→melody : (n : Note) → Melody (noteDuration n)
note→melody (tone (duration zero)    p) = melody []
note→melody (tone (duration (suc d)) p) = melody (tone p ∷ replicate (hold p))
note→melody (rest _)                    = melody (replicate rest)

-- Assumes melody is well-formed in that a held note has the
-- same pitch as the note before it.
-- Does not consolidate rests.
melody→notes : {n : ℕ} → Melody n → List Note
melody→notes (melody m) = (reverse ∘ mn 0 ∘ reverse ∘ toList) m
  where mn : ℕ → List Point → List Note -- c is the number of held points
        mn c []            = []
        mn c (tone p ∷ ps) = tone (duration (suc c)) p ∷ mn 0 ps
        mn c (hold _ ∷ ps) = mn (suc c) ps
        mn c (rest ∷ ps)   = rest (duration 1) ∷ mn 0 ps

pitches→melody : {n : ℕ} → (d : Duration) → (ps : Vec Pitch n) → Melody (n * unduration d)
pitches→melody d ps = melody (concat (map (unmelody ∘ note→melody ∘ tone d) ps))

transposePoint : ℤ → Point → Point
transposePoint k (tone p) = tone (transposePitch k p)
transposePoint k (hold p) = hold (transposePitch k p)
transposePoint k rest     = rest

transposeMelody : {n : ℕ} → ℤ → Melody n → Melody n
transposeMelody k = melody ∘ map (transposePoint k) ∘ unmelody

data Chord (n : ℕ) : Set where
  chord : Vec Point n → Chord n

unchord : {n : ℕ} → Chord n → Vec Point n
unchord (chord ps) = ps

-- We represent music as a v × d grid where v is the number of voices and d is the duration.
-- The primary representation is as parallel melodies (counterpoint).
data Counterpoint (v : ℕ) (d : ℕ): Set where
  cp : Vec (Melody d) v → Counterpoint v d

uncp : {v d : ℕ} → Counterpoint v d → Vec (Melody d) v
uncp (cp m) = m

-- An alternative representation of music is as a series of chords (harmonic progression).
data Harmony (v : ℕ) (d : ℕ): Set where
  harmony : Vec (Chord v) d → Harmony v d

unharmony : {v d : ℕ} → Harmony v d → Vec (Chord v) d
unharmony (harmony h) = h

pitches→harmony : {n : ℕ} (d : Duration) → (ps : Vec Pitch n) → Harmony n (unduration d)
pitches→harmony (duration zero)    ps = harmony []
pitches→harmony (duration (suc d)) ps = harmony (chord (map tone ps) ∷ replicate (chord (map hold ps)))

pitchPair→Harmony : (d : Duration) → PitchPair → Harmony 2 (unduration d)
pitchPair→Harmony d (p , q) = pitches→harmony d (p ∷ q ∷ [])

pitchInterval→Harmony : (d : Duration) → PitchInterval → Harmony 2 (unduration d)
pitchInterval→Harmony d = pitchPair→Harmony d ∘ pitchIntervalToPitchPair

{-
pitchIntervalsToCounterpoint : PitchInterval → Counterpoint
pitchIntervalsToCounterpoint = pitchPairToCounterpoint ∘ pitchIntervalToPitchPair
-}

addEmptyVoice : {v d : ℕ} → Harmony v d → Harmony (suc v) d
addEmptyVoice (harmony h) = harmony (map (chord ∘ (rest ∷_) ∘ unchord) h)

infixl 5 _+H+_
_+H+_ : {v d d' : ℕ} → Harmony v d → Harmony v d' → Harmony v (d + d')
h +H+ h' = harmony (unharmony h ++ unharmony h')

foldIntoHarmony : {k n : ℕ} (ds : Vec Duration (suc k)) → (pss : Vec (Vec Pitch n) (suc k)) → Harmony n (foldr₁ _+_ (map unduration ds))
foldIntoHarmony (d ∷ [])      (ps ∷ [])        = pitches→harmony d ps
foldIntoHarmony (d ∷ d' ∷ ds) (ps ∷ ps' ∷ pss) = (pitches→harmony d ps) +H+ (foldIntoHarmony (d' ∷ ds) (ps' ∷ pss))

-- matrix transposition
mtranspose : {A : Set}{m n : ℕ} → Vec (Vec A n) m → Vec (Vec A m) n
mtranspose []         = replicate []
mtranspose (xs ∷ xss) = zipWith _∷_ xs (mtranspose xss)

counterpoint→harmony : {v d : ℕ} → Counterpoint v d → Harmony v d
counterpoint→harmony = harmony ∘ map chord ∘ mtranspose ∘ map unmelody ∘ uncp

harmony→counterpoint : {v d : ℕ} → Harmony v d → Counterpoint v d
harmony→counterpoint = cp ∘ map melody ∘ mtranspose ∘ map unchord ∘ unharmony


{- Byzantine Fault Tolerant Consensus Verification in Agda, version 0.9.

   Copyright (c) 2020, 2021, Oracle and/or its affiliates.
   Licensed under the Universal Permissive License v 1.0 as shown at https://opensource.oracle.com/licenses/upl
-}

module Haskell.Modules.Either where

open import Data.Bool using (Bool; true; false; not)
import      Data.Sum  as DS renaming ([_,_] to either)
open import Function  using (_∘_)
open import Level           renaming (_⊔_ to _ℓ⊔_)

Either : ∀ {a b} → Set a → Set b → Set (a ℓ⊔ b)
Either A B = A DS.⊎ B
pattern Left  x = DS.inj₁ x
pattern Right x = DS.inj₂ x

either = DS.either

isLeft : ∀ {a b} {A : Set a} {B : Set b} → Either A B → Bool
isLeft (Left _)  = true
isLeft (Right _) = false

isRight : ∀ {a b} {A : Set a} {B : Set b} → Either A B → Bool
isRight = not ∘ isLeft


{-# OPTIONS --safe #-}

module Definition.Conversion.FullReduction where

open import Definition.Untyped as U hiding (wk)
open import Definition.Untyped.Properties
open import Definition.Typed
open import Definition.Typed.Properties
open import Definition.Typed.EqRelInstance
open import Definition.Typed.Weakening
open import Definition.Conversion
open import Definition.Conversion.Whnf
open import Definition.Conversion.Stability
open import Definition.Typed.Consequences.Inversion
open import Definition.Typed.Consequences.Injectivity
open import Definition.Typed.Consequences.Syntactic
open import Definition.Typed.Consequences.NeTypeEq
open import Definition.Typed.Consequences.Equality
open import Definition.Typed.Consequences.RelevanceUnicity
open import Definition.LogicalRelation
open import Definition.LogicalRelation.Properties.Escape
open import Definition.LogicalRelation.Irrelevance
open import Definition.LogicalRelation.ShapeView
open import Definition.LogicalRelation.Fundamental.Reducibility
open import Definition.Typed.Consequences.TypeUnicity

open import Tools.Empty using (⊥; ⊥-elim)
open import Tools.Product
import Tools.PropositionalEquality as PE

mutual
  data NfNeutral (Γ : Con Term) : Term → Set where
    var     : ∀ n                     → NfNeutral Γ (var n)
    ∘ₙ      : ∀ {k u l}     → NfNeutral Γ  k → Nf Γ u → NfNeutral Γ  (k ∘ u ^ l)
    natrecₙ : ∀ {l C c g k} →  Nf (Γ ∙ ℕ ^ [ ! , ι ⁰ ]) C → Nf Γ c → Nf Γ g → NfNeutral Γ  k → NfNeutral Γ  (natrec l C c g k)
    Idₙ : ∀ {A t u} → NfNeutral Γ  A → Nf Γ t → Nf Γ u → NfNeutral Γ  (Id A t u)
    Idℕₙ : ∀ {t u} → NfNeutral Γ  t → Nf Γ u → NfNeutral Γ  (Id ℕ t u)
    Idℕ0ₙ : ∀ {u} → NfNeutral Γ  u → NfNeutral Γ  (Id ℕ zero u)
    IdℕSₙ : ∀ {t u} → Nf Γ t → NfNeutral Γ  u → NfNeutral Γ  (Id ℕ (suc t) u)
    IdUₙ : ∀ {t u l} → NfNeutral Γ  t → Nf Γ u → NfNeutral Γ  (Id (U l) t u)
    IdUℕₙ : ∀ {u l} → NfNeutral Γ  u → NfNeutral Γ  (Id (U l) ℕ u)
    IdUΠₙ : ∀ {A rA lA B lB l u} → Nf Γ A → Nf (Γ ∙ A ^ [ rA , ι lA ]) B → NfNeutral Γ  u
                                 → NfNeutral Γ  (Id (U l) (Π A ^ rA ° lA ▹ B ° lB ° l) u)
    castₙ : ∀ {l A B e t} → NfNeutral Γ  A → Nf Γ B → Nf Γ t → NfNeutral Γ  (cast l A B e t)
    castℕₙ : ∀ {l B e t} → NfNeutral Γ  B → Nf Γ t → NfNeutral Γ  (cast l ℕ B e t)
    castΠₙ : ∀ {l A rA lA P lP B e t} → Nf Γ A → Nf (Γ ∙ A ^ [ rA , ι lA ]) P → NfNeutral Γ  B → Nf Γ t
                                      → NfNeutral Γ (cast l (Π A ^ rA ° lA ▹ P ° lP ° l) B e t)
    castℕℕₙ : ∀ {l e t} → NfNeutral Γ  t → NfNeutral Γ  (cast l ℕ ℕ e t)
    castℕΠₙ : ∀ {l A rA B e t} → Nf Γ A → Nf (Γ ∙ A ^ [ rA , ι ⁰ ]) B → Nf Γ t → NfNeutral Γ  (cast l ℕ (Π A ^ rA ° ⁰ ▹ B ° ⁰ ° l) e t)
    castΠℕₙ : ∀ {l A rA B e t} → Nf Γ A → Nf (Γ ∙ A ^ [ rA , ι ⁰ ]) B → Nf Γ t → NfNeutral Γ  (cast l (Π A ^ rA ° ⁰ ▹ B ° ⁰ ° l) ℕ e t)
    castΠΠ%!ₙ : ∀ {l A B A' B' e t} → Nf Γ A → Nf (Γ ∙ A ^ [ % , ι ⁰ ]) B → Nf Γ A' → Nf (Γ ∙ A' ^ [ ! , ι ⁰ ]) B' → Nf Γ t
                                    → NfNeutral Γ  (cast l (Π A ^ % ° ⁰ ▹ B ° ⁰ ° l) (Π A' ^ ! ° ⁰ ▹ B' ° ⁰ ° l) e t)
    castΠΠ!%ₙ : ∀ {l A B A' B' e t} → Nf Γ A → Nf (Γ ∙ A ^ [ ! , ι ⁰ ]) B → Nf Γ A' → Nf (Γ ∙ A' ^ [ % , ι ⁰ ]) B' → Nf Γ t
                                    → NfNeutral Γ  (cast l (Π A ^ ! ° ⁰ ▹ B ° ⁰ ° l) (Π A' ^ % ° ⁰ ▹ B' ° ⁰ ° l) e t)
    Emptyrecₙ : ∀ {l lEmpty A e} → Nf Γ A → NfNeutral Γ  (Emptyrec l lEmpty A e)

  data Nf (Γ : Con Term) : Term → Set where

    Uₙ    : ∀ {r l} → Nf Γ (Univ r l)
    Πₙ    : ∀ {A r lA B lB l} → Nf Γ A → Nf (Γ ∙ A ^ [ r , ι lA ]) B → Nf Γ (Π A ^ r ° lA ▹ B ° lB ° l)
    ∃ₙ    : ∀ {l A B} → Γ ⊢ A ^ [ % , ι l ] → Nf Γ A → Nf (Γ ∙ A ^ [ % , ι l ]) B → Nf Γ (∃ A ▹ B)
    ℕₙ    : Nf Γ ℕ
    Emptyₙ : ∀ {l} → Nf Γ (Empty l)

    lamₙ  : ∀ {A l rF lF t} → Γ ⊢ A ^ [ rF , ι lF ] → Nf (Γ ∙ A ^ [ rF , ι lF ]) t → Nf Γ (lam A ▹ t ^ l)
    zeroₙ : Nf Γ zero
    sucₙ  : ∀ {t} → Nf Γ t → Nf Γ (suc t)

    ne   : ∀ {n} → NfNeutral Γ  n → Nf Γ n
    sprop   : ∀ {t A l} → Γ ⊢ t ∷ A ^ [ % , l ] → Nf Γ t

NfNeutralNeutral :  ∀ {t Γ} → NfNeutral Γ t → Neutral t
NfNeutralNeutral (var n) = var n
NfNeutralNeutral (∘ₙ X x) = ∘ₙ (NfNeutralNeutral X)
NfNeutralNeutral (natrecₙ x x₁ x₂ X) = natrecₙ (NfNeutralNeutral X)
NfNeutralNeutral (Idₙ X x x₁) = Idₙ (NfNeutralNeutral X)
NfNeutralNeutral (Idℕₙ X x) = Idℕₙ (NfNeutralNeutral X)
NfNeutralNeutral (Idℕ0ₙ X) = Idℕ0ₙ (NfNeutralNeutral X)
NfNeutralNeutral (IdℕSₙ x X) = IdℕSₙ (NfNeutralNeutral X)
NfNeutralNeutral (IdUₙ X x) = IdUₙ (NfNeutralNeutral X)
NfNeutralNeutral (IdUℕₙ X) = IdUℕₙ (NfNeutralNeutral X)
NfNeutralNeutral (IdUΠₙ x x₁ X) = IdUΠₙ (NfNeutralNeutral X)
NfNeutralNeutral (castₙ X x x₁) = castₙ (NfNeutralNeutral X)
NfNeutralNeutral (castℕₙ X x) = castℕₙ (NfNeutralNeutral X)
NfNeutralNeutral (castΠₙ x x₁ X x₂) = castΠₙ (NfNeutralNeutral X)
NfNeutralNeutral (castℕℕₙ X) = castℕℕₙ (NfNeutralNeutral X)
NfNeutralNeutral (castℕΠₙ x x₁ x₂) = castℕΠₙ
NfNeutralNeutral (castΠℕₙ x x₁ x₂) = castΠℕₙ
NfNeutralNeutral (castΠΠ%!ₙ x x₁ x₂ x₃ x₄) = castΠΠ%!ₙ
NfNeutralNeutral (castΠΠ!%ₙ x x₁ x₂ x₃ x₄) = castΠΠ!%ₙ
NfNeutralNeutral (Emptyrecₙ x) = Emptyrecₙ

NfWhnf :  ∀ {Γ t A l} → Γ ⊢ t ∷ A ^ [ ! , l ] → Nf Γ t → Whnf t
NfWhnf ⊢t Uₙ = Uₙ
NfWhnf ⊢t (Πₙ X X₁) = Πₙ
NfWhnf ⊢t (∃ₙ _ X X₁) = ∃ₙ
NfWhnf ⊢t ℕₙ = ℕₙ
NfWhnf ⊢t Emptyₙ = Emptyₙ
NfWhnf ⊢t (lamₙ _ X) = lamₙ
NfWhnf ⊢t zeroₙ = zeroₙ
NfWhnf ⊢t (sucₙ X) = sucₙ
NfWhnf ⊢t (ne x) = ne (NfNeutralNeutral x)
NfWhnf ⊢t (sprop ⊢t') = let !≡% , _  = type-uniq ⊢t ⊢t' in ⊥-elim (!≢% !≡%)

NfΠinversion :  ∀ {F G rF lF lG lΠ Γ} → Nf Γ (Π F ^ rF ° lF ▹ G ° lG ° lΠ ) → Nf Γ F × Nf (Γ ∙ F ^ [ rF , ι lF ]) G
NfΠinversion (Πₙ X Y) = X , Y
NfΠinversion (sprop ⊢t) =
  let _ , _ , _ , _ , _ , _ , e = inversion-Π ⊢t
      %≡! , _ = typelevel-injectivity e
  in ⊥-elim (!≢% (PE.sym %≡!))

NfΠA′ : ∀ {A F G rF lF lG lΠ Γ l} ([Π] : Γ ⊩⟨ l ⟩Π Π F ^ rF ° lF ▹ G ° lG ° lΠ ^[ ! , lΠ ] )
    → Γ ⊩⟨ l ⟩ Π F ^ rF ° lF ▹ G ° lG ° lΠ ≡ A ^ [ ! ,  ι lΠ ] / (Π-intr [Π])
    → Nf Γ A
    → ∃₂ λ H E → Nf Γ H × Nf (Γ ∙ H ^ [ rF , ι lF ]) E × A PE.≡ Π H ^ rF ° lF ▹ E ° lG ° lΠ
NfΠA′ (noemb (Πᵣ rF′ lF′ lG′ lF≤ lG≤  F G D ⊢F ⊢G A≡A [F] [G] G-ext)) (Π₌ F′ G′ D′ A≡B [F≡F′] [G≡G′]) nfA =
    let _ , rF≡rF′ , lF≡lF′ , _ , lG≡lG′ , _ = Π-PE-injectivity (whnfRed* (red D) Πₙ)
        X = whnfRed* D′ (NfWhnf (un-univ (redFirst* D′)) nfA)
        NfH , NfE =  NfΠinversion (PE.subst (Nf _) X nfA)
    in F′ , G′ , NfH , PE.subst₂ (λ r l →  Nf (_ ∙ _ ^ [ r , ι l ]) _) (PE.sym rF≡rF′) (PE.sym lF≡lF′) NfE ,
       PE.subst (λ r → _ PE.≡ Π _ ^ r ° _ ▹ _ ° _ ° _) (PE.sym rF≡rF′)
         (PE.subst (λ l → _ PE.≡ Π _ ^ _ ° l ▹ _ ° _ ° _) (PE.sym lF≡lF′)
           (PE.subst (λ l → _ PE.≡ Π _ ^ _ ° _ ▹ _ ° l ° _) (PE.sym lG≡lG′) X))
NfΠA′ (emb emb< [Π]) [Π≡A] nfA = NfΠA′ [Π] [Π≡A] nfA
NfΠA′ (emb ∞< [Π]) [Π≡A] nfA = NfΠA′ [Π] [Π≡A] nfA

NfΠA : ∀ {A F G rF lF lG lΠ Γ}
    → Γ ⊢ Π F ^ rF ° lF ▹ G ° lG ° lΠ ≡ A ^ [ ! ,  ι lΠ ]
    → Nf Γ A
    → ∃₂ λ H E → Nf Γ H × Nf (Γ ∙ H ^ [ rF , ι lF ]) E × A PE.≡ Π H ^ rF ° lF ▹ E ° lG ° lΠ
NfΠA {A} Π≡A whnfA  =
  let X = reducibleEq Π≡A
      [Π] = proj₁ X
      [A] = proj₁ (proj₂ X)
      [Π≡A] = proj₂ (proj₂ X)
  in NfΠA′ (Π-elim [Π]) (irrelevanceEq [Π] (Π-intr (Π-elim [Π])) [Π≡A]) whnfA

mutual

  convNfNeutral :  ∀ {Γ Δ t A r} → ⊢ Γ ≡ Δ → Γ ⊢ t ∷ A ^ r → NfNeutral Γ t → NfNeutral Δ t
  convNfNeutral Γ≡Δ ⊢t (var n) = var n
  convNfNeutral Γ≡Δ ⊢t (∘ₙ X x) =
    let F , rF , lF , G , lG , rG , ⊢k , ⊢u , _ , erl = inversion-app ⊢t
    in ∘ₙ (convNfNeutral Γ≡Δ ⊢k X) (convNf Γ≡Δ ⊢u x)
  convNfNeutral Γ≡Δ ⊢t (natrecₙ x x₁ x₂ X) =
    let _ , ⊢x , ⊢x₁ , ⊢x₂ , ⊢X , _ = inversion-natrec ⊢t
    in natrecₙ (convNf (Γ≡Δ ∙ refl (univ (ℕⱼ (wfTerm ⊢t)))) (un-univ ⊢x) x) (convNf Γ≡Δ ⊢x₁ x₁)
               (convNf Γ≡Δ ⊢x₂ x₂) (convNfNeutral Γ≡Δ ⊢X X)
  convNfNeutral Γ≡Δ ⊢t (Idₙ X x x₁) =
    let _ , ⊢X , ⊢x , ⊢x₁ , _ = inversion-Id ⊢t
    in Idₙ (convNfNeutral Γ≡Δ ⊢X X) (convNf Γ≡Δ ⊢x x) (convNf Γ≡Δ ⊢x₁ x₁)
  convNfNeutral Γ≡Δ ⊢t (Idℕₙ X x) =
    let _ , _ , ⊢X , ⊢x , _ = inversion-Id ⊢t
    in Idℕₙ (convNfNeutral Γ≡Δ ⊢X X) (convNf Γ≡Δ ⊢x x)
  convNfNeutral Γ≡Δ ⊢t (Idℕ0ₙ X) =
    let _ , _ , _ , ⊢X , _ = inversion-Id ⊢t
    in Idℕ0ₙ (convNfNeutral Γ≡Δ ⊢X X)
  convNfNeutral Γ≡Δ ⊢t (IdℕSₙ x X) =
    let _ , _ , ⊢x , ⊢X , _ = inversion-Id ⊢t
    in IdℕSₙ (convNf Γ≡Δ (proj₁ (inversion-suc ⊢x)) x) (convNfNeutral Γ≡Δ ⊢X X)
  convNfNeutral Γ≡Δ ⊢t (IdUₙ X x) =
    let _ , _ , ⊢X , ⊢x , _ = inversion-Id ⊢t
    in IdUₙ (convNfNeutral Γ≡Δ ⊢X X) (convNf Γ≡Δ ⊢x x)
  convNfNeutral Γ≡Δ ⊢t (IdUℕₙ X) =
    let _ , _ , _ , ⊢X , _ = inversion-Id ⊢t
    in IdUℕₙ (convNfNeutral Γ≡Δ ⊢X X)
  convNfNeutral Γ≡Δ ⊢t (IdUΠₙ x x₁ X) =
    let _ , _ , ⊢Π , ⊢X , _ = inversion-Id ⊢t
        _ , _ , _ , ⊢F , ⊢G , _ = inversion-Π ⊢Π
    in IdUΠₙ (convNf Γ≡Δ ⊢F x) (convNf (Γ≡Δ ∙ refl (univ ⊢F)) ⊢G x₁) (convNfNeutral Γ≡Δ ⊢X X)
  convNfNeutral Γ≡Δ ⊢t (castₙ X x x₁) =
    let _ , ⊢X , ⊢x , ⊢e , ⊢x₁ , _ = inversion-cast ⊢t
    in castₙ (convNfNeutral Γ≡Δ ⊢X X) (convNf Γ≡Δ ⊢x x) (convNf Γ≡Δ ⊢x₁ x₁)
  convNfNeutral Γ≡Δ ⊢t (castℕₙ X x) =
    let _ , _ , ⊢X , ⊢e , ⊢x , _ = inversion-cast ⊢t
    in castℕₙ (convNfNeutral Γ≡Δ ⊢X X) (convNf Γ≡Δ ⊢x x)
  convNfNeutral Γ≡Δ ⊢t (castΠₙ x x₁ X x₂) =
    let _ , ⊢Π , ⊢X , ⊢e , ⊢x₂ , _ = inversion-cast ⊢t
        _ , _ , _ , ⊢F , ⊢G , _ = inversion-Π ⊢Π
    in castΠₙ (convNf Γ≡Δ ⊢F x) (convNf (Γ≡Δ ∙ refl (univ ⊢F)) ⊢G x₁) (convNfNeutral Γ≡Δ ⊢X X) (convNf Γ≡Δ ⊢x₂ x₂)
  convNfNeutral Γ≡Δ ⊢t (castℕℕₙ X) =
    let _ , _ , _ , _ , ⊢X , _ = inversion-cast ⊢t
    in castℕℕₙ (convNfNeutral Γ≡Δ ⊢X X)
  convNfNeutral Γ≡Δ ⊢t (castℕΠₙ x x₁ x₂) =
    let _ , _ , ⊢Π , ⊢e , ⊢x₂ , _ = inversion-cast ⊢t
        _ , _ , _ , ⊢F , ⊢G , _ = inversion-Π ⊢Π
    in castℕΠₙ (convNf Γ≡Δ ⊢F x) (convNf (Γ≡Δ ∙ refl (univ ⊢F)) ⊢G x₁) (convNf Γ≡Δ ⊢x₂ x₂)
  convNfNeutral Γ≡Δ ⊢t (castΠℕₙ x x₁ x₂) =
    let _ , ⊢Π , _ , ⊢e , ⊢x₂ , _ = inversion-cast ⊢t
        _ , _ , _ , ⊢F , ⊢G , _ = inversion-Π ⊢Π
    in castΠℕₙ (convNf Γ≡Δ ⊢F x) (convNf (Γ≡Δ ∙ refl (univ ⊢F)) ⊢G x₁) (convNf Γ≡Δ ⊢x₂ x₂)
  convNfNeutral Γ≡Δ ⊢t (castΠΠ%!ₙ x x₁ x₂ x₃ x₄) =
    let _ , ⊢Π , ⊢Π' , ⊢e , ⊢x₄ , _ = inversion-cast ⊢t
        _ , _ , _ , ⊢F , ⊢G , _ = inversion-Π ⊢Π
        _ , _ , _ , ⊢F' , ⊢G' , _ = inversion-Π ⊢Π'
    in castΠΠ%!ₙ (convNf Γ≡Δ ⊢F x) (convNf (Γ≡Δ ∙ refl (univ ⊢F)) ⊢G x₁)
               (convNf Γ≡Δ ⊢F' x₂) (convNf (Γ≡Δ ∙ refl (univ ⊢F')) ⊢G' x₃) (convNf Γ≡Δ ⊢x₄ x₄)
  convNfNeutral Γ≡Δ ⊢t (castΠΠ!%ₙ x x₁ x₂ x₃ x₄) =
    let _ , ⊢Π , ⊢Π' , ⊢e , ⊢x₄ , _ = inversion-cast ⊢t
        _ , _ , _ , ⊢F , ⊢G , _ = inversion-Π ⊢Π
        _ , _ , _ , ⊢F' , ⊢G' , _ = inversion-Π ⊢Π'
    in castΠΠ!%ₙ (convNf Γ≡Δ ⊢F x) (convNf (Γ≡Δ ∙ refl (univ ⊢F)) ⊢G x₁)
               (convNf Γ≡Δ ⊢F' x₂) (convNf (Γ≡Δ ∙ refl (univ ⊢F')) ⊢G' x₃) (convNf Γ≡Δ ⊢x₄ x₄)
  convNfNeutral Γ≡Δ ⊢t (Emptyrecₙ x) =
    let _ , ⊢x , _ = inversion-Emptyrec ⊢t
    in Emptyrecₙ (convNf Γ≡Δ (un-univ ⊢x) x)

  convNf :  ∀ {Γ Δ t A r} → ⊢ Γ ≡ Δ → Γ ⊢ t ∷ A ^ r → Nf Γ t → Nf Δ t
  convNf Γ≡Δ ⊢t Uₙ = Uₙ
  convNf Γ≡Δ ⊢t (Πₙ X X₁) =
    let _ , _ , _ , ⊢F , ⊢G , _ = inversion-Π ⊢t
    in Πₙ (convNf Γ≡Δ ⊢F X) (convNf (Γ≡Δ ∙ refl (univ ⊢F)) ⊢G X₁)
  convNf Γ≡Δ ⊢t (∃ₙ ⊢A X X₁) =
    let l , ⊢F , ⊢G , _ , erl = inversion-∃ ⊢t
        _ , _  , erl  = type-uniq (un-univ ⊢A) ⊢F
        _ , elA = Uinjectivity erl
    in ∃ₙ (stability Γ≡Δ ⊢A) (convNf Γ≡Δ ⊢F X) (convNf (Γ≡Δ ∙ refl (⊢A))
          (PE.subst (λ l → _ ∙ _ ^ [ % , ι l ] ⊢ _ ∷ SProp l ^ [ ! , next l ]) (PE.sym elA) ⊢G) X₁)
  convNf Γ≡Δ ⊢t ℕₙ = ℕₙ
  convNf Γ≡Δ ⊢t Emptyₙ = Emptyₙ
  convNf Γ≡Δ ⊢t (lamₙ ⊢F X) =
    let rF , lF , G , rG , lG , ⊢F' , ⊢t' , _ , erl = inversion-lam ⊢t
        er , el = typelevel-injectivity erl
        _ , _  , erl  = type-uniq (un-univ ⊢F) (un-univ ⊢F')
        erF , elF = Uinjectivity erl
    in lamₙ (stability Γ≡Δ  ⊢F) (convNf (Γ≡Δ ∙ refl ⊢F)
            (PE.subst₂ (λ r l → _ ∙ _ ^ [ r , ι l ] ⊢ _ ∷ G ^ [ rG , ι lG ]) (PE.sym erF) (PE.sym elF) ⊢t')  X)
  convNf Γ≡Δ ⊢t zeroₙ = zeroₙ
  convNf Γ≡Δ ⊢t (sucₙ X) = sucₙ (convNf Γ≡Δ (proj₁ (inversion-suc ⊢t)) X )
  convNf Γ≡Δ ⊢t (ne x) = ne (convNfNeutral Γ≡Δ ⊢t x)
  convNf Γ≡Δ ⊢t (sprop x) = sprop (stabilityTerm Γ≡Δ x)

mutual
  fullRedNe : ∀ {t A l Γ} → Γ ⊢ t ~ t ↑! A ^ l → ∃ λ u → NfNeutral Γ u × Γ ⊢ t ≡ u ∷ A ^ [ ! , l ]
  fullRedNe (var-refl x _) = var _ , var _ , refl x
  fullRedNe (app-cong {rF = !} {lΠ = lΠ} t u) =
    let t′ , nfT′ , t≡t′ = fullRedNe′ t
        u′ , nfU′ , u≡u′ = fullRedTerm u
    in  (t′ ∘ u′ ^ lΠ) ,
        ∘ₙ nfT′ nfU′ ,
        app-cong t≡t′ u≡u′
  fullRedNe (app-cong {t = a} {rF = %} {lΠ = lΠ} t (%~↑ ⊢a ⊢a')) =
    let t′ , nfT′ , t≡t′ = fullRedNe′ t
    in  (t′ ∘ a ^ lΠ) ,
        ∘ₙ nfT′ (sprop ⊢a) ,
        app-cong t≡t′ (proof-irrelevance ⊢a ⊢a')
  fullRedNe (natrec-cong {lF = l} C z s n) =
    let C′ , nfC′ , C≡C′ = fullRed C
        z′ , nfZ′ , z≡z′ = fullRedTerm z
        s′ , nfS′ , s≡s′ = fullRedTerm s
        n′ , nfN′ , n≡n′ = fullRedNe′ n
    in  natrec l C′ z′ s′ n′
     , natrecₙ nfC′ nfZ′ nfS′ nfN′
     ,  natrec-cong C≡C′ z≡z′ s≡s′ n≡n′
  fullRedNe (Emptyrec-cong {k = k} {ll = l} {lEmpty = lEmpty} C (%~↑ ⊢e ⊢e')) =
    let C′ , nfC′ , C≡C′ = fullRed C
    in  Emptyrec l lEmpty C′ k , Emptyrecₙ nfC′
     ,  Emptyrec-cong C≡C′ ⊢e ⊢e'
  fullRedNe (Id-cong A t u) =
    let A′ , nfA′ , A≡A′ = fullRedNe′ A
        t′ , nfT′ , t≡t′ = fullRedTerm t
        u′ , nfU′ , u≡u′ = fullRedTerm u
    in Id A′ t′ u′ , Idₙ nfA′ nfT′ nfU′ , Id-cong A≡A′ t≡t′ u≡u′
  fullRedNe (Id-ℕ t u) =
    let t′ , nfT′ , t≡t′ = fullRedNe′ t
        u′ , nfU′ , u≡u′ = fullRedTerm u
    in Id ℕ t′ u′ , Idℕₙ  nfT′ nfU′ , Id-cong (refl (ℕⱼ (wfEqTerm u≡u′))) t≡t′ u≡u′
  fullRedNe (Id-ℕ0 t) =
    let t′ , nfT′ , t≡t′ = fullRedNe′ t
    in Id ℕ zero t′ , Idℕ0ₙ  nfT′ , Id-cong (refl (ℕⱼ (wfEqTerm t≡t′))) (refl (zeroⱼ (wfEqTerm t≡t′))) t≡t′
  fullRedNe (Id-ℕS t u) =
    let t′ , nfT′ , t≡t′ = fullRedTerm t
        u′ , nfU′ , u≡u′ = fullRedNe′ u
    in Id ℕ (suc t′) u′ , IdℕSₙ nfT′ nfU′ , Id-cong (refl (ℕⱼ (wfEqTerm u≡u′))) (suc-cong t≡t′) u≡u′
  fullRedNe (Id-U t u) =
    let t′ , nfT′ , t≡t′ = fullRedNe′ t
        u′ , nfU′ , u≡u′ = fullRedTerm u
    in Id (U _) t′ u′ , IdUₙ nfT′ nfU′ , Id-cong (refl (univ 0<1 (wfEqTerm u≡u′))) t≡t′ u≡u′
  fullRedNe (Id-Uℕ t) =
    let t′ , nfT′ , t≡t′ = fullRedNe′ t
    in Id (U _) ℕ t′ , IdUℕₙ nfT′ , Id-cong (refl (univ 0<1 (wfEqTerm t≡t′))) (refl (ℕⱼ (wfEqTerm t≡t′))) t≡t′
  fullRedNe (Id-UΠ {rA = rA} A t) =
    let t′ , nfT′ , t≡t′ = fullRedNe′ t
        A′ , nfA′ , A≡A′ = fullRedTerm A
        H , E , NfH , NfE , Π≡HE = NfΠA (univ A≡A′) nfA′
    in Id (U _) (Π H ^ rA ° ⁰ ▹ E ° ⁰ ° ⁰) t′ ,
       IdUΠₙ NfH NfE nfT′ ,
       Id-cong (refl (univ 0<1 (wfEqTerm t≡t′))) (PE.subst (λ A → _ ⊢ _ ≡ A ∷ U ⁰ ^ _) Π≡HE A≡A′) t≡t′
  fullRedNe (cast-cong {e = e} {e' = e'} x x₁ x₂ ⊢e ⊢e') =
    let A′ , nfA′ , A≡A′ = fullRedNe′ x
        B′ , nfB′ , B≡B′ = fullRedTerm x₁
        t′ , nft′ , t≡t′ = fullRedTerm x₂
    in cast ⁰ A′ B′ e t′ , castₙ nfA′ nfB′ nft′ ,
       cast-cong A≡A′ B≡B′ t≡t′ ⊢e (conv ⊢e (univ (Id-cong (refl (univ 0<1 (wfTerm ⊢e)) ) A≡A′ B≡B′)))
  fullRedNe (cast-ℕ {e = e} {e' = e'} x x₁ ⊢e ⊢e') =
    let A′ , nfA′ , A≡A′ = fullRedNe′ x
        t′ , nft′ , t≡t′ = fullRedTerm x₁
    in cast ⁰ _ A′ e t′ , castℕₙ nfA′ nft′ ,
       cast-cong (refl (ℕⱼ (wfTerm ⊢e)) ) A≡A′ t≡t′ ⊢e
                 (conv ⊢e (univ (Id-cong (refl (univ 0<1 (wfTerm ⊢e)) ) (refl (ℕⱼ (wfTerm ⊢e))) A≡A′)))
  fullRedNe (cast-ℕℕ {e = e} {e' = e'} x ⊢e ⊢e') =
      let t′ , nft′ , t≡t′ = fullRedNe′ x
    in cast ⁰ _ _ e t′ , castℕℕₙ nft′ ,
       cast-cong (refl (ℕⱼ (wfTerm ⊢e)) ) (refl (ℕⱼ (wfTerm ⊢e)) ) t≡t′ ⊢e ⊢e
  fullRedNe (cast-Π {e = e} {e' = e'} x x₁ x₂ ⊢e ⊢e') =
    let A′ , nfA′ , A≡A′ = fullRedTerm x
        B′ , nfB′ , B≡B′ = fullRedNe′ x₁
        t′ , nft′ , t≡t′ = fullRedTerm x₂
        H , E , NfH , NfE , Π≡HE = NfΠA (univ A≡A′) nfA′
        nfCast = castΠₙ NfH NfE nfB′ nft′
    in cast ⁰ A′ B′ e t′ , PE.subst (λ A →  NfNeutral _ (cast ⁰ A _ _ _)) (PE.sym Π≡HE) nfCast ,
       cast-cong A≡A′ B≡B′ t≡t′ ⊢e (conv ⊢e (univ (Id-cong (refl (univ 0<1 (wfTerm ⊢e)) ) A≡A′ B≡B′)))
  fullRedNe (cast-Πℕ {e = e} {e' = e'} x x₁ ⊢e ⊢e') =
    let A′ , nfA′ , A≡A′ = fullRedTerm x
        t′ , nft′ , t≡t′ = fullRedTerm x₁
        H , E , NfH , NfE , Π≡HE = NfΠA (univ A≡A′) nfA′
        nfCast = castΠℕₙ NfH NfE nft′
    in cast ⁰ A′ ℕ e t′ , PE.subst (λ A →  NfNeutral _ (cast ⁰ A _ _ _)) (PE.sym Π≡HE) nfCast ,
       cast-cong A≡A′ (refl (ℕⱼ (wfTerm ⊢e))) t≡t′ ⊢e (conv ⊢e (univ (Id-cong (refl (univ 0<1 (wfTerm ⊢e)) ) A≡A′ (refl (ℕⱼ (wfTerm ⊢e))))))
  fullRedNe (cast-ℕΠ {e = e} {e' = e'} x x₁ ⊢e ⊢e') =
    let A′ , nfA′ , A≡A′ = fullRedTerm x
        t′ , nft′ , t≡t′ = fullRedTerm x₁
        H , E , NfH , NfE , Π≡HE = NfΠA (univ A≡A′) nfA′
        nfCast = castℕΠₙ NfH NfE nft′
    in cast ⁰ ℕ A′ e t′ , PE.subst (λ A →  NfNeutral _ (cast ⁰ _ A _ _)) (PE.sym Π≡HE) nfCast ,
       cast-cong (refl (ℕⱼ (wfTerm ⊢e))) A≡A′ t≡t′ ⊢e (conv ⊢e (univ (Id-cong (refl (univ 0<1 (wfTerm ⊢e)) ) (refl (ℕⱼ (wfTerm ⊢e))) A≡A′ )))
  fullRedNe (cast-ΠΠ%! {e = e} {e' = e'} x x₁ x₂ ⊢e ⊢e') =
    let A′ , nfA′ , A≡A′ = fullRedTerm x
        B′ , nfB′ , B≡B′ = fullRedTerm x₁
        t′ , nft′ , t≡t′ = fullRedTerm x₂
        H , E , NfH , NfE , Π≡HE = NfΠA (univ A≡A′) nfA′
        H' , E' , NfH' , NfE' , Π≡HE' = NfΠA (univ B≡B′) nfB′
        nfCast = castΠΠ%!ₙ NfH NfE NfH' NfE' nft′
    in cast ⁰ A′ B′ e t′ , PE.subst₂ (λ A B →  NfNeutral _ (cast ⁰ A B _ _)) (PE.sym Π≡HE) (PE.sym Π≡HE') nfCast ,
       cast-cong A≡A′ B≡B′ t≡t′ ⊢e (conv ⊢e (univ (Id-cong (refl (univ 0<1 (wfTerm ⊢e)) ) A≡A′ B≡B′ )))
  fullRedNe (cast-ΠΠ!% {e = e} {e' = e'} x x₁ x₂ ⊢e ⊢e') =
    let A′ , nfA′ , A≡A′ = fullRedTerm x
        B′ , nfB′ , B≡B′ = fullRedTerm x₁
        t′ , nft′ , t≡t′ = fullRedTerm x₂
        H , E , NfH , NfE , Π≡HE = NfΠA (univ A≡A′) nfA′
        H' , E' , NfH' , NfE' , Π≡HE' = NfΠA (univ B≡B′) nfB′
        nfCast = castΠΠ!%ₙ NfH NfE NfH' NfE' nft′
    in cast ⁰ A′ B′ e t′ , PE.subst₂ (λ A B →  NfNeutral _ (cast ⁰ A B _ _)) (PE.sym Π≡HE) (PE.sym Π≡HE') nfCast ,
       cast-cong A≡A′ B≡B′ t≡t′ ⊢e (conv ⊢e (univ (Id-cong (refl (univ 0<1 (wfTerm ⊢e)) ) A≡A′ B≡B′ )))

  fullRedNe′ : ∀ {t A rA Γ} → Γ ⊢ t ~ t ↓! A ^ rA → ∃ λ u → NfNeutral Γ u × Γ ⊢ t ≡ u ∷ A ^ [ ! , rA ]
  fullRedNe′ ([~] A D whnfB k~l) =
    let u , nf , t≡u = fullRedNe k~l
    in u , nf , conv t≡u (subset* D)

  fullRed : ∀ {A rA Γ} → Γ ⊢ A [conv↑] A ^ rA → ∃ λ B → Nf Γ B × Γ ⊢ A ≡ B ^ rA
  fullRed ([↑] A′ B′ D D′ whnfA′ whnfB′ A′<>B′)
    rewrite whrDet* (D , whnfA′) (D′ , whnfB′) =
    let B″ , nf , B′≡B″ = fullRed′ A′<>B′
    in  B″ , nf , trans (subset* D′) B′≡B″

  fullRed′ : ∀ {A rA Γ} → Γ ⊢ A [conv↓] A ^ rA → ∃ λ B → Nf Γ B × Γ ⊢ A ≡ B ^ rA
  fullRed′ (U-refl {r = r} _ ⊢Γ) = Univ r ¹  , Uₙ , refl (Uⱼ ⊢Γ)
  fullRed′ (univ x) =
    let u , Nfu , u≡u = fullRedTerm′ x
    in u , Nfu , univ u≡u

  fullRedTerm : ∀ {t A l Γ} → Γ ⊢ t [conv↑] t ∷ A ^ l → ∃ λ u → Nf Γ u × Γ ⊢ t ≡ u ∷ A ^ [ ! , l ]
  fullRedTerm ([↑]ₜ B t′ u′ D d d′ whnfB whnft′ whnfu′ t<>u)
    rewrite whrDet*Term (d , whnft′) (d′ , whnfu′) =
    let u″ , nf , u′≡u″ = fullRedTerm′ t<>u
    in  u″ , nf , conv (trans (subset*Term d′) u′≡u″) (sym (subset* D))

  fullRedTerm′ : ∀ {t A l Γ} → Γ ⊢ t [conv↓] t ∷ A ^ l → ∃ λ u → Nf Γ u × Γ ⊢ t ≡ u ∷ A ^ [ ! , l ]
  fullRedTerm′ (U-refl {r = r} _ ⊢Γ) = Univ r ⁰ , Uₙ , refl (univ 0<1 ⊢Γ)
  fullRedTerm′ (ne A) =
    let B , nf , A≡B = fullRedNe′ A
    in  B , ne nf , A≡B
  fullRedTerm′ (ℕ-refl ⊢Γ) = ℕ , ℕₙ , refl (ℕⱼ ⊢Γ)
  fullRedTerm′ (Empty-refl PE.refl ⊢Γ) = Empty _ , Emptyₙ , refl (Emptyⱼ ⊢Γ)
  fullRedTerm′ (Π-cong {rF = rF} PE.refl PE.refl PE.refl PE.refl l< l<' ⊢F F G) =
    let F′ , nfF′ , F≡F′ = fullRedTerm F
        G′ , nfG′ , G≡G′ = fullRedTerm G
    in Π F′ ^ rF ° _ ▹ G′ ° _ ° _  , Πₙ nfF′ (convNf (reflConEq (wf ⊢F) ∙ univ F≡F′) (proj₂ (proj₂ (syntacticEqTerm G≡G′))) nfG′)
    ,  Π-cong l< l<' ⊢F F≡F′ G≡G′
  fullRedTerm′ (∃-cong PE.refl ⊢F F G) =
    let F′ , nfF′ , F≡F′ = fullRedTerm F
        G′ , nfG′ , G≡G′ = fullRedTerm G
    in ∃ F′ ▹ G′ , ∃ₙ (univ (proj₂ (proj₂ (syntacticEqTerm F≡F′)))) nfF′
         (convNf (reflConEq (wf ⊢F) ∙ univ F≡F′) (proj₂ (proj₂ (syntacticEqTerm G≡G′))) nfG′)
     , ∃-cong ⊢F F≡F′ G≡G′
  fullRedTerm′  (ℕ-ins t) =
    let u , nf , t≡u = fullRedNe′ t
    in  u , ne nf , t≡u
  fullRedTerm′ (ne-ins ⊢t _ _ t) =
    let u , nfU , t≡u = fullRedNe′ t
        _ , ⊢t∷M , _ = syntacticEqTerm t≡u
        _ , neT , _ = ne~↓! t
    in  u , ne nfU , conv t≡u (proj₂ (neTypeEq neT ⊢t∷M ⊢t))
  fullRedTerm′ (zero-refl ⊢Γ) = zero , zeroₙ , refl (zeroⱼ ⊢Γ)
  fullRedTerm′ (suc-cong t) =
    let u , nf , t≡u = fullRedTerm t
    in  suc u , sucₙ nf , suc-cong t≡u
  fullRedTerm′ (η-eq {F = F} {l = l} l< l<' ⊢F ⊢t _ _ _ t∘0) =
    let u , nf , t∘0≡u = fullRedTerm t∘0
        _ , _ , ⊢u = syntacticEqTerm t∘0≡u
        ΓF⊢ = wf ⊢F ∙ ⊢F
        wk⊢F = wk (step id) ΓF⊢ ⊢F
        ΓFF'⊢ = ΓF⊢ ∙ wk⊢F
        wk⊢u = wkTerm (lift (step id)) ΓFF'⊢ ⊢u
        λu∘0 = (lam _ ▹ (U.wk (lift (step id)) u) ^ _) ∘ var 0 ^ l
    in  lam _ ▹ u ^ _ ,
        lamₙ ⊢F nf
     ,  η-eq l< l<' ⊢F ⊢t (lamⱼ l< l<' ⊢F ⊢u)
             (trans t∘0≡u (PE.subst₂ (λ x y → _ ⊢ x ≡ λu∘0 ∷ y ^ _)
                                     (wkSingleSubstId u) (wkSingleSubstId _)
                                     (sym (β-red l< l<' wk⊢F wk⊢u (var ΓF⊢ here)))))


{-# OPTIONS --allow-unsolved-metas #-}

open import Agda.Builtin.Nat

test : (n : Nat) → Nat
test n with zero
... | n = {!n!}


open import FRP.JS.Behaviour using ( Beh ; [_] ; map )
open import FRP.JS.Event using ( Evt ; tag )
open import FRP.JS.DOM using
  ( DOM ; click ; element ; text ; _++_ ; element+ ; text+ ; listen+ ; _+++_ )
open import FRP.JS.RSet using ( RSet ; ⟦_⟧ ; ⟨_⟩ ; _⇒_ )
open import FRP.JS.Product using ( _∧_ ; _,_ )
open import FRP.JS.Demo.Calculator.Model using
  ( Button ; State ; digit ; op ; clear ; eq ; plus ; minus ; times ; button$ ; state$ ; model )

module FRP.JS.Demo.Calculator.View where

button : ∀ {w} → Button → ⟦ Beh (DOM w) ∧ Evt ⟨ Button ⟩ ⟧
button b = listen+ click (λ _ → b) (element+ "button" (text+ [ button$ b ]))

keypad : ∀ {w} → ⟦ Beh (DOM w) ∧ Evt ⟨ Button ⟩ ⟧
keypad =
  element+ "div" (button (digit 7) +++ button (digit 8)  +++ button (digit 9) ) +++
  element+ "div" (button (digit 4) +++ button (digit 5)  +++ button (digit 6) ) +++
  element+ "div" (button (digit 1) +++ button (digit 2)  +++ button (digit 3) ) +++
  element+ "div" (button (op eq)   +++ button (digit 0)  +++ button clear     ) +++
  element+ "div" (button (op plus) +++ button (op minus) +++ button (op times))

display : ∀ {w} → ⟦ Beh ⟨ State ⟩ ⇒ Beh (DOM w) ⟧
display σ = element "div" (text (map state$ σ))

view : ∀ {w} → ⟦ Beh (DOM w) ⟧
view with keypad
... | (dom , evt) = display (model evt) ++ dom


module L0E where

open import Common

-- Syntax

data Conj : Set  where
  and or : Conj

data N : Set where
  Saddie Liz Hank : N

data Vᵢ : Set where
  snores sleeps is-boring : Vᵢ

data Vₜ : Set where
  loves hates is-taller-than : Vₜ

data Neg : Set where
  it-is-not-the-case-that : Neg

data VP : Set where
  iv : Vᵢ -> VP
  tv : Vₜ -> N -> VP

data S : Set where
 sconjs : S -> Conj -> S -> S
 negs : Neg -> S -> S
 predvp : N -> VP -> S

example1 : S
example1 = predvp Saddie (iv snores)

example2 : S
example2 = predvp Liz (iv sleeps)

example3 : S
example3 = negs it-is-not-the-case-that (predvp Hank (iv snores))

example41 example42 : S
example41 = sconjs (sconjs (predvp Saddie (iv sleeps)) or (predvp Liz (iv is-boring))) and (predvp Hank (iv snores))
example42 = sconjs (predvp Saddie (iv sleeps)) or (sconjs (predvp Liz (iv is-boring)) and (predvp Hank (iv snores)))

example5 : S
example5 = negs it-is-not-the-case-that (negs it-is-not-the-case-that (predvp Saddie (iv sleeps)))

-- Semantics

data Individual : Set where
  Anwar_Sadat : Individual
  Queen_Elizabeth_II : Individual
  Henry_Kissinger : Individual

⟦_⟧N : N -> Individual
⟦ Saddie ⟧N = Anwar_Sadat
⟦ Liz ⟧N = Queen_Elizabeth_II
⟦ Hank ⟧N = Henry_Kissinger

⟦_⟧̬̬̌Vᵢ : Vᵢ -> Individual -> Bool
⟦ snores ⟧̬̬̌Vᵢ Anwar_Sadat = true
⟦ snores ⟧̬̬̌Vᵢ Queen_Elizabeth_II = true
⟦ snores ⟧̬̬̌Vᵢ Henry_Kissinger = false

⟦ sleeps ⟧̬̬̌Vᵢ Anwar_Sadat = true
⟦ sleeps ⟧̬̬̌Vᵢ Queen_Elizabeth_II = false
⟦ sleeps ⟧̬̬̌Vᵢ Henry_Kissinger = false

⟦ is-boring ⟧̬̬̌Vᵢ Anwar_Sadat = true
⟦ is-boring ⟧̬̬̌Vᵢ Queen_Elizabeth_II = true
⟦ is-boring ⟧̬̬̌Vᵢ Henry_Kissinger = true

⟦_⟧Vₜ : Vₜ -> Individual -> Individual -> Bool
⟦ loves ⟧Vₜ Anwar_Sadat _ = true
⟦ loves ⟧Vₜ Queen_Elizabeth_II Anwar_Sadat = false
⟦ loves ⟧Vₜ Queen_Elizabeth_II Queen_Elizabeth_II = true
⟦ loves ⟧Vₜ Queen_Elizabeth_II Henry_Kissinger = false
⟦ loves ⟧Vₜ Henry_Kissinger Anwar_Sadat = true
⟦ loves ⟧Vₜ Henry_Kissinger Queen_Elizabeth_II = false
⟦ loves ⟧Vₜ Henry_Kissinger Henry_Kissinger = true

⟦ hates ⟧Vₜ Anwar_Sadat _ = false
⟦ hates ⟧Vₜ Queen_Elizabeth_II Anwar_Sadat = true
⟦ hates ⟧Vₜ Queen_Elizabeth_II Queen_Elizabeth_II = false
⟦ hates ⟧Vₜ Queen_Elizabeth_II Henry_Kissinger = true
⟦ hates ⟧Vₜ Henry_Kissinger Anwar_Sadat = false
⟦ hates ⟧Vₜ Henry_Kissinger Queen_Elizabeth_II = true
⟦ hates ⟧Vₜ Henry_Kissinger Henry_Kissinger = false

⟦ is-taller-than ⟧Vₜ Anwar_Sadat Anwar_Sadat = false
⟦ is-taller-than ⟧Vₜ Anwar_Sadat Queen_Elizabeth_II = true
⟦ is-taller-than ⟧Vₜ Anwar_Sadat Henry_Kissinger = false
⟦ is-taller-than ⟧Vₜ Queen_Elizabeth_II _ = false
⟦ is-taller-than ⟧Vₜ Henry_Kissinger Anwar_Sadat = true
⟦ is-taller-than ⟧Vₜ Henry_Kissinger Queen_Elizabeth_II = true
⟦ is-taller-than ⟧Vₜ Henry_Kissinger Henry_Kissinger = false

⟦_⟧VP : VP -> Individual -> Bool
⟦ iv v ⟧VP = ⟦ v ⟧̬̬̌Vᵢ
⟦ tv v n ⟧VP = ⟦ v ⟧Vₜ ⟦ n ⟧N

⟦_⟧S : S -> Bool
⟦ sconjs x and x₂ ⟧S = ⟦ x ⟧S && ⟦ x₂ ⟧S
⟦ sconjs x or x₂ ⟧S = ⟦ x ⟧S || ⟦ x₂ ⟧S
⟦ negs x x₁ ⟧S = neg ⟦ x₁ ⟧S
⟦ predvp x x₁ ⟧S = ⟦ x₁ ⟧VP ⟦ x ⟧N


{-# OPTIONS --rewriting #-}

module Properties.FunctionTypes where

open import FFI.Data.Either using (Either; Left; Right; mapLR; swapLR; cond)
open import Luau.FunctionTypes using (srcⁿ; src; tgt)
open import Luau.Subtyping using (_<:_; _≮:_; Tree; Language; ¬Language; witness; unknown; never; scalar; function; scalar-function; scalar-function-ok; scalar-function-err; scalar-scalar; function-scalar; function-ok; function-err; left; right; _,_)
open import Luau.Type using (Type; Scalar; nil; number; string; boolean; never; unknown; _⇒_; _∪_; _∩_; skalar)
open import Properties.Contradiction using (CONTRADICTION; ¬; ⊥)
open import Properties.Functions using (_∘_)
open import Properties.Subtyping using (<:-refl; ≮:-refl; <:-trans-≮:; skalar-scalar; <:-impl-⊇; skalar-function-ok; language-comp)
open import Properties.TypeNormalization using (FunType; Normal; never; unknown; _∩_; _∪_; _⇒_; normal; <:-normalize; normalize-<:)

-- Properties of src
function-err-srcⁿ : ∀ {T t} → (FunType T) → (¬Language (srcⁿ T) t) → Language T (function-err t)
function-err-srcⁿ (S ⇒ T) p = function-err p
function-err-srcⁿ (S ∩ T) (p₁ , p₂) = (function-err-srcⁿ S p₁ , function-err-srcⁿ T p₂)

¬function-err-srcᶠ : ∀ {T t} → (FunType T) → (Language (srcⁿ T) t) → ¬Language T (function-err t)
¬function-err-srcᶠ (S ⇒ T) p = function-err p
¬function-err-srcᶠ (S ∩ T) (left p) = left (¬function-err-srcᶠ S p)
¬function-err-srcᶠ (S ∩ T) (right p) = right (¬function-err-srcᶠ T p)

¬function-err-srcⁿ : ∀ {T t} → (Normal T) → (Language (srcⁿ T) t) → ¬Language T (function-err t)
¬function-err-srcⁿ never p = never
¬function-err-srcⁿ unknown (scalar ())
¬function-err-srcⁿ (S ⇒ T) p = function-err p
¬function-err-srcⁿ (S ∩ T) (left p) = left (¬function-err-srcᶠ S p)
¬function-err-srcⁿ (S ∩ T) (right p) = right (¬function-err-srcᶠ T p)
¬function-err-srcⁿ (S ∪ T) (scalar ())

¬function-err-src : ∀ {T t} → (Language (src T) t) → ¬Language T (function-err t)
¬function-err-src {T = S ⇒ T} p = function-err p
¬function-err-src {T = nil} p = scalar-function-err nil
¬function-err-src {T = never} p = never
¬function-err-src {T = unknown} (scalar ())
¬function-err-src {T = boolean} p = scalar-function-err boolean
¬function-err-src {T = number} p = scalar-function-err number
¬function-err-src {T = string} p = scalar-function-err string
¬function-err-src {T = S ∪ T} p = <:-impl-⊇ (<:-normalize (S ∪ T)) _ (¬function-err-srcⁿ (normal (S ∪ T)) p)
¬function-err-src {T = S ∩ T} p = <:-impl-⊇ (<:-normalize (S ∩ T)) _ (¬function-err-srcⁿ (normal (S ∩ T)) p)

src-¬function-errᶠ : ∀ {T t} → (FunType T) → Language T (function-err t) → (¬Language (srcⁿ T) t)
src-¬function-errᶠ (S ⇒ T) (function-err p) = p
src-¬function-errᶠ (S ∩ T) (p₁ , p₂) = (src-¬function-errᶠ S p₁ , src-¬function-errᶠ T p₂)

src-¬function-errⁿ : ∀ {T t} → (Normal T) → Language T (function-err t) → (¬Language (srcⁿ T) t)
src-¬function-errⁿ unknown p = never
src-¬function-errⁿ (S ⇒ T) (function-err p) = p
src-¬function-errⁿ (S ∩ T) (p₁ , p₂) = (src-¬function-errᶠ S p₁ , src-¬function-errᶠ T p₂)
src-¬function-errⁿ (S ∪ T) p = never

src-¬function-err : ∀ {T t} → Language T (function-err t) → (¬Language (src T) t)
src-¬function-err {T = S ⇒ T} (function-err p) = p
src-¬function-err {T = unknown} p = never
src-¬function-err {T = S ∪ T} p = src-¬function-errⁿ (normal (S ∪ T)) (<:-normalize (S ∪ T) _ p)
src-¬function-err {T = S ∩ T} p = src-¬function-errⁿ (normal (S ∩ T)) (<:-normalize (S ∩ T) _ p)

fun-¬scalar : ∀ {S T} (s : Scalar S) → FunType T → ¬Language T (scalar s)
fun-¬scalar s (S ⇒ T) = function-scalar s
fun-¬scalar s (S ∩ T) = left (fun-¬scalar s S)

¬fun-scalar : ∀ {S T t} (s : Scalar S) → FunType T → Language T t → ¬Language S t
¬fun-scalar s (S ⇒ T) function = scalar-function s
¬fun-scalar s (S ⇒ T) (function-ok p) = scalar-function-ok s
¬fun-scalar s (S ⇒ T) (function-err p) = scalar-function-err s
¬fun-scalar s (S ∩ T) (p₁ , p₂) = ¬fun-scalar s T p₂

fun-function : ∀ {T} → FunType T → Language T function
fun-function (S ⇒ T) = function
fun-function (S ∩ T) = (fun-function S , fun-function T)

srcⁿ-¬scalar : ∀ {S T t} (s : Scalar S) → Normal T → Language T (scalar s) → (¬Language (srcⁿ T) t)
srcⁿ-¬scalar s never (scalar ())
srcⁿ-¬scalar s unknown p = never
srcⁿ-¬scalar s (S ⇒ T) (scalar ())
srcⁿ-¬scalar s (S ∩ T) (p₁ , p₂) = CONTRADICTION (language-comp (scalar s) (fun-¬scalar s S) p₁)
srcⁿ-¬scalar s (S ∪ T) p = never

src-¬scalar : ∀ {S T t} (s : Scalar S) → Language T (scalar s) → (¬Language (src T) t)
src-¬scalar {T = nil} s p = never
src-¬scalar {T = T ⇒ U} s (scalar ())
src-¬scalar {T = never} s (scalar ())
src-¬scalar {T = unknown} s p = never
src-¬scalar {T = boolean} s p = never
src-¬scalar {T = number} s p = never
src-¬scalar {T = string} s p = never
src-¬scalar {T = T ∪ U} s p = srcⁿ-¬scalar s (normal (T ∪ U)) (<:-normalize (T ∪ U) (scalar s) p)
src-¬scalar {T = T ∩ U} s p = srcⁿ-¬scalar s (normal (T ∩ U)) (<:-normalize (T ∩ U) (scalar s) p)

srcⁿ-unknown-≮: : ∀ {T U} → (Normal U) → (T ≮: srcⁿ U) → (U ≮: (T ⇒ unknown))
srcⁿ-unknown-≮: never (witness t p q) = CONTRADICTION (language-comp t q unknown)
srcⁿ-unknown-≮: unknown (witness t p q) = witness (function-err t) unknown (function-err p)
srcⁿ-unknown-≮: (U ⇒ V) (witness t p q) = witness (function-err t) (function-err q) (function-err p)
srcⁿ-unknown-≮: (U ∩ V) (witness t p q) = witness (function-err t) (function-err-srcⁿ (U ∩ V) q) (function-err p)
srcⁿ-unknown-≮: (U ∪ V) (witness t p q) = witness (scalar V) (right (scalar V)) (function-scalar V)

src-unknown-≮: : ∀ {T U} → (T ≮: src U) → (U ≮: (T ⇒ unknown))
src-unknown-≮: {U = nil} (witness t p q) = witness (scalar nil) (scalar nil) (function-scalar nil)
src-unknown-≮: {U = T ⇒ U} (witness t p q) = witness (function-err t) (function-err q) (function-err p)
src-unknown-≮: {U = never} (witness t p q) = CONTRADICTION (language-comp t q unknown)
src-unknown-≮: {U = unknown} (witness t p q) = witness (function-err t) unknown (function-err p)
src-unknown-≮: {U = boolean} (witness t p q) = witness (scalar boolean) (scalar boolean) (function-scalar boolean)
src-unknown-≮: {U = number} (witness t p q) = witness (scalar number) (scalar number) (function-scalar number)
src-unknown-≮: {U = string} (witness t p q) = witness (scalar string) (scalar string) (function-scalar string)
src-unknown-≮: {U = T ∪ U} p = <:-trans-≮: (normalize-<: (T ∪ U)) (srcⁿ-unknown-≮: (normal (T ∪ U)) p)
src-unknown-≮: {U = T ∩ U} p = <:-trans-≮: (normalize-<: (T ∩ U)) (srcⁿ-unknown-≮: (normal (T ∩ U)) p)

unknown-src-≮: : ∀ {S T U} → (U ≮: S) → (T ≮: (U ⇒ unknown)) → (U ≮: src T)
unknown-src-≮: (witness t x x₁) (witness (scalar s) p (function-scalar s)) = witness t x (src-¬scalar s p)
unknown-src-≮: r (witness (function-ok (scalar s)) p (function-ok (scalar-scalar s () q)))
unknown-src-≮: r (witness (function-ok (function-ok _)) p (function-ok (scalar-function-ok ())))
unknown-src-≮: r (witness (function-err t) p (function-err q)) = witness t q (src-¬function-err p)

-- Properties of tgt
tgt-function-ok : ∀ {T t} → (Language (tgt T) t) → Language T (function-ok t)
tgt-function-ok {T = nil} (scalar ())
tgt-function-ok {T = T₁ ⇒ T₂} p = function-ok p
tgt-function-ok {T = never} (scalar ())
tgt-function-ok {T = unknown} p = unknown
tgt-function-ok {T = boolean} (scalar ())
tgt-function-ok {T = number} (scalar ())
tgt-function-ok {T = string} (scalar ())
tgt-function-ok {T = T₁ ∪ T₂} (left p) = left (tgt-function-ok p)
tgt-function-ok {T = T₁ ∪ T₂} (right p) = right (tgt-function-ok p)
tgt-function-ok {T = T₁ ∩ T₂} (p₁ , p₂) = (tgt-function-ok p₁ , tgt-function-ok p₂)

function-ok-tgt : ∀ {T t} → Language T (function-ok t) → (Language (tgt T) t)
function-ok-tgt (function-ok p) = p
function-ok-tgt (left p) = left (function-ok-tgt p)
function-ok-tgt (right p) = right (function-ok-tgt p)
function-ok-tgt (p₁ , p₂) = (function-ok-tgt p₁ , function-ok-tgt p₂)
function-ok-tgt unknown = unknown

tgt-never-≮: : ∀ {T U} → (tgt T ≮: U) → (T ≮: (skalar ∪ (never ⇒ U)))
tgt-never-≮: (witness t p q) = witness (function-ok t) (tgt-function-ok p) (skalar-function-ok , function-ok q)

never-tgt-≮: : ∀ {T U} → (T ≮: (skalar ∪ (never ⇒ U))) → (tgt T ≮: U)
never-tgt-≮: (witness (scalar s) p (q₁ , q₂)) = CONTRADICTION (≮:-refl (witness (scalar s) (skalar-scalar s) q₁))
never-tgt-≮: (witness function p (q₁ , scalar-function ()))
never-tgt-≮: (witness (function-ok t) p (q₁ , function-ok q₂)) = witness t (function-ok-tgt p) q₂
never-tgt-≮: (witness (function-err (scalar s)) p (q₁ , function-err (scalar ())))

src-tgtᶠ-<: : ∀ {T U V} → (FunType T) → (U <: src T) → (tgt T <: V) → (T <: (U ⇒ V))
src-tgtᶠ-<: T p q (scalar s) r = CONTRADICTION (language-comp (scalar s) (fun-¬scalar s T) r)
src-tgtᶠ-<: T p q function r = function
src-tgtᶠ-<: T p q (function-ok s) r = function-ok (q s (function-ok-tgt r))
src-tgtᶠ-<: T p q (function-err s) r = function-err (<:-impl-⊇ p s (src-¬function-err r))


module Issue1760b where

-- Skipping an old-style mutual block: Somewhere within a `mutual`
-- block before a record definition.
mutual
  data D : Set where
    lam : (D → D) → D

  {-# NO_POSITIVITY_CHECK #-}
  record U : Set where
    field ap : U → U


{-# OPTIONS --without-K --safe #-}

module Data.String.Printf where

open import Data.List using (List; []; _∷_; foldr)
open import Data.String hiding (show)
open import Data.Nat hiding (_≟_)
open import Data.Char as Char using (Char)
import Level
open import Relation.Nullary

infixr 6 _%_
record FormatUnit : Set (Level.suc Level.zero) where
  constructor _%_
  field
    marker : Char
    {type} : Set
    conv   : type → String
open FormatUnit public

module Internal where
  data Formatter : Set (Level.suc Level.zero) where
    chr : Char → Formatter
    cnv : (t : Set) → (t → String) → Formatter

  formatUnitTy : Formatter → Set → Set
  formatUnitTy (chr _) xs = xs
  formatUnitTy (cnv t _) xs = t → xs

  formatTy : List Formatter → Set
  formatTy = foldr formatUnitTy String

  toFormat : List FormatUnit → List Char → List Formatter
  toFormat fs [] = []
  toFormat fs ('%' ∷ x ∷ xs) = go fs x xs where
    go : List FormatUnit → Char → List Char → List Formatter
    go [] x xs = chr x ∷ toFormat fs xs
    go (f ∷ fs) x xs with marker f Char.≟ x
    go (f ∷ _ ) x xs | yes p = cnv _ (conv f) ∷ toFormat fs xs
    go (f ∷ fs) x xs | no ¬p = go fs x xs
  toFormat fs (x ∷ xs) = chr x ∷ toFormat fs xs

  printf : (fs : List FormatUnit) → (xs : String) → formatTy (toFormat fs (toList xs))
  printf fs xs = go "" (toFormat fs (toList xs))
    where
    go : String → (xs : List Formatter) → formatTy xs
    go k [] = k
    go k (chr x ∷ xs) = go (k ++ fromList (x ∷ [])) xs
    go k (cnv _ c ∷ xs) = λ x → go (k ++ c x) xs
import Data.Nat.Show
open import Function

standard : List FormatUnit
standard = 'i' % Data.Nat.Show.show ∷ 's'% id ∷ []

module Printf (fs : List FormatUnit) where
  printf : (xs : String) → Internal.formatTy (Internal.toFormat fs (toList xs))
  printf = Internal.printf fs


-- Liang-Ting, 2022-01-14, issue #5734

{-# OPTIONS --cubical-compatible #-}

open import Agda.Builtin.Unit
open import Agda.Builtin.List
open import Agda.Builtin.Sigma
open import Agda.Builtin.Reflection
  renaming (returnTC to return; bindTC to _>>=_)
open import Agda.Primitive

private variable
  A B : Set _

reverseApp : List A → List A → List A
reverseApp []       ys = ys
reverseApp (x ∷ xs) ys = reverseApp xs (x ∷ ys)

reverse : List A → List A
reverse xs = reverseApp xs []

extend*Context : Telescope → TC A → TC A
extend*Context []              m = m
extend*Context ((s , a) ∷ tel) m = extendContext s a (extend*Context tel m)

pattern vArg x = arg (arg-info visible (modality relevant quantity-ω)) x
pattern visible-relevant-erased = arg-info visible (modality relevant quantity-0)
pattern var₀ x = var x []

Γ : Telescope
Γ =   ("ℓ" , arg visible-relevant-erased (quoteTerm Level))
    ∷ ("A" , vArg (agda-sort (set (var₀ 0))))
    ∷ []

macro
  m : Term → TC ⊤
  m hole = do
    _ ← extend*Context Γ do
      _ ← checkType (var₀ 0) (agda-sort (set (var₀ 1)))
      return tt
    inContext (reverse Γ) do
      return tt

_ : ⊤
_ = m


{-# OPTIONS --cubical-compatible --rewriting --confluence-check #-}

open import Agda.Primitive using (Level; _⊔_; Setω; lzero; lsuc)

module Issue4032 where

infix 4 _≡_

data _≡_ {ℓ : Level} {A : Set ℓ} (a : A) : A → Set ℓ where
  refl : a ≡ a

{-# BUILTIN REWRITE _≡_ #-}

run : ∀ {ℓ} {A B : Set ℓ} → A ≡ B → A → B
run refl x = x

nur : ∀ {ℓ} {A B : Set ℓ} → A ≡ B → B → A
nur refl x = x

convert : ∀ {ℓ} {A B : Set ℓ} (p : A ≡ B) (a : A) → nur p (run p a) ≡ a
convert refl a = refl

trevnoc : ∀ {ℓ} {A B : Set ℓ} (p : A ≡ B) (b : B) → run p (nur p b) ≡ b
trevnoc refl b = refl

ap : ∀ {a b} {A : Set a} {B : Set b} (f : A → B) {a₁ a₂} → a₁ ≡ a₂ → f a₁ ≡ f a₂
ap f refl = refl

transport : ∀ {a b} {A : Set a} (B : A → Set b) {x y : A} (p : x ≡ y) → B x → B y
transport B p = run (ap B p)

apD : ∀ {a b} {A : Set a} {B : A → Set b} (f : (x : A) → B x) {a₁ a₂} → (p : a₁ ≡ a₂) → transport B p (f a₁) ≡ f a₂
apD f refl = refl

ap2 : ∀ {a b c} {A : Set a} {B : A → Set b} {C : Set c} (f : (x : A) → B x → C) {a₁ a₂} (pa : a₁ ≡ a₂) {b₁ b₂} → transport B pa b₁ ≡ b₂ → f a₁ b₁ ≡ f a₂ b₂
ap2 f refl refl = refl

postulate fromIso : ∀ {ℓ} {A B : Set ℓ} (f : A → B) (g : B → A) (η : (x : A) → g (f x) ≡ x) (ε : (x : B) → f (g x) ≡ x) (τ : (x : A) → ap f (η x) ≡ ε (f x)) → A ≡ B
postulate fromIso-refl : ∀ {ℓ} {A : Set ℓ} → fromIso {ℓ} {A} {A} (λ x → x) (λ x → x) (λ x → refl) (λ x → refl) (λ x → refl) ≡ refl
{-# REWRITE fromIso-refl #-}

J : ∀ {ℓ₁ ℓ₂} {A : Set ℓ₁} {a : A} (P : (b : A) → a ≡ b → Set ℓ₂) {b : A} (p : a ≡ b) → P a refl → P b p
J R refl r = r

module foo {-ℓ₁-} {ℓ} {Γ : Set ℓ{-₁-}} {xs ys : Γ} (ps : xs ≡ ys) (tA : Γ → Set ℓ) (tB : (γ : Γ) → tA γ → Set ℓ) where
  module pf where
    iso-f : ((a : tA xs) → (tB xs) a) → ((a : tA ys) → (tB ys) a)
    iso-f var1 var0 = run (ap2 tB ps (trevnoc (ap tA ps) var0)) (var1 (nur (ap tA ps) var0))

    iso-g : ((a : tA ys) → (tB ys) a) → ((a : tA xs) → (tB xs) a)
    iso-g var1 var0 = nur (ap2 tB ps refl) (var1 (run (ap tA ps) var0))

    iso-η : (var0 : _) → iso-g (iso-f var0) ≡ var0
    iso-η var0 = J (λ ys (ps : xs ≡ ys) → (λ var1 → nur (ap2 tB ps refl) (run (ap2 tB ps (trevnoc (ap tA ps) (run (ap tA ps) var1))) (var0 (nur (ap tA ps) (run (ap tA ps) var1))))) ≡ var0) ps refl

    iso-ε : (var0 : _) → iso-f (iso-g var0) ≡ var0
    iso-ε = J (λ ys (ps : xs ≡ ys) → (var0 : (a : tA ys) → tB ys a) → (λ var1 → run (ap2 tB ps (trevnoc (ap tA ps) var1)) (nur (ap2 tB ps refl) (var0 (run (ap tA ps) (nur (ap tA ps) var1))))) ≡ var0) ps (λ var0 → refl)
    iso-τ : (var0 : _) → ap iso-f (iso-η var0) ≡ iso-ε (iso-f var0)
    iso-τ var0 = J
                   (λ ys (ps : xs ≡ ys) →
                      ap
                      (λ var1 var2 →
                         run (ap2 tB ps (trevnoc (ap tA ps) var2))
                         (var1 (nur (ap tA ps) var2)))
                      (J
                       (λ ys₁ ps₁ →
                          (λ var1 →
                             nur (ap2 tB ps₁ refl)
                             (run (ap2 tB ps₁ (trevnoc (ap tA ps₁) (run (ap tA ps₁) var1)))
                              (var0 (nur (ap tA ps₁) (run (ap tA ps₁) var1)))))
                          ≡ var0)
                       ps refl)
                      ≡
                      J
                      (λ ys₁ ps₁ →
                         (var1 : (a : tA ys₁) → tB ys₁ a) →
                         (λ var2 →
                            run (ap2 tB ps₁ (trevnoc (ap tA ps₁) var2))
                            (nur (ap2 tB ps₁ refl)
                             (var1 (run (ap tA ps₁) (nur (ap tA ps₁) var2)))))
                         ≡ var1)
                      ps (λ var1 → refl)
                      (λ var1 →
                         run (ap2 tB ps (trevnoc (ap tA ps) var1))
                         (var0 (nur (ap tA ps) var1))))
                   ps refl

  open pf

  pf : ((a : tA xs) → (tB xs) a) ≡ ((a : tA ys) → (tB ys) a)
  pf = fromIso iso-f iso-g iso-η iso-ε iso-τ

module bar {ℓ} {Γ : Set ℓ} {γ : Γ} {A : Γ → Set ℓ} {B : (γ : Γ) → A γ → Set ℓ} where
  g1 : ((a : A γ) → B γ a) → (a : A γ) → B γ a
  g2 : ((a : A γ) → B γ a) → (a : A γ) → B γ a

  g1 = foo.pf.iso-g {xs = γ} refl A B
  g2 = λ f x → f x

  pfg : g1 ≡ g2
  pfg = refl

  baz : foo.pf {xs = γ} refl A B ≡ refl
  baz = pf
    where
      pf : fromIso {_} {(x : A γ) → B γ x} (λ f x → f x) g2 (foo.pf.iso-η refl A B) (foo.pf.iso-ε refl A B) (foo.pf.iso-τ refl A B) ≡ refl
      pf = refl

{- WAS:
refl !=
fromIso (foo.pf.iso-f refl A B) (foo.pf.iso-g refl A B)
(foo.pf.iso-η refl A B) (foo.pf.iso-ε refl A B)
(foo.pf.iso-τ refl A B)
of type ((x : A γ) → B γ x) ≡ ((x : A γ) → B γ x)
when checking that the expression pf has type
foo.pf refl A B ≡ refl
-}


{-# OPTIONS --cubical --no-import-sorts #-}
module Cubical.Codata.Everything where

open import Cubical.Codata.EverythingSafe public

--- Modules making assumptions that might be incompatible with other
--  flags or make use of potentially unsafe features.

-- Assumes --guardedness
open import Cubical.Codata.Stream public

open import Cubical.Codata.Conat public

open import Cubical.Codata.M public

-- Also uses {-# TERMINATING #-}.
open import Cubical.Codata.M.Bisimilarity public

{-
-- Alternative M type implemetation, based on
-- https://arxiv.org/pdf/1504.02949.pdf
-- "Non-wellfounded trees in Homotopy Type Theory"
-- Benedikt Ahrens, Paolo Capriotti, Régis Spadotti
-}

open import Cubical.Codata.M.AsLimit.M
open import Cubical.Codata.M.AsLimit.Coalg
open import Cubical.Codata.M.AsLimit.helper
open import Cubical.Codata.M.AsLimit.Container
open import Cubical.Codata.M.AsLimit.itree
open import Cubical.Codata.M.AsLimit.stream