open import Agda.Builtin.Reflection renaming (bindTC to _>>=_)
open import Agda.Builtin.Sigma
open import Agda.Builtin.List
open import Agda.Builtin.Unit
open import Agda.Builtin.Nat
open import Agda.Builtin.Equality

infixr 0 _$_
_$_ : ∀ {a b}{A : Set a}{B : Set b} → (A → B) → (A → B)
f $ x = f x

map : {A B : Set} → (A → B) → List A → List B
map f [] = []
map f (x ∷ xs) = f x ∷ map f xs

reverseAcc : {A : Set} → List A → List A → List A
reverseAcc [] ys = ys
reverseAcc (x ∷ xs) ys = reverseAcc xs (x ∷ ys)

reverse : {A : Set} → List A → List A
reverse xs = reverseAcc xs []

data Vec (A : Set) : Nat → Set where
  []  : Vec A 0
  _∷_ : ∀ {n} (x : A) (xs : Vec A n) → Vec A (suc n)

macro
  ntest : Name → Term → TC ⊤
  ntest f a = do
     (function te@(clause tel _ t ∷ [])) ← withReconstructed $ getDefinition f where
        _ → typeError $ strErr "ERROR" ∷ []
     t ← withReconstructed $ inContext (reverse tel) $ normalise t
     quoteTC t >>= unify a

-- A record with parameters.
record X {n} (x : Vec Nat n) : Set where
  constructor mk
  field
    c : Nat

-- A function that we will call at the unknown argument position
-- when defining the type of `f`.
[_] : ∀ {X} → X → Vec X 1
[ x ] = x ∷ []

-- The function that has two reconstructable arguments in the body.
f : X [ 1 ]
f = mk 1

-- Normalisation of the body of the function should also
-- normalise reconstructed arguments.
test : ntest f ≡ con (quote mk) (_ ∷ arg _ (con (quote Vec._∷_) _) ∷ _)
test = refl


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

mutual

  record R : Set₁ where
    constructor c
    field
      @0 A : Set
      x    : _

  _ : (@0 A : Set) → A → R
  _ = c


{-

This file contains:
  - The reduced version gives the same type as James.

-}
{-# OPTIONS --safe --experimental-lossy-unification #-}
module Cubical.HITs.James.Inductive.ColimitEquivalence where

open import Cubical.Foundations.Prelude
open import Cubical.Foundations.Equiv
open import Cubical.Foundations.Isomorphism
open import Cubical.Foundations.Pointed

open import Cubical.HITs.James.Base
  renaming (James to JamesConstruction)
open import Cubical.HITs.James.Inductive.Reduced
  renaming (𝕁Red to 𝕁RedConstruction ; 𝕁Red∞ to 𝕁amesConstruction)
open import Cubical.HITs.James.Inductive.Coherence

private
  variable
    ℓ : Level

module _
  ((X , x₀) : Pointed ℓ) where

  private
    James = JamesConstruction (X , x₀)
    𝕁ames = 𝕁amesConstruction (X , x₀)
    𝕁Red  =  𝕁RedConstruction (X , x₀)

  -- Mimicking the constructors in each other

  unit' : (x : X)(xs : James) → Path James (x₀ ∷ x ∷ xs) (x ∷ x₀ ∷ xs)
  unit' x xs = sym (unit (x ∷ xs)) ∙∙ refl ∙∙ (λ i → x ∷ unit xs i)

  coh' : (xs : James) → refl ≡ unit' x₀ xs
  coh' xs i j =
    coh-helper {A = James} (unit xs) (unit (x₀ ∷ xs))
      (λ i → x₀ ∷ unit xs i) (λ i j → unit (unit xs j) i) i j

  _∷∞_ : X → 𝕁ames → 𝕁ames
  _∷∞_ x (inl xs) = inl (x ∷ xs)
  _∷∞_ x (push xs i) = (push (x ∷ xs) ∙ (λ i → inl (unit x xs i))) i

  push∞ : (xs : 𝕁ames) → xs ≡ x₀ ∷∞ xs
  push∞ (inl xs) = push xs
  push∞ (push xs i) j =
    push-helper {A = 𝕁ames} (push xs) (push (x₀ ∷ xs))
      (λ i → inl (unit x₀ xs i)) (λ i j → inl (coh xs i j)) j i

  infixr 5 _∷∞_

  -- One side map

  𝕁→James-inl : 𝕁Red → James
  𝕁→James-inl [] = []
  𝕁→James-inl (x ∷ xs) = x ∷ 𝕁→James-inl xs
  𝕁→James-inl (unit x xs i) = unit' x (𝕁→James-inl xs) i
  𝕁→James-inl (coh xs i j) = coh' (𝕁→James-inl xs) i j

  𝕁→James : 𝕁ames → James
  𝕁→James (inl xs) = 𝕁→James-inl xs
  𝕁→James (push xs i) = unit (𝕁→James-inl xs) i

  -- Commutativity with pseudo-constructors

  𝕁→James-∷ : (x : X)(xs : 𝕁ames) → 𝕁→James (x ∷∞ xs) ≡ x ∷ 𝕁→James xs
  𝕁→James-∷ x (inl xs) = refl
  𝕁→James-∷ x (push xs i) j = comp-cong-helper 𝕁→James (push (x ∷ xs)) _ (λ i → inl (unit x xs i)) refl j i

  𝕁→James-push : (xs : 𝕁ames)
    → PathP (λ i → 𝕁→James xs ≡ 𝕁→James-∷ x₀ xs i) (cong 𝕁→James (push∞ xs)) (unit (𝕁→James xs))
  𝕁→James-push (inl xs) = refl
  𝕁→James-push (push xs i) j k =
    hcomp (λ l → λ
      { (i = i0) → unit (𝕁→James-inl xs) k
      ; (i = i1) → unit (x₀ ∷ 𝕁→James-inl xs) k
      ; (j = i0) →
          push-helper-cong 𝕁→James (push xs) (push (x₀ ∷ xs))
            (λ i → inl (unit x₀ xs i)) (λ i j → inl (coh xs i j)) k i (~ l)
      ; (j = i1) → unit (unit (𝕁→James-inl xs) i) k
      ; (k = i0) → unit (𝕁→James-inl xs) i
      ; (k = i1) →
          comp-cong-helper-filler 𝕁→James (push (x₀ ∷ xs)) _
            (λ i → inl (unit x₀ xs i)) refl j i l })
    (push-coh-helper _ _ _ (λ i j → unit (unit (𝕁→James-inl xs) j) i) k i j)

  -- The other-side map

  private
    push-square : (x : X)(xs : 𝕁Red)
      → sym (push (x ∷ xs)) ∙∙ refl ∙∙ (λ i → x ∷∞ push xs i) ≡ (λ i → inl (unit x xs i))
    push-square x xs i j = push-square-helper (push (x ∷ xs)) (λ i → inl (unit x xs i)) i j

    coh-cube : (xs : 𝕁Red)
      → SquareP
          (λ i j → coh-helper _ _ _ (λ i j → push∞ (push xs j) i) i j ≡ inl (coh xs i j))
          (λ i j → inl (x₀ ∷ x₀ ∷ xs))
          (λ i j → push-square-helper (push (x₀ ∷ xs))
                    (λ i → inl (unit x₀ xs i)) j i)
          (λ i j → inl (x₀ ∷ x₀ ∷ xs))
          (λ i j → inl (x₀ ∷ x₀ ∷ xs))
    coh-cube xs =
      coh-cube-helper {A = 𝕁ames} (push xs) (push (x₀ ∷ xs))
        (λ i → inl (unit x₀ xs i)) (λ i j → inl (coh xs i j))

  J→𝕁ames : James → 𝕁ames
  J→𝕁ames [] = inl []
  J→𝕁ames (x ∷ xs) = x ∷∞ (J→𝕁ames xs)
  J→𝕁ames (unit xs i) = push∞ (J→𝕁ames xs) i

  -- The following is the most complicated part.
  -- It seems horrible but mainly it's due to correction of boudaries.

  𝕁→J→𝕁ames-inl : (xs : 𝕁Red) → J→𝕁ames (𝕁→James (inl xs)) ≡ inl xs
  𝕁→J→𝕁ames-inl [] = refl
  𝕁→J→𝕁ames-inl (x ∷ xs) t = x ∷∞ 𝕁→J→𝕁ames-inl xs t
  𝕁→J→𝕁ames-inl (unit x xs i) j =
    hcomp (λ k → λ
      { (i = i0) → square-helper (j ∨ ~ k) i0
      ; (i = i1) → square-helper (j ∨ ~ k) i1
      ; (j = i0) → square-helper (~ k) i
      ; (j = i1) → inl (unit x xs i) })
    (push-square x xs j i)
    where
      square-helper : (i j : I) → 𝕁ames
      square-helper i j =
        doubleCompPath-cong-filler J→𝕁ames
          (sym (unit (x ∷ 𝕁→James-inl xs))) refl (λ i → x ∷ unit (𝕁→James-inl xs) i)
          (λ i j → push∞ (x ∷∞ 𝕁→J→𝕁ames-inl xs i) (~ j))
          (λ i j → x ∷∞ 𝕁→J→𝕁ames-inl xs i)
          (λ i j → x ∷∞ push∞ (𝕁→J→𝕁ames-inl xs i) j) i j i1
  𝕁→J→𝕁ames-inl (coh xs i j) k =
    hcomp (λ l → λ
      { (i = i0) → cube-helper i0 j (k ∨ ~ l)
      ; (i = i1) → inl-filler j k l
      ; (j = i0) → cube-helper i i0 (k ∨ ~ l)
      ; (j = i1) → cube-helper i i1 (k ∨ ~ l)
      ; (k = i0) → cube-helper i j (~ l)
      ; (k = i1) → inl (coh xs i j) })
    (coh-cube xs i j k)
    where
      cube-helper : (i j k : I) → 𝕁ames
      cube-helper i j k =
        coh-helper-cong J→𝕁ames _ _ _
          (λ i j → unit (unit (𝕁→James-inl xs) j) i)
          (λ i j k → push∞ (push∞ (𝕁→J→𝕁ames-inl xs k) j) i) i j k

      inl-filler : (i j k : I) → 𝕁ames
      inl-filler i j k =
        hfill (λ k → λ
          { (i = i0) → square-helper (j ∨ ~ k) i0
          ; (i = i1) → square-helper (j ∨ ~ k) i1
          ; (j = i0) → square-helper (~ k) i
          ; (j = i1) → inl (unit x₀ xs i) })
        (inS (push-square x₀ xs j i)) k
        where
          square-helper : (i j : I) → 𝕁ames
          square-helper i j =
            doubleCompPath-cong-filler J→𝕁ames
              (sym (unit (x₀ ∷ 𝕁→James-inl xs))) refl (λ i → x₀ ∷ unit (𝕁→James-inl xs) i)
              (λ i j → push∞ (x₀ ∷∞ 𝕁→J→𝕁ames-inl xs i) (~ j))
              (λ i j → x₀ ∷∞ 𝕁→J→𝕁ames-inl xs i)
              (λ i j → x₀ ∷∞ push∞ (𝕁→J→𝕁ames-inl xs i) j) i j i1

  -- The main equivalence

  𝕁→J→𝕁ames : (xs : 𝕁ames) → J→𝕁ames (𝕁→James xs) ≡ xs
  𝕁→J→𝕁ames (inl xs) = 𝕁→J→𝕁ames-inl xs
  𝕁→J→𝕁ames (push xs i) j = push∞ (𝕁→J→𝕁ames-inl xs j) i

  J→𝕁→James : (xs : James) → 𝕁→James (J→𝕁ames xs) ≡ xs
  J→𝕁→James [] = refl
  J→𝕁→James (x ∷ xs) = 𝕁→James-∷ x (J→𝕁ames xs) ∙ (λ i → x ∷ J→𝕁→James xs i)
  J→𝕁→James (unit xs i) j =
    hcomp (λ k → λ
      { (i = i0) → J→𝕁→James xs (j ∧ k)
      ; (i = i1) → compPath-filler (𝕁→James-∷ x₀ (J→𝕁ames xs)) (λ i → x₀ ∷ J→𝕁→James xs i) k j
      ; (j = i0) → 𝕁→James (J→𝕁ames (unit xs i))
      ; (j = i1) → unit (J→𝕁→James xs k) i })
    (𝕁→James-push (J→𝕁ames xs) j i)

  James≃𝕁Red∞ : James ≃ 𝕁ames
  James≃𝕁Red∞ = isoToEquiv (iso J→𝕁ames 𝕁→James 𝕁→J→𝕁ames J→𝕁→James)


open import Common.Prelude
open import Common.Reflection
open import Common.Equality

` : Term → Term
` (def f []) = con (quote def) (vArg (lit (qname f)) ∷ vArg (con (quote []) []) ∷ [])
` _ = lit (string "other")

macro
  primQNameType : QName → Tactic
  primQNameType f hole =
    bindTC (getType f) λ a →
    bindTC (normalise a) λ a →
    give (` a) hole

A : Set
a : A
A = _

B : Set
b : B
B = _

aName=bName : primQNameType a ≡ primQNameType b
aName=bName = refl

a = 0
b = 1.0

empty : ⊥
empty with aName=bName
... | ()


module Issue2469 where

open import Agda.Builtin.Nat
open import Agda.Builtin.Unit
open import Agda.Builtin.IO renaming (IO to BIO)
open import Agda.Builtin.String
open import Agda.Builtin.IO
open import Common.IO
open import Common.Prelude
open import Common.Sum
open import Common.Product

data F : Nat → Set where
  [] : F zero
  _∷1 : ∀ {n} → F n → F (suc n)
  _∷2 : ∀ {n} → F n → F (suc (suc n))

f : ∀ k → F (suc k) → F k ⊎ Maybe ⊥
f zero a = inj₂ nothing
f k (xs ∷1) = inj₂ nothing
-- to (suc k) xs = inj₂ nothing  -- This is fine
f (suc k) = λ xs → inj₂ nothing  -- This segfaults

myshow : F 1 ⊎ Maybe ⊥ → String
-- myshow (inj₁ b) = ""        -- This is fine
myshow (inj₁ (b ∷1)) = "bla"      -- This segfaults
myshow _ = "blub"

main : IO ⊤
main =  putStrLn (myshow (f 1 ([] ∷2)))


{-# OPTIONS --type-in-type #-}
open import Data.Unit
open import Data.Product hiding ( curry ; uncurry )
open import Data.List hiding ( concat )
open import Data.String
open import Relation.Binary.PropositionalEquality
open import Function
module GenericElim.Desc where

----------------------------------------------------------------------

Label : Set
Label = String

Enum : Set
Enum = List Label

data Tag : Enum → Set where
  here : ∀{l E} → Tag (l ∷ E)
  there : ∀{l E} → Tag E → Tag (l ∷ E)

Branches : (E : Enum) (P : Tag E → Set) → Set
Branches [] P = ⊤
Branches (l ∷ E) P = P here × Branches E (λ t → P (there t))

case : {E : Enum} (P : Tag E → Set) (cs : Branches E P) (t : Tag E) → P t
case P (c , cs) here = c
case P (c , cs) (there t) = case (λ t → P (there t)) cs t

UncurriedBranches : (E : Enum) (P : Tag E → Set) (X : Set)
  → Set
UncurriedBranches E P X = Branches E P → X

CurriedBranches : (E : Enum) (P : Tag E → Set) (X : Set)
  → Set
CurriedBranches [] P X = X
CurriedBranches (l ∷ E) P X = P here → CurriedBranches E (λ t → P (there t)) X

curryBranches : {E : Enum} {P : Tag E → Set} {X : Set}
  → UncurriedBranches E P X → CurriedBranches E P X
curryBranches {[]} f = f tt
curryBranches {l ∷ E} f = λ c → curryBranches (λ cs → f (c , cs))

uncurryBranches : {E : Enum} {P : Tag E → Set} {X : Set}
  → CurriedBranches E P X → UncurriedBranches E P X
uncurryBranches {[]} x tt = x
uncurryBranches {l ∷ E} f (c , cs) = uncurryBranches (f c) cs

----------------------------------------------------------------------

data Desc (I : Set) : Set₁ where
  End : (i : I) → Desc I
  Rec : (i : I) (D : Desc I) → Desc I
  Arg : (A : Set) (B : A → Desc I) → Desc I

ISet : Set → Set₁
ISet I = I → Set

El : {I : Set} (D : Desc I) → ISet I → ISet I
El (End j) X i = j ≡ i
El (Rec j D) X i = X j × El D X i
El (Arg A B) X i = Σ A (λ a → El (B a) X i)

Hyps : {I : Set} (D : Desc I) (X : ISet I) (P : (i : I) → X i → Set) (i : I) (xs : El D X i) → Set
Hyps (End j) X P i q = ⊤
Hyps (Rec j D) X P i (x , xs) = P j x × Hyps D X P i xs
Hyps (Arg A B) X P i (a , b) = Hyps (B a) X P i b

----------------------------------------------------------------------

BranchesD : (I : Set) (E : Enum) → Set
BranchesD I E = Branches E (λ _ → Desc I)

caseD : {I : Set} {E : Enum} (cs : BranchesD I E) (t : Tag E) → Desc I
caseD = case (λ _ → Desc _)

----------------------------------------------------------------------

UncurriedEl : {I : Set} (D : Desc I) (X : ISet I) → Set
UncurriedEl D X = ∀{i} → El D X i → X i

CurriedEl : {I : Set} (D : Desc I) (X : ISet I) → Set
CurriedEl (End i) X = X i
CurriedEl (Rec i D) X = (x : X i) → CurriedEl D X
CurriedEl (Arg A B) X = (a : A) → CurriedEl (B a) X

CurriedEl' : {I : Set} (D : Desc I) (X : ISet I) (i : I) → Set
CurriedEl' (End j) X i = j ≡ i → X i
CurriedEl' (Rec j D) X i = (x : X j) → CurriedEl' D X i
CurriedEl' (Arg A B) X i = (a : A) → CurriedEl' (B a) X i

curryEl : {I : Set} (D : Desc I) (X : ISet I)
  → UncurriedEl D X → CurriedEl D X
curryEl (End i) X cn = cn refl
curryEl (Rec i D) X cn = λ x → curryEl D X (λ xs → cn (x , xs))
curryEl (Arg A B) X cn = λ a → curryEl (B a) X (λ xs → cn (a , xs))

uncurryEl : {I : Set} (D : Desc I) (X : ISet I)
  → CurriedEl D X → UncurriedEl D X
uncurryEl (End i) X cn refl = cn
uncurryEl (Rec i D) X cn (x , xs) = uncurryEl D X (cn x) xs
uncurryEl (Arg A B) X cn (a , xs) = uncurryEl (B a) X (cn a) xs

----------------------------------------------------------------------

UncurriedHyps : {I : Set} (D : Desc I) (X : ISet I)
  (P : (i : I) → X i → Set)
  (cn : UncurriedEl D X)
  → Set
UncurriedHyps D X P cn =
  ∀ i (xs : El D X i) (ihs : Hyps D X P i xs) → P i (cn xs)

CurriedHyps : {I : Set} (D : Desc I) (X : ISet I)
  (P : (i : I) → X i → Set)
  (cn : UncurriedEl D X)
  → Set
CurriedHyps (End i) X P cn =
  P i (cn refl)
CurriedHyps (Rec i D) X P cn =
  (x : X i) → P i x → CurriedHyps D X P (λ xs → cn (x , xs))
CurriedHyps (Arg A B) X P cn =
  (a : A) → CurriedHyps (B a) X P (λ xs → cn (a , xs))

CurriedHyps' : {I : Set} (D : Desc I) (X : ISet I)
  (P : (i : I) → X i → Set)
  (i : I)
  (cn : El D X i → X i)
  → Set
CurriedHyps' (End j) X P i cn = (q : j ≡ i) → P i (cn q)
CurriedHyps' (Rec j D) X P i cn =
  (x : X j) → P j x → CurriedHyps' D X P i (λ xs → cn (x , xs))
CurriedHyps' (Arg A B) X P i cn =
  (a : A) → CurriedHyps' (B a) X P i (λ xs → cn (a , xs))

curryHyps : {I : Set} (D : Desc I) (X : ISet I)
  (P : (i : I) → X i → Set)
  (cn : UncurriedEl D X)
  → UncurriedHyps D X P cn
  → CurriedHyps D X P cn
curryHyps (End i) X P cn pf =
  pf i refl tt
curryHyps (Rec i D) X P cn pf =
  λ x ih → curryHyps D X P (λ xs → cn (x , xs)) (λ i xs ihs → pf i (x , xs) (ih , ihs))
curryHyps (Arg A B) X P cn pf =
  λ a → curryHyps (B a) X P (λ xs → cn (a , xs)) (λ i xs ihs → pf i (a , xs) ihs)

uncurryHyps : {I : Set} (D : Desc I) (X : ISet I)
  (P : (i : I) → X i → Set)
  (cn : UncurriedEl D X)
  → CurriedHyps D X P cn
  → UncurriedHyps D X P cn
uncurryHyps (End .i) X P cn pf i refl tt =
  pf
uncurryHyps (Rec j D) X P cn pf i (x , xs) (ih , ihs) =
  uncurryHyps D X P (λ ys → cn (x , ys)) (pf x ih) i xs ihs
uncurryHyps (Arg A B) X P cn pf i (a , xs) ihs =
  uncurryHyps (B a) X P (λ ys → cn (a , ys)) (pf a) i xs ihs

----------------------------------------------------------------------

data μ {I : Set} (D : Desc I) : ISet I where
  init : UncurriedEl D (μ D)

inj : {I : Set} (D : Desc I) → CurriedEl D (μ D)
inj D = curryEl D (μ D) init

----------------------------------------------------------------------

ind :
  {I : Set}
  (D : Desc I)
  (P : (i : I) → μ D i → Set)
  (α : UncurriedHyps D (μ D) P init)
  (i : I)
  (x : μ D i)
  → P i x

hyps :
  {I : Set}
  (D₁ : Desc I)
  (P : (i : I) → μ D₁ i → Set)
  (α : UncurriedHyps D₁ (μ D₁) P init)
  (D₂ : Desc I)
  (i : I)
  (xs : El D₂ (μ D₁) i)
  → Hyps D₂ (μ D₁) P i xs

ind D P α i (init xs) = α i xs (hyps D P α D i xs)

hyps D P α (End j) i q = tt
hyps D P α (Rec j A) i (x , xs) = ind D P α j x , hyps D P α A i xs
hyps D P α (Arg A B) i (a , b) = hyps D P α (B a) i b

----------------------------------------------------------------------

indCurried : {I : Set} (D : Desc I)
  (P : (i : I) → μ D i → Set)
  (f : CurriedHyps D (μ D) P init)
  (i : I)
  (x : μ D i)
  → P i x
indCurried D P f i x = ind D P (uncurryHyps D (μ D) P init f) i x

Summer : {I : Set} (E : Enum) (C : Tag E → Desc I)
  → let D = Arg (Tag E) C in
  (X  : ISet I) (cn : UncurriedEl D X)
  (P : (i : I) → X i → Set)
  → Tag E → Set
Summer E C X cn P t =
  let D = Arg (Tag E) C in
  CurriedHyps (C t) X P (λ xs → cn (t , xs))

SumCurriedHyps : {I : Set} (E : Enum) (C : Tag E → Desc I)
  → let D = Arg (Tag E) C in
  (P : (i : I) → μ D i → Set)
  → Tag E → Set
SumCurriedHyps E C P t =
  let D = Arg (Tag E) C in
  Summer E C (μ D) init P t

elimUncurried : {I : Set} (E : Enum) (C : Tag E → Desc I)
  → let D = Arg (Tag E) C in
  (P : (i : I) → μ D i → Set)
  → Branches E (SumCurriedHyps E C P)
  → (i : I) (x : μ D i) → P i x
elimUncurried E C P cs i x =
  let D = Arg (Tag E) C in
  indCurried D P
    (case (SumCurriedHyps E C P) cs)
    i x

elim : {I : Set} (E : Enum) (C : Tag E → Desc I)
  → let D = Arg (Tag E) C in
  (P : (i : I) → μ D i → Set)
  → CurriedBranches E
      (SumCurriedHyps E C P)
      ((i : I) (x : μ D i) → P i x)
elim E C P = curryBranches (elimUncurried E C P)

----------------------------------------------------------------------

Soundness : Set₁
Soundness = {I : Set} (E : Enum) (C : Tag E → Desc I)
  → let D = Arg (Tag E) C in
  (P : (i : I) → μ D i → Set)
  (cs : Branches E (SumCurriedHyps E C P))
  (i : I) (x : μ D i)
  → ∃ λ α
  → elimUncurried E C P cs i x ≡ ind D P α i x

sound : Soundness
sound E C P cs i x =
  let D = Arg (Tag E) C in
  (uncurryHyps D (μ D) P init (case (SumCurriedHyps E C P) cs)) , refl

Completeness : Set₁
Completeness = {I : Set} (E : Enum) (C : Tag E → Desc I)
  → let D = Arg (Tag E) C in
  (P : (i : I) → μ D i → Set)
  (α : UncurriedHyps D (μ D) P init)
  (i : I) (x : μ D i)
  → ∃ λ cs
  → ind D P α i x ≡ elimUncurried E C P cs i x

uncurryHypsIdent : {I : Set} (D : Desc I) (X : ISet I)
  (P : (i : I) → X i → Set)
  (cn : UncurriedEl D X)
  (α : UncurriedHyps D X P cn)
  (i : I) (xs : El D X i) (ihs : Hyps D X P i xs)
  → α i xs ihs ≡ uncurryHyps D X P cn (curryHyps D X P cn α) i xs ihs
uncurryHypsIdent (End .i) X P cn α i refl tt = refl
uncurryHypsIdent (Rec j D) X P cn α i (x , xs) (p , ps) =
  uncurryHypsIdent D X P (λ xs → cn (x , xs)) (λ k ys rs → α k (x , ys) (p , rs)) i xs ps
uncurryHypsIdent (Arg A B) X P cn α i (a , xs) ps =
  uncurryHypsIdent (B a) X P (λ xs → cn (a , xs)) (λ j ys → α j (a , ys)) i xs ps

postulate
  ext3 : {A : Set} {B : A → Set} {C : (a : A) → B a → Set} {Z : (a : A) (b : B a) → C a b → Set}
    (f g : (a : A) (b : B a) (c : C a b) → Z a b c)
    → ((a : A) (b : B a) (c : C a b) → f a b c ≡ g a b c)
    → f ≡ g

toBranches : {I : Set} (E : Enum) (C : Tag E → Desc I)
  → let D = Arg (Tag E) C in
  (X  : ISet I) (cn : UncurriedEl D X)
  (P : (i : I) → X i → Set)
  (α : UncurriedHyps D X P cn)
  → Branches E (Summer E C X cn P)
toBranches [] C X cn P α = tt
toBranches (l ∷ E) C X cn P α =
    curryHyps (C here) X P (λ xs → cn (here , xs)) (λ i xs → α i (here , xs))
  , toBranches E (λ t → C (there t)) X
     (λ xs → cn (there (proj₁ xs) , proj₂ xs))
     P (λ i xs ih → α i (there (proj₁ xs) , proj₂ xs) ih)

ToBranches : {I : Set} {E : Enum} (C : Tag E → Desc I)
  → let D = Arg (Tag E) C in
  (X  : ISet I) (cn : UncurriedEl D X)
  (P : (i : I) → X i → Set)
  (α : UncurriedHyps D X P cn)
  (t : Tag E)
  → let β = toBranches E C X cn P α in
  case (Summer E C X cn P) β t ≡ curryHyps D X P cn α t
ToBranches C X cn P α here = refl
ToBranches C X cn P α (there t)
  with ToBranches (λ t → C (there t)) X
    (λ xs → cn (there (proj₁ xs) , proj₂ xs))
    P (λ i xs ih → α i (there (proj₁ xs) , proj₂ xs) ih) t
... | ih rewrite ih = refl

completeα : {I : Set} (E : Enum) (C : Tag E → Desc I)
  → let D = Arg (Tag E) C in
  (P : (i : I) → μ D i → Set)
  (α : UncurriedHyps D (μ D) P init)
  (i : I) (xs : El D (μ D) i) (ihs : Hyps D (μ D) P i xs)
  → let β = toBranches E C (μ D) init P α in
  α i xs ihs ≡ uncurryHyps D (μ D) P init (case (SumCurriedHyps E C P) β) i xs ihs
completeα E C P α i (t , xs) ihs
  with ToBranches C (μ D) init P α t where D = Arg (Tag E) C
... | q rewrite q = uncurryHypsIdent D (μ D) P init α i (t , xs) ihs where D = Arg (Tag E) C

complete' : {I : Set} (E : Enum) (C : Tag E → Desc I)
  → let D = Arg (Tag E) C in
  (P : (i : I) → μ D i → Set)
  (α : UncurriedHyps D (μ D) P init)
  (i : I) (x : μ D i)
  → let β = toBranches E C (μ D) init P α in
  ind D P α i x ≡ elimUncurried E C P β i x
complete' E C P α i (init (t , xs)) = cong
  (λ f → ind D P f i (init (t , xs)))
  (ext3 α
    (uncurryHyps D (μ D) P init (case (SumCurriedHyps E C P) β))
    (completeα E C P α))
  where
  D = Arg (Tag E) C
  β = toBranches E C (μ D) init P α

complete : Completeness
complete E C P α i x =
  let D = Arg (Tag E) C in
    toBranches E C (μ D) init P α
  , complete' E C P α i x

----------------------------------------------------------------------

ℕE : Enum
ℕE = "zero" ∷ "suc" ∷ []

VecE : Enum
VecE = "nil" ∷ "cons" ∷ []

ℕT : Set
ℕT = Tag ℕE

VecT : Set
VecT = Tag VecE

zeroT : ℕT
zeroT = here

sucT : ℕT
sucT = there here

nilT : VecT
nilT = here

consT : VecT
consT = there here

ℕC : ℕT → Desc ⊤
ℕC = caseD $
    End tt
  , Rec tt (End tt)
  , tt

ℕD : Desc ⊤
ℕD = Arg ℕT ℕC

ℕ : ⊤ → Set
ℕ = μ ℕD

zero : ℕ tt
zero = init (zeroT , refl)

suc : ℕ tt → ℕ tt
suc n = init (sucT , n , refl)

VecC : (A : Set) → VecT → Desc (ℕ tt)
VecC A = caseD $
    End zero
  , Arg (ℕ tt) (λ n → Arg A λ _ → Rec n (End (suc n)))
  , tt

nilD : (A : Set) → Desc (ℕ tt)
nilD A = End zero

consD : (A : Set) → Desc (ℕ tt)
consD A = Arg (ℕ tt) (λ n → Arg A (λ _ → Rec n (End (suc n))))

VecD : (A : Set) → Desc (ℕ tt)
VecD A = Arg VecT (VecC A)

Vec : (A : Set) → ℕ tt → Set
Vec A = μ (VecD A)

NilEl : (A : Set) (n : ℕ tt) → Set
NilEl A n = El (nilD A) (Vec A) n

ConsEl : (A : Set) → ℕ tt → Set
ConsEl A n = El (consD A) (Vec A) n

VecEl : (A : Set) → ℕ tt → Set
VecEl A n = El (VecD A) (Vec A) n

NilHyps : (A : Set) (P : (n : ℕ tt) → Vec A n → Set) (n : ℕ tt) (xs : NilEl A n) → Set
NilHyps A P n xs = Hyps (nilD A) (Vec A) P n xs

ConsHyps : (A : Set) (P : (n : ℕ tt) → Vec A n → Set) (n : ℕ tt) (xs : ConsEl A n) → Set
ConsHyps A P n xs = Hyps (consD A) (Vec A) P n xs

VecHyps : (A : Set) (P : (n : ℕ tt) → Vec A n → Set) (n : ℕ tt) (xs : VecEl A n) → Set
VecHyps A P n xs = Hyps (VecD A) (Vec A) P n xs

ConsUncurriedHyps : (A : Set)
  (P : (n : ℕ tt) → Vec A n → Set)
  (cn : UncurriedEl (consD A) (Vec A)) → Set
ConsUncurriedHyps A P cn = UncurriedHyps (consD A) (Vec A) P cn

nil : (A : Set) → Vec A zero
nil A = init (nilT , refl)

cons : (A : Set) (n : ℕ tt) (x : A) (xs : Vec A n) → Vec A (suc n)
cons A n x xs = init (consT , n , x , xs , refl)

nil2 : (A : Set) → Vec A zero
nil2 A = inj (VecD A) nilT

cons2 : (A : Set) (n : ℕ tt) (x : A) (xs : Vec A n) → Vec A (suc n)
cons2 A = inj (VecD A) consT

----------------------------------------------------------------------

module Induction where

  add : ℕ tt → ℕ tt → ℕ tt
  add = ind ℕD (λ _ _ → ℕ tt → ℕ tt)
    (λ u t,c → case
      (λ t → (c : El (ℕC t) ℕ u)
             (ih : Hyps ℕD ℕ (λ u n → ℕ u → ℕ u) u (t , c))
             → ℕ u → ℕ u
      )
      ( (λ q ih n → n)
      , (λ m,q ih,tt n → suc (proj₁ ih,tt n))
      , tt
      )
      (proj₁ t,c)
      (proj₂ t,c)
    )
    tt

  mult : ℕ tt → ℕ tt → ℕ tt
  mult = ind ℕD (λ _ _ → ℕ tt → ℕ tt)
    (λ u t,c → case
      (λ t → (c : El (ℕC t) ℕ u)
             (ih : Hyps ℕD ℕ (λ u n → ℕ u → ℕ u) u (t , c))
             → ℕ u → ℕ u
      )
      ( (λ q ih n → zero)
      , (λ m,q ih,tt n → add n (proj₁ ih,tt n))
      , tt
      )
      (proj₁ t,c)
      (proj₂ t,c)
    )
    tt

  append : (A : Set) (m : ℕ tt) (xs : Vec A m) (n : ℕ tt) (ys : Vec A n) → Vec A (add m n)
  append A = ind (VecD A) (λ m xs → (n : ℕ tt) (ys : Vec A n) → Vec A (add m n))
    (λ m t,c → case
      (λ t → (c : El (VecC A t) (Vec A) m)
             (ih : Hyps (VecD A) (Vec A) (λ m xs → (n : ℕ tt) (ys : Vec A n) → Vec A (add m n)) m (t , c))
             (n : ℕ tt) (ys : Vec A n) → Vec A (add m n)
      )
      ( (λ q ih n ys → subst (λ m → Vec A (add m n)) q ys)
      , (λ m',x,xs,q ih,tt n ys →
          let m' = proj₁ m',x,xs,q
              x = proj₁ (proj₂ m',x,xs,q)
              q = proj₂ (proj₂ (proj₂ m',x,xs,q))
              ih = proj₁ ih,tt
          in
          subst (λ m → Vec A (add m n)) q (cons A (add m' n) x (ih n ys))
        )
      , tt
      )
      (proj₁ t,c)
      (proj₂ t,c)
    )

  Concat : (A : Set) (m n : ℕ tt) (xss : Vec (Vec A m) n) → Set
  Concat A m n xss = Vec A (mult n m)

  ConsBranch : (A : Set) (m : ℕ tt)
    → Set
  ConsBranch A m = UncurriedHyps (consD (Vec A m)) (Vec (Vec A m)) (Concat A m)
    (λ xs → init (consT , xs))

  ConsElimBranch : (A : Set) (m : ℕ tt)
    → Set
  ConsElimBranch A m = CurriedHyps (consD (Vec A m)) (Vec (Vec A m)) (Concat A m)
    (λ xs → init (consT , xs))

  ElimBranch : (t : VecT) (A : Set) (m : ℕ tt)
    → Set
  ElimBranch t A m = SumCurriedHyps VecE (VecC (Vec A m)) (Concat A m) t

  nilBranch : (A : Set) (m n : ℕ tt)
    (xss : NilEl (Vec A m) n)
    (ihs : NilHyps (Vec A m) (Concat A m) n xss)
    → Vec A (mult n m)
  nilBranch A m n q u = subst
    (λ n → Vec A (mult n m))
    q (nil A)

  consBranch : (A : Set) (m : ℕ tt) → ConsBranch A m
  consBranch A m n n',xs,xss,q ih,u =
    let n' = proj₁ n',xs,xss,q
        xs = proj₁ (proj₂ n',xs,xss,q)
        q = proj₂ (proj₂ (proj₂ n',xs,xss,q))
        ih = proj₁ ih,u
    in subst
      (λ n → Vec A (mult n m))
      q (append A m xs (mult n' m) ih)

  ConcatConvoy : (A : Set) (m n : ℕ tt) (t : VecT) → Set
  ConcatConvoy A m n t =
    (xss : El (VecC (Vec A m) t) (Vec (Vec A m)) n)
    (ihs : VecHyps (Vec A m) (Concat A m) n (t , xss))
    → Vec A (mult n m)

  concatα : (A : Set) (m n : ℕ tt)
    (xss : VecEl (Vec A m) n)
    (ihs : VecHyps (Vec A m) (Concat A m) n xss)
    → Vec A (mult n m)
  concatα A m n xss = case (ConcatConvoy A m n)
    (nilBranch A m n , consBranch A m n , tt)
    (proj₁ xss)
    (proj₂ xss)

  concat : (A : Set) (m n : ℕ tt) (xss : Vec (Vec A m) n) → Concat A m n xss
  concat A m = ind
    (VecD (Vec A m))
    (Concat A m)
    (concatα A m)

----------------------------------------------------------------------

module GenericElim where

  add : ℕ tt → ℕ tt → ℕ tt
  add = elim ℕE ℕC _
    (λ n → n)
    (λ m ih n → suc (ih n))
    tt

  mult : ℕ tt → ℕ tt → ℕ tt
  mult = elim ℕE ℕC _
    (λ n → zero)
    (λ m ih n → add n (ih n))
    tt

  append : (A : Set) (m : ℕ tt) (xs : Vec A m) (n : ℕ tt) (ys : Vec A n) → Vec A (add m n)
  append A = elim VecE (VecC A) (λ m xs → (n : ℕ tt) (ys : Vec A n) → Vec A (add m n))
    (λ n ys → ys)
    (λ m x xs ih n ys → cons A (add m n) x (ih n ys))

  concat : (A : Set) (m n : ℕ tt) (xss : Vec (Vec A m) n) → Vec A (mult n m)
  concat A m = elim VecE (VecC (Vec A m)) (λ n xss → Vec A (mult n m))
    (nil A)
    (λ n xs xss ih → append A m xs (mult n m) ih)

----------------------------------------------------------------------


module Issue448 where

postulate
 Unit : Set
 unit : Unit
 D    : Set → Set
 d    : (A : Set) → A → D A

record R : Set₁ where
 field F : Set

r : _
r = record { F = Unit }

postulate
 D′ : R.F r → D (R.F r) → Set
 d′ : ∀ f τ → D′ f (d _ τ)

data D″ (f : Unit) : D′ f (d Unit unit) → Set where
  d″ : ∀ (x : Unit) → D″ _ (d′ f unit)

-- An internal error has occurred. Please report this as a bug.
-- Location of the error: src/full/Agda/TypeChecking/MetaVars.hs:583


{-# OPTIONS --cubical #-}
module Cubical.Categories.Everything where

import Cubical.Categories.Category
import Cubical.Categories.Functor
import Cubical.Categories.NaturalTransformation
import Cubical.Categories.Presheaves
import Cubical.Categories.Sets
import Cubical.Categories.Type


-- Andreas, 2020-04-19, issue #4560, raised by Andrea
-- Having both matching on constructor and copattern matching
-- for non-eta records leads to loss of subject reduction.

open import Agda.Builtin.Equality

postulate
  A : Set
  a : A

record R : Set where
  constructor con
  no-eta-equality
  field
    X Y : A

foo : R → A
foo (con x y) = x

-- Expected error here:
-- Pattern matching on no-eta record types is by default not allowed
-- when checking that the pattern con x y has type R

bar : R
bar .R.X = a
bar .R.Y = a

test : foo bar ≡ a
test = refl

-- Problem was:
-- foo bar != a of type A
-- when checking that the expression refl has type foo bar ≡ a


module _ where

module A where

  data D : Set where
    !_ : D

module B where

  data D : Set where
    !_ : D

open A

test : B.D
test = !_


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

module CauchyProofsT where

-- Proofs about permutations defined in module Cauchy (multiplicative)

open import Level using (Level; _⊔_) renaming (zero to lzero; suc to lsuc)

open import Relation.Binary.PropositionalEquality
  using (_≡_; refl; sym; trans; subst; subst₂; cong; cong₂; setoid;
        proof-irrelevance; module ≡-Reasoning)
open import Relation.Binary.PropositionalEquality.TrustMe
  using (trustMe)
open import Relation.Nullary using (Dec; yes; no; ¬_)
open import Data.Nat.Properties
  using (m≤m+n; n≤m+n; n≤1+n; cancel-*-right-≤; ≰⇒>; ¬i+1+j≤i)
open import Data.Nat.Properties.Simple
  using (+-right-identity; +-suc; +-assoc; +-comm;
        *-assoc; *-comm; *-right-zero; distribʳ-*-+; +-*-suc)
open import Data.Nat.DivMod using (DivMod; result; _divMod_; _div_; _mod_)
open import Relation.Binary using (Rel; Decidable; Setoid)
open import Relation.Binary.Core using (Transitive)

open import Data.String using (String)
  renaming (_++_ to _++S_)
open import Data.Nat.Show using (show)
open import Data.Bool using (Bool; false; true)
open import Data.Nat using (ℕ; suc; _+_; _∸_; _*_; _<_; _≮_; _≤_; _≰_;
  _≥_; z≤n; s≤s; _≟_; _≤?_; ≤-pred; module ≤-Reasoning)
open import Data.Fin
  using (Fin; zero; suc; toℕ; fromℕ; fromℕ≤; _ℕ-_; _≺_; reduce≥;
         raise; inject+; inject₁; inject≤; _≻toℕ_)
  renaming (_+_ to _F+_)
open import Data.Fin.Properties
  using (bounded; inject+-lemma; to-from; toℕ-injective; inject≤-lemma; toℕ-fromℕ≤)
open import Data.Vec.Properties
  using (lookup∘tabulate; tabulate∘lookup; lookup-allFin; tabulate-∘;
         tabulate-allFin; allFin-map; lookup-++-inject+; lookup-++-≥)
open import Data.Product using (Σ)

open import Data.List
  using (List; []; _∷_; _∷ʳ_; foldl; replicate; reverse; downFrom;
         concatMap; gfilter; initLast; InitLast; _∷ʳ'_)
  renaming (_++_ to _++L_; map to mapL; concat to concatL; zip to zipL)
open import Data.List.NonEmpty
  using (List⁺; [_]; _∷⁺_; head; last; _⁺++_)
  renaming (toList to nonEmptyListtoList; _∷ʳ_ to _n∷ʳ_; tail to ntail)
open import Data.List.Any using (Any; here; there; any; module Membership)
open import Data.Maybe using (Maybe; nothing; just; maybe′)
open import Data.Vec
  using (Vec; tabulate; []; _∷_; tail; lookup; zip; zipWith; splitAt;
         _[_]≔_; allFin; toList)
  renaming (_++_ to _++V_; map to mapV; concat to concatV)
open import Function using (id; _∘_; _$_; _∋_)

open import Data.Empty   using (⊥; ⊥-elim)
open import Data.Unit    using (⊤; tt)
open import Data.Sum     using (_⊎_; inj₁; inj₂)
open import Data.Product using (_×_; _,_; proj₁; proj₂)

open import Proofs
open import Cauchy
open import Perm
open import CauchyProofs

------------------------------------------------------------------------------
-- Proofs about multiplicative permutations

concat-nil : ∀ {m} →
  concatV (tabulate {m} (λ b → [])) ≡ subst Cauchy (sym (*-right-zero m)) []
concat-nil {0} = refl
concat-nil {suc m} = concat-nil {m}

empty-vec : ∀ {m} → (eq : m ≡ 0) → allFin m ≡ subst Cauchy (sym eq) []
empty-vec {0} refl = refl
empty-vec {suc m} ()

inj-lemma' : (m n : ℕ) (d : Fin n) (leq : suc (toℕ d) ≤ n + m) →
  inject+ m d ≡ inject≤ (fromℕ (toℕ d)) leq
inj-lemma' m 0 () _
inj-lemma' m (suc n) zero (s≤s _) = refl
inj-lemma' m (suc n) (suc d) (s≤s leq) = cong suc (inj-lemma' m n d leq)

inj-lemma : (m n : ℕ) (d : Fin n) (leq : suc (toℕ d) ≤ suc m * n) →
  inject+ (m * n) d ≡ inject≤ (fromℕ (toℕ d)) leq
inj-lemma m 0 () _
inj-lemma m (suc n) zero (s≤s _) = refl
inj-lemma m (suc n) (suc d) (s≤s leq) = cong suc (inj-lemma' (m * suc n) n d leq)

map-f≡g : {B : Set} (n : ℕ) (f g : Fin n → B) → (∀ i → f i ≡ g i) →
  mapV f (allFin n) ≡ mapV g (allFin n)
map-f≡g n f g eq =
  begin (mapV f (tabulate id)
           ≡⟨ sym (tabulate-∘ f id) ⟩
         tabulate f
           ≡⟨ finext eq ⟩
         tabulate g
           ≡⟨ tabulate-∘ g id ⟩
         mapV g (tabulate id) ∎)
  where open ≡-Reasoning

map-inj-lemma : (m n : ℕ) →
  (mapV (inject+ (m * n)) (allFin n)) ≡
  (mapV
    (λ d → inject≤
             (fromℕ (toℕ d))
             (i*n+k≤m*n {suc m} {n} zero d))
    (allFin n))
map-inj-lemma m n =
  map-f≡g n (inject+ (m * n))
            (λ d → inject≤ (fromℕ (toℕ d)) (i*n+k≤m*n {suc m} zero d))
            (λ d → inj-lemma m n d (i*n+k≤m*n {suc m} zero d))

map-raise-suc : (m n : ℕ) (j : Fin (suc m)) →
  mapV (λ d → raise (suc n)
                (inject≤
                  (fromℕ (toℕ j * suc n + toℕ d))
                   (i*n+k≤m*n j d)))
       (idcauchy (suc n)) ≡
  mapV (λ d → inject≤
                (fromℕ (toℕ (suc j) * suc n + toℕ d))
                (i*n+k≤m*n (suc j) d))
       (idcauchy (suc n))
map-raise-suc m n j = map-f≡g (suc n)
        (λ d → raise (suc n)
            (inject≤
              (fromℕ (toℕ j * suc n + toℕ d))
              (i*n+k≤m*n j d)))
        (λ d → inject≤
            (fromℕ (toℕ (suc j) * suc n + toℕ d))
            (i*n+k≤m*n (suc j) d))
        ( (λ d → raise-suc m n j d (i*n+k≤m*n j d) (i*n+k≤m*n (suc j) d)))

-- what should this be named?

lemma3 : (n m : ℕ) → (j : Fin m) →
  mapV (raise (suc n))
    (mapV (λ d → inject≤
                 (fromℕ (toℕ j * suc n + toℕ d))
                 (i*n+k≤m*n j d))
          (idcauchy (suc n)))
  ≡
  mapV (λ d → inject≤
              (fromℕ (toℕ (suc j) * suc n + toℕ d))
              (i*n+k≤m*n (suc j) d))
       (idcauchy (suc n))
lemma3 n 0 ()
lemma3 n (suc m) j =
  begin (
  _
    ≡⟨ sym (map-∘ (raise (suc n)) (λ d → inject≤
                 (fromℕ (toℕ j * suc n + toℕ d))
                 (i*n+k≤m*n j d)) (idcauchy (suc n))) ⟩
  mapV (λ d → raise (suc n) (inject≤
                 (fromℕ (toℕ j * suc n + toℕ d))
                 (i*n+k≤m*n j d))) (idcauchy (suc n))
    ≡⟨ map-raise-suc m n j ⟩
  _ ∎)
  where open ≡-Reasoning

map-raise-lemma : (m n : ℕ) →
  mapV
    (λ b → mapV
             (raise (suc n))
             (mapV
               (λ d → inject≤
                        (fromℕ (toℕ b * suc n + toℕ d))
                        (i*n+k≤m*n b d))
               (idcauchy (suc n))))
    (idcauchy m) ≡
  mapV
    (λ b → mapV
             (λ d → inject≤
                      (fromℕ (toℕ b * suc n + toℕ d))
                      (i*n+k≤m*n b d))
             (idcauchy (suc n)))
    (tabulate {m} suc)
map-raise-lemma 0 n = refl
map-raise-lemma (suc m) n =
  begin (
  mapV (λ b → mapV (raise (suc n))
             (mapV
               (λ d → inject≤
                        (fromℕ (toℕ b * suc n + toℕ d))
                        (i*n+k≤m*n b d))
               (idcauchy (suc n))))
    (idcauchy (suc m))
    ≡⟨ sym (tabulate-∘ _ id) ⟩
  tabulate  {suc m} (λ b → mapV (raise (suc n))
             (mapV
               (λ d → inject≤
                        (fromℕ (toℕ b * suc n + toℕ d))
                        (i*n+k≤m*n b d))
               (idcauchy (suc n))))
    ≡⟨ finext (lemma3 n (suc m)) ⟩
  tabulate {suc m} ((λ b → mapV
               (λ d → inject≤
                      (fromℕ (toℕ b * suc n + toℕ d))
                      (i*n+k≤m*n b d))
             (idcauchy (suc n))) ∘ suc)
    ≡⟨ tabulate-∘ _ suc ⟩
  mapV (λ b → mapV
             (λ d → inject≤
                      (fromℕ (toℕ b * suc n + toℕ d))
                      (i*n+k≤m*n b d))
             (idcauchy (suc n)))
    (tabulate {suc m} suc) ∎)
  where open ≡-Reasoning

allFin* : (m n : ℕ) → allFin (m * n) ≡
          concatV
            (mapV
              (λ b →
                mapV
                  (λ d → inject≤ (fromℕ (toℕ b * n + toℕ d)) (i*n+k≤m*n b d))
                  (idcauchy n))
            (idcauchy m))
allFin* 0 _ = refl
allFin* (suc m) 0 =
  begin (allFin (suc m * 0)
           ≡⟨ empty-vec {suc m * 0} (*-right-zero (suc m)) ⟩
         subst Cauchy (sym (*-right-zero (suc m))) []
           ≡⟨ sym (concat-nil {suc m}) ⟩
         concatV (tabulate {suc m} (λ b → []))
           ≡⟨ cong concatV (tabulate-allFin {suc m} (λ b → [])) ⟩
         concatV (mapV (λ b → []) (idcauchy (suc m))) ∎)
  where open ≡-Reasoning
allFin* (suc m) (suc n) =
  begin (allFin (suc n + m * suc n)
           ≡⟨ allFin+ (suc n) (m * suc n) ⟩
         mapV (inject+ (m * suc n)) (allFin (suc n)) ++V
         mapV (raise (suc n)) (allFin (m * suc n))
           ≡⟨ cong
                (λ x →
                  mapV (inject+ (m * suc n)) (allFin (suc n)) ++V
                  mapV (raise (suc n)) x)
                (allFin* m (suc n)) ⟩
         mapV (inject+ (m * suc n)) (allFin (suc n)) ++V
         mapV
           (raise (suc n))
           (concatV
             (mapV
               (λ b →
                 mapV
                   (λ d → inject≤
                            (fromℕ (toℕ b * suc n + toℕ d))
                            (i*n+k≤m*n b d))
                   (idcauchy (suc n)))
               (idcauchy m)))
           ≡⟨ cong
                (_++V_ (mapV (inject+ (m * suc n)) (allFin (suc n))))
                (sym (concat-map
                       (mapV
                         (λ b →
                           mapV
                             (λ d → inject≤
                                      (fromℕ (toℕ b * suc n + toℕ d))
                                      (i*n+k≤m*n b d))
                             (idcauchy (suc n)))
                         (idcauchy m))
                       (raise (suc n)))) ⟩
         mapV (inject+ (m * suc n)) (allFin (suc n)) ++V
         concatV
           (mapV
             (mapV (raise (suc n)))
             (mapV
               (λ b →
                 mapV
                   (λ d → inject≤
                            (fromℕ (toℕ b * suc n + toℕ d))
                            (i*n+k≤m*n b d))
                   (idcauchy (suc n)))
               (idcauchy m)))
           ≡⟨ refl ⟩
         concatV
           (mapV (inject+ (m * suc n)) (allFin (suc n)) ∷
            mapV
              (mapV (raise (suc n)))
              (mapV
                (λ b →
                  mapV
                    (λ d → inject≤
                             (fromℕ (toℕ b * suc n + toℕ d))
                             (i*n+k≤m*n b d))
                    (idcauchy (suc n)))
                (idcauchy m)))
           ≡⟨ cong
                 (λ x →
                   concatV
                     ((mapV (inject+ (m * suc n)) (allFin (suc n))) ∷ x))
                 (sym (map-∘
                        (mapV (raise (suc n)))
                        (λ b →
                          mapV
                            (λ d → inject≤
                                     (fromℕ (toℕ b * suc n + toℕ d))
                                     (i*n+k≤m*n b d))
                            (idcauchy (suc n)))
                        (idcauchy m))) ⟩
         concatV
           (mapV (inject+ (m * suc n)) (allFin (suc n)) ∷
            mapV
              (λ b → mapV
                       (raise (suc n))
                       (mapV
                         (λ d → inject≤
                                  (fromℕ (toℕ b * suc n + toℕ d))
                                  (i*n+k≤m*n b d))
                         (idcauchy (suc n))))
              (idcauchy m))
           ≡⟨ cong
                (λ x →
                  concatV
                    (x ∷
                    mapV
                      (λ b →
                        mapV
                          (raise (suc n))
                          (mapV
                            (λ d → inject≤
                                     (fromℕ (toℕ b * suc n + toℕ d))
                                     (i*n+k≤m*n b d))
                            (idcauchy (suc n))))
                      (idcauchy m)))
                (map-inj-lemma m (suc n)) ⟩
         concatV
           (mapV
              (λ d → inject≤
                       (fromℕ (toℕ d))
                       (i*n+k≤m*n {suc m} {suc n} zero d))
              (idcauchy (suc n)) ∷
            (mapV
              (λ b → mapV
                       (raise (suc n))
                       (mapV
                         (λ d → inject≤
                                  (fromℕ (toℕ b * suc n + toℕ d))
                                  (i*n+k≤m*n b d))
                         (idcauchy (suc n))))
              (idcauchy m)))
           ≡⟨ cong
                 (λ x →
                   concatV
                     (mapV
                       (λ d → inject≤
                                (fromℕ (toℕ d))
                                (i*n+k≤m*n {suc m} {suc n} zero d))
                       (idcauchy (suc n)) ∷
                     x))
                 (map-raise-lemma m n) ⟩
         concatV
           (mapV
              (λ d → inject≤
                       (fromℕ (toℕ d))
                       (i*n+k≤m*n {suc m} {suc n} zero d))
              (idcauchy (suc n)) ∷
            (mapV
               (λ b → mapV
                        (λ d → inject≤
                                 (fromℕ (toℕ b * suc n + toℕ d))
                                 (i*n+k≤m*n b d))
                        (idcauchy (suc n)))
               (tabulate {m} suc)))
           ≡⟨ refl ⟩
         concatV
           (mapV
             (λ b →
               mapV
                 (λ d → inject≤
                          (fromℕ (toℕ b * suc n + toℕ d))
                          (i*n+k≤m*n b d))
                 (idcauchy (suc n)))
             (idcauchy (suc m))) ∎)
  where open ≡-Reasoning

tcomp-id : ∀ {m n} → tcompcauchy (idcauchy m) (idcauchy n) ≡ idcauchy (m * n)
tcomp-id {m} {n} = sym (allFin* m n)

-- Behaviour of parallel multiplicative composition wrt sequential

absurd : (m n q : ℕ) (r : Fin (suc n)) (k : Fin (suc (n + m * suc n)))
         (k≡r+q*sn : toℕ k ≡ toℕ r + q * suc n) (p : suc m ≤ q) → ⊥
absurd m n q r k k≡r+q*sn p = ¬i+1+j≤i (toℕ k) {toℕ r} k≥k+sr
  where k≥k+sr : toℕ k ≥ toℕ k + suc (toℕ r)
        k≥k+sr =
          begin (toℕ k + suc (toℕ r)
                   ≡⟨ +-suc (toℕ k) (toℕ r) ⟩
                 suc (toℕ k) + toℕ r
                   ≤⟨ cong+r≤ (bounded k) (toℕ r) ⟩
                 (suc n + m * suc n) + toℕ r
                   ≡⟨ +-comm (suc n + m * suc n) (toℕ r) ⟩
                 toℕ r + (suc n + m * suc n)
                   ≡⟨ refl ⟩
                 toℕ r + suc m * suc n
                   ≤⟨ cong+l≤ (cong*r≤ p (suc n)) (toℕ r) ⟩
                 toℕ r + q * suc n
                   ≡⟨ sym k≡r+q*sn ⟩
                 toℕ k ∎)
          where open ≤-Reasoning

concat-tabulate-[] : ∀ {m n} {f : Fin m →  Fin n} →
    concatV (tabulate {m} ((λ x → []) ∘ f)) ≡
    subst (λ n → Vec (Fin (m * 0)) n) (sym (*-right-zero m)) []
concat-tabulate-[] {0} = refl
concat-tabulate-[] {suc m} {_} {f} = concat-tabulate-[] {m} {_} {f ∘ suc}

tabulate-⊥ : ∀ {m n} {g : Fin (m * 0) → Fin n} →
  tabulate g ≡ subst (Vec (Fin n)) (sym (*-right-zero m)) []
tabulate-⊥ {0} = refl
tabulate-⊥ {suc m}{_} {g} = tabulate-⊥ {m}

toℕ-inject+ : ∀ {n k} → (i : Fin n) → toℕ (inject+ k i) ≡ toℕ i
toℕ-inject+ {0} ()
toℕ-inject+ {suc n} zero = refl
toℕ-inject+ {suc n} (suc i) = cong suc (toℕ-inject+ i)

q≡ : (m : ℕ) (q : ℕ) (¬p : ¬ suc m ≤ q) →
  q ≡ toℕ (fromℕ≤ (s≤s (≤-pred (≰⇒> ¬p))))
q≡ m q ¬p = sym (toℕ-fromℕ≤ (s≤s (≤-pred (≰⇒> ¬p))))

absurd2 : (n q : ℕ) (i : Fin (suc n)) (r  : Fin (suc (suc n)))
  (eq : suc (toℕ i) ≡ toℕ r + suc (suc (n + q * suc (suc n)))) → ⊥
absurd2 n q i r eq = ¬i+1+j≤i (suc (toℕ i)) {toℕ r} leq
  where leq' = begin (suc (toℕ i)
                   ≤⟨ bounded i ⟩
                      suc n
                   ≤⟨ m≤m+n (suc n) (q * suc (suc n)) ⟩
                      suc (n + q * suc (suc n)) ∎)
               where open ≤-Reasoning
        leq = begin (suc (toℕ i) + suc (toℕ r)
                   ≡⟨ +-suc (suc (toℕ i)) (toℕ r) ⟩
                     suc (suc (toℕ i)) + toℕ r
                   ≡⟨ +-comm (suc (suc (toℕ i))) (toℕ r) ⟩
                     toℕ r + suc (suc (toℕ i))
                   ≤⟨ cong+l≤ (s≤s leq') (toℕ r) ⟩
                     toℕ r + suc (suc (n + q * suc (suc n)))
                   ≡⟨ sym eq ⟩
                     suc (toℕ i) ∎)
              where open ≤-Reasoning

small-quotient : (n q : ℕ) → (i : Fin n) → (r : Fin (suc n)) →
  (eq₁ : suc (toℕ i) ≡ toℕ r + q * suc n) → (q ≡ 0) × (toℕ r ≡ suc (toℕ i))
small-quotient 0 _ () _ _
small-quotient (suc n) 0 i r eq = (refl , sym  (trans eq (+-right-identity (toℕ r))))
small-quotient (suc n) (suc q) i r eq = ⊥-elim (absurd2 n q i r eq)

first-row :
  (m n : ℕ) → (f : Fin (suc m) × Fin (suc n) → Fin ((suc m) * (suc n))) →
  tabulate {suc n} (λ x → f (zero , x)) ≡
  tabulate {suc n} ((λ k →  f (fin-project (suc m) (suc n) k)) ∘ inject+ (m * suc n))
first-row m n f =
  finext pf
    where
      pf : (i : Fin (suc n)) →  f (zero , i) ≡
           f (fin-project (suc m) (suc n) (inject+ (m * suc n) i))
      pf zero = refl
      pf (suc i) with suc (toℕ (inject+ (m * suc n) i)) divMod suc n
      pf (suc i) | result q r property with suc m ≤? q
      pf (suc i) | result q r property | yes p =
                ⊥-elim (absurd m n q r (suc (inject+ (m * suc n) i)) property p)
      pf (suc i) | result q r property | no ¬p =
                cong f (cong₂ _,_ (toℕ-injective (sym a₁)) a₂)
        where
           q≡f₁ : q ≡ toℕ (fromℕ≤ (s≤s (≤-pred (≰⇒> ¬p))))
           q≡f₁ = q≡ m q ¬p
           si≡f₂ : _≡_ {A = ℕ} (suc (toℕ (inject+ (m * suc n) i)))  (suc (toℕ i))
           si≡f₂ = cong suc (toℕ-inject+ {k = m * suc n} i)
           sq : (q ≡ 0) × (toℕ r ≡ suc (toℕ i))
           sq = small-quotient n q i r (trans (sym si≡f₂) property)
           a₁ : toℕ (fromℕ≤ (s≤s (≤-pred (≰⇒> ¬p)))) ≡ toℕ {suc q} zero
           a₁ = trans (sym q≡f₁) (proj₁ sq)
           a₂ :  (suc i) ≡ r
           a₂ = toℕ-injective (sym (proj₂ sq))

lookup-2d' : (m n : ℕ) (k : Fin (m * n))
  (f : Fin m × Fin n → Fin (m * n)) →
  lookup k (concatV (tabulate (λ i → tabulate (λ j → f (i , j)))))
  ≡ f (fin-project m n k)
lookup-2d' m n k f =
  let fin-result b d dec dec' = fin-divMod m n k in
  begin (lookup k (concatV (tabulate (λ i → tabulate (λ j → f (i , j)))))
        ≡⟨ cong (λ x → lookup k (concatV x))
            (finext (λ i → tabulate-allFin (λ j → f (i , j)))) ⟩
         lookup k (concatV (tabulate (λ i → mapV (λ j → f (i , j)) (allFin n))))
        ≡⟨ cong
             (λ x → lookup k (concatV x))
             (tabulate-allFin (λ i → mapV (λ j → f (i , j)) (allFin n))) ⟩
         lookup k (concatV (mapV (λ i → mapV (λ j → f (i , j)) (allFin n)) (allFin m)))
        ≡⟨ lookup-2d m n k (allFin m) (allFin n) f ⟩
         f (lookup b (allFin m) , lookup d (allFin n))
        ≡⟨ cong₂ (λ x y → f (x , y)) (lookup-allFin b) (lookup-allFin d) ⟩
         f (b , d)
        ≡⟨ cong f (sym (inv' (fin-product-iso m n) (b , d))) ⟩
         f (split (fin-product-iso m n) (combine (fin-product-iso m n) (b , d)))
        ≡⟨ refl ⟩
         f (fin-project m n (combine (fin-product-iso m n) (b , d)))
        ≡⟨ cong
             (λ x → f (fin-project m n x))
             (sym dec') ⟩
         f (fin-project m n k) ∎)
  where open ≡-Reasoning
        open Fin-Product-Iso

tabulate-concat : ∀ {m n} → (f : Fin m × Fin n → Fin (m * n)) →
  concatV (tabulate {m} (λ i → tabulate {n} (λ j → f (i , j)))) ≡
  tabulate {m * n} (λ (k : Fin (m * n)) → f (fin-project m n k))
tabulate-concat {m} {n} f =
  begin (concatV (tabulate {m} (λ i → tabulate {n} (λ j → f (i , j))))
       ≡⟨ sym (tabulate∘lookup
                (concatV (tabulate {m} (λ i → tabulate {n} (λ j → f (i , j)))))) ⟩
         tabulate (λ i →
           lookup i
             (concatV (tabulate {m} (λ i → tabulate {n} (λ j → f (i , j))))))
       ≡⟨ finext (λ i → lookup-2d' m n i f) ⟩
         tabulate {m * n} (λ (k : Fin (m * n)) → f (fin-project m n k)) ∎)
  where open ≡-Reasoning

lookup-concat :
  ∀ {m n} → (k : Fin (m * n)) → (pm qm : Cauchy m) → (pn qn : Cauchy n) →
  let vs = concatV
             (mapV
               (λ b →
                 mapV
                   (λ d → inject≤ (fromℕ (toℕ b * n + toℕ d)) (i*n+k≤m*n b d))
                   pn)
             pm)
      ws = concatV
             (mapV
               (λ b →
                 mapV
                   (λ d → inject≤ (fromℕ (toℕ b * n + toℕ d)) (i*n+k≤m*n b d))
                   qn)
             qm)
  in lookup (lookup k vs) ws
  ≡
  let (b , d) = fin-project m n k
      x = lookup (lookup b pm) qm
      y = lookup (lookup d pn) qn
  in inject≤ (fromℕ (toℕ x * n + toℕ y)) (i*n+k≤m*n x y)
lookup-concat {0} () pm qm pn qn
lookup-concat {suc m} {0} k pm qm [] [] =
  ⊥-elim (Fin0-⊥ (subst Fin (*-right-zero m) k))
lookup-concat {suc m} {suc n} zero (x ∷ pm) (x₁ ∷ qm) (x₂ ∷ pn) (x₃ ∷ qn) =
  begin (lookup
           (inject≤ (fromℕ (toℕ x * suc n + toℕ x₂)) (i*n+k≤m*n x x₂))
           (concatV
             (mapV
               (λ b →
                 mapV
                   (λ d → inject≤ (fromℕ (toℕ b * suc n + toℕ d)) (i*n+k≤m*n b d))
                   (x₃ ∷ qn))
               (x₁ ∷ qm)))
       ≡⟨ lookup-concat'
            (suc m) (suc n) x x₂ (i*n+k≤m*n x x₂)
            (λ {(b , d) → inject≤ (fromℕ (toℕ b * suc n + toℕ d)) (i*n+k≤m*n b d)})
            (x₁ ∷ qm) (x₃ ∷ qn) ⟩
         inject≤
           (fromℕ (toℕ (lookup x (x₁ ∷ qm)) * suc n + toℕ (lookup x₂ (x₃ ∷ qn))))
           (i*n+k≤m*n (lookup x (x₁ ∷ qm)) (lookup x₂ (x₃ ∷ qn)))
       ≡⟨ refl ⟩
         let (b , d) = fin-project (suc m) (suc n) zero
             x = lookup (lookup b (x ∷ pm)) (x₁ ∷ qm)
             y = lookup (lookup d (x₂ ∷ pn)) (x₃ ∷ qn)
         in inject≤ (fromℕ (toℕ x * suc n + toℕ y)) (i*n+k≤m*n x y) ∎)
  where open ≡-Reasoning
lookup-concat {suc m} {suc n} (suc k) (x ∷ pm) (x₁ ∷ qm) (x₂ ∷ pn) (x₃ ∷ qn) =
  begin (let vs = concatV
                    (mapV
                      (λ b →
                        mapV
                          (λ d →
                            inject≤ (fromℕ (toℕ b * suc n + toℕ d)) (i*n+k≤m*n b d))
                          (x₂ ∷ pn))
                      (x ∷ pm))
             ws = concatV
                    (mapV
                      (λ b →
                        mapV
                          (λ d →
                            inject≤ (fromℕ (toℕ b * suc n + toℕ d)) (i*n+k≤m*n b d))
                          (x₃ ∷ qn))
                    (x₁ ∷ qm))
         in lookup (lookup (suc k) vs) ws
       ≡⟨ cong (λ z →
                lookup
                  (lookup z
                    (concatV
                      (mapV
                        (λ b →
                          mapV
                            (λ d →
                              inject≤ (fromℕ (toℕ b * suc n + toℕ d)) (i*n+k≤m*n b d))
                            (x₂ ∷ pn))
                        (x ∷ pm))))
                  (concatV
                    (mapV
                      (λ b →
                        mapV
                          (λ d →
                            inject≤ (fromℕ (toℕ b * suc n + toℕ d)) (i*n+k≤m*n b d))
                          (x₃ ∷ qn))
                    (x₁ ∷ qm))))
                  (fin-proj-lem (suc m) (suc n) (suc k)) ⟩
         let (b' , d') = fin-project (suc m) (suc n) (suc k)
             vs = concatV
                    (mapV
                      (λ b →
                        mapV
                          (λ d →
                            inject≤ (fromℕ (toℕ b * suc n + toℕ d)) (i*n+k≤m*n b d))
                          (x₂ ∷ pn))
                      (x ∷ pm))
             ws = concatV
                    (mapV
                      (λ b →
                        mapV
                          (λ d →
                            inject≤ (fromℕ (toℕ b * suc n + toℕ d)) (i*n+k≤m*n b d))
                          (x₃ ∷ qn))
                    (x₁ ∷ qm))
         in lookup
              (lookup
                (inject≤ (fromℕ (toℕ b' * (suc n) + toℕ d')) (i*n+k≤m*n b' d'))
                vs)
              ws
       ≡⟨ cong
            (λ x → lookup x ws)
            (lookup-concat' (suc m) (suc n) b' d' (i*n+k≤m*n b' d')
              (λ {(b , d) → inject≤ (fromℕ (toℕ b * suc n + toℕ d)) (i*n+k≤m*n b d)})
              (x ∷ pm) (x₂ ∷ pn)) ⟩
         let (b' , d') = fin-project (suc m) (suc n) (suc k)
             ws = concatV
                    (mapV
                      (λ b →
                        mapV
                          (λ d →
                            inject≤ (fromℕ (toℕ b * suc n + toℕ d)) (i*n+k≤m*n b d))
                          (x₃ ∷ qn))
                    (x₁ ∷ qm))
         in lookup
              (inject≤
                (fromℕ (toℕ (lookup b' (x ∷ pm)) * suc n + toℕ (lookup d' (x₂ ∷ pn))))
                (i*n+k≤m*n (lookup b' (x ∷ pm)) (lookup d' (x₂ ∷ pn))))
              ws
       ≡⟨ lookup-concat' (suc m) (suc n) (lookup b' (x ∷ pm)) (lookup d' (x₂ ∷ pn))
             (i*n+k≤m*n (lookup b' (x ∷ pm)) (lookup d' (x₂ ∷ pn)))
             (λ {(b , d) → inject≤ (fromℕ (toℕ b * suc n + toℕ d)) (i*n+k≤m*n b d)})
             (x₁ ∷ qm) (x₃ ∷ qn) ⟩
         let (b , d) = fin-project (suc m) (suc n) (suc k)
             r = lookup (lookup b (x ∷ pm)) (x₁ ∷ qm)
             s = lookup (lookup d (x₂ ∷ pn)) (x₃ ∷ qn)
         in inject≤
              (fromℕ (toℕ r * suc n + toℕ s))
              (i*n+k≤m*n r s) ∎)
  where open ≡-Reasoning

tcomp-dist : ∀ {m n} → (pm qm : Cauchy m) → (pn qn : Cauchy n) →
  scompcauchy (tcompcauchy pm pn) (tcompcauchy qm qn) ≡
  tcompcauchy (scompcauchy pm qm) (scompcauchy pn qn)
tcomp-dist {m} {n} pm qm pn qn =
  begin (scompcauchy (tcompcauchy pm pn) (tcompcauchy qm qn)
           ≡⟨ refl ⟩
         tabulate {m * n} (λ k →
           lookup
             (lookup k (concatV
                         (mapV
                           (λ b →
                             mapV (λ d →
                               inject≤
                                 (fromℕ (toℕ b * n + toℕ d))
                                 (i*n+k≤m*n b d)) pn)
                           pm)))
             (concatV
               (mapV
                 (λ b →
                   mapV (λ d →
                     inject≤
                       (fromℕ (toℕ b * n + toℕ d))
                       (i*n+k≤m*n b d)) qn)
                 qm)))
           ≡⟨  finext (λ k → lookup-concat {m} {n} k pm qm pn qn) ⟩
         tabulate {m * n}
           (λ k →
             let (i , j) = fin-project m n k
                 b = lookup (lookup i pm) qm
                 d = lookup (lookup j pn) qn in
             inject≤ (fromℕ (toℕ b * n + toℕ d)) (i*n+k≤m*n b d))
           ≡⟨  sym (tabulate-concat
                 (λ {(i , j) →
                   let b = lookup (lookup i pm) qm
                       d = lookup (lookup j pn) qn in
                   inject≤ (fromℕ (toℕ b * n + toℕ d)) (i*n+k≤m*n b d)})) ⟩
         concatV
           (tabulate {m}
             (λ i →
               tabulate {n}
                 (λ j →
                   let b = lookup (lookup i pm) qm
                       d = lookup (lookup j pn) qn in
                   inject≤ (fromℕ (toℕ b * n + toℕ d)) (i*n+k≤m*n b d))))
           ≡⟨  cong concatV
                 (finext
                   (λ i →
                     tabulate-∘
                       (let b = lookup (lookup i pm) qm in
                        λ d →
                          inject≤ (fromℕ (toℕ b * n + toℕ d)) (i*n+k≤m*n b d))
                       (λ i → lookup (lookup i pn) qn))) ⟩
         concatV
           (tabulate {m}
             (λ i →
               let b = lookup (lookup i pm) qm in
               mapV
                 (λ d → inject≤ (fromℕ (toℕ b * n + toℕ d)) (i*n+k≤m*n b d))
                 (tabulate (λ i → lookup (lookup i pn) qn))))
           ≡⟨ cong concatV (tabulate-∘
                (λ b →
                  mapV
                    (λ d → inject≤ (fromℕ (toℕ b * n + toℕ d)) (i*n+k≤m*n b d))
                    (tabulate (λ i → lookup (lookup i pn) qn)))
                 (λ i → lookup (lookup i pm) qm)) ⟩
         concatV
           (mapV
             (λ b →
               mapV
                 (λ d → inject≤ (fromℕ (toℕ b * n + toℕ d)) (i*n+k≤m*n b d))
                 (tabulate (λ i → lookup (lookup i pn) qn)))
             (tabulate (λ i → lookup (lookup i pm) qm)))
           ≡⟨  refl ⟩
         tcompcauchy (scompcauchy pm qm) (scompcauchy pn qn) ∎)
  where open ≡-Reasoning

------------------------------------------------------------------------------


-- WARNING: This file was generated automatically by Vehicle
-- and should not be modified manually!
-- Metadata
--  - Agda version: 2.6.2
--  - AISEC version: 0.1.0.1
--  - Time generated: ???

{-# OPTIONS --allow-exec #-}

open import Vehicle
open import Vehicle.Data.Tensor
open import Data.Rational as ℚ using (ℚ)
open import Data.List
open import Relation.Binary.PropositionalEquality

module autoencoderError-output where

private
  VEHICLE_PROJECT_FILE = "TODO_projectFile"

encode : Tensor ℚ (5 ∷ []) → Tensor ℚ (2 ∷ [])
encode = evaluate record
  { projectFile = VEHICLE_PROJECT_FILE
  ; networkUUID = "TODO_networkUUID"
  }

decode : Tensor ℚ (2 ∷ []) → Tensor ℚ (5 ∷ [])
decode = evaluate record
  { projectFile = VEHICLE_PROJECT_FILE
  ; networkUUID = "TODO_networkUUID"
  }

abstract
  identity : ∀ (x : Tensor ℚ (5 ∷ [])) → decode (encode x) ≡ x
  identity = checkProperty record
    { projectFile  = VEHICLE_PROJECT_FILE
    ; propertyUUID = "TODO_propertyUUID"
    }


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

mutual

  data D : Set → Set₁ where
    c : (@0 A : Set) → _ → D _

  _ : (@0 A : Set) → A → D A
  _ = c


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

open import Definition.Typed.EqualityRelation

module Definition.LogicalRelation.Substitution.Introductions.Snd {{eqrel : EqRelSet}} where
open EqRelSet {{...}}

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.Weakening as T hiding (wk; wkTerm; wkEqTerm)
open import Definition.Typed.RedSteps
open import Definition.LogicalRelation
open import Definition.LogicalRelation.ShapeView
open import Definition.LogicalRelation.Irrelevance
open import Definition.LogicalRelation.Weakening
open import Definition.LogicalRelation.Properties
open import Definition.LogicalRelation.Application
open import Definition.LogicalRelation.Substitution
open import Definition.LogicalRelation.Substitution.Properties
open import Definition.LogicalRelation.Substitution.Introductions.Pi
open import Definition.LogicalRelation.Substitution.Introductions.SingleSubst
open import Definition.LogicalRelation.Substitution.Introductions.Fst

open import Tools.Product
import Tools.PropositionalEquality as PE

snd-subst*′ : ∀ {Γ l l′ F G t t′}
             ([F] : Γ ⊩⟨ l ⟩ F)
             ([ΣFG] : Γ ⊩⟨ l′ ⟩B⟨ BΣ ⟩ Σ F ▹ G)
             ([t′] : Γ ⊩⟨ l′ ⟩ t′ ∷ Σ F ▹ G / B-intr BΣ [ΣFG])
             → Γ ⊢ t ⇒* t′ ∷ Σ F ▹ G
             → Γ ⊢ snd t ⇒* snd t′ ∷ G [ fst t ]
snd-subst*′ [F] (noemb (Bᵣ F G D ⊢F ⊢G A≡A [F]₁ [G] G-ext)) _ (id x) with
              B-PE-injectivity BΣ (whnfRed* (red D) Σₙ)
... | PE.refl , PE.refl = id (sndⱼ ⊢F ⊢G x)
snd-subst*′ {Γ = Γ} {F = F} {G = G} {t = t} {t′ = t″} [F]
            [ΣFG]₀@(noemb (Bᵣ F₁ G₁ D ⊢F ⊢G A≡A [F]₁ [G] G-ext))
            [t″]
            t⇒*t″@(_⇨_ {t′ = t′} t⇒t′ t′⇒*t″) with
              B-PE-injectivity BΣ (whnfRed* (red D) Σₙ)
... | PE.refl , PE.refl =
  let [ΣFG] = B-intr BΣ [ΣFG]₀
      [t] , _ = redSubst*Term t⇒*t″ [ΣFG] [t″]
      [t′] , _ = redSubst*Term t′⇒*t″ [ΣFG] [t″]
      [t≡t′] : Γ ⊩⟨ _ ⟩ t ≡ t′ ∷ Σ F ▹ G / [ΣFG]
      [t≡t′] = proj₂ (redSubstTerm t⇒t′ [ΣFG] [t′])
      [fstt] : Γ ⊩⟨ _ ⟩ fst t ∷ F / [F]
      [fstt] = fst″ [F] [ΣFG] [t]
      [fstt′] : Γ ⊩⟨ _ ⟩ fst t′ ∷ F / [F]
      [fstt′] = fst″ [F] [ΣFG] [t′]
      [Gfstt] : Γ ⊩⟨ _ ⟩ G [ fst t ]
      [Gfstt] = substSΠ₁ BΣ [ΣFG] [F] [fstt]
      [Gfstt′] : Γ ⊩⟨ _ ⟩ G [ fst t′ ]
      [Gfstt′] = substSΠ₁ BΣ [ΣFG] [F] [fstt′]
      [fstt′≡fstt] : Γ ⊩⟨ _ ⟩ fst t′ ≡ fst t ∷ F / [F]
      [fstt′≡fstt] = symEqTerm [F] (fst-cong″ [F] [ΣFG] [t≡t′])
      [Gfstt′≡Gfstt] : Γ ⊩⟨ _ ⟩ G [ fst t′ ] ≡ G [ fst t ] / [Gfstt′]
      [Gfstt′≡Gfstt] = substSΠ₂ BΣ [ΣFG] (reflEq [ΣFG]) [F] [F] [fstt′] [fstt] [fstt′≡fstt] [Gfstt′] [Gfstt]
  in  snd-subst ⊢F ⊢G t⇒t′ ⇨ conv* (snd-subst*′ [F] [ΣFG]₀ [t″] t′⇒*t″)
                                               (≅-eq (escapeEq [Gfstt′] [Gfstt′≡Gfstt]))
snd-subst*′ [F] (emb 0<1 x) = snd-subst*′ [F] x

-- NOTE this has a horrible interface (and implementation)
snd-subst* : ∀ {Γ l l′ F G t t′}
             ([F] : Γ ⊩⟨ l ⟩ F)
             ([ΣFG] : Γ ⊩⟨ l′ ⟩ Σ F ▹ G)
             ([t′] : Γ ⊩⟨ l′ ⟩ t′ ∷ Σ F ▹ G / [ΣFG])
             → Γ ⊢ t ⇒* t′ ∷ Σ F ▹ G
             → Γ ⊢ snd t ⇒* snd t′ ∷ G [ fst t ]
snd-subst* [F] [ΣFG] [t′] t⇒*t′ =
  let [t′]′ = irrelevanceTerm [ΣFG] (B-intr BΣ (B-elim BΣ [ΣFG])) [t′]
  in  snd-subst*′ [F] (B-elim BΣ [ΣFG]) [t′]′ t⇒*t′

snd′ : ∀ {F G t Γ l l′}
       ([ΣFG] : Γ ⊩⟨ l ⟩B⟨ BΣ ⟩ Σ F ▹ G)
       ([t] : Γ ⊩⟨ l ⟩ t ∷ Σ F ▹ G / B-intr BΣ [ΣFG])
       ([Gfst] : Γ ⊩⟨ l′ ⟩ G [ fst t ])
       → Γ ⊩⟨ l′ ⟩ snd t ∷ G [ fst t ] / [Gfst]
snd′ {F = F} {G = G} {t = t} {Γ = Γ} {l = l} {l′ = l′}
     [ΣFG]@(noemb (Bᵣ F' G' D ⊢F ⊢G A≡A [F'] [G'] G-ext))
     [t]@(Σₜ p d pProd p≅p [fstp] [sndp]) [Gfst] with
       B-PE-injectivity BΣ (whnfRed* (red D) Σₙ)
... | PE.refl , PE.refl =
  let ⊢Γ = wf ⊢F
      [p] = Σₜ p (idRedTerm:*: (⊢u-redₜ d)) pProd p≅p [fstp] [sndp]

      [fstt] , [fstt≡fstp] = redSubst*Term (PE.subst (λ x → Γ ⊢ fst t ⇒* fst p ∷ x)
                                                     (PE.sym (wk-id F))
                                                     (fst-subst* ⊢F ⊢G (redₜ d)))
                                           ([F'] id ⊢Γ) [fstp]

      [Gfstt] = [G'] id ⊢Γ [fstt]
      [Gfstp] = [G'] id ⊢Γ [fstp]
      [Gfstt≡Gfstp] = G-ext id ⊢Γ [fstt] [fstp] [fstt≡fstp]

      [sndp] = convTerm₂ [Gfstt] [Gfstp] [Gfstt≡Gfstp] [sndp]

      [sndp] : Γ ⊩⟨ l′ ⟩ snd p ∷ G [ fst t ] / [Gfst]
      [sndp] = irrelevanceTerm′ (PE.cong (λ x → x [ fst t ]) (wk-lift-id G))
                                [Gfstt] [Gfst] [sndp]
  in  proj₁ (redSubst*Term (snd-subst* (PE.subst (λ x → Γ ⊩⟨ l ⟩ x) (wk-id F) ([F'] id ⊢Γ))
                                       (B-intr BΣ [ΣFG])
                                       [p]
                                       (redₜ d))
                           [Gfst]
                           [sndp])
snd′ (emb 0<1 x) = snd′ x

snd″ : ∀ {F G t Γ l l′}
       ([ΣFG] : Γ ⊩⟨ l ⟩ Σ F ▹ G)
       ([t] : Γ ⊩⟨ l ⟩ t ∷ Σ F ▹ G / [ΣFG])
       ([Gfst] : Γ ⊩⟨ l′ ⟩ G [ fst t ])
       → Γ ⊩⟨ l′ ⟩ snd t ∷ G [ fst t ] / [Gfst]
snd″ {t = t} {Γ = Γ} {l = l} [ΣFG] [t] [Gfst] =
  let [t]′ = irrelevanceTerm [ΣFG] (B-intr BΣ (Σ-elim [ΣFG])) [t]
  in  snd′ (Σ-elim [ΣFG]) [t]′ [Gfst]

snd-cong′ : ∀ {F G t t′ Γ l l′}
            ([ΣFG] : Γ ⊩⟨ l ⟩B⟨ BΣ ⟩ Σ F ▹ G)
            ([t] : Γ ⊩⟨ l ⟩ t ∷ Σ F ▹ G / B-intr BΣ [ΣFG])
            ([t′] : Γ ⊩⟨ l ⟩ t′ ∷ Σ F ▹ G / B-intr BΣ [ΣFG])
            ([t≡t′] : Γ ⊩⟨ l ⟩ t ≡ t′ ∷ Σ F ▹ G / B-intr BΣ [ΣFG])
            ([Gfst] : Γ ⊩⟨ l′ ⟩ G [ fst t ])
            → Γ ⊩⟨ l′ ⟩ snd t ≡ snd t′ ∷ G [ fst t ] / [Gfst]
snd-cong′ {F} {G} {t} {t′} {Γ} {l} {l′}
          [ΣFG]@(noemb (Bᵣ F' G' D ⊢F ⊢G A≡A [F] [G] G-ext))
          [t]@(Σₜ p d pProd p≅p [fstp] [sndp])
          [t′]@(Σₜ p′ d′ pProd′ p′≅p′ [fstp′] [sndp′])
          [t≡t′]@(Σₜ₌ p₁ p′₁ d₁ d′₁ pProd₁ pProd′₁ p≅p′ [t]₁ [t′]₁ [fstp]₁ [fstp′]₁ [fst≡] [snd≡])
          [Gfst] with
            B-PE-injectivity BΣ (whnfRed* (red D) Σₙ)
          | whrDet*Term (redₜ d , productWhnf pProd) (redₜ d₁ , productWhnf pProd₁)
          | whrDet*Term (redₜ d′ , productWhnf pProd′) (redₜ d′₁ , productWhnf pProd′₁)
... | PE.refl , PE.refl | PE.refl | PE.refl =
  let ⊢Γ = wf ⊢F
      [p] : Γ ⊩⟨ l ⟩ p ∷ Σ F ▹ G / B-intr BΣ [ΣFG]
      [p] = Σₜ p (idRedTerm:*: (⊢u-redₜ d)) pProd p≅p [fstp] [sndp]
      [p′] : Γ ⊩⟨ l ⟩ p′ ∷ Σ F ▹ G / B-intr BΣ [ΣFG]
      [p′] = Σₜ p′ (idRedTerm:*: (⊢u-redₜ d′)) pProd′ p′≅p′ [fstp′] [sndp′]
      [F]′ = irrelevance′ (wk-id F) ([F] id ⊢Γ)

      [fstt] , [fstt≡fstp] = redSubst*Term (PE.subst (λ x → Γ ⊢ fst t ⇒* fst p ∷ x)
                                                     (PE.sym (wk-id F))
                                                     (fst-subst* ⊢F ⊢G (redₜ d)))
                                           ([F] id ⊢Γ) [fstp]
      [Gfstt≡Gfstp] = G-ext id ⊢Γ [fstt] [fstp] [fstt≡fstp]

      [sndp]′ : Γ ⊩⟨ l ⟩ snd p ∷ U.wk (lift id) G [ fst t ] / [G] id ⊢Γ [fstt]
      [sndp]′ = convTerm₂ ([G] id ⊢Γ [fstt]) ([G] id ⊢Γ [fstp]) [Gfstt≡Gfstp] [sndp]
      sndt⇒*sndp = snd-subst* [F]′ (B-intr BΣ [ΣFG]) [p] (redₜ d)
      [sndp]″ = irrelevanceTerm′ (PE.cong (λ x → x [ fst t ]) (wk-lift-id G))
                                 ([G] id ⊢Γ [fstt]) [Gfst]
                                 [sndp]′
      [sndt≡sndp] : Γ ⊩⟨ l′ ⟩ snd t ≡ snd p ∷ G [ fst t ] / [Gfst]
      [sndt≡sndp] = proj₂ (redSubst*Term sndt⇒*sndp [Gfst] [sndp]″)

      [snd≡]′ = convEqTerm₂ ([G] id ⊢Γ [fstt]) ([G] id ⊢Γ [fstp]₁) [Gfstt≡Gfstp] [snd≡]
      [sndp≡sndp′] : Γ ⊩⟨ l′ ⟩ snd p ≡ snd p′ ∷ G [ fst t ] / [Gfst]
      [sndp≡sndp′] = irrelevanceEqTerm′ (PE.cong (λ x → x [ fst t ]) (wk-lift-id G))
                                        ([G] id ⊢Γ [fstt]) [Gfst]
                                        [snd≡]′

      [fstt′] , [fstt′≡fstp′] = redSubst*Term (PE.subst (λ x → Γ ⊢ fst t′ ⇒* fst p′ ∷ x)
                                                     (PE.sym (wk-id F))
                                                     (fst-subst* ⊢F ⊢G (redₜ d′)))
                                           ([F] id ⊢Γ) [fstp′]
      [fstt≡fstt′] = irrelevanceEqTerm′ (PE.sym (wk-id F))
                                        [F]′ ([F] id ⊢Γ)
                                        (fst-cong′ [F]′ [ΣFG] [t≡t′])
      [fstt≡fstp′] = transEqTerm ([F] id ⊢Γ) [fstt≡fstt′] [fstt′≡fstp′]
      [Gfstt≡Gfstp′] = G-ext id ⊢Γ [fstt] [fstp′] [fstt≡fstp′]
      [sndp′]′ : Γ ⊩⟨ l ⟩ snd p′ ∷ U.wk (lift id) G [ fst t ] / [G] id ⊢Γ [fstt]
      [sndp′]′ = convTerm₂ ([G] id ⊢Γ [fstt]) ([G] id ⊢Γ [fstp′]) [Gfstt≡Gfstp′] [sndp′]
      [sndp′]″ = irrelevanceTerm′ (PE.cong (λ x → x [ fst t ]) (wk-lift-id G))
                                  ([G] id ⊢Γ [fstt]) [Gfst]
                                  [sndp′]′
      [Gfstt]′ = irrelevance′ (PE.cong (λ x → x [ fst t ]) (wk-lift-id G))
                              ([G] id ⊢Γ [fstt])
      [Gfstt≡Gfstt′] = irrelevanceEq″ (PE.cong (λ x → x [ fst t ]) (wk-lift-id G))
                                      (PE.cong (λ x → x [ fst t′ ]) (wk-lift-id G))
                                      ([G] id ⊢Γ [fstt]) [Gfstt]′
                                      (G-ext id ⊢Γ [fstt] [fstt′] [fstt≡fstt′])
      sndt′⇒*sndp′ : Γ ⊢ snd t′ ⇒* snd p′ ∷ G [ fst t ]
      sndt′⇒*sndp′ = conv* (snd-subst* [F]′ (B-intr BΣ [ΣFG]) [p′] (redₜ d′))
                           (≅-eq (≅-sym (escapeEq [Gfstt]′ [Gfstt≡Gfstt′])))
      [sndt′≡sndp′] : Γ ⊩⟨ l′ ⟩ snd t′ ≡ snd p′ ∷ G [ fst t ] / [Gfst]
      [sndt′≡sndp′] = proj₂ (redSubst*Term sndt′⇒*sndp′ [Gfst] [sndp′]″)

  in  transEqTerm [Gfst] [sndt≡sndp] (transEqTerm [Gfst] [sndp≡sndp′] (symEqTerm [Gfst] [sndt′≡sndp′]))
snd-cong′ {F} {G} (emb 0<1 x) = snd-cong′ x

snd-cong″ : ∀ {F G t t′ Γ l l′}
            ([ΣFG] : Γ ⊩⟨ l ⟩ Σ F ▹ G)
            ([t] : Γ ⊩⟨ l ⟩ t ∷ Σ F ▹ G / [ΣFG])
            ([t′] : Γ ⊩⟨ l ⟩ t′ ∷ Σ F ▹ G / [ΣFG])
            ([t≡t′] : Γ ⊩⟨ l ⟩ t ≡ t′ ∷ Σ F ▹ G / [ΣFG])
            ([Gfst] : Γ ⊩⟨ l′ ⟩ G [ fst t ])
            → Γ ⊩⟨ l′ ⟩ snd t ≡ snd t′ ∷ G [ fst t ] / [Gfst]
snd-cong″ {F} {G} [ΣFG] [t] [t′] [t≡t′] [Gfst] =
  let [t] = irrelevanceTerm [ΣFG] (B-intr BΣ (Σ-elim [ΣFG])) [t]
      [t′] = irrelevanceTerm [ΣFG] (B-intr BΣ (Σ-elim [ΣFG])) [t′]
      [t≡t′] = irrelevanceEqTerm [ΣFG] (B-intr BΣ (Σ-elim [ΣFG])) [t≡t′]
  in  snd-cong′ (B-elim BΣ [ΣFG]) [t] [t′] [t≡t′] [Gfst]

snd-congᵛ : ∀ {F G t t′ Γ l}
            ([Γ] : ⊩ᵛ Γ)
            ([F] : Γ ⊩ᵛ⟨ l ⟩ F / [Γ])
            ([G] : Γ ∙ F ⊩ᵛ⟨ l ⟩ G / [Γ] ∙ [F])
            ([t] : Γ ⊩ᵛ⟨ l ⟩ t ∷ Σ F ▹ G / [Γ] / Σᵛ {F} {G} [Γ] [F] [G])
            ([t′] : Γ ⊩ᵛ⟨ l ⟩ t′ ∷ Σ F ▹ G / [Γ] / Σᵛ {F} {G} [Γ] [F] [G])
            ([t≡t′] : Γ ⊩ᵛ⟨ l ⟩ t ≡ t′ ∷ Σ F ▹ G / [Γ] / Σᵛ {F} {G} [Γ] [F] [G])
          → Γ ⊩ᵛ⟨ l ⟩ snd t ≡ snd t′ ∷ G [ fst t ] / [Γ] / substS {F} {G} [Γ] [F] [G] (fstᵛ {F} {G} {t} [Γ] [F] [G] [t])
snd-congᵛ {F} {G} {t} {t′} {Γ} {l} [Γ] [F] [G] [t] [t′] [t≡t′] {Δ} {σ} ⊢Δ [σ] =
  let [ΣFG] = Σᵛ {F} {G} [Γ] [F] [G]
      [fst] = fstᵛ {F} {G} {t} [Γ] [F] [G] [t]
      [Gfst] = substS {F} {G} [Γ] [F] [G] [fst]

      ⊩σΣFG = proj₁ ([ΣFG] ⊢Δ [σ])
      ⊩σt = proj₁ ([t] ⊢Δ [σ])
      ⊩σt′ = proj₁ ([t′] ⊢Δ [σ])
      σt≡σt′ = [t≡t′] ⊢Δ [σ]

      ⊩σGfst₁ = proj₁ ([Gfst] ⊢Δ [σ])
      ⊩σGfst = irrelevance′ (singleSubstLift G (fst t)) ⊩σGfst₁

      σsnd≡₁ = snd-cong″ ⊩σΣFG ⊩σt ⊩σt′ σt≡σt′ ⊩σGfst
      σsnd≡ = irrelevanceEqTerm′ (PE.sym (singleSubstLift G (fst t))) ⊩σGfst ⊩σGfst₁ σsnd≡₁
  in  σsnd≡

-- Validity of second projection
sndᵛ : ∀ {F G t Γ l}
       ([Γ] : ⊩ᵛ Γ)
       ([F] : Γ ⊩ᵛ⟨ l ⟩ F / [Γ])
       ([G] : Γ ∙ F ⊩ᵛ⟨ l ⟩ G / [Γ] ∙ [F])
       ([t] : Γ ⊩ᵛ⟨ l ⟩ t ∷ Σ F ▹ G / [Γ] / Σᵛ {F} {G} [Γ] [F] [G])
       → Γ ⊩ᵛ⟨ l ⟩ snd t ∷ G [ fst t ] / [Γ] / substS {F} {G} [Γ] [F] [G] (fstᵛ {F} {G} {t} [Γ] [F] [G] [t])
sndᵛ {F} {G} {t} {Γ} {l} [Γ] [F] [G] [t] {Δ = Δ} {σ = σ} ⊢Δ [σ] =
  let [ΣFG] = Σᵛ {F} {G} [Γ] [F] [G]
      [Gfst] : Γ ⊩ᵛ⟨ l ⟩ G [ fst t ] / [Γ]
      [Gfst] = substS {F} {G} [Γ] [F] [G] (fstᵛ {F} {G} {t} [Γ] [F] [G] [t])

      σsnd : ∀ {Δ σ} (⊢Δ : ⊢ Δ) ([σ] : Δ ⊩ˢ σ ∷ Γ / [Γ] / ⊢Δ)
           → Δ ⊩⟨ l ⟩ subst σ (snd t) ∷ subst σ (G [ fst t ]) / proj₁ ([Gfst] ⊢Δ [σ])
      σsnd {Δ} {σ} ⊢Δ [σ] =
        let ⊩σΣFG = proj₁ ([ΣFG] ⊢Δ [σ])
            ⊩σt = proj₁ ([t] ⊢Δ [σ])
            ⊩σGfstt = proj₁ ([Gfst] ⊢Δ [σ])
            ⊩σGfstt′ = PE.subst (λ x → Δ ⊩⟨ l ⟩ x) (singleSubstLift G (fst t)) ⊩σGfstt
            ⊩σsnd = snd″ ⊩σΣFG ⊩σt ⊩σGfstt′
        in  irrelevanceTerm′
              (PE.sym (singleSubstLift G (fst t)))
              ⊩σGfstt′  ⊩σGfstt
              ⊩σsnd

  in  σsnd ⊢Δ [σ] ,
      (λ {σ′} [σ′] [σ≡σ′] →
        let [σF] = proj₁ ([F] ⊢Δ [σ])
            [σΣFG] = proj₁ ([ΣFG] ⊢Δ [σ])
            [σ′ΣFG] = proj₁ ([ΣFG] ⊢Δ [σ′])
            [σΣFG≡σ′ΣFG] = proj₂ ([ΣFG] ⊢Δ [σ]) [σ′] [σ≡σ′]
            [σt] = proj₁ ([t] ⊢Δ [σ])
            [σ′t] = proj₁ ([t] ⊢Δ [σ′])
            [σ′t] : Δ ⊩⟨ l ⟩ subst σ′ t ∷ subst σ (Σ F ▹ G) / [σΣFG]
            [σ′t] = convTerm₂ [σΣFG] [σ′ΣFG] [σΣFG≡σ′ΣFG] [σ′t]
            [σt≡σ′t] = proj₂ ([t] ⊢Δ [σ]) [σ′] [σ≡σ′]
            [σGfstt] = proj₁ ([Gfst] ⊢Δ [σ])
            [σGfstt]′ = PE.subst (λ x → _ ⊩⟨ l ⟩ x)
                                (singleSubstLift G (fst t))
                                [σGfstt]
            [sndt≡sndt′] = snd-cong″ [σΣFG] [σt] [σ′t] [σt≡σ′t] [σGfstt]′
        in  irrelevanceEqTerm′ (PE.sym (singleSubstLift G (fst t)))
                               [σGfstt]′ [σGfstt]
                               [sndt≡sndt′])


open import Agda.Builtin.List
open import Agda.Builtin.Reflection
open import Agda.Builtin.Unit

postulate
  F : Set → Set

module M₀ where
  macro
    go-tactic₀ : Term → TC ⊤
    go-tactic₀ hole = unify hole (def (quote F) [])

  test₀ : Set
  test₀ = go-tactic₀ ⊤

module M₁ (A : Set) where
  macro
    go-tactic₁ : Term → TC ⊤
    go-tactic₁ hole = unify hole (def (quote F) [])

  test-inside-M₁ : Set
  test-inside-M₁ = go-tactic₁ ⊤

test-outside-M₁ : Set
test-outside-M₁ = M₁.go-tactic₁ ⊤ ⊤


module _ where

module M (X : Set) where
  postulate
    F : Set
    G : Set

data ⊥ : Set where

open M ⊥ hiding (F)

easy : M.G ⊥
easy = {!!}   -- G

hard : M.F ⊥
hard = {!!}    -- M.F ⊥ (and not .Issue1640._.F)

data ⊤ : Set where
  tt : ⊤

module With where
  private
    F : ⊤ → Set
    F x with x
    F _ | tt = ⊥

  T = F

tricky : ∀ t → With.T t
tricky t = {!!}  -- .Issue1640.With.F t | t


open import FRP.JS.Behaviour using ( Beh ; [_] )
open import FRP.JS.DOM using ( DOM ; text )
open import FRP.JS.RSet using ( ⟦_⟧ )

module FRP.JS.Demo.Hello where

main : ∀ {w} → ⟦ Beh (DOM w) ⟧
main = text ["Hello, world."]


{-# OPTIONS --no-positivity-check #-}
open import Prelude

module Implicits.Resolution.Undecidable.Resolution where

open import Data.Fin.Substitution
open import Implicits.Syntax
open import Implicits.Syntax.MetaType
open import Implicits.Substitutions
open import Extensions.ListFirst

infixl 4 _⊢ᵣ_ _⊢_↓_ _⟨_⟩=_

mutual
  data _⊢_↓_ {ν} (Δ : ICtx ν) : Type ν → SimpleType ν → Set where
    i-simp : ∀ a → Δ ⊢ simpl a ↓ a
    i-iabs : ∀ {ρ₁ ρ₂ a} → Δ ⊢ᵣ ρ₁ → Δ ⊢ ρ₂ ↓ a → Δ ⊢ ρ₁ ⇒ ρ₂ ↓ a
    i-tabs : ∀ {ρ a} b → Δ ⊢ ρ tp[/tp b ] ↓ a → Δ ⊢ ∀' ρ ↓ a

  -- implicit resolution is simply the first rule in the implicit context
  -- that yields the queried type
  _⟨_⟩=_ : ∀ {ν} → ICtx ν → SimpleType ν → Type ν → Set
  Δ ⟨ a ⟩= r = first r ∈ Δ ⇔ (λ r' → Δ ⊢ r' ↓ a)

  data _⊢ᵣ_ {ν} (Δ : ICtx ν) : Type ν → Set where
    r-simp : ∀ {τ ρ} → Δ ⟨ τ ⟩= ρ → Δ ⊢ᵣ simpl τ
    r-iabs : ∀ ρ₁ {ρ₂} → ρ₁ List.∷ Δ ⊢ᵣ ρ₂ → Δ ⊢ᵣ ρ₁ ⇒ ρ₂
    r-tabs : ∀ {ρ} → ictx-weaken Δ ⊢ᵣ ρ → Δ ⊢ᵣ ∀' ρ

_⊢ᵣ[_] : ∀ {ν} → (Δ : ICtx ν) → List (Type ν) → Set
_⊢ᵣ[_] Δ ρs = All (λ r → Δ ⊢ᵣ r) ρs


{-# OPTIONS --cubical --safe #-}
module Cubical.Structures.Everything where

open import Cubical.Structures.Pointed public
open import Cubical.Structures.InftyMagma public
open import Cubical.Structures.Monoid public
open import Cubical.Structures.Queue public

open import Cubical.Structures.TypeEqvTo public


module Haskell.RangedSets.Ranges where

open import Haskell.Prim
open import Haskell.Prim.Ord
open import Haskell.Prim.Bool
open import Haskell.Prim.Maybe
open import Haskell.Prim.Enum
open import Haskell.Prim.Num
open import Haskell.Prim.Eq
open import Haskell.Prim.Functor
open import Haskell.Prim.Foldable
open import Haskell.Prim.Monoid
open import Haskell.Prim.Monad
open import Haskell.Prim.Applicative
open import Haskell.Prim.Int
open import Haskell.Prim.List
open import Haskell.Prim.Integer
open import Haskell.Prim.Real
open import Haskell.Prim.Show
open import Haskell.Prim.String
open import Haskell.Prim.Tuple

open import Haskell.RangedSets.Boundaries

{-# FOREIGN AGDA2HS
import Haskell.RangedSets.Boundaries
#-}

data Range (a : Set) ⦃ o : Ord a ⦄ ⦃ dio : DiscreteOrdered a ⦄ : Set where
    Rg : Boundary a → Boundary a → Range a
{-# COMPILE AGDA2HS Range #-}

rangeLower : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → Range a → Boundary a

rangeUpper : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → Range a → Boundary a

rangeIsEmpty : ⦃  o : Ord a  ⦄ → ⦃  dio : DiscreteOrdered a  ⦄ → Range a → Bool

emptyRange : ⦃  o : Ord a ⦄ → ⦃  dio : DiscreteOrdered a  ⦄ → Range a

rangeHas : ⦃  o : Ord a  ⦄ → ⦃  dio : DiscreteOrdered a  ⦄ → Range a → a → Bool

rangeListHas : ⦃  o : Ord a  ⦄ → ⦃  dio : DiscreteOrdered a  ⦄ → List (Range a) → a → Bool

fullRange : ⦃ o : Ord a ⦄ → ⦃  dio : DiscreteOrdered a  ⦄ → Range a

singletonRange : ⦃  o : Ord a  ⦄ → ⦃  dio : DiscreteOrdered a  ⦄ → a → Range a

rangeIsFull : ⦃  o : Ord a  ⦄ → ⦃  dio : DiscreteOrdered a  ⦄ → Range a → Bool

rangeOverlap : ⦃  o : Ord a  ⦄ → ⦃  dio : DiscreteOrdered a  ⦄ → Range a → Range a → Bool

rangeEncloses : ⦃  o : Ord a  ⦄ → ⦃  dio : DiscreteOrdered a  ⦄ → Range a → Range a → Bool

rangeUnion : ⦃  o : Ord a  ⦄ → ⦃  dio : DiscreteOrdered a  ⦄ → Range a → Range a → List (Range a)

rangeIntersection : ⦃  o : Ord a  ⦄ → ⦃  dio : DiscreteOrdered a  ⦄ → Range a → Range a → Range a

rangeDifference : ⦃  o : Ord a  ⦄ → ⦃  dio : DiscreteOrdered a  ⦄ → Range a → Range a → List (Range a)

rangeSingletonValue : ⦃  o : Ord a  ⦄ → ⦃  dio : DiscreteOrdered a  ⦄ → Range a → Maybe a

instance
    isRangeEq : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → Eq (Range a)
    isRangeEq . _==_ r1 r2 = (rangeIsEmpty r1 && rangeIsEmpty r2) || (rangeLower r1 == rangeLower r2 && rangeUpper r1 == rangeUpper r2)
{-# COMPILE AGDA2HS isRangeEq #-}

instance
    isRangeOrd : ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → Ord (Range a)
    isRangeOrd . compare r1 r2 = if_then_else_ (r1 == r2) EQ
                        (if_then_else_ (rangeIsEmpty r1) LT (if_then_else_ (rangeIsEmpty r2) GT
                        (compare (rangeLower r1) (rangeUpper r1) <> compare (rangeLower r2) (rangeUpper r2))))
    isRangeOrd ._<_ x y = compare x y == LT
    isRangeOrd ._>_ x y = compare x y == GT
    isRangeOrd ._<=_ x y = (compare x y == LT) || (compare x y == EQ)
    isRangeOrd ._>=_ x y = (compare x y == GT) || (compare x y == EQ)
    isRangeOrd .max x y = if (compare x y == GT) then x else y
    isRangeOrd .min x y = if (compare x y == LT) then x else y
{-# COMPILE AGDA2HS isRangeOrd #-}

h : ⦃  o : Ord a  ⦄ → ⦃  dio : DiscreteOrdered a  ⦄ → ⦃ Show a ⦄ → Boundary a → String
h BoundaryBelowAll = ""
h (BoundaryBelow x) = show x ++ " <= "
h (BoundaryAbove x) = show x ++ " < "
h BoundaryAboveAll = "show Range: lower bound is BoundaryAboveAll"
{-# COMPILE AGDA2HS h #-}

h2 : ⦃  o : Ord a  ⦄ → ⦃  dio : DiscreteOrdered a  ⦄ → ⦃ Show a ⦄ → Boundary a → String
h2 BoundaryBelowAll = "show Range: upper bound is BoundaryBelowAll"
h2 (BoundaryBelow x) = " < " ++ show x
h2 (BoundaryAbove x) = " <= " ++ show x
h2 BoundaryAboveAll = ""
{-# COMPILE AGDA2HS h2 #-}

showHelper : ⦃ Show a ⦄ → ⦃  o : Ord a  ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → Range a → Maybe a → String
showHelper r (Just v) = "x == " ++ show v
showHelper r Nothing = lowerBound ++ "x" ++ upperBound
         where
            lowerBound = h (rangeLower r)
            upperBound = h2 (rangeUpper r)
showHelper2 : ⦃ Show a ⦄ → ⦃  o : Ord a  ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → Range a → String
showHelper2 r = if_then_else_ (rangeIsEmpty r) "Empty" (if_then_else_ (rangeIsFull r) "All x" (showHelper r (rangeSingletonValue r)))
{-# COMPILE AGDA2HS showHelper #-}
{-# COMPILE AGDA2HS showHelper2 #-}

instance
   isRangeShow : ⦃ Show a ⦄ → ⦃ o : Ord a ⦄ → ⦃ dio : DiscreteOrdered a ⦄ → Show (Range a)
   isRangeShow .showsPrec _ = showString ∘ showHelper2
   isRangeShow .showList = defaultShowList (showString ∘ showHelper2)
{-# COMPILE AGDA2HS isRangeShow #-}

rangeLower ⦃ o ⦄ ⦃ dio ⦄ (Rg x y) = x
{-# COMPILE AGDA2HS rangeLower #-}

rangeUpper ⦃ o ⦄ ⦃ dio ⦄ (Rg x y) = y
{-# COMPILE AGDA2HS rangeUpper #-}

rangeIsEmpty r@(Rg lower upper) = upper <= lower
{-# COMPILE AGDA2HS rangeIsEmpty #-}

emptyRange = Rg BoundaryAboveAll BoundaryBelowAll
{-# COMPILE AGDA2HS emptyRange #-}

rangeHas r@(Rg b1 b2) v = (v />/ b1) && not (v />/ b2)
{-# COMPILE AGDA2HS rangeHas #-}

rangeHas1 : ⦃  o : Ord a  ⦄ → ⦃  dio : DiscreteOrdered a  ⦄ → a → Range a → Bool
rangeHas1 v r@(Rg b1 b2) = (v />/ b1) && not (v />/ b2)

rangeListHas (r@(Rg _ _) ∷ []) v = rangeHas r v
rangeListHas (r1@(Rg _ _) ∷ r2@(Rg _ _) ∷ []) v = (rangeHas r1 v) || (rangeHas r2 v)
rangeListHas ls v = or $ map (\r → rangeHas r v) ls
{-# COMPILE AGDA2HS rangeListHas #-}

rangeListHas1 : ⦃  o : Ord a  ⦄ → ⦃  dio : DiscreteOrdered a  ⦄ → a → List (Range a) → Bool
rangeListHas1 v (r@(Rg _ _) ∷ []) = rangeHas r v
rangeListHas1 v (r1@(Rg _ _) ∷ r2@(Rg _ _) ∷ []) = (rangeHas r1 v) || (rangeHas r2 v)
rangeListHas1 v ls = or $ map (\r → rangeHas r v) ls

fullRange ⦃ o ⦄ ⦃ dio ⦄ = Rg BoundaryBelowAll BoundaryAboveAll
{-# COMPILE AGDA2HS fullRange #-}

singletonRange v = Rg (BoundaryBelow v) (BoundaryAbove v)
{-# COMPILE AGDA2HS singletonRange #-}

rangeIsFull range = (range == fullRange)
{-# COMPILE AGDA2HS rangeIsFull #-}

rangeOverlap r1 r2 =
   not (rangeIsEmpty r1) && not (rangeIsEmpty r2) && not (rangeUpper r1 <= rangeLower r2 || rangeUpper r2 <= rangeLower r1)
{-# COMPILE AGDA2HS rangeOverlap #-}

rangeEncloses r1 r2 =
   (rangeLower r1 <= rangeLower r2 && rangeUpper r2 <= rangeUpper r1)
   || rangeIsEmpty r2
{-# COMPILE AGDA2HS rangeEncloses #-}

rangeIntersection r1@(Rg l1 u1) r2@(Rg l2 u2) = if_then_else_ (rangeIsEmpty r1 || rangeIsEmpty r2) emptyRange (Rg (max l1 l2) (min u1 u2))
{-# COMPILE AGDA2HS rangeIntersection #-}

rangeU2 : ⦃  o : Ord a  ⦄ → ⦃  dio : DiscreteOrdered a  ⦄ → Range a → Range a → List (Range a)
rangeU2 r1@(Rg l1 u1) r2@(Rg l2 u2) = (if_then_else_ touching ((Rg lower upper) ∷ []) (r1 ∷ r2 ∷ []))
   where
     touching = (max l1 l2) <= (min u1 u2)
     lower = min l1 l2
     upper = max u1 u2
{-# COMPILE AGDA2HS rangeU2 #-}

rangeU1 : ⦃  o : Ord a  ⦄ → ⦃  dio : DiscreteOrdered a  ⦄ → Range a → Range a → List (Range a)
rangeU1 r1@(Rg l1 u1) r2@(Rg l2 u2) = if_then_else_ (rangeIsEmpty r2) (r1 ∷ []) (rangeU2 r1 r2)
{-# COMPILE AGDA2HS rangeU1 #-}

rangeUnion r1@(Rg l1 u1) r2@(Rg l2 u2) = if_then_else_ (rangeIsEmpty r1) (r2 ∷ []) (rangeU1 r1 r2)
{-# COMPILE AGDA2HS rangeUnion #-}

rangeDifference (Rg lower1 upper1) (Rg lower2 upper2) = if_then_else_ intersects filtered (r1 ∷ [])
   where
      intersects = ((max lower1 lower2) < (min upper1 upper2))
      r1 = Rg lower1 upper1
      list = ((Rg lower1 lower2) ∷ (Rg upper2 upper1) ∷ [])
      filtered = filter (λ x → (rangeIsEmpty x) == false) list
{-# COMPILE AGDA2HS rangeDifference #-}

rangeSingletonValue (Rg (BoundaryBelow v1) (BoundaryBelow v2)) = if_then_else_ (adjacent v1 v2) (Just v1) Nothing
rangeSingletonValue (Rg (BoundaryBelow v1) (BoundaryAbove v2)) = if_then_else_ (v1 == v2) (Just v1) Nothing
rangeSingletonValue (Rg (BoundaryAbove v1) (BoundaryBelow v2)) = adjacentBelow v2 >>= λ x → adjacentBelow x >>= λ y → if_then_else_ (v1 == y) (return x) Nothing
rangeSingletonValue (Rg (BoundaryAbove v1) (BoundaryAbove v2)) = if_then_else_ (adjacent v1 v2) (Just v2) Nothing
rangeSingletonValue (Rg _ _) = Nothing
{-# COMPILE AGDA2HS rangeSingletonValue #-}