------------------------------------------------------------------------------
-- First-order logic theorems
------------------------------------------------------------------------------

{-# OPTIONS --exact-split              #-}
{-# OPTIONS --no-sized-types           #-}
{-# OPTIONS --no-universe-polymorphism #-}
{-# OPTIONS --without-K                #-}

module FOL.TheoremsI where

-- The theorems below are valid on intuitionistic logic and with an
-- empty domain.
open import FOL.Base hiding ( D≢∅ ; pem )

------------------------------------------------------------------------------
-- We postulate some formulae and propositional functions.
postulate
  A     : Set
  A¹ B¹ : D → Set
  A²    : D → D → Set

-- The introduction and elimination rules for the quantifiers are theorems.
{-
      φ(x)
  -----------  ∀-intro
    ∀x.φ(x)

    ∀x.φ(x)
  -----------  ∀-elim
     φ(t)

      φ(t)
  -----------  ∃-intro
    ∃x.φ(x)

   ∃x.φ(x)   φ(x) → ψ
 ----------------------  ∃-elim
           ψ
-}

∀-intro : ((x : D) → A¹ x) → ∀ x → A¹ x
∀-intro h = h

∀-intro' : ((x : D) → A¹ x) → ⋀ A¹
∀-intro' = dfun

∀-elim : (t : D) → (∀ x → A¹ x) → A¹ t
∀-elim t h = h t

∀-elim' : (t : D) → ⋀ A¹ → A¹ t
∀-elim' = dapp

∃-intro : (t : D) → A¹ t → ∃ A¹
∃-intro t A¹x = t , A¹x

∃-elim : ∃ A¹ → ((x : D) → A¹ x → A) → A
∃-elim (x , A¹x) h = h x A¹x

-- Generalization of De Morgan's laws.
gDM₂ : ¬ (∃ A¹) ↔ (∀ {x} → ¬ (A¹ x))
gDM₂ = l→r , r→l
  where
  l→r : ¬ (∃ A¹) → ∀ {x} → ¬ (A¹ x)
  l→r h A¹x = h (_ , A¹x)

  r→l : (∀ {x} → ¬ (A¹ x)) → ¬ (∃ A¹)
  r→l h (x , A¹x) = h A¹x

gDM₂' : ¬ (∃ A¹) ⇔ (⋀[ x ] ¬ (A¹ x))
gDM₂' = fun l→r , fun r→l
  where
  l→r : ¬ (∃ A¹) → ⋀[ x ] ¬ A¹ x
  l→r h = dfun (λ d A¹d → h (d , A¹d))

  r→l : ⋀[ x ] ¬ A¹ x → ¬ ∃ A¹
  r→l (dfun f) (x , A¹x) = f x A¹x

-- Quantification over a variable that does not occur can be erased or
-- added.
∃-erase-add : (∃[ x ] A ∧ A¹ x) ↔ A ∧ (∃[ x ] A¹ x)
∃-erase-add = l→r , r→l
  where
  l→r : ∃[ x ] A ∧ A¹ x → A ∧ (∃[ x ] A¹ x)
  l→r (x , a , A¹x) = a , x , A¹x

  r→l : A ∧ (∃[ x ] A¹ x) → ∃[ x ] A ∧ A¹ x
  r→l (a , x , A¹x) = x , a , A¹x

-- Interchange of quantifiers.
-- The related theorem ∀x∃y.Axy → ∃y∀x.Axy is not (classically) valid.
∃∀ : ∃[ x ] (∀ y → A² x y) → ∀ y → ∃[ x ] A² x y
∃∀ (x , h) y = x , h y

-- ∃ in terms of ∀ and ¬.
∃→¬∀¬ : ∃[ x ] A¹ x → ¬ (∀ {x} → ¬ A¹ x)
∃→¬∀¬ (_ , A¹x) h = h A¹x

∃¬→¬∀ : ∃[ x ] ¬ A¹ x → ¬ (∀ {x} → A¹ x)
∃¬→¬∀ (_ , h₁) h₂ = h₁ h₂

-- ∀ in terms of ∃ and ¬.
∀→¬∃¬ : (∀ {x} → A¹ x) → ¬ (∃[ x ] ¬ A¹ x)
∀→¬∃¬ h₁ (_ ,  h₂) = h₂ h₁

∀¬→¬∃ : (∀ {x} → ¬ A¹ x) → ¬ (∃[ x ] A¹ x)
∀¬→¬∃ h₁ (_ , h₂) = h₁ h₂

-- Distribution of ∃ and ∨.
∃∨ : ∃[ x ](A¹ x ∨ B¹ x) → (∃[ x ] A¹ x) ∨ (∃[ x ] B¹ x)
∃∨ (x , inj₁ A¹x) = inj₁ (x , A¹x)
∃∨ (x , inj₂ B¹x) = inj₂ (x , B¹x)


{-# OPTIONS --sized-types #-}
module SList.Properties (A : Set) where

open import Data.List
open import List.Permutation.Base A
open import SList

lemma-unsize-size : (xs : List A) → xs ∼ unsize A (size A xs)
lemma-unsize-size [] = ∼[]
lemma-unsize-size (x ∷ xs) = ∼x /head  /head (lemma-unsize-size xs)


------------------------------------------------------------------------
-- The Agda standard library
--
-- Indexed binary relations
------------------------------------------------------------------------

-- The contents of this module should be accessed via
-- `Relation.Binary.Indexed.Heterogeneous`.

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

open import Relation.Binary.Indexed.Heterogeneous.Core

module Relation.Binary.Indexed.Heterogeneous.Structures
  {i a ℓ} {I : Set i} (A : I → Set a) (_≈_ : IRel A ℓ)
  where

open import Function.Base
open import Level using (suc; _⊔_)
open import Relation.Binary using (_⇒_)
open import Relation.Binary.PropositionalEquality.Core as P using (_≡_)
open import Relation.Binary.Indexed.Heterogeneous.Definitions

------------------------------------------------------------------------
-- Equivalences

record IsIndexedEquivalence : Set (i ⊔ a ⊔ ℓ) where
  field
    refl  : Reflexive  A _≈_
    sym   : Symmetric  A _≈_
    trans : Transitive A _≈_

  reflexive : ∀ {i} → _≡_ ⟨ _⇒_ ⟩ _≈_ {i}
  reflexive P.refl = refl

record IsIndexedPreorder {ℓ₂} (_∼_ : IRel A ℓ₂) : Set (i ⊔ a ⊔ ℓ ⊔ ℓ₂) where
  field
    isEquivalence : IsIndexedEquivalence
    reflexive     : ∀ {i j} → (_≈_ {i} {j}) ⟨ _⇒_ ⟩ _∼_
    trans         : Transitive A _∼_

  module Eq = IsIndexedEquivalence isEquivalence

  refl : Reflexive A _∼_
  refl = reflexive Eq.refl


------------------------------------------------------------------------
-- The Agda standard library
--
-- Integers, basic types and operations
------------------------------------------------------------------------

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

module Data.Integer.Base where

open import Data.Nat.Base as ℕ
  using (ℕ) renaming (_+_ to _ℕ+_; _*_ to _ℕ*_)
open import Data.Sign as Sign using (Sign) renaming (_*_ to _S*_)
open import Function
open import Relation.Nullary using (¬_)
open import Relation.Binary using (Rel)
open import Relation.Binary.PropositionalEquality using (_≡_)

infix  8 -_
infixl 7 _*_ _⊓_
infixl 6 _+_ _-_ _⊖_ _⊔_
infix  4 _≤_ _≥_ _<_ _>_ _≰_ _≱_ _≮_ _≯_

------------------------------------------------------------------------
-- The types

open import Agda.Builtin.Int public
  using ()
  renaming
  ( Int to ℤ
  ; pos    to +_      -- "+ n"      stands for "n"
  ; negsuc to -[1+_]  -- "-[1+ n ]" stands for "- (1 + n)"
  )

------------------------------------------------------------------------
-- Conversions

-- Absolute value.

∣_∣ : ℤ → ℕ
∣ + n      ∣ = n
∣ -[1+ n ] ∣ = ℕ.suc n

-- Gives the sign. For zero the sign is arbitrarily chosen to be +.

sign : ℤ → Sign
sign (+ _)    = Sign.+
sign -[1+ _ ] = Sign.-

------------------------------------------------------------------------
-- A view of integers as sign + absolute value

infix 5 _◂_ _◃_

_◃_ : Sign → ℕ → ℤ
_      ◃ ℕ.zero  = + ℕ.zero
Sign.+ ◃ n       = + n
Sign.- ◃ ℕ.suc n = -[1+ n ]

data SignAbs : ℤ → Set where
  _◂_ : (s : Sign) (n : ℕ) → SignAbs (s ◃ n)

signAbs : ∀ i → SignAbs i
signAbs (+ ℕ.zero)    = Sign.+ ◂ ℕ.zero
signAbs (+ (ℕ.suc n)) = Sign.+ ◂ ℕ.suc n
signAbs (-[1+ n ])    = Sign.- ◂ ℕ.suc n

------------------------------------------------------------------------
-- Arithmetic

-- Negation.

-_ : ℤ → ℤ
- (+ ℕ.suc n) = -[1+ n ]
- (+ ℕ.zero)  = + ℕ.zero
- -[1+ n ]    = + ℕ.suc n

-- Subtraction of natural numbers.

_⊖_ : ℕ → ℕ → ℤ
m       ⊖ ℕ.zero  = + m
ℕ.zero  ⊖ ℕ.suc n = -[1+ n ]
ℕ.suc m ⊖ ℕ.suc n = m ⊖ n

-- Addition.

_+_ : ℤ → ℤ → ℤ
-[1+ m ] + -[1+ n ] = -[1+ ℕ.suc (m ℕ+ n) ]
-[1+ m ] + +    n   = n ⊖ ℕ.suc m
+    m   + -[1+ n ] = m ⊖ ℕ.suc n
+    m   + +    n   = + (m ℕ+ n)

-- Subtraction.

_-_ : ℤ → ℤ → ℤ
i - j = i + (- j)

-- Successor.

suc : ℤ → ℤ
suc i = (+ 1) + i

-- Predecessor.

pred : ℤ → ℤ
pred i = (- + 1) + i

-- Multiplication.

_*_ : ℤ → ℤ → ℤ
i * j = sign i S* sign j ◃ ∣ i ∣ ℕ* ∣ j ∣

-- Maximum.

_⊔_ : ℤ → ℤ → ℤ
-[1+ m ] ⊔ -[1+ n ] = -[1+ ℕ._⊓_ m n ]
-[1+ m ] ⊔ +    n   = + n
+    m   ⊔ -[1+ n ] = + m
+    m   ⊔ +    n   = + (ℕ._⊔_ m n)

-- Minimum.

_⊓_ : ℤ → ℤ → ℤ
-[1+ m ] ⊓ -[1+ n ] = -[1+ ℕ._⊔_ m n ]
-[1+ m ] ⊓ +    n   = -[1+ m ]
+    m   ⊓ -[1+ n ] = -[1+ n ]
+    m   ⊓ +    n   = + (ℕ._⊓_ m n)

------------------------------------------------------------------------
-- Ordering

data _≤_ : ℤ → ℤ → Set where
  -≤+ : ∀ {m n} → -[1+ m ] ≤ + n
  -≤- : ∀ {m n} → (n≤m : n ℕ.≤ m) → -[1+ m ] ≤ -[1+ n ]
  +≤+ : ∀ {m n} → (m≤n : m ℕ.≤ n) → + m ≤ + n

_≥_ : Rel ℤ _
x ≥ y = y ≤ x

_<_ : Rel ℤ _
x < y = suc x ≤ y

_>_ : Rel ℤ _
x > y = y < x

_≰_ : Rel ℤ _
x ≰ y = ¬ (x ≤ y)

_≱_ : Rel ℤ _
x ≱ y = ¬ (x ≥ y)

_≮_ : Rel ℤ _
x ≮ y = ¬ (x < y)

_≯_ : Rel ℤ _
x ≯ y = ¬ (x > y)


-- {-# OPTIONS -v tc.with:40 #-}

module RewriteAndWhere where

open import Common.Equality

data ℕ : Set where
  zero : ℕ

-- good : (a b : ℕ) → a ≡ b → b ≡ a
-- good a b eq with a | eq
-- ... | .b | refl = foo
--   where
--     foo : b ≡ b
--     foo = refl

mutual
  aux : (a b : ℕ)(w : ℕ) → w ≡ b → b ≡ w
  aux a b .b refl = foo
    where
     foo : b ≡ b
     foo = refl

  good₂ : (a b : ℕ) → a ≡ b → b ≡ a
  good₂ a b eq = aux a b a eq

bad : (a b : ℕ) → a ≡ b → b ≡ a
bad a b eq rewrite eq = foo
  where
    foo : b ≡ b
    foo = refl
    -- Andreas, 2014-11-06: this rewrite is trying to touch
    -- variable b bound in pattern of parent function, which is
    -- illegal.
    --
    -- foo rewrite sym eq = bar
    --   where
    --     bar : a ≡ a
    --     bar = refl

-- Andreas, 2015-11-18 added test during exploration of issue 1692.
-- Ulf, 2016-02-25 after fix to #745 this no longer works.
-- test : (a b : ℕ) → a ≡ b → b ≡ a
-- test a b eq with a | eq
-- test a b eq | .b | refl = eq


module Logic.Predicate.Theorems where

import      Lvl
open import Functional
open import Logic
open import Logic.Propositional
open import Logic.Propositional.Theorems
open import Logic.Predicate
open import Syntax.Type
open import Type
open import Type.Properties.Inhabited using (◊ ; [◊]-existence)

------------------------------------------
-- Swapping nested quantifiers

module _ {ℓₒ₁}{ℓₒ₂}{ℓₗ} {X : Type{ℓₒ₁}}{Y : Type{ℓₒ₂}}{P : X → Y → Stmt{ℓₗ}} where
  [∀]-swap : ∀ₗ(x ↦ ∀ₗ(y ↦ P(x)(y))) → ∀ₗ(y ↦ ∀ₗ(x ↦ P(x)(y)))
  [∀]-swap(xypxy){y}{x} = xypxy{x}{y}

  [∃]-swap : ∃(x ↦ ∃(y ↦ P(x)(y))) → ∃(y ↦ ∃(x ↦ P(x)(y)))
  [∃]-swap([∃]-intro(x) ⦃ [∃]-intro(y) ⦃ proof ⦄ ⦄) = [∃]-intro(y) ⦃ [∃]-intro(x) ⦃ proof ⦄ ⦄

------------------------------------------
-- Introducing and eliminating unnecessary quantifiers when the predicate is constant

module _ {ℓₒ}{ℓₗ} {X : Type{ℓₒ}} ⦃ pos : ◊ X ⦄ {P : Stmt{ℓₗ}} where
  [∃]-unnecessary-intro : P → ∃{Obj = X}(x ↦ P)
  [∃]-unnecessary-intro(p) = [∃]-intro([◊]-existence ⦃ pos ⦄) ⦃ p ⦄

module _ {ℓₒ}{ℓₗ} {X : Type{ℓₒ}} {P : Stmt{ℓₗ}} where
  [∀]-unnecessary-intro : P → ∀ₗ{Obj = X}(x ↦ P)
  [∀]-unnecessary-intro(p){x} = p

  [∃]-unnecessary-elim : ∃{Obj = X}(x ↦ P) → P
  [∃]-unnecessary-elim([∃]-intro(_) ⦃ proof ⦄) = proof

module _ {ℓₒ}{ℓₗ} {X : Type{ℓₒ}} ⦃ pos : ◊ X ⦄ {P : Stmt{ℓₗ}} where
  -- Note:
  --   The following is unprovable:
  --   [∀]-unnecessary : ∀{X}{P : Stmt} → ∀ₗ{X}(x ↦ P) → P
  --   X is not guaranteed to not be the empty type, and even if it was, the ∀ function requires a constructed value. It seems to need a non-empty domain to quantify over.
  [∀ₑ]-unnecessary-elim : ∀ₗ{Obj = X}(x ↦ P) → P
  [∀ₑ]-unnecessary-elim = [∀ₑ]-elim{Obj = X} ⦃ pos ⦄

------------------------------------------
-- When quantifiers contradict

module _ {ℓₒ}{ℓₗ} {X : Type{ℓₒ}} {P : X → Stmt{ℓₗ}} where
  [∀][∃¬]-contradiction : ∀ₗ(x ↦ P(x)) → ∃(x ↦ ¬(P(x))) → ⊥
  [∀][∃¬]-contradiction(ap)(enp) =
    ([∃]-elim(\{a} → np ↦ (
      ([⊥]-intro
        ([∀]-elim{Obj = X}{P} ap(a))
        np
      )
    )) (enp))

  [∀¬][∃]-contradiction : ∀ₗ(x ↦ ¬ P(x)) → ∃(x ↦ P(x)) → ⊥
  [∀¬][∃]-contradiction (axnpx) (expx) =
    axnpx {[∃]-witness(expx)} ([∃]-proof(expx))

------------------------------------------
-- Moving in and out negation from quantifiers

module _ {ℓₒ}{ℓₗ} {X : Type{ℓₒ}} {P : X → Stmt{ℓₗ}} where
  [∃¬]-to-[¬∀] : (∃(x ↦ ¬(P(x)))) → ¬(∀ₗ(x ↦ P(x)))
  [∃¬]-to-[¬∀] = swap ([∀][∃¬]-contradiction {ℓₒ}{ℓₗ})

  [∀¬]-to-[¬∃] : ∀ₗ(x ↦ ¬(P(x))) → ¬(∃(x ↦ P(x)))
  [∀¬]-to-[¬∃] = [∀¬][∃]-contradiction {ℓₒ}{ℓₗ} {X}{P}
    -- [∀¬]-to-[¬∃] (anpx) =
    --   ([¬]-intro(epx ↦
    --     [∃]-elim(\{a} → pa ↦
    --       ([⊥]-intro
    --         pa
    --         (anpx{a})
    --       )
    --     )(epx)
    --   ))

  [¬∃]-to-[∀¬] : ∀ₗ(x ↦ ¬(P(x))) ← ¬(∃(x ↦ P(x)))
  [¬∃]-to-[∀¬] (nepx) =
    ([∀]-intro(a ↦
      (([¬]-intro(pa ↦
        (([⊥]-intro
          (([∃]-intro a ⦃ pa ⦄) :of: (∃(x ↦ P(x))))
          (nepx :of: ¬(∃(x ↦ P(x))))
        ) :of: ⊥)
      )) :of: ¬(P(a)))
    ))

module _ {ℓₒ}{ℓₗ} {X : Type{ℓₒ}} ⦃ pos : ◊ X ⦄ {P : X → Stmt{ℓₗ}} where
  [¬∃]-to-[∃¬] : ¬(∃ P) → ∃(¬_ ∘ P)
  [¬∃]-to-[∃¬] (nexpx) = [∃]-intro ([◊]-existence ⦃ pos ⦄) ⦃ [¬∃]-to-[∀¬] {ℓₒ}{ℓₗ} {X}{P} (nexpx) ⦄

  [¬∃]-to-[¬∀] : ¬(∃ P) → ¬(∀ₗ P)
  [¬∃]-to-[¬∀] = ([∃¬]-to-[¬∀] {ℓₒ}{ℓₗ} {X}{P}) ∘ [¬∃]-to-[∃¬]

  [∀¬]-to-[¬∀] : ∀ₗ(¬_ ∘ P) → ¬(∀ₗ P)
  [∀¬]-to-[¬∀] axnpx axpx = (axnpx{[◊]-existence ⦃ pos ⦄}) (axpx{[◊]-existence ⦃ pos ⦄})

------------------------------------------
-- Introducing negations to change quantifier

module _ {ℓₒ}{ℓₗ} {X : Type{ℓₒ}} {P : X → Stmt{ℓₗ}} where
  [∀]-to-[¬∃¬] : ∀ₗ(x ↦ P(x)) → (¬ ∃(x ↦ ¬(P(x))))
  [∀]-to-[¬∃¬] = [∀][∃¬]-contradiction {ℓₒ}{ℓₗ} {X}{P} -- [∃]-elim(\{a} → npa ↦ npa(p{a}))(ep)

  [∃]-to-[¬∀¬] : ∃(x ↦ P(x)) → (¬ ∀ₗ(x ↦ ¬(P(x))))
  [∃]-to-[¬∀¬] = swap ([∀¬][∃]-contradiction {ℓₒ}{ℓₗ} {X}{P})

------------------------------------------
-- Stuff using double negation

module _ {ℓₒ}{ℓₗ} {X : Type{ℓₒ}} {P : X → Stmt{ℓₗ}} where
  [∀¬¬][∃¬]-contradiction : ∀ₗ(x ↦ ¬¬(P(x))) → (∃(x ↦ ¬(P(x)))) → ⊥
  [∀¬¬][∃¬]-contradiction (annp)([∃]-intro(a) ⦃ na ⦄) =
    [∀][∃¬]-contradiction {ℓₒ}{ℓₗ} {X}{¬¬_ ∘ P} (annp)([∃]-intro(a) ⦃ [¬¬]-intro(na) ⦄)

  [∀¬¬]-to-[¬∃¬] : ∀ₗ(x ↦ ¬¬(P(x))) → (¬ ∃(x ↦ ¬(P(x))))
  [∀¬¬]-to-[¬∃¬] = [∀¬¬][∃¬]-contradiction

  [¬¬∀]-to-[¬∃¬] : ¬¬ ∀ₗ(x ↦ (P(x))) → (¬ ∃(x ↦ ¬(P(x))))
  [¬¬∀]-to-[¬∃¬] = contrapositiveᵣ ([∃¬]-to-[¬∀] {ℓₒ}{ℓₗ} {X}{P})
  -- [¬¬∀]-to-[¬∃¬] (annx) (enx) =
  --   ([⊥]-intro
  --     ([∃¬]-to-[¬∀](enx))
  --     (annx)
  --   )

  [¬∃¬]-to-[∀¬¬] : ¬(∃(x ↦ ¬(P(x)))) → ∀ₗ(x ↦ ¬¬(P(x)))
  [¬∃¬]-to-[∀¬¬] (nenx) {a} (npa) = nenx([∃]-intro(a) ⦃ npa ⦄)

  [¬¬∀]-to-[∀¬¬] : ¬¬ ∀ₗ(x ↦ (P(x))) → ∀ₗ(x ↦ ¬¬(P(x)))
  [¬¬∀]-to-[∀¬¬] = [¬∃¬]-to-[∀¬¬] ∘ [¬¬∀]-to-[¬∃¬]

  [∀]-to-[∃]-conditional-by-existence : ∃(P) → ∀{Q : X → Stmt{ℓₗ}} → ∀ₗ(x ↦ (P(x) → Q(x))) → ∃(x ↦ (P(x) ∧ Q(x)))
  ∃.witness ([∀]-to-[∃]-conditional-by-existence p pq) = [∃]-witness p
  ∃.proof   ([∀]-to-[∃]-conditional-by-existence p pq) = [∧]-intro ([∃]-proof p) (pq{[∃]-witness p} ([∃]-proof p))

  -- TODO: Probably unprovable. Not sure why. Maybe because (¬¬A is valid in constructive logic) ⇔ (A is valid in classical logic), and therefore this would not be possible because everything here is in constructive logic.
  -- [∀¬¬]-to-[¬¬∀] : ∀{X}{P : X → Stmt} → ¬¬∀ₗ(x ↦ (P(x))) ← ∀ₗ(x ↦ ¬¬(P(x)))

------------------------------------------
-- Changing quantifier

module _ {ℓₒ}{ℓₗ} {X : Type{ℓₒ}} ⦃ pos : ◊ X ⦄ {P : X → Stmt{ℓₗ}} where
  -- Note: If X would be empty, then this would be unprovable because [∀]-elim needs a constructed element.
  [∀ₑ]-to-[∃] : ∀ₗ(x ↦ P(x)) → ∃(x ↦ P(x))
  [∀ₑ]-to-[∃] (apx) =
    [∃]-intro ([◊]-existence ⦃ pos ⦄) ⦃ [∀ₑ]-elim{Obj = X}{P = P}(apx) ⦄

------------------------------------------
-- "Distributing" quantifiers into logical operators

module _ {ℓₒ}{ℓₗ₁}{ℓₗ₂} {X : Type{ℓₒ}}{P : X → Stmt{ℓₗ₁}}{Q : X → Stmt{ℓₗ₂}} where
  [∀][→]-distributivity : ∀ₗ(x ↦ (P(x) → Q(x))) → ∀ₗ(x ↦ P(x)) → ∀ₗ(x ↦ Q(x))
  [∀][→]-distributivity (PxQx) (Px) = PxQx(Px)

  [∀][∧]-distributivity : ∀ₗ(x ↦ (P(x) ∧ Q(x))) ↔ (∀ₗ(x ↦ P(x)) ∧ ∀ₗ(x ↦ Q(x)))
  [∀][∧]-distributivity = [↔]-intro l r where
    l : (∀ₗ(x ↦ P(x)) ∧ ∀ₗ(x ↦ Q(x))) → ∀ₗ(x ↦ (P(x) ∧ Q(x)))
    l ([∧]-intro (axPx) (axQx)) {x} = [∧]-intro (axPx{x}) (axQx{x})

    r : (∀ₗ(x ↦ P(x)) ∧ ∀ₗ(x ↦ Q(x))) ← ∀ₗ(x ↦ (P(x) ∧ Q(x)))
    r(apxqx) = [∧]-intro (\{x} → [∧]-elimₗ(apxqx{x})) (\{x} → [∧]-elimᵣ(apxqx{x}))

  [∃][∨]-distributivity : ∃(x ↦ (P(x) ∨ Q(x))) ↔ (∃(x ↦ P(x)) ∨ ∃(x ↦ Q(x)))
  [∃][∨]-distributivity = [↔]-intro l r where
    l : (∃(x ↦ P(x)) ∨ ∃(x ↦ Q(x))) → ∃(x ↦ (P(x) ∨ Q(x)))
    l ([∨]-introₗ ([∃]-intro x ⦃ px ⦄)) = [∃]-intro x ⦃ [∨]-introₗ px ⦄
    l ([∨]-introᵣ ([∃]-intro x ⦃ qx ⦄)) = [∃]-intro x ⦃ [∨]-introᵣ qx ⦄

    r : (∃(x ↦ P(x)) ∨ ∃(x ↦ Q(x))) ← ∃(x ↦ (P(x) ∨ Q(x)))
    r ([∃]-intro x ⦃ [∨]-introₗ px ⦄) = [∨]-introₗ ([∃]-intro x ⦃ px ⦄)
    r ([∃]-intro x ⦃ [∨]-introᵣ qx ⦄) = [∨]-introᵣ ([∃]-intro x ⦃ qx ⦄)

  [∃][∧]-semidistributivity : ∃(x ↦ ∃(y ↦ (P(x) ∧ Q(y)))) ↔ (∃(x ↦ P(x)) ∧ ∃(x ↦ Q(x)))
  [∃][∧]-semidistributivity = [↔]-intro l r where
    l : ∃(x ↦ ∃(y ↦ (P(x) ∧ Q(y)))) ← (∃(x ↦ P(x)) ∧ ∃(x ↦ Q(x)))
    l ([∧]-intro ([∃]-intro x ⦃ px ⦄) ([∃]-intro y ⦃ qy ⦄)) = [∃]-intro x ⦃ [∃]-intro y ⦃ [∧]-intro px qy ⦄ ⦄

    r : ∃(x ↦ ∃(y ↦ (P(x) ∧ Q(y)))) → (∃(x ↦ P(x)) ∧ ∃(x ↦ Q(x)))
    r ([∃]-intro x ⦃ [∃]-intro y ⦃ [∧]-intro px qy ⦄ ⦄) = [∧]-intro ([∃]-intro x ⦃ px ⦄) ([∃]-intro y ⦃ qy ⦄)

  [∃][∧]-distributivity : ∃(x ↦ (P(x) ∧ Q(x))) → (∃(x ↦ P(x)) ∧ ∃(x ↦ Q(x)))
  [∃][∧]-distributivity ([∃]-intro x ⦃ [∧]-intro px qx ⦄ ) = [∧]-intro l r where
    l = [∃]-intro x ⦃ px ⦄
    r = [∃]-intro x ⦃ qx ⦄

module _ {ℓₒ}{ℓₗ₁}{ℓₗ₂} {X : Type{ℓₒ}}{P : X → Stmt{ℓₗ₁}}{Q : X → Stmt{ℓₗ₂}} where
  [∀][↔]-distributivity : ∀ₗ(x ↦ (P(x) ↔ Q(x))) → (∀ₗ(x ↦ P(x)) ↔ ∀ₗ(x ↦ Q(x)))
  [∀][↔]-distributivity = r where -- [↔]-intro l r where
    -- l : ∀ₗ(x ↦ (P(x) ↔ Q(x))) ← (∀ₗ(x ↦ P(x)) ↔ ∀ₗ(x ↦ Q(x)))
    -- l([↔]-intro aqxapx apxaqx) {x} = [↔]-intro (\qx → aqxpx(qx{x})) (apxqx{x})

    r : ∀ₗ(x ↦ (P(x) ↔ Q(x))) → (∀ₗ(x ↦ P(x)) ↔ ∀ₗ(x ↦ Q(x)))
    r apxqx = [↔]-intro ([∀][→]-distributivity rl) ([∀][→]-distributivity rr) where
      rl : ∀ₗ(x ↦ (P(x) ← Q(x)))
      rl{x} = [↔]-to-[←](apxqx{x})

      rr : ∀ₗ(x ↦ (P(x) → Q(x)))
      rr{x} = [↔]-to-[→](apxqx{x})

  [∀]-to-[∃]-[↔]-semidistributivity : ∀ₗ(x ↦ (P(x) ↔ Q(x))) → (∃(x ↦ P(x)) ↔ ∃(x ↦ Q(x)))
  [∀]-to-[∃]-[↔]-semidistributivity apq = [↔]-intro ([∃]-map-proof ([↔]-to-[←] apq)) ([∃]-map-proof ([↔]-to-[→] apq))

------------------------------------------
-- Quantifiers with logical operators inside, but one of the predicates are constant

module _ {ℓₒ}{ℓₗ₁}{ℓₗ₂} {X : Type{ℓₒ}}{P : X → Stmt{ℓₗ₁}}{Q : Stmt{ℓₗ₂}} where
  [∀]-unrelatedₗ-[→] : ∀ₗ(x ↦ (P(x) → Q)) ↔ (∃(x ↦ P(x)) → Q)
  [∀]-unrelatedₗ-[→] = [↔]-intro l r where
    l : ∀ₗ(x ↦ (P(x) → Q)) ← (∃(x ↦ P(x)) → Q)
    l(expxq) {x} px = expxq([∃]-intro(x) ⦃ px ⦄)

    r : ∀ₗ(x ↦ (P(x) → Q)) → (∃(x ↦ P(x)) → Q)
    r(axpxq) = [∃]-elim(\{x} → px ↦ axpxq{x}(px))

  [∃]-unrelatedₗ-[→]ᵣ : ∃(x ↦ (P(x) → Q)) → (∀ₗ(x ↦ P(x)) → Q)
  [∃]-unrelatedₗ-[→]ᵣ = r where -- [↔]-intro l r where
    r : ∃(x ↦ (P(x) → Q)) → (∀ₗ(x ↦ P(x)) → Q)
    r(expxq)(axpx) = [∃]-proof(expxq) (axpx{[∃]-witness(expxq)})

  [∃]-unrelatedₗ-[∧] : ∃(x ↦ (P(x) ∧ Q)) ↔ (∃(x ↦ P(x)) ∧ Q)
  [∃]-unrelatedₗ-[∧] = [↔]-intro l r where
    l : ∃(x ↦ (P(x) ∧ Q)) ← (∃(x ↦ P(x)) ∧ Q)
    l ([∧]-intro ([∃]-intro x ⦃ px ⦄) q) = [∃]-intro x ⦃ [∧]-intro px q ⦄

    r : ∃(x ↦ (P(x) ∧ Q)) → (∃(x ↦ P(x)) ∧ Q)
    r ([∃]-intro x ⦃ [∧]-intro px q ⦄) = [∧]-intro ([∃]-intro x ⦃ px ⦄) q

module _ {ℓₒ}{ℓₗ₁}{ℓₗ₂} {X : Type{ℓₒ}}{P : Stmt{ℓₗ₁}}{Q : X → Stmt{ℓₗ₂}} where
  [∀]-unrelatedᵣ-[→] : ∀ₗ(x ↦ (P → Q(x))) ↔ (P → ∀ₗ(x ↦ Q(x)))
  [∀]-unrelatedᵣ-[→] = [↔]-intro l r where
    l : ∀ₗ(x ↦ (P → Q(x))) ← (P → ∀ₗ(x ↦ Q(x)))
    l(paxqx) {x} p = paxqx(p){x}

    r : ∀ₗ(x ↦ (P → Q(x))) → (P → ∀ₗ(x ↦ Q(x)))
    r(axpqx)(p){x} = axpqx{x}(p)

  [∃]-unrelatedᵣ-[→]ᵣ : ∃(x ↦ (P → Q(x))) → (P → ∃(x ↦ Q(x)))
  [∃]-unrelatedᵣ-[→]ᵣ = r where -- [↔]-intro l r where
    r : ∃(x ↦ (P → Q(x))) → (P → ∃(x ↦ Q(x)))
    r(expqx)(p) = [∃]-elim(\{x} → pqx ↦ [∃]-intro(x) ⦃ pqx(p) ⦄) (expqx)

  [∃]-unrelatedᵣ-[∧] : ∃(x ↦ (P ∧ Q(x))) ↔ (P ∧ ∃(x ↦ Q(x)))
  [∃]-unrelatedᵣ-[∧] = [↔]-intro l r where
    l : ∃(x ↦ (P ∧ Q(x))) ← (P ∧ ∃(x ↦ Q(x)))
    l ([∧]-intro p ([∃]-intro x ⦃ qx ⦄)) = [∃]-intro x ⦃ [∧]-intro p qx ⦄

    r : ∃(x ↦ (P ∧ Q(x))) → (P ∧ ∃(x ↦ Q(x)))
    r ([∃]-intro x ⦃ [∧]-intro p qx ⦄) = [∧]-intro p ([∃]-intro x ⦃ qx ⦄)

------------------------------------------
-- Equivalences

module _ {ℓₒ}{ℓₗ₁}{ℓₗ₂} {X : Type{ℓₒ}}{P : X → Stmt{ℓₗ₁}}{Q : X → Stmt{ℓₗ₂}} where
  [∃]-map-proof-[↔] : (∀{x} → P(x) ↔ Q(x)) → ((∃ P) ↔ (∃ Q))
  [∃]-map-proof-[↔] p = [↔]-intro ([∃]-map-proof ([↔]-to-[←] p)) ([∃]-map-proof ([↔]-to-[→] p))

------------------------------------------
-- Other rules

module _ {ℓₒ}{ℓₗ₁}{ℓₗ₂} {X : Type{ℓₒ}}{P : X → Stmt{ℓₗ₁}}{Q : X → Stmt{ℓₗ₂}} where
  [∀][→]-add-[∃] : ∀ₗ(x ↦ (P(x) → Q(x))) → ∀ₗ(x ↦ (P(x) → ∃(x ↦ Q(x))))
  [∀][→]-add-[∃] (proof) {x} px = [∃]-intro(x) ⦃ proof{x} px ⦄

  [∀][→]-to-[∃] : ∀ₗ(x ↦ (P(x) → Q(x))) → (∃(x ↦ P(x)) → ∃(x ↦ Q(x)))
  [∀][→]-to-[∃] (proof) = ([↔]-to-[→] ([∀]-unrelatedₗ-[→] {X = X} {P})) ([∀][→]-add-[∃] (proof))

module _ {ℓₒ₁}{ℓₒ₂}{ℓₗ} {X : Type{ℓₒ₁}}{Y : Type{ℓₒ₂}}{P : X → Y → Stmt{ℓₗ}} where
  [∀][∃]-swap : ∃(x ↦ ∀ₗ(y ↦ P(x)(y))) → ∀ₗ(y ↦ ∃(x ↦ P(x)(y)))
  [∀][∃]-swap ([∃]-intro x ⦃ aypxy ⦄) {y} = [∃]-intro x ⦃ aypxy{y} ⦄

  {-
  no-intermediate : ∀{X : Stmt} → ¬(¬(X ↔ ⊤) ∧ ¬(X ↔ ⊥))
  no-intermediate = [¬][∨] [¬¬]-excluded-middle

  ¬((¬ X) ∧ (¬ Y)) ↔ ¬(¬ (X ∨ Y))
  ∀{X} → ¬¬(X ∨ (¬ X))
  -}

module _ {ℓₒ₁}{ℓₒ₂}{ℓₗ} {X : Type{ℓₒ₁}}{Y : Type{ℓₒ₂}}{P : X → Y → Stmt{ℓₗ}} where
  [∀][∃]-to-function-existence : ∀ₗ(x ↦ ∃(y ↦ P(x)(y))) → ∃(f ↦ ∀ₗ(x ↦ P(x)(f(x))))
  [∀][∃]-to-function-existence p = [∃]-intro (x ↦ [∃]-witness(p{x})) ⦃ \{x} → [∃]-proof(p{x}) ⦄


{-# OPTIONS --safe --warning=error --without-K --guardedness #-}

open import Agda.Primitive using (Level; lzero; lsuc; _⊔_)
open import Setoids.Setoids
open import Rings.Definition
open import Rings.Orders.Partial.Definition
open import Rings.Orders.Total.Definition
open import Groups.Definition
open import Fields.Fields
open import Sets.EquivalenceRelations
open import Sequences
open import Functions.Definition
open import LogicalFormulae
open import Numbers.Naturals.Semiring
open import Numbers.Naturals.Order
open import Setoids.Orders.Partial.Definition
open import Setoids.Orders.Total.Definition

module Fields.CauchyCompletion.Definition {m n o : _} {A : Set m} {S : Setoid {m} {n} A} {_+_ : A → A → A} {_*_ : A → A → A} {_<_ : Rel {m} {o} A} {pOrder : SetoidPartialOrder S _<_} {R : Ring S _+_ _*_} {pRing : PartiallyOrderedRing R pOrder} (order : TotallyOrderedRing pRing) (F : Field R) where

open Setoid S
open SetoidTotalOrder (TotallyOrderedRing.total order)
open SetoidPartialOrder pOrder
open Equivalence eq
open TotallyOrderedRing order
open Ring R
open Group additiveGroup
open Field F

open import Rings.Orders.Total.Lemmas order
open import Rings.Orders.Total.AbsoluteValue order
open import Rings.Orders.Total.Cauchy order
open import Groups.Lemmas additiveGroup

cauchyWellDefined : {s1 s2 : Sequence A} → ((m : ℕ) → index s1 m ∼ index s2 m) → cauchy s1 → cauchy s2
cauchyWellDefined {s1} {s2} prop c e 0<e with c e 0<e
... | N , pr = N , λ {m} {n} N<m N<n → <WellDefined (absWellDefined _ _ (+WellDefined (prop m) (inverseWellDefined (prop n)))) reflexive (pr N<m N<n)

record CauchyCompletion : Set (m ⊔ o) where
  field
    elts : Sequence A
    converges : (cauchy elts)

injection : A → CauchyCompletion
CauchyCompletion.elts (injection a) = constSequence a
CauchyCompletion.converges (injection a) = (λ ε 0<e → 0 , λ {m} {n} _ _ → <WellDefined (symmetric (identityOfIndiscernablesRight _∼_ (absWellDefined (index (constSequence a) m + inverse (index (constSequence a) n)) 0R (t m n)) absZero)) reflexive 0<e)
  where
    t : (m n : ℕ) → index (constSequence a) m + inverse (index (constSequence a) n) ∼ 0R
    t m n = identityOfIndiscernablesLeft _∼_ (identityOfIndiscernablesLeft _∼_ invRight (equalityCommutative (applyEquality (λ i → a + inverse i) (indexAndConst a n)))) (applyEquality (_+ inverse (index (constSequence a) n)) (equalityCommutative (indexAndConst a m)))

-- Some slightly odd things here relating to equality rather than equivalence. Ultimately this is here so we can say Q → R is a genuine injection, not just a setoid one.
private
  lemma : {x y : CauchyCompletion} → x ≡ y → CauchyCompletion.elts x ≡ CauchyCompletion.elts y
  lemma {x} {.x} refl = refl

CInjection' : Injection injection
CInjection' pr = headInjective (lemma pr)


module Relation.Equality where

open import Data.Product

-- Identity Types
--

{-
  The type of identifications of two (x y : A).

  While this can be read as propositional equality, in HoTT identity
  can be (and is) elevated to a data type.
-}
data _≡_ {a}{A : Set a}(x : A) : A → Set a where
  refl : x ≡ x

cong : ∀ {a b} {A : Set a}{B : Set b} (f : A → B) {x y} → x ≡ y → f x ≡ f y
cong f refl = refl

-- Path Induction over the Identity Type
--
ind₌ : ∀ {a c}{A : Set a} → (C : (x y : A) → (x ≡ y) → Set c) → ((x : A) → C x x refl) → (x y : A) → (p : x ≡ y) → C x y p
ind₌ C c x .x refl = c x


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

module Algebra.Linear.Structures.Bundles.FiniteDimensional where

open import Algebra
open import Algebra.FunctionProperties
open import Relation.Binary using (Rel)
open import Level using (Level; suc; _⊔_)

open import Algebra.Structures.Bundles.Field
open import Algebra.Linear.Structures.Bundles

open import Algebra.Linear.Structures.VectorSpace
open import Algebra.Linear.Structures.FiniteDimensional

open import Data.Nat using (ℕ)

record FiniteDimensional {k ℓᵏ} (K : Field k ℓᵏ) (c ℓ : Level) (n : ℕ) : Set (suc (c ⊔ k ⊔ ℓ ⊔ ℓᵏ)) where
  field
    Carrier             : Set c
    _≈_                 : Rel Carrier ℓ
    _+_                 : Carrier -> Carrier -> Carrier
    _∙_                 : Field.Carrier K -> Carrier -> Carrier
    -_                  : Carrier -> Carrier
    0#                  : Carrier
    isFiniteDimensional : IsFiniteDimensional K _≈_ _+_ _∙_ -_ 0# n

  open IsFiniteDimensional isFiniteDimensional public

  vectorSpace : VectorSpace K c ℓ
  vectorSpace = record { isVectorSpace = isVectorSpace }


{-# OPTIONS --universe-polymorphism #-}
module Categories.Monoidal.Cartesian where

open import Data.Product using (proj₁; proj₂) renaming (_×_ to _×₀_)
open import Data.Fin using (zero)

open import Categories.Category
open import Categories.Monoidal
open import Categories.Object.BinaryProducts
open import Categories.Object.Products
open import Categories.Object.Products.Properties
  renaming (module Properties to ProductProperties)
open import Categories.Object.Terminal
open import Categories.Bifunctor using (Bifunctor)
import Categories.Morphisms
open import Categories.Square
import Categories.Monoidal.Cartesian.Pentagon as Pentagon

Cartesian : ∀ {o ℓ e} (C : Category o ℓ e) → Products C → Monoidal C
Cartesian C Ps = record
  { ⊗ = ⊗
  ; id = ⊤
  ; identityˡ = record
    { F⇒G = record
      { η = λ X → π₂
      ; commute = λ f → commute₂
      }
    ; F⇐G = record
      { η = λ X → ⟨ ! , id ⟩
      ; commute = λ f → unitˡ-natural
      }
    ; iso = λ X → _≅_.iso unitˡ
    }
  ; identityʳ = record
    { F⇒G = record
      { η = λ X → π₁
      ; commute = λ f → commute₁
      }
    ; F⇐G = record
      { η = λ X → ⟨ id , ! ⟩
      ; commute = λ f → unitʳ-natural
      }
    ; iso = λ X → _≅_.iso unitʳ
    }
  ; assoc = record
    { F⇒G = record
      { η = λ X → assocˡ
      ; commute = λ f → assocˡ∘⁂
      }
    ; F⇐G = record
      { η = λ X → assocʳ
      ; commute = λ f → assocʳ∘⁂
      }
    ; iso = λ X → record
      { isoˡ = Iso.isoʳ (_≅_.iso ×-assoc)
      ; isoʳ = Iso.isoˡ (_≅_.iso ×-assoc)
      }
    }
  ; triangle = λ {X} → triangle {X}
  ; pentagon = pentagon
  }
  where
  open Categories.Morphisms C
  open Category C
  open Products Ps renaming (terminal to T₀; binary to P₀)
  open ProductProperties C Ps
  open Terminal T₀ using (⊤; !; !-unique; !-unique₂)

  open BinaryProducts P₀
  open Pentagon.Law C P₀ using (pentagon)

  ⊗ : Bifunctor C C C
  ⊗ = record
    { F₀ = λ p → proj₁ p × proj₂ p
    ; F₁ = λ x → proj₁ x ⁂ proj₂ x
    ; identity = identity
    ; homomorphism = Equiv.sym ⁂∘⁂
    ; F-resp-≡ = λ {A B F G} x → F-resp-≡ {A} {B} {F} {G} x
    }
    where
    .identity : ∀ {A : Obj ×₀ Obj} → (id {proj₁ A} ⁂ id {proj₂ A}) ≡ id
    identity = universal (id-comm {f = π₁}) (id-comm {f = π₂})

    .F-resp-≡ : ∀ {A B F G} F≡G → _
    F-resp-≡ {F = F} {G} x = ⟨⟩-cong₂ (∘-resp-≡ˡ (proj₁ x)) (∘-resp-≡ˡ (proj₂ x))

  -- The implicit x is actually used implicitly by the rest of the expression, so don't take it out,
  -- or Agda will complain about something referring to something to which it has no access.
  -- The connection between the mentioned x and the rest of the type is given by the caller way up
  -- there, so if that were not using these the triangle and pentagon laws would be yellow.
  .triangle : ∀ {x} → first π₁ ≡ second π₂ ∘ assocˡ
  triangle =
    begin
      first π₁
    ↓⟨ ⟨⟩-congʳ identityˡ ⟩
      ⟨ π₁ ∘ π₁ , π₂ ⟩
    ↑⟨ ⟨⟩-congʳ commute₂ ⟩
      ⟨ π₁ ∘ π₁ , π₂ ∘ ⟨ π₂ ∘ π₁ , π₂ ⟩ ⟩
    ↑⟨ second∘⟨⟩ ⟩
      second π₂ ∘ assocˡ
    ∎
    where
    open HomReasoning
    open Equiv


------------------------------------------------------------------------
-- The Agda standard library
--
-- Fin Literals
------------------------------------------------------------------------

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

module Data.Fin.Literals where

open import Agda.Builtin.FromNat
open import Data.Nat using (suc; _≤?_)
open import Data.Fin using (Fin ; #_)
open import Relation.Nullary.Decidable using (True)

number : ∀ n → Number (Fin n)
number n = record
  { Constraint = λ m → True (suc m ≤? n)
  ; fromNat    = λ m {{pr}} → (# m) {n} {pr}
  }


{-# OPTIONS --safe --warning=error --without-K #-}

open import Functions.Definition
open import Sets.CantorBijection.Proofs

module Sets.CantorBijection.CantorBijection where

open Sets.CantorBijection.Proofs using (cantorInverse ; cantorInverseLemma) public

cantorBijection : Bijection cantorInverse
Bijection.inj cantorBijection {x} {y} = cantorInverseInjective x y
Bijection.surj cantorBijection = cantorInverseSurjective


{-# OPTIONS --safe #-}
module Cubical.Relation.Nullary.DecidablePropositions where

open import Cubical.Foundations.Prelude
open import Cubical.Foundations.HLevels
open import Cubical.Foundations.Equiv renaming (_∙ₑ_ to _⋆_)

open import Cubical.Data.Bool
open import Cubical.Data.Sigma

open import Cubical.Relation.Nullary.Base
open import Cubical.Relation.Nullary.Properties

private
  variable
    ℓ ℓ'  : Level

DecProp : (ℓ : Level) → Type (ℓ-suc ℓ)
DecProp ℓ = Σ[ P ∈ hProp ℓ ] Dec (P .fst)

isSetDecProp : isSet (DecProp ℓ)
isSetDecProp = isOfHLevelΣ 2 isSetHProp (λ P → isProp→isSet (isPropDec (P .snd)))

-- the following is an alternative formulation of decidable propositions
-- it separates the boolean value from more proof-relevant part
-- so it performs better when doing computation

isDecProp : Type ℓ → Type ℓ
isDecProp P = Σ[ t ∈ Bool ] P ≃ Bool→Type t

DecProp' : (ℓ : Level) → Type (ℓ-suc ℓ)
DecProp' ℓ = Σ[ P ∈ Type ℓ ] isDecProp P

-- properties of the alternative formulation

isDecProp→isProp : {P : Type ℓ} → isDecProp P → isProp P
isDecProp→isProp h = isOfHLevelRespectEquiv 1 (invEquiv (h .snd)) isPropBool→Type

isDecProp→Dec : {P : Type ℓ} → isDecProp P → Dec P
isDecProp→Dec h = EquivPresDec (invEquiv (h .snd)) DecBool→Type

isPropIsDecProp : {P : Type ℓ} → isProp (isDecProp P)
isPropIsDecProp p q =
  Σ≡PropEquiv (λ _ → isOfHLevel⁺≃ᵣ 0 isPropBool→Type) .fst
    (Bool→TypeInj _ _ (invEquiv (p .snd) ⋆ q .snd))

isDecPropRespectEquiv : {P : Type ℓ} {Q : Type ℓ'}
  → P ≃ Q → isDecProp Q → isDecProp P
isDecPropRespectEquiv e (t , e') = t , e ⋆ e'


----------------------------------------------------------------------------
-- Well-founded induction on the natural numbers
----------------------------------------------------------------------------

{-# OPTIONS --exact-split              #-}
{-# OPTIONS --no-sized-types           #-}
{-# OPTIONS --no-universe-polymorphism #-}
{-# OPTIONS --without-K                #-}

module FOTC.Data.Nat.Induction.NonAcc.WF-I where

open import FOTC.Base
open import FOTC.Data.Nat.Inequalities
open import FOTC.Data.Nat.Inequalities.EliminationPropertiesI
open import FOTC.Data.Nat.Inequalities.PropertiesI
open import FOTC.Data.Nat.Type

------------------------------------------------------------------------------
-- Well-founded induction on the natural numbers.
-- Adapted from http://code.haskell.org/~dolio/agda-share/induction/.

module WFInd where
  <-wfind : (A : D → Set) →
            (∀ {n} → N n → (∀ {m} → N m → m < n → A m) → A n) →
            ∀ {n} → N n → A n
  <-wfind A h Nn = h Nn (helper Nn)
    where
    helper : ∀ {n m} → N n → N m → m < n → A m
    helper nzero     Nm    m<0  = ⊥-elim (x<0→⊥ Nm m<0)
    helper (nsucc _) nzero 0<Sn = h nzero (λ Nm' m'<0 → ⊥-elim (x<0→⊥ Nm' m'<0))

    helper (nsucc {n} Nn) (nsucc {m} Nm) Sm<Sn = h (nsucc Nm)
      (λ {m'} Nm' m'<Sm →
        let Sm'≤Sm : succ₁ m' ≤ succ₁ m
            Sm'≤Sm = x<y→Sx≤y Nm' (nsucc Nm) m'<Sm

            Sm≤n : succ₁ m ≤ n
            Sm≤n = Sx≤Sy→x≤y (x<y→Sx≤y (nsucc Nm) (nsucc Nn) Sm<Sn)

            Sm'≤n : succ₁ m' ≤ n
            Sm'≤n = ≤-trans (nsucc Nm') (nsucc Nm) Nn Sm'≤Sm Sm≤n

            m'<n : m' < n
            m'<n = Sx≤y→x<y Nm' Nn Sm'≤n

        in  helper Nn Nm' m'<n
      )

------------------------------------------------------------------------------
-- Well-founded induction on the natural numbers (using different
-- properties of inequalities).

module WFInd' where

  <-wfind : (A : D → Set) →
            (∀ {n} → N n → (∀ {m} → N m → m < n → A m) → A n) →
            ∀ {n} → N n → A n
  <-wfind A h Nn = h Nn (helper Nn)
    where
    helper : ∀ {n m} → N n → N m → m < n → A m
    helper nzero Nm m<0 = ⊥-elim (x<0→⊥ Nm m<0)
    helper (nsucc _) nzero 0<Sn = h nzero (λ Nm' m'<0 → ⊥-elim (x<0→⊥ Nm' m'<0))
    helper (nsucc {n} Nn) (nsucc {m} Nm) Sm<Sn = h (nsucc Nm)
      (λ {m'} Nm' m'<Sm →
         let m<n : m < n
             m<n = Sx<Sy→x<y Sm<Sn

             m'<n : m' < n
             m'<n = case (λ m'<m → <-trans Nm' Nm Nn m'<m m<n)
                         (λ m'≡m → x≡y→y<z→x<z m'≡m m<n)
                         (x<Sy→x<y∨x≡y Nm' Nm m'<Sm)

         in  helper Nn Nm' m'<n
      )


{-# OPTIONS --cubical --safe #-}

module Codata.Stream where

open import Prelude
open import Data.List using (List; _∷_; [])
open import Data.List.Kleene
import Data.List.Kleene.Membership as Kleene
open import Data.Fin

Stream : Type a → Type a
Stream A = ℕ → A

infixr 5 _∈_
_∈_ : A → Stream A → Type _
x ∈ xs = fiber xs x

toList : ℕ → Stream A → List A
toList zero xs = []
toList (suc n) xs = xs zero ∷ toList n (xs ∘ suc)

mutual
  concat⋆ : A ⋆ → Stream (A ⁺) → Stream A
  concat⋆ []    xs = concat⁺ (xs zero) (xs ∘ suc)
  concat⋆ (∹ x) xs = concat⁺ x xs

  concat⁺ : A ⁺ → Stream (A ⁺) → Stream A
  concat⁺ x xs zero    = x .head
  concat⁺ x xs (suc n) = concat⋆ (x .tail) xs n

concat : Stream (A ⁺) → Stream A
concat xs = concat⁺ (xs zero) (xs ∘ suc)

infixr 5 _∈²_
_∈²_ : A → Stream (A ⁺) → Type _
x ∈² xs = ∃[ n ] x Kleene.∈⁺ xs n

mutual
  ◇++⋆ : ∀ (x : A) y ys → x Kleene.∈⋆ y → x ∈ concat⋆ y ys
  ◇++⋆ x (∹ y) ys x∈y = ◇++⁺ x y ys x∈y

  ◇++⁺ : ∀ (x : A) y ys → x Kleene.∈⁺ y → x ∈ concat⁺ y ys
  ◇++⁺ x y ys (f0 , x∈y) = zero , x∈y
  ◇++⁺ x y ys (fs n , x∈y) = let m , p = ◇++⋆ x (y .tail) ys (n , x∈y) in suc m , p

mutual
  ++◇⋆ : ∀ (x : A) y ys → x ∈ concat ys → x ∈ concat⋆ y ys
  ++◇⋆ x [] ys x∈ys = x∈ys
  ++◇⋆ x (∹ y) ys x∈ys = ++◇⁺ x y ys x∈ys

  ++◇⁺ : ∀ (x : A) y ys → x ∈ concat ys → x ∈ concat⁺ y ys
  ++◇⁺ x y ys x∈ys = let n , p = ++◇⋆ x (y .tail) ys x∈ys in suc n , p

concat-∈ : ∀ (x : A) xs → x ∈² xs → x ∈ concat xs
concat-∈ x xs (zero  , x∈xs) = ◇++⁺ x (xs zero) (xs ∘ suc) x∈xs
concat-∈ x xs (suc n , x∈xs) = ++◇⁺ x (xs zero) (xs ∘ suc) (concat-∈ x (xs ∘ suc) (n , x∈xs))


module Foundation.Equivalence where

open import Foundation.Primitive

record IsEquivalence {a} {A : Set a} {ℓ} (_≈_ : A → A → Set ℓ) : ℞ a ⊔ ℓ where
  field
    reflexivity : ∀ x → x ≈ x
    symmetry : ∀ x y → x ≈ y → y ≈ x
    transitivity : ∀ x y z → x ≈ y → y ≈ z → x ≈ z

open IsEquivalence ⦃ … ⦄ public

record Equivalence {a} (A : Set a) ℓ : ℞ a ⊔ ⟰ ℓ where
  infix 4 _≈_
  field
    _≈_ : A → A → Set ℓ
    instance ⦃ isEquivalence ⦄ : IsEquivalence _≈_

open Equivalence ⦃ … ⦄ public

open import Foundation.Bottom

infix 4 _≉_
_≉_ : ∀ {a} {A : Set a} {ℓ} ⦃ _ : Equivalence A ℓ ⦄ {b} ⦃ _ : Bottom b ℓ  ⦄ → A → A → Set (b ⊔ ℓ)
_≉_ {ℓ = ℓ} x y = ¬ (x ≈ y)


open import Data.Natural using ( Natural ; # ; _+_ )

module System.IO.Examples.Four where

four : Natural
four = # 2 + # 2


import Relation.Binary.PropositionalEquality as PE

module x01 where

import Data.Empty.Polymorphic as DEP
open import Data.Unit.Polymorphic
import Data.Maybe as Maybe

{-
Dependent Types at Work
Ana Bove and Peter Dybjer
Chalmers University of Technology, Göteborg, Sweden

intro to functional programming with dependent types

- simply typed functional programming in style of Haskell and ML
- discuss differences between Agda’s type system and Hindley-Milner type system of Haskell/ML
- how to use dependent types for programming
- explain ideas behind type-checking dependent types
- explain Curry-Howard identification of propositions and types
- show a method to encode partial/general recursive functions
  as total functions using dependent types

Dependent types are types that depend on elements of other types (e.g., Vec of length n)
Invariants can be expressed with dependent type (e.g., sorted list)

Agda's dependent type system is an extension of Martin-Löf type theory [20,21,22,25].

Parametrised types
- e.g., [A]
- usually not called dependent types
- they are are families of types indexed by other types
  - NOT families of types indexed by ELEMENTS of another type
- however, in dependent type theories, there is a type of small types (a universe),
  so that we have a type [A] of lists of elements of a given small type A.
- FORTRAN could define arrays of a given dimension, so a form a dependent type on small type
- simply typed lambda calculus and the Hindley-Milner type system,
  (e.g., Haskell/ML) do not include dependent types, only parametrised types
- polymorphic lambda calculus System F [15] has types like
  ∀X.A where X ranges over all types,
  but no quantification over ELEMENTS of other types

development of dependently typed programming languages has
origins in Curry-Howard isomorphism between propositions and types

1930’s : Curry noticed similarity between axioms of implicational logic
   P ⊃ Q ⊃ P                                (P ⊃ Q ⊃ R) ⊃ (P ⊃ Q) ⊃ P ⊃ R
and types of combinators
   K              and                       S
   A → B → A                                (A → B → C) → (A → B) → A → C

K can be viewed as a witness (i.e., proof object) of the truth of P ⊃ Q ⊃ P
S can be viewed as a withness of the truth of (P ⊃ Q ⊃ R) ⊃ (P ⊃ Q) ⊃ P ⊃ R

typing rule for application
corresponds to the inference rule modus ponens: from P ⊃ Q and P conclude Q
- f : A → B
- a : A
- f a → B

product types correspond to conjunctions
sum types (disjoint unions) to disjunctions

to extend this correspondence to predicate logic
Howard and de Bruijn introduced dependent types A(x) corresponding to predicates P(x).
They formed
indexed products Π x : D.A(x) : corresponding to universal   quantifications ∀x : D.P (x)
indexed sums     Σ x : D.A(x) :                  existential quantifications ∃x : D.P (x)

this gives a Curry-Howard interpretation of intuitionistic predicate logic

one-to-one correspondence between propositions and types
in a type system with dependent types

one-to-one correspondence between
- proofs of a certain proposition in constructive predicate logic, and
- terms of the corresponding type

To accommodate equality in predicate logic
introduce the type a == b of proofs that a and b are equal.
Gives a Curry-Howard interpretation of predicate logic with equality.

Can go further and add natural numbers with addition and multiplication
to obtain a Curry-Howard version of Heyting (intuitionistic) arithmetic.

Curry-Howard interpretation was basis for Martin-Löf’s intuitionistic type theory [20,21,22].
- propositions and types are identified
- intended to be a foundational system for constructive mathematics
- can also be used as a programming language [21]
- from 1980’s and onwards, systems implementing variants of Martin-Löf type theory
  - NuPRL [6] : implementing an extensional version of the theory
  - Coq [33]  : implementing an intensional impredicative version
  - Agda      : implements   an intensional predicative extension

About these Notes

Agda's type-checking algorithm
- Section 5
- ideas first presented by Coquand [7]
- more information
  - Norell’s thesis [26]
  - Abel, Coquand, and Dybjer [1,2]
  - Coquand, Kinoshita, Nordström, and Takeyama [8].

more complete understanding of dependent type theory
- read a book about Martin-Löf type theory and related systems
- Martin-Löf’s “Intuitionistic Type Theory” [22] is a classic
  - be aware that it describes an extensional version of the theory
- Nordström, Petersson, and Smith [25]
  description of the later intensional theory on which Agda is based
- variants of dependent type theory are
  - Thompson [34]
  - Constable et al     [6] : NuPRL
  - Bertot and Casteran [4] : Coq
- lecture notes (Agda wiki [3]) by Norell
  - collection of advanced examples of how to use Agda for dependently typed programming
- Geuvers’ lecture notes : introduction to type theory
  - including Barendregt’s pure type systems and important meta-theoretic properties
- Bertot’s notes : how dependent types (in Coq) can be used for
  implementing a number of concepts of programming language theory
  - focus on abstract interpretation
- Barthe, Grégoire, and Riba’s notes
  - method for making termination-checkers

Section 2 : ordinary functional programming
Section 3 : basic dependent types and shows how to use them
Section 4 : Curry-Howard isomorphism
Section 5 : aspects of type-checking and pattern matching with dependent types
Section 6 : use Agda as a programming logic
Section 7 : how to represent general recursion and partial functions as total functions in Agda

------------------------------------------------------------------------------
2 Simply Typed Functional Programming in Agda

2.1 Truth Values
-}
data Bool : Set where
  true  : Bool
  false : Bool
{-
states
- Bool is a data type with the two (no-arg) constructors
- “:” denotes type membership
- Bool is a member of the type Set
- Set
  - the type of sets (using a terminology introduced by Martin-Löf [22])
    or small types (mentioned in the introduction).
- Bool is a small type, but Set itself is not, it is a large type.
- allowing Set : Set, would make the system inconsistent
-}
not : Bool -> Bool
not true  = false
not false = true
{-
Agda cannot generally infer types.
Because Agda type-checking done via normalisation (simplification)
- without the normality restriction it may not terminate
-}
equiv : Bool -> Bool -> Bool
equiv false false = true
equiv  true false = false
equiv false  true = false
equiv  true  true = true

_||_ : Bool -> Bool -> Bool
true  || _     = true
false || true  = true
false || false = false
infixl 60 _||_

-- EXERCISE: Define some more truth functions, such as conjunction and implication/TODO.

_&&_ : Bool -> Bool -> Bool
false && _     = false
true  && false = false
true  && true  = true
-- infixl ?? _&&_

-- 2.2 Natural Numbers

-- such data types known as recursive in Haskell
-- in constructive type theory, referred to as inductive types or inductively defined types

data Nat : Set where
  zero : Nat
  succ : Nat -> Nat
{-# BUILTIN NATURAL Nat #-}

pred : Nat -> Nat
pred  zero    = zero
pred (succ n) = n

_+_ : Nat -> Nat -> Nat
zero + m = m
succ n + m = succ (n + m)
{-# BUILTIN NATPLUS _+_ #-}

_*_ : Nat -> Nat -> Nat
zero   * n = zero
succ n * m = (n * m) + m
{-# BUILTIN NATTIMES _*_ #-}

infixl 6  _+_  _∸_
infixl 7  _*_

_ : (2 * 3) + 10 PE.≡ 16
_ = PE.refl
{-
+ and * are defined by PRIMITIVE RECURSION in FIRST ARG.
  - PRIMITIVE RECURSIION :
    - upper bound of number of iterations of every loop can be determined before entering loop
    - time complexity of PR functions bounded by the input size
- base case for zero
- step case for non zero defined recursively

Given a first order data type
- distinguish between
  - canonical form
    - built by constructors only
    - e.g., true, false,  zero, succ zero, succ (succ zero), ...
  - non-canonical forms
    - whereas non-canonical elements might contain defined functions
    - e.g., not true, zero + zero, zero * zero, succ (zero + zero)

Martin-Löf [21] instead considers lazy canonical forms
- a term begins with a constructor to be considered a canonical form
- e.g., succ (zero + zero) is a lazy canonical form, but not a “full” canonical form
- Lazy canonical forms are appropriate for lazy functional programming languages (e.g., Haskell)

-- EXERCISE: Write the cut-off subtraction function
-- the function on natural numbers, which returns 0
-- if the second argument is greater than or equal to the first.
-}
_∸_ : Nat -> Nat -> Nat
zero   ∸    _   = zero
succ n ∸ zero   = succ n
succ n ∸ succ m = n ∸ m

_ :  0 ∸  0 PE.≡  0
_ = PE.refl
_ :  0 ∸ 10 PE.≡  0
_ = PE.refl
_ : 10 ∸  0 PE.≡ 10
_ = PE.refl
_ : 10 ∸ 10 PE.≡  0
_ = PE.refl
_ : 10 ∸  9 PE.≡  1
_ = PE.refl

-- EXERCISE: Also write some more numerical functions like < or <=

_<_ : Nat -> Nat -> Bool
zero   < zero   = false
zero   < succ _ = true
succ _ < zero   = false
succ n < succ m = n < m

_ :  9 < 10 PE.≡ true
_ = PE.refl
_ : 10 < 10 PE.≡ false
_ = PE.refl

_<=_ : Nat -> Nat -> Bool
zero   <= zero   = true
zero   <= succ _ = true
succ _ <= zero   = false
succ n <= succ m = n <= m

_ :  9 <= 10 PE.≡ true
_ = PE.refl
_ : 10 <= 10 PE.≡ true
_ = PE.refl

_>_ : Nat -> Nat -> Bool
zero   > zero   = false
zero   > succ _ = false
succ _ > zero   = true
succ n > succ m = n > m

{-
2.3 Lambda Notation and Polymorphism

Agda is based on the typed lambda calculus.

APPLICATION is juxtaposition

lambda ABSTRACTION written either
- Curry-style (without a type label)
   \x -> e
- Church-style (with a type label)
  \(x : A) -> e

a family of identity functions, one for each small type:
-}
-- idE(xplicit)
idE :  (A : Set) ->       A  -> A
idE = \(A : Set) -> \(x : A) -> x
{-
apply this “generic” identity function id to a type argument A
to obtain the identity function from A to A

1st use of dependent types: type A -> A depends on variable A : Set
- ranging over the small types

Agda’s notation for dependent function types
- if A is a type and B[x] is a type which depends on (is indexed by) (x : A)
  then (x : A) -> B[x] is the type of functions f mapping arguments (x : A) to values f x : B[x].

If the type-checker can figure out value of an arg, can use a wild card character:
id _ x : A

K and S combinators in Agda (uses telescopic notation (A B : Set)
-}
K : (A B : Set) -> A -> B -> A
K _ _ x _     = x

S : (A B C : Set) -> (A -> B -> C) -> (A -> B) -> A -> C
S _ _ _ f g x = f x (g x)
{-
2.4 Implicit Arguments : declared by enclosing typings in curly brackets
-}

id : {A : Set} -> A -> A
id x = x

-- implicit arguments are omitted in applications
_ : id       zero PE.≡ zero
_ = PE.refl
-- can explicitly write an implicit argument by using curly brackets if needed
_ : id {Nat} zero PE.≡ zero
_ = PE.refl
_ : id {_}   zero PE.≡ zero
_ = PE.refl
{-
2.5 Gödel System T is a subsystem of Agda.

System of primitive recursive functionals [16]
- important in logic and a precursor to Martin-Löf type theory

recursion restricted to primitive recursion : to make sure programs terminate

Gödel System T
- based on simply typed lambda calculus
- with two base types : truth values and natural numbers
  - (some formulations code truth values as 0 and 1)
- constants for constructors true, false, zero
- conditional and primitive recursion combinators
-}

-- conditional
if_then_else_ : {C : Set} -> Bool -> C -> C -> C
if true  then x else _ = x
if false then _ else y = y

-- primitive recursion combinator for natural numbers
-- natrec is a higher-order function defined by primitive recursion with args
-- - (implicit) return type
-- - c     : element returned in base case
-- - 𝕟→c→c : step function
-- - the Nat on which to perform the recursion
natrec : {C : Set} -> C -> (Nat -> C -> C) -> Nat -> C
natrec c 𝕟→c→c  zero    = c
natrec c 𝕟→c→c (succ n) = 𝕟→c→c n (natrec c 𝕟→c→c n)

-- natrec definitions of addition and multiplication
_plus_ : Nat -> Nat -> Nat
_plus_ n m = natrec m    (\x y -> succ y)   n

_mult_ : Nat -> Nat -> Nat
_mult_ n m = natrec zero (\x y -> y plus m) n

-- compare plus/mult to _+_/_*_

_ : succ (succ  zero) + 2   PE.≡
    succ (succ  zero  + 2)
_ = PE.refl
_ : succ (succ  zero  + 2)  PE.≡
    succ (succ (zero  + 2))
_ = PE.refl
_ : succ (succ (zero  + 2)) PE.≡
    succ (succ          2 )
_ = PE.refl

_ :                                                      succ (succ  zero) plus 2                     PE.≡
                                                         natrec 2 (\x y -> succ y) (succ (succ zero))
_ = PE.refl
_ :                                                      natrec 2 (\x y -> succ y) (succ (succ zero)) PE.≡
    (\x y -> succ y) (succ zero)                        (natrec 2 (\x y -> succ y)       (succ zero))
_ = PE.refl
_ : (\x y -> succ y) (succ zero)                        (natrec 2 (\x y -> succ y)       (succ zero)) PE.≡
    (\  y -> succ y)                                    (natrec 2 (\x y -> succ y)       (succ zero))
_ = PE.refl
_ : (\  y -> succ y)                                    (natrec 2 (\x y -> succ y)       (succ zero)) PE.≡
             succ                                       (natrec 2 (\x y -> succ y)       (succ zero))
_ = PE.refl
_ :          succ                                       (natrec 2 (\x y -> succ y)       (succ zero)) PE.≡
             succ                ((\x y -> succ y) zero (natrec 2 (\x y -> succ y)             zero))
_ = PE.refl
_ :          succ                ((\x y -> succ y) zero (natrec 2 (\x y -> succ y)             zero)) PE.≡
             succ                ((\  y -> succ y)      (natrec 2 (\x y -> succ y)             zero))
_ = PE.refl
_ :          succ                ((\  y -> succ y)      (natrec 2 (\x y -> succ y)             zero)) PE.≡
             succ                (         succ         (natrec 2 (\x y -> succ y)             zero))
_ = PE.refl
_ :          succ                (         succ         (natrec 2 (\x y -> succ y)             zero)) PE.≡
             succ                (         succ                 2                                   )
_ = PE.refl

{-
to stay entirely in Gödel system T
- use terms built up by variables, application, lambda abstraction,
- and constants true, false, zero, succ, if_then_else_, natrec

Gödel system T has unusual property (for a programming language)
- all typable programs terminate

not only do terms in base types Bool and Nat terminate whatever reduction is chosen,
but also terms of function type terminate

reduction rules
- β-reduction
- defining equations for if_then_else and natrec

reductions can be performed anywhere in a term,
so there may be several ways to reduce a term

therefore, Gödel system T is strongly normalising
- any typable term reaches a normal form whatever reduction strategy is chosen

Even in this restrictive Gödel system T, possible to define many numerical functions.
Can define all primitive recursive functions
(in the usual sense without higher-order functions).

Can also define functions which are not primitive recursive, such as the Ackermann function.

Gödel system T is important in the history of ideas that led to
the Curry-Howard isomorphism and Martin-Löf type theory.

Gödel system T
- is the simply typed kernel of Martin-Löf’s constructive type theory,
Martin-Löf type theory
- is the foundational system from which Agda grew

relationship between Agda and Martin-Löf type theory is much like the
relationship between Haskell and the simply typed lambda calculus.
Or compare it with the relationship between Haskell and Plotkin’s PCF [30].

Like Gödel system T,
PCF is based on the simply typed lambda calculus with truth values and natural numbers.
But PCF includes a fixed point combinator
- used for encoding arbitrary general recursive definitions
  - therefore can define non-terminating functions in PCF.
-}

-- Exercise/TODO: Define all functions previously given in the text in Gödel System T.

-- induction principle for booleans (from Mimram)
Bool-rec : (P : Bool → Set) → P false → P true → (b : Bool) → P b
Bool-rec P Pf Pt false = Pf
Bool-rec P Pf Pt true  = Pt

not' : Bool -> Bool
not' b = Bool-rec (λ bool → Bool) true false b

_ : not' false PE.≡ not false
_ = PE.refl
_ : not' true  PE.≡ not true
_ = PE.refl

equiv' : Bool -> Bool -> Bool
equiv' b false = Bool-rec (λ bool → Bool) true false b
equiv' b true  = Bool-rec (λ bool → Bool) false true b

_ : equiv' false false PE.≡ equiv false false
_ = PE.refl
_ : equiv'  true false PE.≡ equiv  true false
_ = PE.refl
_ : equiv' false  true PE.≡ equiv false  true
_ = PE.refl
_ : equiv'  true  true PE.≡ equiv  true  true
_ = PE.refl

_||'_ : Bool -> Bool -> Bool
b ||' false = Bool-rec (λ bool → Bool)      b  b b
b ||'  true = Bool-rec (λ bool → Bool) (not b) b b

_ : false ||' false PE.≡ false || false
_ = PE.refl
_ : false ||'  true PE.≡ false ||  true
_ = PE.refl
_ :  true ||' false PE.≡  true || false
_ = PE.refl
_ :  true ||'  true PE.≡  true ||  true
_ = PE.refl

_&&'_ : Bool -> Bool -> Bool
b &&' false = Bool-rec (λ bool → Bool) false false b
b &&'  true = Bool-rec (λ bool → Bool) b     b     b

_ : false &&' false PE.≡ false && false
_ = PE.refl
_ : false &&'  true PE.≡ false &&  true
_ = PE.refl
_ :  true &&' false PE.≡  true && false
_ = PE.refl
_ :  true &&'  true PE.≡  true &&  true
_ = PE.refl

pred' : Nat -> Nat
pred'  zero    = natrec zero (\x y -> zero) zero
pred' (succ n) = natrec zero (\_ _ -> n)    n
-- test after List def

{-
2.6 Parametrised Types

Haskell parametrised types : [a]
-}
data List (A : Set) : Set where
  []   :                List A
  _::_ : A -> List A -> List A
infixr 5 _::_
{-# BUILTIN LIST List #-}
{-
(A : Set) to the left of the colon
- tells Agda that A is a parameter
- and it becomes an implicit argument to the constructors:
  []   : {A : Set} -> List A
  _::_ : {A : Set} -> A -> List A -> List A

def only allows defining lists with elements in arbitrary SMALL types
- cannot define lists of sets using this definition, since sets form a large type
-}

-- test for pred'
_ : (pred' 0 :: pred' 1 :: pred' 2 :: pred' 101 :: []) PE.≡ (pred 0 :: pred 1 :: pred 2 :: pred 101 :: [])
_ = PE.refl

mapL : {A B : Set} -> (A -> B) -> List A -> List B
mapL f       []  = []
mapL f (x :: xs) = f x :: mapL f xs

_ : mapL succ (1 :: 2 :: []) PE.≡ (2 :: 3 :: [])
_ = PE.refl

-- Exercise: Define some more list combinators like for example foldl or filter.
filter : {A : Set} -> (A -> Bool) -> List A -> List A
filter f       []  = []
filter f (x :: xs) = let tail = filter f xs in if f x then x :: tail else tail

_ : filter (_< 4) (5 :: 4 :: 3 :: 2 :: 1 :: []) PE.≡ (3 :: 2 :: 1 :: [])
_ = PE.refl

foldl : {A B : Set} -> (B -> A -> B) -> B -> List A -> B
foldl _ b       []  = b
foldl f b (a :: as) = foldl f (f b a) as

foldr : {A B : Set} -> (A -> B -> B) -> B -> List A -> B
foldr f b       []  = b
foldr f b (a :: as) = f a (foldr f b as)

_ : foldl _+_ 0 (3 :: 2 :: 1 :: []) PE.≡ 6
_ = PE.refl

_ : foldl _∸_ 0 (3 :: 1 :: []) PE.≡ 0
_ = PE.refl

_ : foldr _∸_ 0 (3 :: 1 :: []) PE.≡ 2
_ = PE.refl

-- Exercise: define list recursion combinator listrec (like natrec, but for lists)
-- from Mimram
List-rec
  : {A : Set}
  → (P : List A → Set)
  → P []
  → ((x : A) → (xs : List A) → P xs → P (x :: xs))
  → (xs : List A)
  → P xs
List-rec P Pe Pc       []  = Pe
List-rec P Pe Pc (x :: xs) = Pc x xs (List-rec P Pe Pc xs)

mapL' : {A B : Set} -> (A -> B) -> List A -> List B
mapL' {_} {B} f xs = List-rec (λ _ → List B) [] (λ a _ bs → f a :: bs) xs

_ : mapL' succ (1 :: 2 :: []) PE.≡ mapL succ (1 :: 2 :: [])
_ = PE.refl

filter' : {A : Set} -> (A -> Bool) -> List A -> List A
filter' {A} f xs = List-rec (λ _ → List A) [] (λ a _ as' → if f a then a :: as' else as') xs

_ : filter' (_< 4) (5 :: 4 :: 3 :: 2 :: 1 :: []) PE.≡ filter (_< 4) (5 :: 4 :: 3 :: 2 :: 1 :: [])
_ = PE.refl

foldl' : {A B : Set} -> (B -> A -> B) -> B -> List A -> B
foldl' {_} {B} f b as = List-rec (λ _ → B) b (λ a _ b → f b a) as

_ : foldl' _+_ 0 (3 :: 2 :: 1 :: []) PE.≡ foldl _+_ 0 (3 :: 2 :: 1 :: [])
_ = PE.refl

foldr' : {A B : Set} -> (A -> B -> B) -> B -> List A -> B
foldr' {A} {B} f b as = List-rec (λ _ → B) b (λ a as b → f a b) as

_ : foldr' _∸_ 0 (3 :: 1 :: []) PE.≡ foldr _∸_ 0 (3 :: 1 :: [])
_ = PE.refl

-- binary Cartesian product AKA pair
data _X_ (A B : Set) : Set where
  <_,_> : A -> B -> A X B

-- prime because these are never used but are redeinfed later
fst' : {A B : Set} -> A X B -> A
fst' < a , b > = a

snd' : {A B : Set} -> A X B -> B
snd' < a , b > = b

-- Usually want to zip lists of equal length.
-- Can fix that with runtime Maybe or compiletime dependent types (later).
zipL : {A B : Set} -> List A -> List B -> List (A X B)
zipL       []         _  = []
zipL (_ ::  _)       []  = []
zipL (x :: xs) (y :: ys) = < x , y > :: zipL xs ys

-- Exercise: Define the sum A + B of two small types with constructors: inl, inr.
data Either (A B : Set) : Set where
  inl : A -> Either A B
  inr : B -> Either A B

-- Exercise: Define a function from A + B to a small type C by cases.
toC : {A B C : Set} → (A -> C) -> (B -> C) -> (Either A B) -> C
toC ac  _ (inl a) = ac a
toC  _ bc (inr b) = bc b

{-
2.7 Termination-checking

General recursion allowed in most languages.
Therefore possible to define "partial" functions (e.g., divide by 0)

How to ensure functions terminate?
- one solution : restrict recursion to primitive recursion (like in Gödel system T)
  - the approach taken in Martin-Löf type theory
    where primitive recursion as a kind of structural recursion on well-founded data types
    (see Martin-Löf’s book [22] and Dybjer’s schema for inductive definitions [10])
  - but structural recursion (in one argument at a time) is often inconvenient

Agda’s termination-checker
- generalisation of primitive recursion which is practically useful
- enables doing pattern matching on several arguments simultaneously
- and having recursive calls to structurally smaller arguments

But repeated subtraction is rejected by Agda termination-checker although it is terminating.
Because Agda does not recognise the recursive call to (m - n) as structurally smaller.
Because subtraction is not a constructor for natural numbers.
Further reasoning required to deduce the recursive call is on a smaller argument.

Section 7 : describes how partial and general recursive functions can be represented in Agda.
Idea is to replace a partial function by a total function with an extra argument:
a proof that the function terminates on its arguments.

------------------------------------------------------------------------------
3 Dependent Types

3.1 Vectors of a Given Length

2 ways to define
- Recursive family
  - by primitive recursion/induction on n
- Inductive family
  - as a family of data types by declaring its constructors and the types of constructors
  - like def of List, except length info included in types

paper mostly uses inductive families

--------------------------------------------------
Vectors as a Recursive Family

In math : define vectors by induction on n:
  A   0 = 1
  A n+1 = A × An
In Agda (and Martin-Löf type theory):
-}
-- type with only one element
data Unit : Set where
  <> : Unit

VecR : Set -> Nat -> Set
VecR A  zero    = Unit
VecR A (succ n) = A X VecR A n

{-
Up till now, only used primitive recursion for defining functions
where the range is in a given set (in a given small type).
Here, primitive recursion used for defining a family of sets
- a family of elements in a given large type.
-}

zipR : {A B : Set} {n : Nat} -> VecR A n -> VecR B n -> VecR (A X B) n
zipR {n =  zero}          _          _   = <>
zipR {n = succ n'} < a , as > < b , bs > = < < a , b > , zipR {n = n'} as bs >

{-
base case : type-correct since the right hand side has type
            VecR (A X B) zero     = <>
step case : type-correct since the right hand side has type
            VecR (A X B) (succ n) = (A X B) X (VecR (A X B) n)
-}

-- Exercise. Write the functions head, tail, and map for the recursive vectors.

headR : {A : Set} {n : Nat} -> VecR A (succ n) ->      A
headR < x , _ > = x

tailR : {A : Set} {n : Nat} -> VecR A (succ n) -> VecR A n
tailR < _ ,  t > = t

mapR : {A B : Set} {n : Nat} -> (A -> B) -> VecR A n -> VecR B n
mapR {n = zero}    _        _   = <>
mapR {n = succ n'} f < a , as > = < f a , mapR {n = n'} f as >

_ : mapR succ < 1 , < 2 , < 0 , <> > > > PE.≡ < 2 , < 3 , < 1 , <> > > >
_ = PE.refl

--------------------------------------------------
-- Vectors as an Inductive Family

data Vec (A : Set) : Nat -> Set where
  []   :                              Vec A  zero
  _::_ : {n : Nat} -> A -> Vec A n -> Vec A (succ n)

{-
this time no induction on length
instead : constructors generate vectors of different lengths
[] : length 0
:: : length (n + 1)

Definition style called an inductive family, or an inductively defined family of sets.

Terminology comes from constructive type theory,
where data types such as Nat and (List A) are called inductive types.

Remark: Beware of terminological confusion:
- In programming languages one talks about recursive types for such data
  types defined by declaring the constructors with their types.
- May be confusing since the word recursive family was used for a different notion.
- Reason for terminological distinction between data types in ordinary functional languages,
  and data types in languages where all programs terminate.
- In terminating languages, there will not be any non-terminating numbers or non-terminating lists.
- The set-theoretic meaning of such types is therefore simple:
  - build the set inductively generated by the constructors, see [9] for details.
- In non-terminating language, the semantic domains are more complex.
  - One typically considers various kinds of Scott domains which are complete partially orders.

(Vec A n) has two args:
- small type A of the elements
  - A is a parameter in the sense that it remains the same throughout the definition:
    for a given A, define the family Vec A : Nat -> Set
- length n of type Nat.
  - n is not a parameter since it varies in the types of the constructors

Non-parameters are often called INDICES
- say that Vec A is an inductive family indexed by natural numbers

In Agda data type definitions
- parameters are placed to the left of the colon
  and become implicit arguments to the constructors
- indices are placed to the right
-}

zip : {A B : Set} {n : Nat} -> Vec A n -> Vec B n -> Vec (A X B) n
zip {n = zero}          []        []  = []
zip {n = succ n'} (x :: xs) (y :: ys) = < x , y > :: zip {n = n'} xs ys

head : {A : Set} {n : Nat} -> Vec A (succ n) -> A
head (x :: _) = x

tail : {A : Set} {n : Nat} -> Vec A (succ n) -> Vec A n
tail (_ :: xs) = xs

map : {A B : Set} {n : Nat} -> (A -> B) -> Vec A n -> Vec B n
map f [] = []
map f (x :: xs) = f x :: map f xs

--------------------------------------------------
-- 3.2 Finite Sets

data Fin : Nat -> Set where
  fzero : {n : Nat} ->          Fin (succ n)
  fsucc : {n : Nat} -> Fin n -> Fin (succ n)

{-
for each n, Fin n contains n elements
e.g., Fin 3 contains fzero, fsucc fzero and fsucc (fsucc fzero)

useful to access element in a vector
- for Vec A n
- position given by (Fin n)
- ensures accessing an element inside the vector

For empty vector n is zero.
So would use (Fin 0) --- which has no elements.
There is no such case.
Expressed in Agda via "absurd" pattern '()'
-}

_!_ : {A : Set} {n : Nat} -> Vec A n -> Fin n -> A
[]        ! ()
(x ::  _) ! fzero   = x
(_ :: xs) ! fsucc i = xs ! i

-- Exercise: Rewrite the function !! so that it has the following type:
-- This eliminates the empty vector case, but other cases are needed.

_!!_  : {A : Set} {n : Nat} -> Vec A (succ n) -> Fin (succ n) -> A
_!!_  {_}   {zero} (a ::  f_)  fzero    = a
_!!_  {_} {succ n} (a ::  _)  fzero    = a
_!!_  {_} {succ n} (_ :: as) (fsucc f) = _!!_  {n = n} as f

_!!'_ : {A : Set} {n : Nat} -> Vec A (succ n) -> Fin (succ n) -> A
_!!'_              (a ::  _)  fzero    = a
_!!'_ {_} {succ n} (_ :: as) (fsucc f) = _!!'_ {n = n} as f

_ : (0 :: 1 :: 2 :: []) !   fsucc fzero PE.≡ 1
_ = PE.refl
_ : (0 :: 1 :: 2 :: []) !!  fsucc fzero PE.≡ 1
_ = PE.refl
_ : (0 :: 1 :: 2 :: []) !!' fsucc fzero PE.≡ 1
_ = PE.refl

-- Exercise: Give an alternative definition of Fin as a recursive family.

-- from Conal Eliot https://raw.githubusercontent.com/conal/agda-play/main/DependentTypesAtWork/RecVec.agda
FinR : Nat -> Set
FinR  zero    = DEP.⊥
FinR (succ n) = Maybe.Maybe (FinR n)

f5 : FinR 5
f5 = Maybe.nothing
f5' : FinR 5 PE.≡ Maybe.Maybe (Maybe.Maybe (Maybe.Maybe (Maybe.Maybe (Maybe.Maybe DEP.⊥))))
f5' = PE.refl
f4 : FinR 4
f4 = Maybe.nothing
f3 : FinR 3
f3 = Maybe.nothing
f2 : FinR 2
f2 = Maybe.nothing
f1 : FinR 1
f1 = Maybe.nothing
f1' : FinR 1 PE.≡ Maybe.Maybe DEP.⊥
f1' = PE.refl
--f0 : FinR 0
--f0 = {!!} -- no solution found
f0' : FinR 0 PE.≡ DEP.⊥
f0' = PE.refl

_!'_ : {A : Set} {n : Nat} → VecR A n → FinR n → A
_!'_  {n = succ m} < a ,  _ >  Maybe.nothing    = a
_!'_  {n = succ m} < _ , as > (Maybe.just finm) = as !' finm

_    : < 0 , < 1 , < 2 , <> > > >  !'                                    Maybe.nothing   PE.≡ 0
_    = PE.refl
_    : < 0 , < 1 , < 2 , <> > > >  !'                         Maybe.just Maybe.nothing   PE.≡ 1
_    = PE.refl
_    : < 0 , < 1 , < 2 , <> > > >  !'             Maybe.just (Maybe.just Maybe.nothing)  PE.≡ 2
_    = PE.refl
-- (Maybe.Maybe _A_645) !=< DEP.⊥
-- _ : < 0 , < 1 , < 2 , <> > > >  !' Maybe.just (Maybe.just (Maybe.just Maybe.nothing)) PE.≡ 100
-- _ = PE.refl

--------------------------------------------------
-- 3.3 More Inductive Families

-- binary trees of a certain height
-- any given (t : DBTree A n) is a perfectly balanced tree
-- with 2n elements and information in the leaves
data DBTree (A : Set) : Nat -> Set where
  leaf :                     A                 -> DBTree A zero
  node : {n : Nat} -> DBTree A n -> DBTree A n -> DBTree A (succ n)

l1       : DBTree Nat 0
l1       = leaf 1
l2       : DBTree Nat 0
l2       = leaf 2
n1-2     : DBTree Nat 1
n1-2     = node l1 l2
l3       : DBTree Nat 0
l3       = leaf 3
l4       : DBTree Nat 0
l4       = leaf 4
n3-4     : DBTree Nat 1
n3-4     = node l3 l4
n1-2-3-4 : DBTree Nat 2
n1-2-3-4 = node n1-2 n3-4

-- Exercise/TODO: Modify DBTree def to define the height balanced binary trees
-- i.e., binary trees where difference between heights of left and right subtree is at most one.

-- Exercise/TODO: Define lambda terms as an inductive family
-- indexed by the maximal number of free variables allowed in the term.

-- Exercise/TODO: define typed lambda terms as an inductive family indexed by the type of the term.

{-
------------------------------------------------------------------------------
Curry, 1930’s : one-to-one correspondence between propositions in propositional logic and types.
1960’s de Bruijn and Howard introduced dependent types to extend Curry’s correspondence to predicate logic.
Scott [31] and Martin-Löf [20], correspondence became building block of foundation for constructive math:
- Martin-Löf’s intuitionistic type theory.

Will now show how intuitionistic predicate logic with equality is a subsystem of
Martin-Löf type theory by realising it as a theory in Agda.

4.1 Propositional Logic

isomorphism : each proposition is interpreted as the set of its proofs.
To emphazie PROOFS here are FIRST-CLASS mathematical object, say PROOF OBJECTS.
aka : CONSTRUCTIONS

proposition
- is true IFF its set of proofs is inhabited
- it is false iff its set of proofs is empty
-}

-- CONJUNCTION (aka AND)
-- A and B are two propositions represented by their sets of proofs.
-- A & B is also a set of proofs, representing the conjunction of A and B.
-- Note : conjunction is same as Cartesian product of two sets.
-- applying & constructor is &-introduction
data _&_ (A B : Set) : Set where
  <_,_> : A -> B -> A & B

-- alternate def
_&'_ : Set -> Set -> Set
A &' B = A X B

-- two rules of &-elimination
-- rules state that if A & B is true then A and B are also true
fst : {A B : Set} -> A & B -> A
fst < a , _ > = a

snd : {A B : Set} -> A & B -> B
snd < _ , b > = b

sndP : {A B : Set} -> A &' B -> B
sndP < _ , b > = b

-- DISJUNCTION (aka OR)
-- disjunction corresponds to disjoint union
data _\/_ (A B : Set) : Set where
  inl : A -> A \/ B
  inr : B -> A \/ B

-- alternate def
_\/'_ : Set -> Set -> Set
A \/' B = Either A B

-- rule of \/-elimination is case analysis for a disjoint union
case : {A B C : Set} -> A \/ B -> (A -> C) -> (B -> C) -> C
case (inl a) d e = d a
case (inr b) d e = e b

-- proposition which is always true
-- corresponds to the unit set (see page 14) according to Curry-Howard:
data True : Set where
  <> : True

-- proposition False is the proposition that is false by definition
-- corresponds to the the empty set according to Curry-Howard.
-- This is the set which is defined by stating that it has no canonical elements.
-- sometimes referred as the “absurdity” set and denoted by ⊥
data False : Set where

-- rule of ⊥-elimination states that if False has been proved, then can prove any proposition A.
-- Can only happen by starting with contradictory assumptions.
nocase : {A : Set} -> False -> A
nocase () -- tells agda no cases to consider
{-
Justification of this rule is same as justification of existence of
an empty function from the empty set into an arbitrary set.
Since the empty set has no elements there is nothing to define; it is definition by no cases.
Recall the explanation on page 16 when we used the notation ().
-}

-- In constructive logic
-- - proving negation of a proposition is the same as
-- - proving the proposition leads to absurdity:
Not : Set -> Set
Not A = A -> False

{-
BHK-interpretation says an implication is proved by providing a method for transforming
a proof of A into a proof of B.

When Brouwer pioneered this 100 years ago, there were no computers and no models of computation.
In contemporary constructive mathematics in general, and in Martin-Löf type theory in particular,
a “method” is usually understood as a computable function (or computer program) which transforms proofs.
Implication is defined as function space.
Emphasized via new notation:
-}

_==>_ : (A B : Set) -> Set
A ==> B = A -> B

_ : False ==> False -- T
_ = λ ()
_ : False ==> True  -- T
_ = λ ()
_ : True  ==> False -- F
_ = λ _ → {!!}
_ : True  ==> True  -- T
_ = λ _ → <>

{-
Above def not accepted in Martin-Löf’s version of propositions-as-sets.
Because each proposition should be defined by stating what its canonical proofs are.
A canonical proof should always begin with a constructor.
A function in A -> B does not, unless one considers the lambda-sign as a constructor.

Instead, Martin-Löf defines implication as a set with one constructor:
Using this, a canonical proof of A ==>' B always begins with the constructor fun.
-}
data _==>'_ (A B : Set) : Set where
  fun : (A -> B) -> A ==>' B

-- rule of ==>-elimination (modus ponens)
apply : {A B : Set} -> A ==>' B -> A -> B
apply (fun f) a = f a

-- equivalence of propositions
_<==>_ : Set -> Set -> Set
A <==> B = (A ==> B) & (B ==> A)

_ : False <==> False
_ = < ( λ () ) , ( λ () ) >
_ : False <==> True
_ = < (λ () ) , (λ { <> → {!!}}) >
_ : True  <==> False
_ = < (λ { <> → {!!}}) , (λ () ) >
_ : True  <==> True
_ = < (λ _ → <>) , (λ _ → <>) >

{-
Exercise/TODO: Prove your favourite tautology from propositional logic.
Beware that you will not be able to prove the law of the excluded middle A \/ Not A.
This is a consequence of the definition of disjunction, can you explain why?.
The law of the excluded middle is not available in intuitonistic logic, only in classical logic.
-}

le : ∀ {P Q : Set} → (P ==> Q) <==> (Not P \/ Q)
le {P} {Q} = < (λ {P==>Q → {!!} }) , (λ { (inl NotP) p → {!!} ; (inr q) p → q}) >


{-# OPTIONS --safe --without-K #-}
module Categories.Examples.Functor.Sets where

import Data.List as List
import Data.List.Properties
open import Data.Nat using (ℕ)
import Data.Product as Product
import Data.Vec as Vec
import Data.Vec.Properties
open import Function using (id; λ-; _$-)
open import Relation.Binary.PropositionalEquality using (refl)

open import Categories.Category.Discrete using (Discrete)
open import Categories.Category.Instance.Sets
open import Categories.Functor using (Endofunctor)
open import Categories.Functor.Bifunctor using (Bifunctor; appʳ)

List : ∀ {o} → Endofunctor (Sets o)
List = record
  { F₀ = List.List
  ; F₁ = List.map
  ; identity = map-id $-
  ; homomorphism = map-compose $-
  ; F-resp-≈ = λ f≈g → map-cong (λ- f≈g) $-
  }
  where
    open Data.List.Properties

Vec′ : ∀ {o} → Bifunctor (Sets o) (Discrete ℕ) (Sets o)
Vec′ = record
  { F₀ = Product.uncurry Vec.Vec
  ; F₁ = λ { (f , refl) → Vec.map f }
  ; identity = map-id $-
  ; homomorphism = λ { {_} {_} {_} {f , refl} {g , refl} → map-∘ g f _}
  ; F-resp-≈ = λ { {_} {_} {_} {_ , refl} (g , refl) → map-cong (λ- g) _}
  }
  where
    open Product using (_,_)
    open Data.Vec.Properties

Vec : ∀ {o} → ℕ → Endofunctor (Sets o)
Vec = appʳ Vec′


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

module Categories.Category.Instance.Properties.Setoids.CCC where

open import Level
open import Data.Product using (Σ ; _,_)
open import Function.Equality as ⟶ using (Π; _⟶_)
open import Relation.Binary using (Setoid)

open import Categories.Category
open import Categories.Category.Monoidal.Instance.Setoids
open import Categories.Category.CartesianClosed
open import Categories.Category.CartesianClosed.Canonical renaming (CartesianClosed to CCartesianClosed)
open import Categories.Category.Instance.Setoids

open Π

module _ ℓ where
  private
    S = Setoids ℓ ℓ
    module S = Category S

  Setoids-Canonical : CCartesianClosed S
  Setoids-Canonical = record
    { ⊤            = ⊤
    ; _×_          = _×_
    ; !            = !
    ; π₁           = π₁
    ; π₂           = π₂
    ; ⟨_,_⟩        = ⟨_,_⟩
    ; !-unique     = !-unique
    ; π₁-comp      = λ {_ _ f _ g} → project₁ {h = f} {g}
    ; π₂-comp      = λ {_ _ f _ g} → project₂ {h = f} {g}
    ; ⟨,⟩-unique   = λ {_ _ _ f g h} → unique {h = h} {f} {g}
    ; _^_          = λ X Y → Y ⟶.⇨ X
    ; eval         = λ {X Y} → record
      { _⟨$⟩_ = λ { (f , x) → f ⟨$⟩ x }
      ; cong  = λ { (eq₁ , eq₂) → eq₁ eq₂ }
      }
    ; curry        = λ {C A B} f → record
      { _⟨$⟩_ = λ c → record
        { _⟨$⟩_ = λ a → f ⟨$⟩ (c , a)
        ; cong  = λ eq → cong f (Setoid.refl C , eq)
        }
      ; cong  = λ eq₁ eq₂ → cong f (eq₁ , eq₂)
      }
    ; eval-comp    = λ {_ _ _ f} → cong f
    ; curry-resp-≈ = λ eq₁ eq₂ eq → eq₁ (eq₂ , eq)
    ; curry-unique = λ eq₁ eq₂ eq → eq₁ (eq₂ , eq)
    }
    where open Setoids-Cartesian

  Setoids-CCC : CartesianClosed S
  Setoids-CCC = Equivalence.fromCanonical S Setoids-Canonical


{-# OPTIONS --cubical --safe #-}

module Data.Binary.Subtraction where

open import Data.Binary.Definition
open import Data.Nat

double : 𝔹 → 𝔹
double 0ᵇ      = 0ᵇ
double (1ᵇ xs) = 2ᵇ double xs
double (2ᵇ xs) = 2ᵇ 1ᵇ xs

dec : 𝔹 → 𝔹
dec 0ᵇ = 0ᵇ
dec (2ᵇ xs) = 1ᵇ xs
dec (1ᵇ xs) = double xs

ones : ℕ → 𝔹 → 𝔹
ones zero    xs = xs
ones (suc n) xs = ones n (1ᵇ xs)

fromZ₁ : ℕ → 𝔹 → 𝔹
fromZ₁ n 0ᵇ      = 0ᵇ
fromZ₁ n (1ᵇ xs) = 2ᵇ ones n (double xs)
fromZ₁ n (2ᵇ xs) = 2ᵇ ones (suc n) xs

mutual
  compl₁′ : ℕ → 𝔹 → 𝔹 → 𝔹
  compl₁′ n 0ᵇ      _       = 2ᵇ ones n 0ᵇ
  compl₁′ n (1ᵇ xs) 0ᵇ      = fromZ₁ (suc n) xs
  compl₁′ n (2ᵇ xs) 0ᵇ      = 2ᵇ ones n (double xs)
  compl₁′ n (1ᵇ xs) (1ᵇ ys) = 2ᵇ ones n (compl₁′ 0 xs ys)
  compl₁′ n (1ᵇ xs) (2ᵇ ys) = compl₁′ (suc n) xs ys
  compl₁′ n (2ᵇ xs) (1ᵇ ys) = compl₂′ (suc n) xs ys
  compl₁′ n (2ᵇ xs) (2ᵇ ys) = 2ᵇ ones n (compl₁′ 0 xs ys)

  compl₂′ : ℕ → 𝔹 → 𝔹 → 𝔹
  compl₂′ n xs      0ᵇ      = fromZ₁ n xs
  compl₂′ n 0ᵇ      _       = 0ᵇ
  compl₂′ n (1ᵇ xs) (1ᵇ ys) = compl₂′ (suc n) xs ys
  compl₂′ n (1ᵇ xs) (2ᵇ ys) = 2ᵇ ones n (compl₁′ 0 xs ys)
  compl₂′ n (2ᵇ xs) (1ᵇ ys) = 2ᵇ ones n (compl₂′ 0 xs ys)
  compl₂′ n (2ᵇ xs) (2ᵇ ys) = compl₂′ (suc n) xs ys

mutual
  compl₁ : 𝔹 → 𝔹 → 𝔹
  compl₁ xs      0ᵇ      = dec xs
  compl₁ 0ᵇ      _       = 1ᵇ 0ᵇ
  compl₁ (1ᵇ xs) (1ᵇ ys) = 1ᵇ compl₁ xs ys
  compl₁ (1ᵇ xs) (2ᵇ ys) = compl₁′ zero xs ys
  compl₁ (2ᵇ xs) (1ᵇ ys) = compl₂′ zero xs ys
  compl₁ (2ᵇ xs) (2ᵇ ys) = 1ᵇ compl₁ xs ys

  compl₂ : 𝔹 → 𝔹 → 𝔹
  compl₂ 0ᵇ      _       = 0ᵇ
  compl₂ xs      0ᵇ      = xs
  compl₂ (1ᵇ xs) (1ᵇ ys) = compl₂′ zero xs ys
  compl₂ (1ᵇ xs) (2ᵇ ys) = 1ᵇ compl₁ xs ys
  compl₂ (2ᵇ xs) (1ᵇ ys) = 1ᵇ compl₂ xs ys
  compl₂ (2ᵇ xs) (2ᵇ ys) = compl₂′ zero xs ys

open import Data.Binary.Order
open import Data.Bool

infixl 6 _-_
_-_ : 𝔹 → 𝔹 → 𝔹
n - m = if n ≤ᴮ m then 0ᵇ else compl₂ n m

open import Data.Binary.Testers
open import Path using (refl)

_ : test _-_ _∸_ 30
_ = refl


module RMonads.Modules where

open import Library
open import Categories
open import Functors
open import RMonads

record Mod {a}{b}{c}{d}{C : Cat {a}{b}}{D : Cat {c}{d}}{J : Fun C D}
           (RM : RMonad J) : Set (a ⊔ c ⊔ d) where
  constructor mod
  open Cat
  open Fun
  open RMonad RM
  field M       : Obj C → Obj D
        mbind   : ∀ {X Y} → Hom D (OMap J X) (T Y) → Hom D (M X) (M Y)
        laweta  : ∀{X} → mbind (η {X}) ≅ iden D {M X}
        lawbind : ∀{X Y Z}
                  {f : Hom D (OMap J X) (T Y)}{g : Hom D (OMap J Y) (T Z)} →
                  mbind (comp D (bind g) f) ≅ comp D (mbind g) (mbind f)

-- any rel. monad is trivially a module over its J.
ModJ : forall {a}{b}{c}{d}{C : Cat {a}{b}}{D : Cat {c}{d}}
       {J : Fun C D} (RM : RMonad J) -> Mod (trivRM J)
ModJ {D = D}{J = J} RM =
  mod T
      (\ f -> bind (comp η f))
      (trans (cong bind idr) law1)
      (trans (cong bind (trans (trans (sym ass)
                                      (cong (\ g -> comp g _) (sym law2)))
                               ass))
             law3)
  where open Fun J; open RMonad RM; open Cat D

open import Functors.FullyFaithful
open import Isomorphism
-- if J is fully faithful then any suitably typed functor is a module for trivial rel monad given by J
ModF : forall {a}{b}{c}{d}{C : Cat {a}{b}}{D : Cat {c}{d}}
       {J : Fun C D} → Full J → Faithful J → (F : Fun C D) -> Mod (trivRM J)
ModF {C = C}{D = D}{J = J} P Q F = mod
  (OMap F)
  (λ f → HMap F (fst (P f)))
  (trans (cong (HMap F) (Q (trans (snd (P (Cat.iden D))) (sym $ fid J)))) (fid F))
  (trans (cong (HMap F)
               (Q (trans (snd (P _))
                         (trans (cong₂ (Cat.comp D)
                                       (sym $ snd (P _))
                                       (sym $ snd (P _)))
                                (sym $ fcomp J)))))
         (fcomp F)) where open Fun

-- any rel. monad is trivially a module over itself, 'tautalogical module'
ModRM : forall {a}{b}{c}{d}{C : Cat {a}{b}}{D : Cat {c}{d}}
       {J : Fun C D} (RM : RMonad J) -> Mod RM
ModRM RM = mod T bind law1 law3 where open RMonad RM


-- There's something very strange going on with mutual and parameterised
-- modules.  Can't reproduce the bug... :(
module Mutual where

data True : Set where
  tt : True

data False : Set where

data _\/_ (A B : Set) : Set where
  inl : A -> A \/ B
  inr : B -> A \/ B

swap : {A B : Set} -> A \/ B -> B \/ A
swap (inl a) = inr a
swap (inr b) = inl b

module Foo (A : Set)(P : A -> Set) where

  Q : A -> A -> Set
  Q x y = P x \/ P y

mutual

  data Nat : Set where
    zero : Nat
    suc  : Nat -> Nat

  Even : Nat -> Set
  Even zero = True
  Even (suc zero) = False
  Even (suc (suc n)) = Even n

  f : Nat -> Set
  f zero    = True
  f (suc n) = Q n (suc n)
    where
      open module F = Foo Nat Even

  g : (n : Nat) -> f n
  g zero = tt
  g (suc zero) = inl tt
  g (suc (suc n)) = swap (g (suc n))


{-
This second-order signature was created from the following second-order syntax description:

syntax Combinatory | CL

type
  * : 0-ary

term
  app : *  *  ->  * | _$_ l20
  i   : *
  k   : *
  s   : *

theory
  (IA) x     |> app (i, x) = x
  (KA) x y   |> app (app(k, x), y) = x
  (SA) x y z |> app (app (app (s, x), y), z) = app (app(x, z), app(y, z))
-}

module Combinatory.Signature where

open import SOAS.Context

open import SOAS.Common

open import SOAS.Syntax.Signature *T public
open import SOAS.Syntax.Build *T public

-- Operator symbols
data CLₒ : Set where
  appₒ iₒ kₒ sₒ : CLₒ

-- Term signature
CL:Sig : Signature CLₒ
CL:Sig = sig λ
  {  appₒ  → (⊢₀ *) , (⊢₀ *) ⟼₂ *
  ;  iₒ    → ⟼₀ *
  ;  kₒ    → ⟼₀ *
  ;  sₒ    → ⟼₀ *
  }

open Signature CL:Sig public


module Numeric.Nat where

open import Numeric.Nat.BinarySearch      public
open import Numeric.Nat.Divide.Properties public
open import Numeric.Nat.Divide            public
open import Numeric.Nat.DivMod            public
open import Numeric.Nat.GCD.Extended      public
open import Numeric.Nat.GCD.Properties    public
open import Numeric.Nat.GCD               public
open import Numeric.Nat.LCM.Properties    public
open import Numeric.Nat.LCM               public
open import Numeric.Nat.Modulo            public
open import Numeric.Nat.Pow               public
open import Numeric.Nat.Prime.Properties  public
open import Numeric.Nat.Prime             public
open import Numeric.Nat.Properties        public
open import Numeric.Nat.Sqrt              public


{-# OPTIONS --cubical #-}

module Type.Cubical.Path.Proofs where

import      Lvl
open import Type
open import Type.Cubical
open import Type.Cubical.Path

private variable ℓ ℓ₁ ℓ₂ : Lvl.Level

module _ where
  private variable A B : Type{ℓ}
  private variable P : Interval → Type{ℓ}
  private variable x y z w : A

  -- The full path from the starting point to the end.
  path : (point : Interval → A) → Path(point(Interval.𝟎)) (point(Interval.𝟏))
  path point i = point i

  -- The point on the path, given a point of the interval indexing the path.
  pointOn : ∀{x y : A} → Path x y → (Interval → A)
  pointOn p i = p i

  -- The path from a point to itself.
  -- This path only consists of the point itself.
  point : Path x x
  point{x = x} _ = x

  -- The reverse path of a path.
  -- Reverses the direction of a path by flipping all points around the point of symmetry.
  reverseP : PathP(P) x y → PathP(\i → P(Interval.flip i)) y x
  reverseP p(i) = p(Interval.flip i)

  reverse : Path x y → Path y x
  reverse = reverseP

  -- A function mapping points between two spaces, given a path between the spaces.
  spaceMap : Path A B → (A → B)
  spaceMap p = Interval.transp (pointOn p) Interval.𝟎

  -- TODO: Move
  module _ {A : Type{ℓ}} where
    private variable a₀ a₁ a₂ a₃ : A
    private variable a₀₀ a₀₁ a₁₀ a₁₁ : A
    private variable a₀₀₀ a₀₀₁ a₀₁₀ a₀₁₁ a₁₀₀ a₁₀₁ a₁₁₀ a₁₁₁ : A
    private variable p₀₀₋ p₀₁₋ p₀₋₀ p₀₋₁ p₁₀₋ p₁₁₋ p₁₋₀ p₁₋₁ p₋₀₀ p₋₀₁ p₋₁₀ p₋₁₁ : Path a₀ a₁

    Path-missingSide : A → A
    Path-missingSide a = Interval.hComp diag a where
      diag : Interval → Interval.Partial Interval.𝟎 A
      diag i ()

    module _
      (p₀₋ : Path a₀₀ a₀₁)
      (p₁₋ : Path a₁₀ a₁₁)
      (p₋₀ : Path a₀₀ a₁₀)
      (p₋₁ : Path a₀₁ a₁₁)
      where
      -- a₀₁ → p₋₁ → a₁₁
      --  ↑           ↑
      -- p₀₋         p₁₋
      --  ↑           ↑
      -- a₀₀ → p₋₀ → a₁₀
      Square : Type
      Square = PathP (\i → Path (p₋₀ i) (p₋₁ i)) p₀₋ p₁₋
    module Square where
      missingSide : Path a₀₀ a₀₁ → Path a₁₀ a₁₁ → Path a₀₀ a₁₀ → Path a₀₁ a₁₁
      missingSide p₀₋ p₁₋ p₋₀ ix = Interval.hComp diagram (p₋₀ ix) where
        diagram : Interval → Interval.Partial(Interval.max ix (Interval.flip ix)) A
        diagram iy (ix = Interval.𝟎) = p₀₋ iy
        diagram iy (ix = Interval.𝟏) = p₁₋ iy

      module _
        {p₀₋ : Path a₀₀ a₀₁}
        {p₁₋ : Path a₁₀ a₁₁}
        {p₋₀ : Path a₀₀ a₁₀}
        {p₋₁ : Path a₀₁ a₁₁}
        (s : Square p₀₋ p₁₋ p₋₀ p₋₁)
        where

        diagonal : Path a₀₀ a₁₁
        diagonal i = s i i

        rotate₊ : Square p₋₁ p₋₀ (reverse p₀₋) (reverse p₁₋)
        rotate₊ iy ix = s ix (Interval.flip iy)

        rotate₋ : Square (reverse p₋₀) (reverse p₋₁) p₁₋ p₀₋
        rotate₋ iy ix = s (Interval.flip ix) iy

        flipX : Square p₁₋ p₀₋ (reverse p₋₀) (reverse p₋₁)
        flipX iy ix = s (Interval.flip iy) ix

        flipY : Square (reverse p₀₋) (reverse p₁₋) p₋₁ p₋₀
        flipY iy ix = s iy (Interval.flip ix)

      module _
        {a₀ a₁ : A}
        (p : Path a₀ a₁)
        where

        lineX : Square point point p p
        lineX ix iy = p ix

        lineY : Square p p point point
        lineY ix iy = p iy

        min : Square point p point p
        min ix iy = p(Interval.min ix iy)

        max : Square p point p point
        max ix iy = p(Interval.max ix iy)

    module _
      (p₀₋₋ : Square p₀₀₋ p₀₁₋ p₀₋₀ p₀₋₁)
      (p₁₋₋ : Square p₁₀₋ p₁₁₋ p₁₋₀ p₁₋₁)
      (p₋₀₋ : Square p₀₀₋ p₁₀₋ p₋₀₀ p₋₀₁)
      (p₋₁₋ : Square p₀₁₋ p₁₁₋ p₋₁₀ p₋₁₁)
      (p₋₋₀ : Square p₀₋₀ p₁₋₀ p₋₀₀ p₋₁₀)
      (p₋₋₁ : Square p₀₋₁ p₁₋₁ p₋₀₁ p₋₁₁)
      where

      Cube : Type
      Cube = PathP (\i → Square (p₋₀₋ i) (p₋₁₋ i) (p₋₋₀ i) (p₋₋₁ i)) p₀₋₋ p₁₋₋
    {-
    module Cube where
      module _
        (p₀₋₋ : Square p₀₀₋ p₀₁₋ p₀₋₀ p₀₋₁)
        (p₁₋₋ : Square p₁₀₋ p₁₁₋ p₁₋₀ p₁₋₁)
        (p₋₀₋ : Square p₀₀₋ p₁₀₋ p₋₀₀ p₋₀₁)
        (p₋₁₋ : Square p₀₁₋ p₁₁₋ p₋₁₀ p₋₁₁)
        (p₋₋₀ : Square p₀₋₀ p₁₋₀ p₋₀₀ p₋₁₀)
        where
        missingSide : Square p₀₋₁ p₁₋₁ p₋₀₁ p₋₁₁
        missingSide ix iy = Interval.hComp diagram (p₋₋₀ ix iy) where -- (Square.max {!!} ix iy)
          diagram : Interval → Interval.Partial {!!} A
          {-diagram : (i : Interval) → Interval.Partial (Interval.max (Interval.max ix (Interval.flip ix)) (Interval.max iy (Interval.flip iy))) _
          diagram iz (ix = Interval.𝟎) = Square.max p₀₋₁ ix iy
          diagram iz (ix = Interval.𝟏) = Square.min p₁₋₁ ix iy
          diagram iz (iy = Interval.𝟎) = Square.max p₋₀₁ ix iy
          diagram iz (iy = Interval.𝟏) = Square.min p₋₁₁ ix iy-}
    -}

  -- Concatenates (joins the ends of) two paths.
  concat : Path x y → Path y z → Path x z
  concat xy yz = Square.missingSide point yz xy

module _ where
  private variable X : Type{ℓ}
  private variable Y : X → Type{ℓ}

  -- Maps a path into another space.
  mapP : (f : (x : X) → Y(x)) → ∀{x y} → (path : Path x y) → PathP(\i → Y(path(i))) (f(x)) (f(y))
  mapP(f) p(i) = f(p(i))

  -- When there is a path between two space mappings.
  mapping : ∀{f g : (x : X) → Y(x)} → (∀{x} → Path(f(x)) (g(x))) → Path f g
  mapping ppt i x = ppt{x} i

  mappingPoint : ∀{f g : (x : X) → Y(x)} → Path f g → (∀{x} → Path(f(x)) (g(x)))
  mappingPoint pfg {x} i = pfg i x

module _ where
  private variable X : Type{ℓ}
  private variable Y : X → Type{ℓ}
  private variable Z : (x : X) → Y(x) → Type{ℓ}

  -- mapP₂' : (f : (x : X) → (y : Y(x)) → Z(x)(y)) → ∀{a₁ b₁ : X}{a₂ : Y(a₁)}{b₂ : Y(b₁)} → (path₁ : Path a₁ b₁) → (path₂ : Path a₂ b₂) → PathP(\i → Z(path₁(i))(?)) (f a₁ a₂) (f b₁ b₂)

  mapP₂ : (f : (x : X) → (y : (x : X) → Y(x)) → Z(x)(y)) → ∀{a₁ b₁ : X}{a₂ b₂ : (x : X) → Y(x)} → (path₁ : Path a₁ b₁) → (path₂ : Path a₂ b₂) → PathP(\i → Z(path₁(i))(path₂(i))) (f a₁ a₂) (f b₁ b₂)
  mapP₂ f ab1 ab2 i = mapP (mapP f ab1 i) ab2 i

  -- mapP₂ : (f : (x : X) → (y : Y(x)) → Z(x)(y)) → ∀{x₁ x₂} → (path : Path x₁ x₂) → PathP(\i → Y(path(i))) (f(x)) (f(y))
  -- mapP₂(f) = ?

module _ where
  private variable X X₁ X₂ Y Y₁ Y₂ : Type{ℓ}

  map : (f : X → Y) → ∀{a b} → Path a b → Path (f(a)) (f(b))
  map = mapP

  map₂ : (f : X₁ → X₂ → Y) → ∀{a₁ b₁}{a₂ b₂} → Path a₁ b₁ → Path a₂ b₂ → Path (f a₁ a₂) (f b₁ b₂)
  map₂ f ab1 ab2 i = mapP (mapP f ab1 i) ab2 i

  liftedSpaceMap : (S : X → Type{ℓ}) → ∀{a b} → Path a b → S(a) → S(b)
  liftedSpaceMap S p = spaceMap(map S p)

  liftedSpaceMap₂ : (S : X → Y → Type{ℓ}) → ∀{a₁ b₁}{a₂ b₂} → Path a₁ b₁ → Path a₂ b₂ → S a₁ a₂ → S b₁ b₂
  liftedSpaceMap₂ S p q = spaceMap(map₂ S p q)

-- TODO: Move
data Loop{ℓ} : Type{ℓ} where
  base : Loop
  loop : Path base base


{-# OPTIONS --without-K #-}
open import Types

module J {a c} {A : Set a} (C : (x y : A) → x ≡ y → Set c) where

open import GroupoidStructure
open import PathOperations
open import PathStructure.Sigma
open import Transport

γ : {x y : A} (p : x ≡ y) →
  Id (Σ A λ y → x ≡ y) (x , refl) (y , p)
γ p = merge-path (p , tr-post _ p refl · id·p _)

justification : {x y : A} (p : x ≡ y) → C x x refl → C x y p
justification p = tr (λ z → C _ (π₁ z) (π₂ z)) (γ p)


open import Prelude
open import Nat
open import dynamics-core
open import contexts

module lemmas-gcomplete where
  -- if you add a complete type to a complete context, the result is also a
  -- complete context
  gcomp-extend : ∀{Γ τ x} → Γ gcomplete → τ tcomplete → x # Γ → (Γ ,, (x , τ)) gcomplete
  gcomp-extend {Γ} {τ} {x} gc tc apart x_query τ_query x₁ with natEQ x x_query
  gcomp-extend {Γ} {τ} {x} gc tc apart .x τ_query x₂ | Inl refl = tr (λ qq → qq tcomplete) (someinj x₂) tc
  gcomp-extend {Γ} {τ} {x} gc tc apart x_query τ_query x₂ | Inr x₁ = gc x_query τ_query x₂


module Generic.Test.Data.Fin where

open import Generic.Main

import Data.Fin as Fin

Fin : ℕ -> Set
Fin = readData Fin.Fin

pattern fzero {n}   = #₀  (relv n , lrefl)
pattern fsuc  {n} i = !#₁ (relv n , i , lrefl)

elimFin : ∀ {n π}
        -> (P : ∀ {n} -> Fin n -> Set π)
        -> (∀ {n} {i : Fin n} -> P i -> P (fsuc i))
        -> (∀ {n} -> P {suc n} fzero)
        -> (i : Fin n)
        -> P i
elimFin P f x  fzero   = x
elimFin P f x (fsuc i) = f (elimFin P f x i)


module Serializer.VecBool where

open import Data.Fin hiding (_+_)
open import Data.Nat
open import Data.Vec
open import Data.Bool
open import Function using (_∘_ ; _$_ ; _∋_ ; id ; const)
open import Function.Bijection
open import Function.Injection
open import Function.Surjection
open import Function.Equality using (_⟶_ ;  _⟨$⟩_ ; Π )
open import Function.LeftInverse hiding (_∘_)
open import Relation.Binary
open import Relation.Binary.EqReasoning
open import Relation.Binary.PropositionalEquality using (_≡_ ; refl ; cong ; setoid )
import Relation.Binary.Indexed as I

open import Serializer
open import Helper.Fin
open import Serializer.Bool

open Serializer.Serializer {{...}}

2^ : ℕ -> ℕ
2^ zero = 1
2^ (suc b) = 2 * 2^ b

--fromVec : ∀ {a n} {A : Set a} -> Vec A n -> Fin n
fromVec : ∀ {n} -> Vec Bool n -> Fin (2^ n)
fromVec {zero} [] = zero
fromVec {suc n} (x ∷ x₁) = × 2 (2^ n) (from x) (fromVec x₁)

toVec` : ∀ {n} -> Fin (2^ n) -> Vec Bool n
toVec` {zero} x = []
toVec` {suc n} x with ⨂ 2 (2^ n) x
toVec` {suc n} .(× 2 (2^ n) i j) | is× i j = (to i) ∷ (toVec` j)

vec-from-cong : ∀ {n} -> Setoid._≈_ (setoid (Vec Bool n)) I.=[ fromVec ]⇒ Setoid._≈_ (setoid (Fin (2^ n)))
vec-from-cong refl = refl

vec-from-preserves-eq : ∀ {n} -> setoid (Vec Bool n) ⟶ setoid (Fin (2^ n))
vec-from-preserves-eq = record { _⟨$⟩_ = fromVec ; cong = vec-from-cong }

vec-from-injective : ∀ {n} -> Injective (vec-from-preserves-eq {n})
vec-from-injective {zero} {[]} {[]} p with fromVec []
... | p2 = refl
vec-from-injective {suc n} {x ∷ x₁} {y ∷ y₁} p with (⨂ 2 (2^ n) (fromVec (x ∷ x₁))) | (⨂ 2 (2^ n) (fromVec (y ∷ y₁)))
... | a1 | b2 with vec-from-injective {n} {x₁} {y₁}
... | c with c (×-equal₁ {x₁ = (fromBool x)} {x₂ = (fromBool y)} p) | (×-equal₂ {x₁ = (fromBool x)} {x₂ = (fromBool y)} p)
... | p1 | p2 with from-bool-injective p2
vec-from-injective {suc n} {x ∷ x₁} {.x ∷ .x₁} p | a1 | b2 | c | refl | p2 | refl = refl

vec-from-surjective : ∀ {n} -> Surjective (vec-from-preserves-eq {n})
vec-from-surjective {n} = record { from = preserves-eq-inv ; right-inverse-of = (inv {n}) }
  where
    cong-inverse : ∀ {n} -> Setoid._≈_ (setoid (Fin (2^ n))) I.=[ toVec` ]⇒ Setoid._≈_ (setoid (Vec Bool n))
    cong-inverse refl = refl

    preserves-eq-inv : ∀ {n} -> setoid (Fin  (2^ n)) ⟶ setoid (Vec Bool n)
    preserves-eq-inv = record { _⟨$⟩_ = toVec` ; cong = cong-inverse }

    inv : ∀ {n} -> (preserves-eq-inv {n}) RightInverseOf (vec-from-preserves-eq {n})
    inv {zero} zero = refl
    inv {zero} (suc ())
    inv {suc n₁} x with ⨂ 2 (2^ n₁) x
    inv {suc n₁} .(× 2 (2^ n₁) i j) | is× i j
      rewrite (Surjective.right-inverse-of (Bijective.surjective (Bijection.bijective (bijection {Bool})))) i | (inv {n₁} j) = refl


------------------------------------------------------------------------------
-- Inequalities on partial natural numbers
------------------------------------------------------------------------------

{-# OPTIONS --exact-split              #-}
{-# OPTIONS --no-sized-types           #-}
{-# OPTIONS --no-universe-polymorphism #-}
{-# OPTIONS --without-K                #-}

module FOTC.Data.Nat.Inequalities where

open import FOTC.Base

infix 4 _<_ _≮_ _>_ _≯_ _≤_ _≰_ _≥_ _≱_

------------------------------------------------------------------------------
-- The function terms.

postulate
  lt    : D → D → D
  lt-00 : lt zero zero                   ≡ false
  lt-0S : ∀ n → lt zero (succ₁ n)        ≡ true
  lt-S0 : ∀ n → lt (succ₁ n) zero        ≡ false
  lt-SS : ∀ m n → lt (succ₁ m) (succ₁ n) ≡ lt m n
{-# ATP axioms lt-00 lt-0S lt-S0 lt-SS #-}

le : D → D → D
le m n = lt m (succ₁ n)
{-# ATP definition le #-}

gt : D → D → D
gt m n = lt n m
{-# ATP definition gt #-}

ge : D → D → D
ge m n = le n m
{-# ATP definition ge #-}

------------------------------------------------------------------------
-- The relations.

_<_ : D → D → Set
m < n = lt m n ≡ true
{-# ATP definition _<_ #-}

_≮_ : D → D → Set
m ≮ n = lt m n ≡ false
{-# ATP definition _≮_ #-}

_>_ : D → D → Set
m > n = gt m n ≡ true
{-# ATP definition _>_ #-}

_≯_ : D → D → Set
m ≯ n = gt m n ≡ false
{-# ATP definition _≯_ #-}

_≤_  : D → D → Set
m ≤ n = le m n ≡ true
{-# ATP definition _≤_ #-}

_≰_  : D → D → Set
m ≰ n = le m n ≡ false
{-# ATP definition _≰_ #-}

_≥_ : D → D → Set
m ≥ n = ge m n ≡ true
{-# ATP definition _≥_ #-}

_≱_ : D → D → Set
m ≱ n = ge m n ≡ false
{-# ATP definition _≱_ #-}

------------------------------------------------------------------------------
-- The lexicographical order.
Lexi : D → D → D → D → Set
Lexi m n m' n' = m < m' ∨ m ≡ m' ∧ n < n'
{-# ATP definition Lexi #-}


module list-test where

open import bool
open import list
open import nat
open import list-to-string
open import bool-to-string
open import eq

test1 : 𝕃 𝔹
test1 = tt :: tt :: tt :: []

test2 : 𝕃 𝔹
test2 = ff :: ff :: []

test3 = test1 ++ test2

test-lem : test3 ≡ tt :: tt :: tt :: ff :: ff :: []
test-lem = refl

test-lem2 : reverse test3 ≡ ff :: ff :: tt :: tt :: tt :: []
test-lem2 = refl

test3-string = 𝕃-to-string 𝔹-to-string ", " test3

test4-even = filter is-even (1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: [])


------------------------------------------------------------------------
-- The Agda standard library
--
-- An example of how the Record module can be used
------------------------------------------------------------------------

-- Taken from Randy Pollack's paper "Dependently Typed Records in Type
-- Theory".

module README.Record where

open import Data.Product
open import Data.String
open import Function using (flip)
open import Level
import Record
open import Relation.Binary

-- Let us use strings as labels.

open Record String _≟_

-- Partial equivalence relations.

PER : Signature _
PER = ∅ , "S"     ∶ (λ _ → Set)
        , "R"     ∶ (λ r → r · "S" → r · "S" → Set)
        , "sym"   ∶ (λ r → Lift (Symmetric (r · "R")))
        , "trans" ∶ (λ r → Lift (Transitive (r · "R")))

-- Given a PER the converse relation is also a PER.

converse : (P : Record PER) →
           Record (PER With "S" ≔ (λ _ → P · "S")
                       With "R" ≔ (λ _ → flip (P · "R")))
converse P =
  Rec′⇒Rec
    (PER With "S" ≔ (λ _ → P · "S")
         With "R" ≔ (λ _ → flip (P · "R")))
    ((((_ ,) ,) , lift λ {_} → lower (P · "sym")) ,
     (lift λ {_} yRx zRy → lower (P · "trans") zRy yRx))


{-# OPTIONS --safe #-}
module Cubical.Algebra.CommAlgebra.Kernel where

open import Cubical.Foundations.Prelude
open import Cubical.Foundations.Equiv

open import Cubical.Algebra.CommRing.Base
open import Cubical.Algebra.CommRing.Ideal using (Ideal→CommIdeal)
open import Cubical.Algebra.Ring.Kernel using () renaming (kernelIdeal to ringKernel)
open import Cubical.Algebra.CommAlgebra.Base
open import Cubical.Algebra.CommAlgebra.Properties
open import Cubical.Algebra.CommAlgebra.Ideal

private
  variable
    ℓ : Level

module _ {R : CommRing ℓ} (A B : CommAlgebra R ℓ) (ϕ : CommAlgebraHom A B) where

  kernel : IdealsIn A
  kernel = Ideal→CommIdeal (ringKernel (CommAlgebraHom→RingHom {A = A} {B = B} ϕ))


{-# OPTIONS --without-K #-}
module sets.vec.core where

open import function.core
open import sets.nat.core using (ℕ; zero; suc)
open import sets.fin

data Vec {i}(A : Set i) : ℕ → Set i where
  [] : Vec A 0
  _∷_ : ∀ {n} → A → Vec A n → Vec A (suc n)
infixr 5 _∷_

head : ∀ {i}{A : Set i}{n : ℕ} → Vec A (suc n) → A
head (x ∷ _) = x

tail : ∀ {i}{A : Set i}{n : ℕ} → Vec A (suc n) → Vec A n
tail (_ ∷ xs) = xs

tabulate : ∀ {i}{A : Set i}{n : ℕ}
         → (Fin n → A) → Vec A n
tabulate {n = zero} _ = []
tabulate {n = suc m} f = f zero ∷ tabulate (f ∘ suc)

lookup : ∀ {i}{A : Set i}{n : ℕ}
       → Vec A n → Fin n → A
lookup [] ()
lookup (x ∷ xs) zero = x
lookup (x ∷ xs) (suc i) = lookup xs i

_!_ : ∀ {i}{A : Set i}{n : ℕ}
    → Vec A n → Fin n → A
_!_ = lookup


module Cats.Category.Constructions.Epi where

open import Level

open import Cats.Category.Base

module Build {lo la l≈} (Cat : Category lo la l≈) where

  private open module Cat = Category Cat
  open Cat.≈-Reasoning

  IsEpi : ∀ {A B} → A ⇒ B → Set (lo ⊔ la ⊔ l≈)
  IsEpi {A} {B} f = ∀ {C} {g h : B ⇒ C} → g ∘ f ≈ h ∘ f → g ≈ h