removed IType_i, because it was useless...simply using List IType now

module ITyping where

open import Data.Empty
open import Data.List
open import Data.Nat
open import Data.Product
open import Data.Sum
open import Data.List.Properties
open import Data.List.Any as LAny
open LAny.Membership-≡
open import Relation.Nullary
open import Relation.Binary.PropositionalEquality
open import Relation.Binary.Core

open import Core
open import Core-Lemmas
open import Typing
open import Reduction

data IType : Set where
  o : IType
  _~>_ : List IType -> List IType -> IType

ω : List IType
ω = []

∩' : IType -> List IType
∩' x = (x ∷ [])

_∩_ : IType -> IType -> List IType
A ∩ B = A ∷ B ∷ []

~>-inj-l : ∀ {τ₁₁ τ₁₂ τ₂₁ τ₂₂} -> (τ₁₁ ~> τ₁₂) ≡ (τ₂₁ ~> τ₂₂) -> τ₁₁ ≡ τ₂₁
~>-inj-l refl = refl

~>-inj-r : ∀ {τ₁₁ τ₁₂ τ₂₁ τ₂₂} -> (τ₁₁ ~> τ₁₂) ≡ (τ₂₁ ~> τ₂₂) -> τ₁₂ ≡ τ₂₂
~>-inj-r refl = refl

-- list-inj-cons : ∀ {x y τᵢ τⱼ} -> (x ∷ τᵢ) ≡ (y ∷ τⱼ) -> τᵢ ≡ τⱼ
-- list-inj-cons refl = refl
--
-- list-inj : ∀ {x y τᵢ τⱼ} -> (x ∷ τᵢ) ≡ (y ∷ τⱼ) -> x ≡ y
-- ∩-inj refl = refl
--
-- list-∷-≡ : ∀ {x y : IType} {xs ys} -> x ≡ y -> xs ≡ ys -> (x ∷ xs) ≡ (y ∷ ys)
-- list-∷-≡ refl refl = refl

_≟TI_ : Decidable {A = IType} _≡_
_≟TIₗ_ : Decidable {A = List IType} _≡_

o ≟TI o = yes refl
o ≟TI (_ ~> _) = no (λ ())
(_ ~> _) ≟TI o = no (λ ())
(τ₁₁ ~> τ₁₂) ≟TI (τ₂₁ ~> τ₂₂) with τ₁₁ ≟TIₗ τ₂₁ | τ₁₂ ≟TIₗ τ₂₂
(τ₁₁ ~> τ₁₂) ≟TI (.τ₁₁ ~> .τ₁₂) | yes refl | yes refl = yes refl
(τ₁₁ ~> τ₁₂) ≟TI (.τ₁₁ ~> τ₂₂) | yes refl | no τ₁₂≠τ₂₂ = no (λ eq → τ₁₂≠τ₂₂ (~>-inj-r eq))
(τ₁₁ ~> τ₁₂) ≟TI (τ₂₁ ~> τ₂₂) | no τ₁₁≠τ₂₁ | _ = no (λ eq → τ₁₁≠τ₂₁ (~>-inj-l eq))

[] ≟TIₗ [] = yes refl
[] ≟TIₗ (x ∷ τⱼ) = no (λ ())
(x ∷ τᵢ) ≟TIₗ [] = no (λ ())
(x ∷ τᵢ) ≟TIₗ (y ∷ τⱼ) with x ≟TI y | τᵢ ≟TIₗ τⱼ
(x ∷ τᵢ) ≟TIₗ (.x ∷ .τᵢ) | yes refl | yes refl = yes refl
(x ∷ τᵢ) ≟TIₗ (.x ∷ τⱼ) | yes refl | no τᵢ≠τⱼ = no (λ ∩x∷τᵢ≡∩x∷τⱼ → τᵢ≠τⱼ (proj₂ (∷-injective ∩x∷τᵢ≡∩x∷τⱼ)))
(x ∷ τᵢ) ≟TIₗ (y ∷ τⱼ) | no x≠y | _ = no (λ ∩x∷τᵢ≡∩y∷τⱼ → x≠y (proj₁ (∷-injective ∩x∷τᵢ≡∩y∷τⱼ)))

ICtxt = List (Atom × ((List IType) × Type))

data _∷'_ : IType -> Type -> Set
data _∷'ₗ_ : List IType -> Type -> Set

data _∷'_ where
  base : o ∷' σ
  arr : ∀ {δ τ A B} -> δ ∷'ₗ A -> τ ∷'ₗ B -> (δ ~> τ) ∷' (A ⟶ B)

data _∷'ₗ_ where
  nil : ∀ {A} -> ω ∷'ₗ A
  cons : ∀ {τᵢ τ A} -> τ ∷' A -> τᵢ ∷'ₗ A -> (τ ∷ τᵢ) ∷'ₗ A

data Wf-ICtxt : ICtxt -> Set where
  nil : Wf-ICtxt []
  cons : ∀ {A Γ x τ} ->
    (x∉ : x ∉ dom Γ) -> τ ∷'ₗ A -> Wf-ICtxt Γ ->
    --------------------------------------------
            Wf-ICtxt ((x , (τ , A)) ∷ Γ)

data _⊆[_]_ : IType -> Type -> IType -> Set
data _⊆ₗ[_]_ : List IType -> Type -> List IType -> Set

data _⊆[_]_ where
  base : o ⊆[ σ ] o
  arr : ∀ {A B τ₁₁ τ₁₂ τ₂₁ τ₂₂} ->
    τ₂₁ ⊆ₗ[ A ] τ₁₁ -> τ₁₂ ⊆ₗ[ B ] τ₂₂ -> (τ₁₁ ~> τ₁₂) ∷' (A ⟶ B) -> (τ₂₁ ~> τ₂₂) ∷' (A ⟶ B) ->
    -------------------------------------------------------------------------------------------
                            (τ₁₁ ~> τ₁₂) ⊆[ A ⟶ B ] (τ₂₁ ~> τ₂₂)
  -- ⊆-trans : ∀ {A τ₁ τ₂ τ₃} ->
  --   τ₁ ⊆[ A ] τ₂ -> τ₂ ⊆[ A ] τ₃ ->
  --   -------------------------------
  --             τ₁ ⊆[ A ] τ₃

data _⊆ₗ[_]_ where
  nil : ∀ {A τ} ->
    τ ∷'ₗ A ->
    -----------
    ω ⊆ₗ[ A ] τ
  cons : ∀ {A τᵢ τ' τ'ᵢ} ->
    ∃(λ τ -> (τ ∈ τᵢ) × (τ' ⊆[ A ] τ)) -> τ'ᵢ ⊆ₗ[ A ] τᵢ ->
    -------------------------------------------------------
                    (τ' ∷ τ'ᵢ) ⊆ₗ[ A ] τᵢ

∷'ₗ-∈ : ∀ {A τ τᵢ} -> τ ∈ τᵢ -> τᵢ ∷'ₗ A -> τ ∷' A
∷'ₗ-∈ {τᵢ = []} () _
∷'ₗ-∈ {τ = τ} {τ' ∷ τᵢ} τ∈τ'τᵢ τ'τᵢ∷A with τ' ≟TI τ
∷'ₗ-∈ {A} {τ} {.τ ∷ τᵢ} τ∈τ'τᵢ (cons τ∷A τ'τᵢ∷A) | yes refl = τ∷A
∷'ₗ-∈ {A} {τ} {τ' ∷ τᵢ} τ∈τ'τᵢ (cons τ'∷A τ'τᵢ∷A) | no τ'≠τ = ∷'ₗ-∈ (∈-∷-elim τ τᵢ τ'≠τ τ∈τ'τᵢ) τ'τᵢ∷A

⊆-refl : ∀ {A τ} -> τ ∷' A -> τ ⊆[ A ] τ
⊆ₗ-refl : ∀ {A τ} -> τ ∷'ₗ A -> τ ⊆ₗ[ A ] τ
⊆ₗ-⊆ : ∀ {A τᵢ τⱼ} -> τᵢ ⊆ τⱼ -> τⱼ ∷'ₗ A -> τᵢ ⊆ₗ[ A ] τⱼ

⊆-refl {τ = o} base = base
⊆-refl {τ = τ ~> τ'} (arr τ∷ᵢA τ'∷ᵢB) =
  arr (⊆ₗ-refl τ∷ᵢA) (⊆ₗ-refl τ'∷ᵢB) (arr τ∷ᵢA τ'∷ᵢB) (arr τ∷ᵢA τ'∷ᵢB)

⊆ₗ-refl {τ = []} nil = nil nil
⊆ₗ-refl {A} {τ ∷ τᵢ} ττᵢ∷A = ⊆ₗ-⊆ (λ {x} z → z) ττᵢ∷A

⊆ₗ-⊆ {τᵢ = []} τᵢ⊆τⱼ τⱼ∷A = nil τⱼ∷A
⊆ₗ-⊆ {τᵢ = τ ∷ τᵢ} τᵢ⊆τⱼ τⱼ∷A =
  cons (τ , (τᵢ⊆τⱼ (here refl)) , ⊆-refl (∷'ₗ-∈ (τᵢ⊆τⱼ (here refl)) τⱼ∷A)) (⊆ₗ-⊆ (λ {x} z → τᵢ⊆τⱼ (there z)) τⱼ∷A)

⊆ₗ-∈-∃ : ∀ {A τ τ₁ τ₂} -> τ₁ ⊆ₗ[ A ] τ₂ -> τ ∈ τ₁ -> ∃(λ τ' -> (τ' ∈ τ₂) × (τ ⊆[ A ] τ'))
⊆ₗ-∈-∃ (cons ∃τ τ₁⊆τ₂) (here refl) = ∃τ
⊆ₗ-∈-∃ (cons _ τ₁⊆τ₂) (there τ∈τ₁) = ⊆ₗ-∈-∃ τ₁⊆τ₂ τ∈τ₁

⊆ₗ-ω-⊥ : ∀ {A τ τᵢ} -> (τ ∷ τᵢ) ⊆ₗ[ A ] ω -> ⊥
⊆ₗ-ω-⊥ (cons (_ , () , _) _)

⊆-∷'-r : ∀ {A τ τ'} -> τ ⊆[ A ] τ' -> τ' ∷' A
⊆-∷'-r base = base
⊆-∷'-r (arr _ _ _ x) = x

⊆-∷'-l : ∀ {A τ τ'} -> τ ⊆[ A ] τ' -> τ ∷' A
⊆-∷'-l base = base
⊆-∷'-l (arr _ _ x _) = x

⊆ₗ-∷'ₗ-r : ∀ {A τᵢ τⱼ} -> τᵢ ⊆ₗ[ A ] τⱼ -> τⱼ ∷'ₗ A
⊆ₗ-∷'ₗ-r {τᵢ = []} (nil τⱼ∷A) = τⱼ∷A
⊆ₗ-∷'ₗ-r {τᵢ = τ ∷ τᵢ} (cons x τᵢ⊆τⱼ) = ⊆ₗ-∷'ₗ-r τᵢ⊆τⱼ

⊆ₗ-∷'ₗ-l : ∀ {A τᵢ τⱼ} -> τᵢ ⊆ₗ[ A ] τⱼ -> τᵢ ∷'ₗ A
⊆ₗ-∷'ₗ-l (nil x) = nil
⊆ₗ-∷'ₗ-l (cons (_ , _ , τ'⊆τ) τᵢ⊆τⱼ) = cons (⊆-∷'-l τ'⊆τ) (⊆ₗ-∷'ₗ-l τᵢ⊆τⱼ)

⊆ₗ-trans : ∀ {A τᵢ τⱼ τₖ} ->
  τᵢ ⊆ₗ[ A ] τⱼ -> τⱼ ⊆ₗ[ A ] τₖ ->
  ---------------------------------
            τᵢ ⊆ₗ[ A ] τₖ

⊆-trans : ∀ {A τ₁ τ₂ τ₃} ->
  τ₁ ⊆[ A ] τ₂ -> τ₂ ⊆[ A ] τ₃ ->
  -------------------------------
            τ₁ ⊆[ A ] τ₃

⊆ₗ-trans {τᵢ = []} τᵢ⊆τⱼ τⱼ⊆τₖ = nil (⊆ₗ-∷'ₗ-r τⱼ⊆τₖ)
⊆ₗ-trans {τᵢ = τ' ∷ τᵢ} τᵢ⊆τⱼ (nil x) = ⊥-elim (⊆ₗ-ω-⊥ τᵢ⊆τⱼ)
⊆ₗ-trans {τᵢ = τ ∷ τᵢ} {τⱼ} {τₖ} (cons (τ' , τ'∈τⱼ , τ⊆τ') τᵢ⊆τⱼ) τⱼ⊆τₖ =
  cons (τ'' , (τ''∈τₖ , (⊆-trans τ⊆τ' τ'⊆τ''))) (⊆ₗ-trans τᵢ⊆τⱼ τⱼ⊆τₖ)
    where
    τ'' = proj₁ (⊆ₗ-∈-∃ τⱼ⊆τₖ τ'∈τⱼ)
    τ''∈τₖ = proj₁ (proj₂ (⊆ₗ-∈-∃ τⱼ⊆τₖ τ'∈τⱼ))
    τ'⊆τ'' = proj₂ (proj₂ (⊆ₗ-∈-∃ τⱼ⊆τₖ τ'∈τⱼ))

⊆-trans base base = base
⊆-trans (arr τ₂₁⊆τ₁₁ τ₁₂⊆τ₂₂ τ₁₁~>τ₁₂∷A⟶B _) (arr τ₂₃⊆τ₂₁ τ₂₂⊆τ₂₄ τ₂₁~>τ₂₂∷A⟶B τ₂₃~>τ₂₄∷A⟶B) =
  arr (⊆ₗ-trans τ₂₃⊆τ₂₁ τ₂₁⊆τ₁₁) (⊆ₗ-trans τ₁₂⊆τ₂₂ τ₂₂⊆τ₂₄) τ₁₁~>τ₁₂∷A⟶B τ₂₃~>τ₂₄∷A⟶B

⊆->⊆ₗ : ∀ {A τ τ'} -> τ ⊆[ A ] τ' -> (∩' τ) ⊆ₗ[ A ] (∩' τ')
⊆->⊆ₗ {τ = τ} {τ'} τ⊆τ' = cons (τ' , (here refl , τ⊆τ')) (nil (cons (⊆-∷'-r τ⊆τ') nil))

data Λ : Type -> Set where
  bv : ∀ {A} -> (i : ℕ) -> Λ A
  fv : ∀ {A} -> (x : Atom) -> Λ A
  lam : ∀ {B} -> (A : Type) -> (e : Λ B) -> Λ (A ⟶ B)
  app : ∀ {A B} -> (e₁ : Λ (A ⟶ B)) -> (e₂ : Λ A) -> Λ B
  Y : (t : Type) -> Λ ((t ⟶ t) ⟶ t)

data _~_ : ∀{t} -> Λ t -> PTerm -> Set where
  bv : ∀ {t i} -> (bv {t} i) ~ (bv i)
  fv : ∀ {t x} -> (fv {t} x) ~ (fv x)
  lam : ∀ {t s m m'} -> m ~ m' -> (lam {s} t m) ~ (lam m')
  app : ∀ {t s m n m' n'} -> m ~ m' -> n ~ n' -> (app {t} {s} m n) ~ (app m' n')
  Y : ∀ {t} -> (Y t) ~ (Y t)

Λ[_<<_] : ∀ {t} -> ℕ -> Atom -> Λ t -> Λ t
Λ[ k << x ] (bv i) = bv i
Λ[ k << x ] (fv y) with x ≟ y
... | yes _ = bv k
... | no _ = fv y
Λ[ k << x ] (lam t m) = lam t (Λ[ (suc k) << x ] m)
Λ[ k << x ] (app t1 t2) = app (Λ[ k << x ] t1) (Λ[ k << x ] t2)
Λ[ k << x ] (Y t) = Y t

⊢->Λ : ∀ {Γ m t} -> Γ ⊢ m ∶ t -> Λ t
⊢->Λ {m = bv i} ()
⊢->Λ {m = fv x} {t} Γ⊢m∶t = fv {t} x
⊢->Λ {m = lam m} (abs {_} {τ₁} {τ₂} L cf) =
  lam τ₁ ( Λ[ 0 << ∃fresh (L ++ FV m) ] (⊢->Λ (cf (∉-cons-l _ _ (∃fresh-spec (L ++ FV m)) ))) )
⊢->Λ {m = app s t} (app Γ⊢s Γ⊢t) = app (⊢->Λ Γ⊢s) (⊢->Λ Γ⊢t)
⊢->Λ {m = Y τ} (Y _) = Y τ

-- ⊢->Λ≡ : ∀ {Γ m n t} -> m ≡ n -> {Γ⊢m : Γ ⊢ m ∶ t} -> {Γ⊢n : Γ ⊢ n ∶ t} -> (⊢->Λ Γ⊢m) ≡ (⊢->Λ Γ⊢m)
-- ⊢->Λ≡ refl = λ {Γ⊢m} {Γ⊢n} → refl

Λ*^-*^~ : ∀ {τ x k} t t' -> _~_ {τ} t t' -> Λ[ k << x ] t ~ ([ k << x ] t')
Λ*^-*^~ _ _ bv = bv
Λ*^-*^~ {x = x} (fv y) _ fv with x ≟ y
Λ*^-*^~ (fv x) .(fv x) fv | yes _ = bv
Λ*^-*^~ (fv y) .(fv y) fv | no _ = fv
Λ*^-*^~ _ _ (lam {m = m} {m'} t~t') = lam (Λ*^-*^~ m m' t~t')
Λ*^-*^~ _ _ (app {m = m} {n} {m'} {n'} t~t' t~t'') = app (Λ*^-*^~ m m' t~t') (Λ*^-*^~ n n' t~t'')
Λ*^-*^~ _ _ Y = Y

⊢->Λ~ : ∀ {Γ t τ} -> (Γ⊢t : Γ ⊢ t ∶ τ) -> (⊢->Λ Γ⊢t) ~ t
⊢->Λ~ {t = bv i} ()
⊢->Λ~ {t = fv x} (var _ _) = fv
⊢->Λ~ {t = lam t} (abs {τ₁ = τ₁} {τ₂} L cf) = lam ih
  where
  x = ∃fresh (L ++ FV t)
  x∉ = ∃fresh-spec (L ++ FV t)
  x∷Γ⊢t^'x = cf (∉-cons-l _ _ x∉)

  sub : ∀ {τ x m} -> x ∉ FV t -> _~_ {τ} m t ≡ m ~ (* x ^ (t ^' x))
  sub {_} {x} x∉ rewrite fv-^-*^-refl x t {0} x∉ = refl

  ih : Λ[ 0 << x ] (⊢->Λ x∷Γ⊢t^'x) ~ t
  ih rewrite sub {_} {x} {Λ[ 0 << x ] (⊢->Λ x∷Γ⊢t^'x)} (∉-cons-r L _ x∉) =
    Λ*^-*^~ (⊢->Λ x∷Γ⊢t^'x) (t ^' x) (⊢->Λ~ (cf (∉-cons-l _ _ x∉)))
⊢->Λ~ {t = app t t₁} (app Γ⊢t Γ⊢t₁) = app (⊢->Λ~ Γ⊢t) (⊢->Λ~ Γ⊢t₁)
⊢->Λ~ {t = Y t₁} (Y x) = Y

Λ[_>>_] : ∀ {τ τ'} -> ℕ -> Λ τ' -> Λ τ -> Λ τ
Λ[_>>_] {τ} {τ'} k u (bv i) with k ≟ i | τ ≟T τ'
Λ[ k >> u ] (bv i) | yes _ | yes refl = u
... | yes _ | no _ = bv i
... | no _ | _ = bv i
Λ[ k >> u ] (fv x) = fv x
Λ[ k >> u ] (lam A t) = lam A (Λ[ (suc k) >> u ] t)
Λ[ k >> u ] (app t1 t2) = app (Λ[ k >> u ] t1) (Λ[ k >> u ] t2)
Λ[ k >> u ] (Y t) = Y t

data _⊩_∶_ : ∀ {A} -> ICtxt -> Λ A -> IType -> Set
data _⊩ₗ_∶_ : ∀ {A} -> ICtxt -> Λ A -> List IType -> Set

data _⊩_∶_ where
  var : ∀ {A Γ x τ} {τᵢ : List IType} ->
    (wf-Γ : Wf-ICtxt Γ) -> (τᵢ∈Γ : (x , (τᵢ , A)) ∈ Γ) -> (τ⊆τᵢ : (∩' τ) ⊆ₗ[ A ] τᵢ) ->
    -----------------------------------------------------------------------------------
                                    Γ ⊩ fv {A} x ∶ τ
  app : ∀ {A B Γ s t τ τ₁ τ₂} ->
    Γ ⊩ s ∶ (τ₁ ~> τ₂) -> Γ ⊩ₗ t ∶ τ₁ -> (∩' τ) ⊆ₗ[ B ] τ₂ -> τ₁ ∷'ₗ A ->
    ---------------------------------------------------------------------
                        Γ ⊩ (app {A} {B} s t) ∶ τ
  abs : ∀ {A B Γ τ τ'} (L : FVars) -> ∀ {t : Λ B} ->
    ( cf : ∀ {x} -> (x∉L : x ∉ L) -> ((x , (τ , A)) ∷ Γ) ⊩ₗ Λ[ 0 >> fv {A} x ] t ∶ τ' ) -> (τ ~> τ') ∷' (A ⟶ B) ->
    --------------------------------------------------------------------------------------------------------------
                                                Γ ⊩ lam A t ∶ (τ ~> τ')
  Y : ∀ {Γ A τ τ₁ τ₂} ->
    (wf-Γ : Wf-ICtxt Γ) -> ∃(λ τ' -> (τ' ∈ τ₁) × ((τ ~> τ) ⊆[ A ⟶ A ] τ')) -> τ₁ ∷'ₗ (A ⟶ A) -> τ₂ ⊆ₗ[ A ] τ -> --  τ₁ ⊆[ (A ⟶ A) ⟶ A ]((∩' (τ ~> τ)) ~> τ)
    -----------------------------------------------------------------------------------------
                                    Γ ⊩ Y A ∶ (τ₁ ~> τ₂)

data _⊩ₗ_∶_ where
  nil : ∀ {A Γ} {m : Λ A} ->
    (wf-Γ : Wf-ICtxt Γ) ->
    ----------------------
          Γ ⊩ₗ m  ∶ ω
  cons : ∀ {A Γ τ τᵢ} {m : Λ A} ->
    Γ ⊩ m  ∶ τ -> Γ ⊩ₗ m  ∶ τᵢ ->
    --------------------------------
          Γ ⊩ₗ m  ∶ (τ ∷ τᵢ)

data ΛTerm : ∀ {τ} -> Λ τ -> Set where
  var : ∀ {A x} -> ΛTerm (fv {A} x)
  lam : ∀ {A B} (L : FVars) -> ∀ {e : Λ B} ->
    (cf : ∀ {x} -> (x∉L : x ∉ L) -> ΛTerm (Λ[ 0 >> fv {A} x ] e)) -> ΛTerm (lam A e)
  app : ∀ {A B} {e₁ : Λ (A ⟶ B)} {e₂ : Λ A} -> ΛTerm e₁ -> ΛTerm e₂ -> ΛTerm (app e₁ e₂)
  Y : ∀ {t} -> ΛTerm (Y t)

data _⊆Γ_ : ICtxt -> ICtxt -> Set where
  nil : ∀ {Γ} ->
    (wf-Γ : Wf-ICtxt Γ) ->
    ----------------------
          [] ⊆Γ Γ
  cons : ∀ {A x τ' Γ Γ'} ->
    ∃(λ τ -> ((x , (τ , A)) ∈ Γ') × (τ' ⊆ₗ[ A ] τ)) -> Γ ⊆Γ Γ' ->
    ------------------------------------------------------------
                      ((x , (τ' , A)) ∷ Γ) ⊆Γ Γ'

⊩ₗ-wf-Γ : ∀ {A Γ} {m : Λ A} {τ} -> Γ ⊩ₗ m ∶ τ -> Wf-ICtxt Γ
⊩ₗ-wf-Γ (nil wf-Γ) = wf-Γ
⊩ₗ-wf-Γ (cons _ Γ⊩ₗm∶τ) = ⊩ₗ-wf-Γ Γ⊩ₗm∶τ

⊆Γ-wfΓ' : ∀ {Γ Γ'} -> Γ ⊆Γ Γ' -> Wf-ICtxt Γ'
⊆Γ-wfΓ' (nil wf-Γ') = wf-Γ'
⊆Γ-wfΓ' (cons _ Γ⊆Γ') = ⊆Γ-wfΓ' Γ⊆Γ'

wf-Γ-∷'ₗ : ∀ {A x τ Γ} -> (x , (τ , A)) ∈ Γ -> Wf-ICtxt Γ -> τ ∷'ₗ A
wf-Γ-∷'ₗ (here refl) (cons _ x₁ _) = x₁
wf-Γ-∷'ₗ (there xτA∈Γ) (cons _ _ wf-Γ) = wf-Γ-∷'ₗ xτA∈Γ wf-Γ

⊆Γ-⊆ : ∀ {Γ Γ'} -> Wf-ICtxt Γ' -> Γ ⊆ Γ' -> Γ ⊆Γ Γ'
⊆Γ-⊆ {[]} wf-Γ' Γ⊆Γ' = nil wf-Γ'
⊆Γ-⊆ {(x , τ , A) ∷ Γ} wf-Γ' Γ⊆Γ' = cons
  (τ , ((Γ⊆Γ' (here refl)) , ⊆ₗ-refl (wf-Γ-∷'ₗ (Γ⊆Γ' (here refl)) wf-Γ')))
  (⊆Γ-⊆ wf-Γ' (λ {x₁} z → Γ⊆Γ' (there z)))

-- ⊆Γ-refl {[]} _ = nil nil
-- ⊆Γ-refl {(x , τ , A) ∷ Γ} (cons _ τ∷A wf-Γ) = cons (τ , (here refl , ⊆ₗ-refl τ∷A)) {!   !}

⊩-∷' : ∀ {A Γ} {m : Λ A} {τ} -> Γ ⊩ m ∶ τ -> τ ∷' A
⊩ₗ-∷'ₗ : ∀ {A Γ} {m : Λ A} {τ} -> Γ ⊩ₗ m ∶ τ -> τ ∷'ₗ A

⊩-∷' (var _ _ τ⊆τᵢ) = ∷'ₗ-∈ (here refl) (⊆ₗ-∷'ₗ-l τ⊆τᵢ)
⊩-∷' (app _ _ τ⊆τᵢ _) = ∷'ₗ-∈ (here refl) (⊆ₗ-∷'ₗ-l τ⊆τᵢ)
⊩-∷' (abs _ _ x) = x
⊩-∷' (Y _ _ τ₁∷A⟶A τ₂⊆τ) = arr τ₁∷A⟶A (⊆ₗ-∷'ₗ-l τ₂⊆τ)

⊩ₗ-∷'ₗ (nil _) = nil
⊩ₗ-∷'ₗ (cons Γ⊩m∶τ Γ⊩ₗm∶τᵢ) = cons (⊩-∷' Γ⊩m∶τ) (⊩ₗ-∷'ₗ Γ⊩ₗm∶τᵢ)

⊩ₗ-∈-⊩ : ∀ {A Γ} {m : Λ A} {τ τᵢ} -> Γ ⊩ₗ m ∶ τᵢ -> τ ∈ τᵢ -> Γ ⊩ m ∶ τ
⊩ₗ-∈-⊩ (nil _) ()
⊩ₗ-∈-⊩ (cons Γ⊩m∶τ x) (here refl) = Γ⊩m∶τ
⊩ₗ-∈-⊩ (cons _ Γ⊩ₗm∶τᵢ) (there τ∈τᵢ) = ⊩ₗ-∈-⊩ Γ⊩ₗm∶τᵢ τ∈τᵢ

data _->Λβ_ : ∀ {τ} -> Λ τ ↝ Λ τ where
  redL : ∀ {A B} {n : Λ A} {m m' : Λ (A ⟶ B)} -> ΛTerm n -> m ->Λβ m' -> app m n ->Λβ app m' n
  redR : ∀ {A B} {m : Λ (A ⟶ B)} {n n' : Λ A} -> ΛTerm m -> n ->Λβ n' -> app m n ->Λβ app m n'
  abs : ∀ L {A B} {m m' : Λ B} -> ( ∀ {x} -> x ∉ L -> Λ[ 0 >> fv {A} x ] m ->Λβ Λ[ 0 >> fv {A} x ] m' ) ->
    lam A m ->Λβ lam A m'
  beta : ∀ {A B} {m : Λ (A ⟶ B)} {n : Λ A} -> ΛTerm (lam A m) -> ΛTerm n -> app (lam A m) n ->Λβ (Λ[ 0 >> n ] m)
  Y : ∀ {A} {m : Λ (A ⟶ A)} -> ΛTerm m -> app (Y A) m ->Λβ app m (app (Y A) m)

∈-⊆Γ-trans : ∀ {A x τᵢ} {Γ Γ'} -> (x , (τᵢ , A)) ∈ Γ -> Γ ⊆Γ Γ' -> ∃(λ τᵢ' -> ((x , (τᵢ' , A)) ∈ Γ') × τᵢ ⊆ₗ[ A ] τᵢ')
∈-⊆Γ-trans (here refl) (cons x _) = x
∈-⊆Γ-trans (there x∈L) (cons _ L⊆L') = ∈-⊆Γ-trans x∈L L⊆L'

⊆Γ-∷ : ∀ {A x τᵢ Γ Γ'} -> x ∉ dom Γ' -> τᵢ ∷'ₗ A -> Γ ⊆Γ Γ' -> Γ ⊆Γ ((x , τᵢ , A) ∷ Γ')
⊆Γ-∷ {Γ = []} x∉Γ' τᵢ∷A Γ⊆Γ' = nil (cons x∉Γ' τᵢ∷A (⊆Γ-wfΓ' Γ⊆Γ'))
⊆Γ-∷ {Γ = (x , τᵢ , A) ∷ Γ} x∉Γ' τᵢ∷A (cons (proj₁ , proj₂ , proj₃) Γ⊆Γ') =
  cons (proj₁ , ((there proj₂) , proj₃)) (⊆Γ-∷ x∉Γ' τᵢ∷A Γ⊆Γ')

subΓ : ∀ {A Γ Γ'} {m : Λ A} {τ} -> Γ ⊩ m ∶ τ -> Γ ⊆Γ Γ' -> Γ' ⊩ m ∶ τ
subᵢΓ : ∀ {A Γ Γ'} {m : Λ A} {τ} -> Γ ⊩ₗ m ∶ τ -> Γ ⊆Γ Γ' -> Γ' ⊩ₗ m ∶ τ

subΓ (var wf-Γ τᵢ∈Γ τ⊆τᵢ) Γ⊆Γ' = var (⊆Γ-wfΓ' Γ⊆Γ') τᵢ'∈ (⊆ₗ-trans τ⊆τᵢ τᵢ⊆τᵢ')
  where
  τᵢ'∈ = proj₁ (proj₂ (∈-⊆Γ-trans τᵢ∈Γ Γ⊆Γ'))
  τᵢ⊆τᵢ' = proj₂ (proj₂ (∈-⊆Γ-trans τᵢ∈Γ Γ⊆Γ'))

subΓ (app Γ⊩m∶τ x x₁ x₂) Γ⊆Γ' = app (subΓ Γ⊩m∶τ Γ⊆Γ') (subᵢΓ x Γ⊆Γ') x₁ x₂
subΓ {Γ' = Γ'} (abs {τ = τ} L cf (arr τ∷A τ'∷B)) Γ⊆Γ' = abs
  (L ++ dom Γ')
  (λ x∉ → subᵢΓ
    (cf (∉-cons-l _ _ x∉))
    (cons
      (τ , (here refl) , (⊆ₗ-refl τ∷A))
      (⊆Γ-∷ (∉-cons-r L _ x∉) τ∷A Γ⊆Γ')))
  (arr τ∷A τ'∷B)
subΓ (Y x x₁ x₂ x₃) Γ⊆Γ' = Y (⊆Γ-wfΓ' Γ⊆Γ') x₁ x₂ x₃

subᵢΓ (nil wf-Γ) Γ⊆Γ' = nil (⊆Γ-wfΓ' Γ⊆Γ')
subᵢΓ (cons x Γ⊩ₗm∶τ) Γ⊆Γ' = cons (subΓ x Γ⊆Γ') (subᵢΓ Γ⊩ₗm∶τ Γ⊆Γ')

∈-⊆ₗ-trans : ∀ {A τ τᵢ τⱼ} -> τ ∈ τᵢ -> τᵢ ⊆ₗ[ A ] τⱼ -> ∃(λ τ' -> (τ' ∈ τⱼ) × τ ⊆[ A ] τ')
∈-⊆ₗ-trans (here refl) (cons x _) = x
∈-⊆ₗ-trans (there τ∈τᵢ) (cons _ τᵢ⊆τⱼ) = ∈-⊆ₗ-trans τ∈τᵢ τᵢ⊆τⱼ

sub : ∀ {A Γ Γ'} {m : Λ A} {τ τ'} -> Γ ⊩ m ∶ τ -> τ' ⊆[ A ] τ -> Γ ⊆Γ Γ' -> Γ' ⊩ m ∶ τ'
subᵢ : ∀ {A Γ Γ'} {m : Λ A} {τ τ'} -> Γ ⊩ₗ m ∶ τ -> τ' ⊆ₗ[ A ] τ -> Γ ⊆Γ Γ' -> Γ' ⊩ₗ m ∶ τ'

sub (var wf-Γ τᵢ∈Γ τ⊆τᵢ) τ'⊆τ Γ⊆Γ' =
  var (⊆Γ-wfΓ' Γ⊆Γ') τᵢ'∈ (⊆ₗ-trans (⊆ₗ-trans (⊆->⊆ₗ τ'⊆τ) τ⊆τᵢ) τᵢ⊆τᵢ')
  where
  τᵢ'∈ = proj₁ (proj₂ (∈-⊆Γ-trans τᵢ∈Γ Γ⊆Γ'))
  τᵢ⊆τᵢ' = proj₂ (proj₂ (∈-⊆Γ-trans τᵢ∈Γ Γ⊆Γ'))

sub (app Γ⊩s∶τ₁~>τ₂ Γ⊩ₗt∶τ₁ τ⊆τ₂ τ∷A) τ'⊆τ Γ⊆Γ' = app
  (subΓ Γ⊩s∶τ₁~>τ₂ Γ⊆Γ')
  (subᵢΓ Γ⊩ₗt∶τ₁ Γ⊆Γ')
  (⊆ₗ-trans (⊆->⊆ₗ τ'⊆τ) τ⊆τ₂)
  τ∷A
sub {_} {Γ} {Γ'} (abs {τ = τ} {τ'} L {t} cf τ~>τ'∷A⟶B) (arr {A} {τ₁₁ = τ₁₁} τ⊆τ₁₁ τ₁₂⊆τ' (arr τ₁₁∷A τ₁₂∷B) x₃) Γ⊆Γ' = abs
  (L ++ dom Γ')
  (λ x∉ → subᵢ
    (cf (∉-cons-l _ _ x∉))
    τ₁₂⊆τ'
    (cons (τ₁₁ , (here refl) , τ⊆τ₁₁) (⊆Γ-∷ (∉-cons-r L _ x∉) τ₁₁∷A Γ⊆Γ')))
  (arr τ₁₁∷A τ₁₂∷B)
sub (Y wf-Γ (τ' , τ'∈τ₁ , τ~>τ⊆τ') τ₁∷A⟶A τ₂⊆τ) (arr {τ₁₁ = τ₁'} τ₁⊆τ₁' τ₂'⊆τ₂ (arr ∩τ₁'∷A⟶A τ₂'∷A) x₄) Γ⊆Γ' =
  Y ((⊆Γ-wfΓ' Γ⊆Γ')) (τ'' , (τ''∈τ₁' , ⊆-trans τ~>τ⊆τ' τ'⊆τ'')) ∩τ₁'∷A⟶A (⊆ₗ-trans τ₂'⊆τ₂ τ₂⊆τ)
  where
  τ'' = proj₁ (∈-⊆ₗ-trans τ'∈τ₁ τ₁⊆τ₁')
  τ''∈τ₁' = proj₁ (proj₂ (∈-⊆ₗ-trans τ'∈τ₁ τ₁⊆τ₁'))
  τ'⊆τ'' = proj₂ (proj₂ (∈-⊆ₗ-trans τ'∈τ₁ τ₁⊆τ₁'))

subᵢ Γ⊩ₗm∶τ (nil x) Γ⊆Γ' = nil (⊆Γ-wfΓ' Γ⊆Γ')
subᵢ Γ⊩ₗm∶τᵢ (cons (τ , τ∈τᵢ , τ'⊆τ) τ'ᵢ⊆τᵢ) Γ⊆Γ' with ⊩ₗ-∈-⊩ Γ⊩ₗm∶τᵢ τ∈τᵢ
... | Γ⊩m∶τ = cons (sub Γ⊩m∶τ τ'⊆τ Γ⊆Γ') (subᵢ Γ⊩ₗm∶τᵢ τ'ᵢ⊆τᵢ Γ⊆Γ')

~>∩ : ∀ {X A B C} -> (A ~> B) ∷' X -> (A ~> C) ∷' X ->
  ∩' (A ~> (B ++ C)) ⊆ₗ[ X ] ((A ~> B) ∷ (A ~> C) ∷ [])
~>∩ A~>B∷X A~>C∷X = cons ({!   !} , ({!   !} , {!   !})) (nil (cons A~>B∷X (cons A~>C∷X nil)))

Γ⊩Ym-max : ∀ {A Γ} {m : Λ (A ⟶ A)} {τ} -> Γ ⊩ app (Y A) m ∶ τ -> ∃(λ τ' -> Γ ⊩ m ∶ (τ' ~> τ') × (∩' τ) ⊆ₗ[ A ] τ')
Γ⊩Ym-max {A} {Γ} {m} {τ} (app {τ₁ = τ₁ᵢ~>τ₂ᵢ} {τ'}
  (Y {τ = τ''} wf-Γ (_ , τ₁~>τ₂∈τ₁ᵢ~>τ₂ᵢ , arr {τ₂₁ = τ₁} {τ₂} τ₁⊆τ'' τ''⊆τ₂ τ''~>τ''∷A⟶A (arr τ₁∷A τ₂∷A)) τ₁ᵢ~>τ₂ᵢ∷A⟶A τ'⊆τ'')
  Γ⊩ₗm∶τ₁ᵢ~>τ₂ᵢ
  τ⊆τ' τ₁ᵢ~>τ₂ᵢ∷A⟶A₂) =
  τ₂ , Γ⊩m∶τ₂~>τ₂ , τ⊆τ₂

  where
  Γ⊆Γ-refl = ⊆Γ-⊆ wf-Γ (λ {x} z → z)
  τ⊆τ'' = ⊆ₗ-trans τ⊆τ' τ'⊆τ''
  τ⊆τ₂ = ⊆ₗ-trans τ⊆τ'' τ''⊆τ₂

  Γ⊩m∶τ₁~>τ₂ : Γ ⊩ m ∶ (τ₁ ~> τ₂)
  Γ⊩m∶τ₁~>τ₂ = ⊩ₗ-∈-⊩ Γ⊩ₗm∶τ₁ᵢ~>τ₂ᵢ τ₁~>τ₂∈τ₁ᵢ~>τ₂ᵢ

  Γ⊩m∶τ₂~>τ₂ : Γ ⊩ m ∶ (τ₂ ~> τ₂)
  Γ⊩m∶τ₂~>τ₂ = sub Γ⊩m∶τ₁~>τ₂ (arr (⊆ₗ-trans τ₁⊆τ'' τ''⊆τ₂) (⊆ₗ-refl τ₂∷A) (arr τ₂∷A τ₂∷A) (arr τ₁∷A τ₂∷A)) Γ⊆Γ-refl

Γ⊩ₗYm-max : ∀ {A Γ} {m : Λ (A ⟶ A)} {τ} -> ¬(τ ≡ ω) -> Γ ⊩ₗ app (Y A) m ∶ τ -> ∃(λ τ' -> Γ ⊩ m ∶ (τ' ~> τ') × τ ⊆ₗ[ A ] τ')
Γ⊩ₗYm-max τ≠ω (nil wf-Γ) = ⊥-elim (τ≠ω refl)
Γ⊩ₗYm-max τ≠ω (cons x (nil wf-Γ)) = Γ⊩Ym-max x
Γ⊩ₗYm-max {A} {Γ} {m} τ≠ω (cons {τ = τ} x (cons {τ = τ₂} {τᵢ} x₁ Γ⊩ₗYm∶τ)) =
  {!   !}
  where
  ih : ∃(λ τ' -> Γ ⊩ m ∶ (τ' ~> τ') × (τ₂ ∷ τᵢ) ⊆ₗ[ A ] τ')
  ih = Γ⊩ₗYm-max {!   !} (cons {τ = τ₂} {τᵢ} x₁ Γ⊩ₗYm∶τ)

  τᵢ' = proj₁ ih
  Γ⊩m∶τᵢ'~>τᵢ' = proj₁ (proj₂ ih)
  τ₂τᵢ⊆τᵢ' = proj₂ (proj₂ ih)

  τ' = proj₁ (Γ⊩Ym-max x)
  Γ⊩m∶τ'~>τ' = proj₁ (proj₂ (Γ⊩Ym-max x))
  τ⊆τ' = proj₂ (proj₂ (Γ⊩Ym-max x))

⊩->β : ∀ {A Γ} {m m' : Λ A} {τ} -> Γ ⊩ m' ∶ τ -> m ->Λβ m' -> Γ ⊩ m ∶ τ
⊩->β Γ⊩m'∶τ (redL x m->βm') = {!   !}
⊩->β Γ⊩m'∶τ (redR x m->βm') = {!   !}
⊩->β Γ⊩m'∶τ (abs L x) = {!   !}
⊩->β Γ⊩m'∶τ (beta x x₁) = {!   !}
⊩->β {τ = τ} (app Γ⊩m∶[]~>τᵢ (nil wf-Γ) τ⊆τᵢ []∷A) (Y _) = app
  (Y {τ = ∩' τ} {(ω ~> ∩' τ) ∷ []} {∩' τ}
    wf-Γ
    ((ω ~> ∩' τ) , here refl , arr (nil τ∷A) (⊆ₗ-refl τ∷A) (arr τ∷A τ∷A) (arr nil τ∷A))
    (cons (arr []∷A τ∷A) nil)
    (⊆ₗ-refl τ∷A))
  (cons (sub Γ⊩m∶[]~>τᵢ (arr (nil []∷A) τ⊆τᵢ (arr []∷A τ∷A) (arr []∷A (⊆ₗ-∷'ₗ-r τ⊆τᵢ))) (⊆Γ-⊆ wf-Γ (λ {x} z → z))) (nil wf-Γ))
  (⊆ₗ-refl τ∷A)
  (cons (arr []∷A τ∷A) nil)

  where
  τ∷A = ⊆ₗ-∷'ₗ-l τ⊆τᵢ

⊩->β {A} {Γ} {τ = τ} (app {s = m} {τ₁ = τ' ∷ τ'ᵢ} {τᵢ} Γ⊩m∶τ'~>τᵢ Γ⊩ₗYm∶τ' τ⊆τᵢ τ'∷A) (Y _) = {!   !}
  where
  Γ⊆Γ-refl = ⊆Γ-⊆ (⊩ₗ-wf-Γ Γ⊩ₗYm∶τ') (λ {x} z → z)

  τ'' = proj₁ (Γ⊩ₗYm-max (λ x → {!   !}) Γ⊩ₗYm∶τ')

  Γ⊩m∶τ''~>τ'' : Γ ⊩ m ∶ (τ'' ~> τ'')
  Γ⊩m∶τ''~>τ'' = proj₁ (proj₂ (Γ⊩ₗYm-max {!   !} Γ⊩ₗYm∶τ'))

  τ'τ'ᵢ⊆τ'' : (τ' ∷ τ'ᵢ) ⊆ₗ[ A ] τ''
  τ'τ'ᵢ⊆τ'' = proj₂ (proj₂ (Γ⊩ₗYm-max {!   !} Γ⊩ₗYm∶τ'))

  Γ⊩m∶τ''~>τᵢ : Γ ⊩ m ∶ (τ'' ~> ∩' τ)
  Γ⊩m∶τ''~>τᵢ = sub Γ⊩m∶τ'~>τᵢ (arr τ'τ'ᵢ⊆τ'' τ⊆τᵢ (arr (⊆ₗ-∷'ₗ-r τ'τ'ᵢ⊆τ'') (⊆ₗ-∷'ₗ-l τ⊆τᵢ)) (arr τ'∷A (⊆ₗ-∷'ₗ-r τ⊆τᵢ))) Γ⊆Γ-refl

-- ⊩->β {τ = τ} (app Γ⊩m∶[]~>τᵢ (nil wf-Γ) τ⊆τᵢ []∷A) (Y _) = app
--   (Y {τ = ∩' τ} {(ω ~> ∩' τ) ∷ []} {∩' τ}
--     wf-Γ
--     ((ω ~> ∩' τ) , here refl , arr (nil τ∷A) (⊆ₗ-refl τ∷A) (arr τ∷A τ∷A) (arr nil τ∷A))
--     (cons (arr []∷A τ∷A) nil)
--     (⊆ₗ-refl τ∷A))
--   (cons (sub Γ⊩m∶[]~>τᵢ (arr (nil []∷A) τ⊆τᵢ (arr []∷A τ∷A) (arr []∷A (⊆ₗ-∷'ₗ-r τ⊆τᵢ))) (⊆Γ-⊆ wf-Γ (λ {x} z → z))) (nil wf-Γ))
--   (⊆ₗ-refl τ∷A)
--   (cons (arr []∷A τ∷A) nil)
--
--
-- -- ⊩->β (app {τ₁ = ∩ (τ₁ ∷ τ₁ᵢ)} Γ⊩m∶τ₁ᵢ~>τ₂ (cons (app (Y wf-Γ (proj₁ , () , proj₃) x₁ x₂) (nil wf-Γ₁) τ₁⊆τ₁₂ x₅) Γ⊩Ym∶τ₁ᵢ) τ⊆τ₂ τ₁∷A) (Y x)
-- -- ⊩->β {τ = τ} (app {τ₁ = ∩ (τ₁ ∷ τ₁ᵢ)} {τ₂} Γ⊩m∶τ₁ᵢ~>τ₂ (cons (app {τ₁ = ∩ (τ₁₁ ∷ τ₁₁ᵢ)} {τ₁₂} (Y {τ = τ'} wf-Γ (τ'' , τ''∈ τ₁₁, proj₃) x₁ x₂) (cons Γ⊩m∶τ₁₁ Γ⊩ₗm∶τ₁₁ᵢ) τ₁⊆τ₁₂ x₅) Γ⊩Ym∶τ₁ᵢ) τ⊆τ₂ τ₁∷A) (Y _) =
-- ⊩->β {A} {Γ} {τ = τ} (app {s = m} {τ₁ = ∩ (τ₁ ∷ τ₁ᵢ)} {τ₂}
--   Γ⊩m∶τ₁ᵢτ₁ᵢ~>τ₂
--   (cons
--     (app {τ₁ = ∩ (τ₁₁)} {τ₁₂}
--       (Y {τ = τ'} wf-Γ (_ , τ''∈τ₁₁ , arr {τ₂₁ = τ''₁} {τ''₂} τ''₁⊆τ' τ'⊆τ''₂ τ'~>τ'∷A⟶A (arr τ''₁∷A τ''₂∷A)) τ₁₁∷A⟶A τ₁₂⊆τ')
--       Γ⊩ₗm∶τ₁₁ τ₁⊆τ₁₂ τ₁₁∷A⟶A₂)
--     Γ⊩Ym∶τ₁ᵢ)
--   τ⊆τ₂
--   τ₁∷A) (Y _) =
--   {!   !}
--
--   where
--   Γ⊆Γ-refl = ⊆Γ-⊆ wf-Γ (λ {x} z → z)
--
--   Γ⊩m∶τ''₁~>τ''₂ : Γ ⊩ m ∶ (τ''₁ ~> τ''₂)
--   Γ⊩m∶τ''₁~>τ''₂ = ⊩ₗ-∈-⊩ Γ⊩ₗm∶τ₁₁ τ''∈τ₁₁
--
--   Γ⊩m∶τ''₂~>τ''₂ : Γ ⊩ m ∶ (τ''₂ ~> τ''₂)
--   Γ⊩m∶τ''₂~>τ''₂ = sub Γ⊩m∶τ''₁~>τ''₂ (arr (⊆ₗ-trans τ''₁⊆τ' τ'⊆τ''₂) (⊆ₗ-refl τ''₂∷A) (arr τ''₂∷A τ''₂∷A) (arr τ''₁∷A τ''₂∷A)) Γ⊆Γ-refl
--
--   Γ⊩m∶τ₁~>τ₂ : Γ ⊩ m ∶ (∩' τ₁ ~> τ₂)
--   Γ⊩m∶τ₁~>τ₂ = sub Γ⊩m∶τ₁ᵢτ₁ᵢ~>τ₂ (arr {!   !} {!   !} {!   !} {!   !}) Γ⊆Γ-refl

-- ⊩->β Γ⊩m'∶τ (redL x m->βm') = {!   !}
-- ⊩->β Γ⊩m'∶τ (redR x m->βm') = {!   !}
-- ⊩->β Γ⊩m'∶τ (abs L x) = {!   !}
-- ⊩->β Γ⊩m'∶τ (beta x x₁) = {!   !}
-- ⊩->β (app Γ⊩m'∶ω~>τ₂ (nil wf-Γ) τ⊆τ₂ nil) (Y trm-m) = {!   !}
-- ⊩->β (app Γ⊩m∶τ₃τᵢ~>τ₅ (cons _ (app (Y _ τ₂⊆τ₁ τ₁⊆τ) (cons _ Γ⊩m∶τ~>τ₁ (nil wf-Γ)) τ₃⊆τ₂ (cons τ~>τ₁∷A⟶A _)) Γ⊩ₗYm∶∩τᵢ) τ₄⊆τ₅ τ₃τᵢ∷A) (Y trm-m) = {!   !}

-- ⊩->β Γ⊩m'∶τ (redL x m->βm') = {!   !}
-- ⊩->β Γ⊩m'∶τ (redR x m->βm') = {!   !}
-- ⊩->β Γ⊩m'∶τ (abs L x) = {!   !}
-- ⊩->β Γ⊩m'∶τ (beta x x₁) = {!   !}
-- -- ⊩->β (app Γ⊩m∶τ₁~>τ (app (Y wf-Γ (arr (arr ::' ::'') ::''') τ≤τ₁ τ₂≤τ₁) Γ⊩m'∶τ₂ x₄) x₅) (Y x₆) = {!   !}
-- ⊩->β (app {s = m} {τ₂ = τ} Γ⊩m∶τ₁~>τ (app {τ₂ = τ₁} (Y {τ = τ₂} {τ₃} wf-Γ (arr (arr τ₂∷A τ₃∷A) _) τ≤τ₁ τ₂≤τ₁) Γ⊩m∶τ₂~>τ₃ _) (arr {A = A} τ₁∷A τ∷A)) (Y x₆) =
--   app {A = A ⟶ A}
--     (Y {_} {A} {∩ (τ₂ ∷ τ₁ ∷ [])} {∩ (τ₃ ∷ τ ∷ [])} {τ}
--       wf-Γ
--       (arr (arr (∩-cons τ₂∷A (∩-cons τ₁∷A ∩-nil)) (∩-cons τ₃∷A (∩-cons τ∷A ∩-nil))) τ∷A)
--       {!   !}
--       (∩-∈ (there (here refl))))
--     {!   !}
--     (arr (arr (∩-cons τ₂∷A (∩-cons τ₁∷A ∩-nil)) (∩-cons τ₃∷A (∩-cons τ∷A ∩-nil))) τ∷A)
--
-- ⊩->β (app Γ⊩m'∶τ (∩-nil ¬Y-shape wf-Γ) x) (Y x₁) = ⊥-elim (¬Y-shape intro₁)
-- ⊩->β (app Γ⊩m'∶τ (∩-cons ¬Y-shape wf-Γ Γ⊩m'∶τ₁ Γ⊩m'∶τ₂) x) (Y x₁) = ⊥-elim (¬Y-shape intro₁)
-- ⊩->β (∩-nil ¬Y-shape wf-Γ) (Y x) = ⊥-elim (¬Y-shape intro₂)
-- ⊩->β (∩-cons ¬Y-shape wf-Γ Γ⊩m'∶τ Γ⊩m'∶τ₁) (Y x) = ⊥-elim (¬Y-shape intro₂)

-- ⊩->β Γ⊩m'∶τ (redL trm-n m->βm') = ⊩->β-redL Γ⊩m'∶τ m->βm'
--   where
--   ⊩->β-redL : ∀ {A B Γ} {m m' : Λ (A ⟶ B)} {n : Λ A} {τ} -> Γ ⊩ app m' n ∶ τ -> m ->Λβ m' -> Γ ⊩ app m n ∶ τ
--   ⊩->β-redL (app Γ⊩m'n∶τ Γ⊩m'n∶τ₁ x x₁) (redL x₂ m->Λβm') =
--     app (⊩->β-redL Γ⊩m'n∶τ m->Λβm') Γ⊩m'n∶τ₁ x x₁
--   ⊩->β-redL (∩-nil ¬Y-shape wf-Γ) (redL x m->Λβm') = {!   !}
--   ⊩->β-redL (∩-cons ¬Y-shape wf-Γ Γ⊩m'n∶τ Γ⊩m'n∶τ₁) (redL x m->Λβm') = {!   !}
--   ⊩->β-redL Γ⊩m'n∶τ (redR x m->Λβm') = {!   !}
--   ⊩->β-redL Γ⊩m'n∶τ (abs L x) = {!   !}
--   ⊩->β-redL Γ⊩m'n∶τ (beta x x₁) = {!   !}
--   ⊩->β-redL Γ⊩m'n∶τ (Y x) = {!   !}
-- ⊩->β Γ⊩m'∶τ (redR trm-m n->βn') = {!   !}
-- ⊩->β Γ⊩m'∶τ (abs L x) = {!   !}
-- ⊩->β Γ⊩m'∶τ (beta x x₁) = {!   !}
-- ⊩->β (app {s = m} {τ₂ = τ} Γ⊩m∶τ₁~>τ (app (Y {_} {_} {τ₂} {τ₃} {τ₁} wf-Γ τ₂∷A τ₃∷A τ₁∷A τ₂≤∩τ₃ τ₁≤∩τ₃) Γ⊩m∶τ₂~>τ₃ x τ₂~>τ₃∷A) (arr {A = A} _ τ∷A) _) (Y trm-m) =
--   -- app {A = A ⟶ A} (Y wf-Γ τ₁∷A τ∷A τ∷A {!   !} {!   !}) Γ⊩m∶τ₁~>τ (arr (arr τ₁∷A τ∷A) τ∷A) (arr τ₁∷A τ∷A)
--   app {A = A ⟶ A}
--     (Y {_} {A} {∩ (τ₁ ∷ τ₂ ∷ τ₃ ∷ [])} {∩ (τ ∷ τ₃ ∷ [])} {τ}
--       wf-Γ
--       {!   !}
--       (∩-cons τ∷A (∩-cons τ₃∷A ∩-nil))
--       τ∷A
--       {!   !}
--       {!   !})
--     {!   !}
--     (arr {!   !} {!   !})
--     {!   !}
--
-- ⊩->β (app Γ⊩m∶τ~>τ' (∩-nil ¬Y-shape wf-Γ) x τ∷A) (Y trm-m) = ⊥-elim (¬Y-shape intro₁)
-- ⊩->β (app Γ⊩m∶τ~>τ' (∩-cons ¬Y-shape wf-Γ Γ⊩Ym∶τ' Γ⊩Ym∶τ'') x τ∷A) (Y trm-m) = ⊥-elim (¬Y-shape intro₁)
-- ⊩->β (∩-nil ¬Y-shape wf-Γ) (Y x) = ⊥-elim (¬Y-shape intro₂)
-- ⊩->β (∩-cons ¬Y-shape wf-Γ Γ⊩m'∶τ Γ⊩m'∶τ₁) (Y x) = ⊥-elim (¬Y-shape intro₂)

module ITyping where

open import Data.Empty
open import Data.List
open import Data.Nat
open import Data.Product
open import Data.Sum
open import Data.List.Any as LAny
open LAny.Membership-≡
open import Relation.Nullary
open import Relation.Binary.PropositionalEquality
open import Relation.Binary.Core

open import Core
open import Core-Lemmas
open import Typing
open import Reduction

data IType : Set
data ITypeᵢ : Set

data IType where
  o : IType
  _~>_ : ITypeᵢ -> ITypeᵢ -> IType

data ITypeᵢ where
  ∩ : List IType -> ITypeᵢ

ω = ∩ []

∩' : IType -> ITypeᵢ
∩' x = ∩ (x ∷ [])

~>-inj-l : ∀ {τ₁₁ τ₁₂ τ₂₁ τ₂₂} -> (τ₁₁ ~> τ₁₂) ≡ (τ₂₁ ~> τ₂₂) -> τ₁₁ ≡ τ₂₁
~>-inj-l refl = refl

~>-inj-r : ∀ {τ₁₁ τ₁₂ τ₂₁ τ₂₂} -> (τ₁₁ ~> τ₁₂) ≡ (τ₂₁ ~> τ₂₂) -> τ₁₂ ≡ τ₂₂
~>-inj-r refl = refl

∩-inj-cons : ∀ {x y τᵢ τⱼ} -> ∩ (x ∷ τᵢ) ≡ ∩ (y ∷ τⱼ) -> ∩ τᵢ ≡ ∩ τⱼ
∩-inj-cons refl = refl

∩-inj : ∀ {x y τᵢ τⱼ} -> ∩ (x ∷ τᵢ) ≡ ∩ (y ∷ τⱼ) -> x ≡ y
∩-inj refl = refl

∩-∷-≡ : ∀ {x y : IType} {xs ys} -> x ≡ y -> ∩ xs ≡ ∩ ys -> ∩ (x ∷ xs) ≡ ∩ (y ∷ ys)
∩-∷-≡ refl refl = refl

_≟TI_ : Decidable {A = IType} _≡_
_≟TIᵢ_ : Decidable {A = ITypeᵢ} _≡_

o ≟TI o = yes refl
o ≟TI (_ ~> _) = no (λ ())
(_ ~> _) ≟TI o = no (λ ())
(τ₁₁ ~> τ₁₂) ≟TI (τ₂₁ ~> τ₂₂) with τ₁₁ ≟TIᵢ τ₂₁ | τ₁₂ ≟TIᵢ τ₂₂
(τ₁₁ ~> τ₁₂) ≟TI (.τ₁₁ ~> .τ₁₂) | yes refl | yes refl = yes refl
(τ₁₁ ~> τ₁₂) ≟TI (.τ₁₁ ~> τ₂₂) | yes refl | no τ₁₂≠τ₂₂ = no (λ eq → τ₁₂≠τ₂₂ (~>-inj-r eq))
(τ₁₁ ~> τ₁₂) ≟TI (τ₂₁ ~> τ₂₂) | no τ₁₁≠τ₂₁ | _ = no (λ eq → τ₁₁≠τ₂₁ (~>-inj-l eq))

∩ [] ≟TIᵢ ∩ [] = yes refl
∩ [] ≟TIᵢ ∩ (x ∷ τⱼ) = no (λ ())
∩ (x ∷ τᵢ) ≟TIᵢ ∩ [] = no (λ ())
∩ (x ∷ τᵢ) ≟TIᵢ ∩ (y ∷ τⱼ) with x ≟TI y | (∩ τᵢ) ≟TIᵢ (∩ τⱼ)
∩ (x ∷ τᵢ) ≟TIᵢ ∩ (.x ∷ .τᵢ) | yes refl | yes refl = yes refl
∩ (x ∷ τᵢ) ≟TIᵢ ∩ (.x ∷ τⱼ) | yes refl | no τᵢ≠τⱼ = no (λ ∩x∷τᵢ≡∩x∷τⱼ → τᵢ≠τⱼ (∩-inj-cons ∩x∷τᵢ≡∩x∷τⱼ))
∩ (x ∷ τᵢ) ≟TIᵢ ∩ (y ∷ τⱼ) | no x≠y | _ = no (λ ∩x∷τᵢ≡∩y∷τⱼ → x≠y (∩-inj ∩x∷τᵢ≡∩y∷τⱼ))

ICtxt = List (Atom × (ITypeᵢ × Type))

data _∷'_ : IType -> Type -> Set
data _∷'ᵢ_ : ITypeᵢ -> Type -> Set

data _∷'_ where
  base : o ∷' σ
  arr : ∀ {δ τ A B} -> δ ∷'ᵢ A -> τ ∷'ᵢ B -> (δ ~> τ) ∷' (A ⟶ B)

data Wf-ICtxt : ICtxt -> Set where
  nil : Wf-ICtxt []
  cons : ∀ {A Γ x τ} ->
    (x∉ : x ∉ dom Γ) -> τ ∷'ᵢ A -> Wf-ICtxt Γ ->
    --------------------------------------------
              Wf-ICtxt ((x , (τ , A)) ∷ Γ)

data _∷'ᵢ_ where
  nil : ∀ {A} ->  ω ∷'ᵢ A
  cons : ∀ {τᵢ τ A} ->  τ ∷' A -> ∩ τᵢ ∷'ᵢ A -> ∩ (τ ∷ τᵢ) ∷'ᵢ A

data _⊆[_]_ : IType -> Type -> IType -> Set
data _⊆ᵢ[_]_ : ITypeᵢ -> Type -> ITypeᵢ -> Set

data _⊆[_]_ where
  base : o ⊆[ σ ] o
  arr : ∀ {A B τ₁₁ τ₁₂ τ₂₁ τ₂₂} ->
    τ₂₁ ⊆ᵢ[ A ] τ₁₁ -> τ₁₂ ⊆ᵢ[ B ] τ₂₂ -> (τ₁₁ ~> τ₁₂) ∷' (A ⟶ B) -> (τ₂₁ ~> τ₂₂) ∷' (A ⟶ B) ->
    -------------------------------------------------------------------------------------------
                            (τ₁₁ ~> τ₁₂) ⊆[ A ⟶ B ] (τ₂₁ ~> τ₂₂)
  -- ⊆-trans : ∀ {A τ₁ τ₂ τ₃} ->
  --   τ₁ ⊆[ A ] τ₂ -> τ₂ ⊆[ A ] τ₃ ->
  --   -------------------------------
  --             τ₁ ⊆[ A ] τ₃

data _⊆ᵢ[_]_ where
  nil : ∀ {A τ} ->
    τ ∷'ᵢ A ->
    -----------
    ω ⊆ᵢ[ A ] τ
  -- ∩-∈ : ∀ {τ τᵢ} -> τ ∈ τᵢ -> (∩' τ) ⊆[ A ] (∩ τᵢ)
  cons : ∀ {A τᵢ τ' τ'ᵢ} ->
    ∃(λ τ -> (τ ∈ τᵢ) × (τ' ⊆[ A ] τ)) -> (∩ τ'ᵢ) ⊆ᵢ[ A ] (∩ τᵢ) ->
    -------------------------------------------------------------
                  (∩ (τ' ∷ τ'ᵢ)) ⊆ᵢ[ A ] (∩ τᵢ)

-- data _≤∩_ : IType -> IType -> Set where
--   base : o ≤∩ o
--   arr : ∀ {τ₁₁ τ₁₂ τ₂₁ τ₂₂} -> τ₁₂ ≤∩ τ₂₂ -> τ₂₁ ≤∩ τ₁₁ -> (τ₁₁ ~> τ₁₂) ≤∩ (τ₂₁ ~> τ₂₂)
--   ∩-∈ : ∀ {τ τᵢ} -> τ ∈ τᵢ -> ∩ τᵢ ≤∩ τ
--   ∩-nil : ∀ {τ} -> τ ≤∩ ω
--   ∩-cons : ∀ {τ τ' τᵢ} -> τ ≤∩ τ' -> τ ≤∩ ∩ τᵢ -> τ ≤∩ ∩ (τ' ∷ τᵢ)
--   ∩-trans : ∀ {τ₁ τ₂ τ₃} -> τ₁ ≤∩ τ₂ -> τ₂ ≤∩ τ₃ -> τ₁ ≤∩ τ₃

∷'ᵢ-∈ : ∀ {A τ τᵢ} -> τ ∈ τᵢ -> (∩ τᵢ) ∷'ᵢ A -> τ ∷' A
∷'ᵢ-∈ {τᵢ = []} () _
∷'ᵢ-∈ {τ = τ} {τ' ∷ τᵢ} τ∈τ'τᵢ τ'τᵢ∷A with τ' ≟TI τ
∷'ᵢ-∈ {A} {τ} {.τ ∷ τᵢ} τ∈τ'τᵢ (cons τ∷A τ'τᵢ∷A) | yes refl = τ∷A
∷'ᵢ-∈ {A} {τ} {τ' ∷ τᵢ} τ∈τ'τᵢ (cons τ'∷A τ'τᵢ∷A) | no τ'≠τ = ∷'ᵢ-∈ (∈-∷-elim τ τᵢ τ'≠τ τ∈τ'τᵢ) τ'τᵢ∷A

⊆-refl : ∀ {A τ} -> τ ∷' A -> τ ⊆[ A ] τ
⊆ᵢ-refl : ∀ {A τ} -> τ ∷'ᵢ A -> τ ⊆ᵢ[ A ] τ
⊆ᵢ-⊆ : ∀ {A τᵢ τⱼ} -> τᵢ ⊆ τⱼ -> (∩ τⱼ) ∷'ᵢ A -> ∩ τᵢ ⊆ᵢ[ A ] ∩ τⱼ

⊆-refl {τ = o} base = base
⊆-refl {τ = τ ~> τ'} (arr τ∷ᵢA τ'∷ᵢB) =
  arr (⊆ᵢ-refl τ∷ᵢA) (⊆ᵢ-refl τ'∷ᵢB) (arr τ∷ᵢA τ'∷ᵢB) (arr τ∷ᵢA τ'∷ᵢB)

⊆ᵢ-refl {τ = ∩ []} nil = nil nil
⊆ᵢ-refl {A} {∩ (τ ∷ τᵢ)} ττᵢ∷A = ⊆ᵢ-⊆ (λ {x} z → z) ττᵢ∷A

⊆ᵢ-⊆ {τᵢ = []} τᵢ⊆τⱼ τⱼ∷A = nil τⱼ∷A
⊆ᵢ-⊆ {τᵢ = τ ∷ τᵢ} τᵢ⊆τⱼ τⱼ∷A =
  cons (τ , (τᵢ⊆τⱼ (here refl)) , ⊆-refl (∷'ᵢ-∈ (τᵢ⊆τⱼ (here refl)) τⱼ∷A)) (⊆ᵢ-⊆ (λ {x} z → τᵢ⊆τⱼ (there z)) τⱼ∷A)

⊆ᵢ-∈-∃ : ∀ {A τ τ₁ τ₂} -> ∩ τ₁ ⊆ᵢ[ A ] ∩ τ₂ -> τ ∈ τ₁ -> ∃(λ τ' -> (τ' ∈ τ₂) × (τ ⊆[ A ] τ'))
⊆ᵢ-∈-∃ (cons ∃τ τ₁⊆τ₂) (here refl) = ∃τ
⊆ᵢ-∈-∃ (cons _ τ₁⊆τ₂) (there τ∈τ₁) = ⊆ᵢ-∈-∃ τ₁⊆τ₂ τ∈τ₁

⊆ᵢ-ω-⊥ : ∀ {A τ τᵢ} -> (∩ (τ ∷ τᵢ)) ⊆ᵢ[ A ] ω -> ⊥
⊆ᵢ-ω-⊥ (cons (_ , () , _) _)

⊆-∷'-r : ∀ {A τ τ'} -> τ ⊆[ A ] τ' -> τ' ∷' A
⊆-∷'-r base = base
⊆-∷'-r (arr _ _ _ x) = x

⊆-∷'-l : ∀ {A τ τ'} -> τ ⊆[ A ] τ' -> τ ∷' A
⊆-∷'-l base = base
⊆-∷'-l (arr _ _ x _) = x

⊆ᵢ-∷'ᵢ-r : ∀ {A τᵢ τⱼ} -> τᵢ ⊆ᵢ[ A ] τⱼ -> τⱼ ∷'ᵢ A
⊆ᵢ-∷'ᵢ-r {τᵢ = ∩ []} (nil τⱼ∷A) = τⱼ∷A
⊆ᵢ-∷'ᵢ-r {τᵢ = ∩ (τ ∷ τᵢ)} (cons x τᵢ⊆τⱼ) = ⊆ᵢ-∷'ᵢ-r τᵢ⊆τⱼ

⊆ᵢ-∷'ᵢ-l : ∀ {A τᵢ τⱼ} -> τᵢ ⊆ᵢ[ A ] τⱼ -> τᵢ ∷'ᵢ A
⊆ᵢ-∷'ᵢ-l (nil x) = nil
⊆ᵢ-∷'ᵢ-l (cons (_ , _ , τ'⊆τ) τᵢ⊆τⱼ) = cons (⊆-∷'-l τ'⊆τ) (⊆ᵢ-∷'ᵢ-l τᵢ⊆τⱼ)

⊆ᵢ-trans : ∀ {A τᵢ τⱼ τₖ} ->
  τᵢ ⊆ᵢ[ A ] τⱼ -> τⱼ ⊆ᵢ[ A ] τₖ ->
  ---------------------------------
            τᵢ ⊆ᵢ[ A ] τₖ

⊆-trans : ∀ {A τ₁ τ₂ τ₃} ->
  τ₁ ⊆[ A ] τ₂ -> τ₂ ⊆[ A ] τ₃ ->
  -------------------------------
            τ₁ ⊆[ A ] τ₃

⊆ᵢ-trans {τᵢ = ∩ []} τᵢ⊆τⱼ τⱼ⊆τₖ = nil (⊆ᵢ-∷'ᵢ-r τⱼ⊆τₖ)
⊆ᵢ-trans {τᵢ = ∩ (τ' ∷ τᵢ)} τᵢ⊆τⱼ (nil x) = ⊥-elim (⊆ᵢ-ω-⊥ τᵢ⊆τⱼ)
⊆ᵢ-trans {τᵢ = ∩ (τ ∷ τᵢ)} {∩ τⱼ} {∩ τₖ} (cons (τ' , τ'∈τⱼ , τ⊆τ') τᵢ⊆τⱼ) τⱼ⊆τₖ =
  cons (τ'' , (τ''∈τₖ , (⊆-trans τ⊆τ' τ'⊆τ''))) (⊆ᵢ-trans τᵢ⊆τⱼ τⱼ⊆τₖ)
    where
    τ'' = proj₁ (⊆ᵢ-∈-∃ τⱼ⊆τₖ τ'∈τⱼ)
    τ''∈τₖ = proj₁ (proj₂ (⊆ᵢ-∈-∃ τⱼ⊆τₖ τ'∈τⱼ))
    τ'⊆τ'' = proj₂ (proj₂ (⊆ᵢ-∈-∃ τⱼ⊆τₖ τ'∈τⱼ))

-- ⊆ᵢ-trans {τᵢ = ∩ (τ' ∷ τᵢ)} {∩ (_ ∷ τⱼ)} {∩ τₖ} (cons (τ , τ∈τⱼ , τ'⊆τ) τᵢ⊆τⱼ) (cons x τⱼ⊆τₖ) = cons (τ , ({!   !} , {!   !})) {!   !}

-- ⊆ᵢ-trans {τᵢ = ∩ (τ' ∷ τᵢ)} (cons (τ , τ∈τⱼ , τ'⊆τ) τᵢ⊆τⱼ) τⱼ⊆τₖ = {!   !}

⊆-trans base base = base
⊆-trans (arr τ₂₁⊆τ₁₁ τ₁₂⊆τ₂₂ τ₁₁~>τ₁₂∷A⟶B _) (arr τ₂₃⊆τ₂₁ τ₂₂⊆τ₂₄ τ₂₁~>τ₂₂∷A⟶B τ₂₃~>τ₂₄∷A⟶B) =
  arr (⊆ᵢ-trans τ₂₃⊆τ₂₁ τ₂₁⊆τ₁₁) (⊆ᵢ-trans τ₁₂⊆τ₂₂ τ₂₂⊆τ₂₄) τ₁₁~>τ₁₂∷A⟶B τ₂₃~>τ₂₄∷A⟶B

⊆->⊆ᵢ : ∀ {A τ τ'} -> τ ⊆[ A ] τ' -> (∩' τ) ⊆ᵢ[ A ] (∩' τ')
⊆->⊆ᵢ {τ = τ} {τ'} τ⊆τ' = cons (τ' , (here refl , τ⊆τ')) (nil (cons (⊆-∷'-r τ⊆τ') nil))

data Λ : Type -> Set where
  bv : ∀ {A} -> (i : ℕ) -> Λ A
  fv : ∀ {A} -> (x : Atom) -> Λ A
  lam : ∀ {B} -> (A : Type) -> (e : Λ B) -> Λ (A ⟶ B)
  app : ∀ {A B} -> (e₁ : Λ (A ⟶ B)) -> (e₂ : Λ A) -> Λ B
  Y : (t : Type) -> Λ ((t ⟶ t) ⟶ t)

data _~_ : ∀{t} -> Λ t -> PTerm -> Set where
  bv : ∀ {t i} -> (bv {t} i) ~ (bv i)
  fv : ∀ {t x} -> (fv {t} x) ~ (fv x)
  lam : ∀ {t s m m'} -> m ~ m' -> (lam {s} t m) ~ (lam m')
  app : ∀ {t s m n m' n'} -> m ~ m' -> n ~ n' -> (app {t} {s} m n) ~ (app m' n')
  Y : ∀ {t} -> (Y t) ~ (Y t)

Λ[_<<_] : ∀ {t} -> ℕ -> Atom -> Λ t -> Λ t
Λ[ k << x ] (bv i) = bv i
Λ[ k << x ] (fv y) with x ≟ y
... | yes _ = bv k
... | no _ = fv y
Λ[ k << x ] (lam t m) = lam t (Λ[ (suc k) << x ] m)
Λ[ k << x ] (app t1 t2) = app (Λ[ k << x ] t1) (Λ[ k << x ] t2)
Λ[ k << x ] (Y t) = Y t

⊢->Λ : ∀ {Γ m t} -> Γ ⊢ m ∶ t -> Λ t
⊢->Λ {m = bv i} ()
⊢->Λ {m = fv x} {t} Γ⊢m∶t = fv {t} x
⊢->Λ {m = lam m} (abs {_} {τ₁} {τ₂} L cf) =
  lam τ₁ ( Λ[ 0 << ∃fresh (L ++ FV m) ] (⊢->Λ (cf (∉-cons-l _ _ (∃fresh-spec (L ++ FV m)) ))) )
⊢->Λ {m = app s t} (app Γ⊢s Γ⊢t) = app (⊢->Λ Γ⊢s) (⊢->Λ Γ⊢t)
⊢->Λ {m = Y τ} (Y _) = Y τ

-- ⊢->Λ≡ : ∀ {Γ m n t} -> m ≡ n -> {Γ⊢m : Γ ⊢ m ∶ t} -> {Γ⊢n : Γ ⊢ n ∶ t} -> (⊢->Λ Γ⊢m) ≡ (⊢->Λ Γ⊢m)
-- ⊢->Λ≡ refl = λ {Γ⊢m} {Γ⊢n} → refl

Λ*^-*^~ : ∀ {τ x k} t t' -> _~_ {τ} t t' -> Λ[ k << x ] t ~ ([ k << x ] t')
Λ*^-*^~ _ _ bv = bv
Λ*^-*^~ {x = x} (fv y) _ fv with x ≟ y
Λ*^-*^~ (fv x) .(fv x) fv | yes _ = bv
Λ*^-*^~ (fv y) .(fv y) fv | no _ = fv
Λ*^-*^~ _ _ (lam {m = m} {m'} t~t') = lam (Λ*^-*^~ m m' t~t')
Λ*^-*^~ _ _ (app {m = m} {n} {m'} {n'} t~t' t~t'') = app (Λ*^-*^~ m m' t~t') (Λ*^-*^~ n n' t~t'')
Λ*^-*^~ _ _ Y = Y

⊢->Λ~ : ∀ {Γ t τ} -> (Γ⊢t : Γ ⊢ t ∶ τ) -> (⊢->Λ Γ⊢t) ~ t
⊢->Λ~ {t = bv i} ()
⊢->Λ~ {t = fv x} (var _ _) = fv
⊢->Λ~ {t = lam t} (abs {τ₁ = τ₁} {τ₂} L cf) = lam ih
  where
  x = ∃fresh (L ++ FV t)
  x∉ = ∃fresh-spec (L ++ FV t)
  x∷Γ⊢t^'x = cf (∉-cons-l _ _ x∉)

  sub : ∀ {τ x m} -> x ∉ FV t -> _~_ {τ} m t ≡ m ~ (* x ^ (t ^' x))
  sub {_} {x} x∉ rewrite fv-^-*^-refl x t {0} x∉ = refl

  ih : Λ[ 0 << x ] (⊢->Λ x∷Γ⊢t^'x) ~ t
  ih rewrite sub {_} {x} {Λ[ 0 << x ] (⊢->Λ x∷Γ⊢t^'x)} (∉-cons-r L _ x∉) =
    Λ*^-*^~ (⊢->Λ x∷Γ⊢t^'x) (t ^' x) (⊢->Λ~ (cf (∉-cons-l _ _ x∉)))
⊢->Λ~ {t = app t t₁} (app Γ⊢t Γ⊢t₁) = app (⊢->Λ~ Γ⊢t) (⊢->Λ~ Γ⊢t₁)
⊢->Λ~ {t = Y t₁} (Y x) = Y

Λ[_>>_] : ∀ {τ τ'} -> ℕ -> Λ τ' -> Λ τ -> Λ τ
Λ[_>>_] {τ} {τ'} k u (bv i) with k ≟ i | τ ≟T τ'
Λ[ k >> u ] (bv i) | yes _ | yes refl = u
... | yes _ | no _ = bv i
... | no _ | _ = bv i
Λ[ k >> u ] (fv x) = fv x
Λ[ k >> u ] (lam A t) = lam A (Λ[ (suc k) >> u ] t)
Λ[ k >> u ] (app t1 t2) = app (Λ[ k >> u ] t1) (Λ[ k >> u ] t2)
Λ[ k >> u ] (Y t) = Y t

data _⊩_∶_ : ∀ {A} -> ICtxt -> Λ A -> IType -> Set
data _⊩ᵢ_∶_ : ∀ {A} -> ICtxt -> Λ A -> ITypeᵢ -> Set

data _⊩_∶_ where
  var : ∀ {A Γ x τ} {τᵢ : ITypeᵢ} ->
    (wf-Γ : Wf-ICtxt Γ) -> (τᵢ∈Γ : (x , (τᵢ , A)) ∈ Γ) -> (τ⊆τᵢ : (∩' τ) ⊆ᵢ[ A ] τᵢ) ->
    -----------------------------------------------------------------------------------
                                    Γ ⊩ fv {A} x ∶ τ
  app : ∀ {A B Γ s t τ τ₁ τ₂} ->
    Γ ⊩ s ∶ (τ₁ ~> τ₂) -> Γ ⊩ᵢ t ∶ τ₁ -> (∩' τ) ⊆ᵢ[ B ] τ₂ -> τ₁ ∷'ᵢ A ->
    ---------------------------------------------------------------------
                        Γ ⊩ (app {A} {B} s t) ∶ τ
  abs : ∀ {A B Γ τ τ'} (L : FVars) -> ∀ {t : Λ B} ->
    ( cf : ∀ {x} -> (x∉L : x ∉ L) -> ((x , (τ , A)) ∷ Γ) ⊩ᵢ Λ[ 0 >> fv {A} x ] t ∶ τ' ) -> (τ ~> τ') ∷' (A ⟶ B) ->
    --------------------------------------------------------------------------------------------------------------
                                                Γ ⊩ lam A t ∶ (τ ~> τ')
  Y : ∀ {Γ A τ τ₁ τ₂} ->
    (wf-Γ : Wf-ICtxt Γ) -> ∃(λ τ' -> (τ' ∈ τ₁) × ((τ ~> τ) ⊆[ A ⟶ A ] τ')) -> (∩ τ₁) ∷'ᵢ (A ⟶ A) -> τ₂ ⊆ᵢ[ A ] τ -> --  τ₁ ⊆[ (A ⟶ A) ⟶ A ]((∩' (τ ~> τ)) ~> τ)
    -----------------------------------------------------------------------------------------
                                    Γ ⊩ Y A ∶ ((∩ τ₁) ~> τ₂)

data _⊩ᵢ_∶_ where
  nil : ∀ {A Γ} {m : Λ A} ->
    (wf-Γ : Wf-ICtxt Γ) ->
    ----------------------
          Γ ⊩ᵢ m  ∶ ω
  cons : ∀ {A Γ τ τᵢ} {m : Λ A} ->
    Γ ⊩ m  ∶ τ -> Γ ⊩ᵢ m  ∶ (∩ τᵢ) ->
    --------------------------------
          Γ ⊩ᵢ m  ∶ (∩ (τ ∷ τᵢ))

data ΛTerm : ∀ {τ} -> Λ τ -> Set where
  var : ∀ {A x} -> ΛTerm (fv {A} x)
  lam : ∀ {A B} (L : FVars) -> ∀ {e : Λ B} ->
    (cf : ∀ {x} -> (x∉L : x ∉ L) -> ΛTerm (Λ[ 0 >> fv {A} x ] e)) -> ΛTerm (lam A e)
  app : ∀ {A B} {e₁ : Λ (A ⟶ B)} {e₂ : Λ A} -> ΛTerm e₁ -> ΛTerm e₂ -> ΛTerm (app e₁ e₂)
  Y : ∀ {t} -> ΛTerm (Y t)

data _⊆Γ_ : ICtxt -> ICtxt -> Set where
  nil : ∀ {Γ} ->
    (wf-Γ : Wf-ICtxt Γ) ->
    ----------------------
          [] ⊆Γ Γ
  cons : ∀ {A x τ' Γ Γ'} ->
    ∃(λ τ -> ((x , (τ , A)) ∈ Γ') × (τ' ⊆ᵢ[ A ] τ)) -> Γ ⊆Γ Γ' ->
    ------------------------------------------------------------
                      ((x , (τ' , A)) ∷ Γ) ⊆Γ Γ'

⊆Γ-wfΓ' : ∀ {Γ Γ'} -> Γ ⊆Γ Γ' -> Wf-ICtxt Γ'
⊆Γ-wfΓ' (nil wf-Γ') = wf-Γ'
⊆Γ-wfΓ' (cons _ Γ⊆Γ') = ⊆Γ-wfΓ' Γ⊆Γ'

⊩-∷' : ∀ {A Γ} {m : Λ A} {τ} -> Γ ⊩ m ∶ τ -> τ ∷' A
⊩ᵢ-∷'ᵢ : ∀ {A Γ} {m : Λ A} {τ} -> Γ ⊩ᵢ m ∶ τ -> τ ∷'ᵢ A

⊩-∷' (var _ _ τ⊆τᵢ) = ∷'ᵢ-∈ (here refl) (⊆ᵢ-∷'ᵢ-l τ⊆τᵢ)
⊩-∷' (app _ _ τ⊆τᵢ _) = ∷'ᵢ-∈ (here refl) (⊆ᵢ-∷'ᵢ-l τ⊆τᵢ)
⊩-∷' (abs _ _ x) = x
⊩-∷' (Y _ _ τ₁∷A⟶A τ₂⊆τ) = arr τ₁∷A⟶A (⊆ᵢ-∷'ᵢ-l τ₂⊆τ)

⊩ᵢ-∷'ᵢ (nil _) = nil
⊩ᵢ-∷'ᵢ (cons Γ⊩m∶τ Γ⊩ᵢm∶τᵢ) = cons (⊩-∷' Γ⊩m∶τ) (⊩ᵢ-∷'ᵢ Γ⊩ᵢm∶τᵢ)

⊩ᵢ-∈-⊩ : ∀ {A Γ} {m : Λ A} {τ τᵢ} -> Γ ⊩ᵢ m ∶ ∩ τᵢ -> τ ∈ τᵢ -> Γ ⊩ m ∶ τ
⊩ᵢ-∈-⊩ (nil _) ()
⊩ᵢ-∈-⊩ (cons Γ⊩m∶τ x) (here refl) = Γ⊩m∶τ
⊩ᵢ-∈-⊩ (cons _ Γ⊩ᵢm∶τᵢ) (there τ∈τᵢ) = ⊩ᵢ-∈-⊩ Γ⊩ᵢm∶τᵢ τ∈τᵢ

data _->Λβ_ : ∀ {τ} -> Λ τ ↝ Λ τ where
  redL : ∀ {A B} {n : Λ A} {m m' : Λ (A ⟶ B)} -> ΛTerm n -> m ->Λβ m' -> app m n ->Λβ app m' n
  redR : ∀ {A B} {m : Λ (A ⟶ B)} {n n' : Λ A} -> ΛTerm m -> n ->Λβ n' -> app m n ->Λβ app m n'
  abs : ∀ L {A B} {m m' : Λ B} -> ( ∀ {x} -> x ∉ L -> Λ[ 0 >> fv {A} x ] m ->Λβ Λ[ 0 >> fv {A} x ] m' ) ->
    lam A m ->Λβ lam A m'
  beta : ∀ {A B} {m : Λ (A ⟶ B)} {n : Λ A} -> ΛTerm (lam A m) -> ΛTerm n -> app (lam A m) n ->Λβ (Λ[ 0 >> n ] m)
  Y : ∀ {A} {m : Λ (A ⟶ A)} -> ΛTerm m -> app (Y A) m ->Λβ app m (app (Y A) m)

∈-⊆Γ-trans : ∀ {A x τᵢ} {Γ Γ'} -> (x , (τᵢ , A)) ∈ Γ -> Γ ⊆Γ Γ' -> ∃(λ τᵢ' -> ((x , (τᵢ' , A)) ∈ Γ') × τᵢ ⊆ᵢ[ A ] τᵢ')
∈-⊆Γ-trans (here refl) (cons x _) = x
∈-⊆Γ-trans (there x∈L) (cons _ L⊆L') = ∈-⊆Γ-trans x∈L L⊆L'

⊆Γ-∷ : ∀ {A x τᵢ Γ Γ'} -> x ∉ dom Γ' -> τᵢ ∷'ᵢ A -> Γ ⊆Γ Γ' -> Γ ⊆Γ ((x , τᵢ , A) ∷ Γ')
⊆Γ-∷ {Γ = []} x∉Γ' τᵢ∷A Γ⊆Γ' = nil (cons x∉Γ' τᵢ∷A (⊆Γ-wfΓ' Γ⊆Γ'))
⊆Γ-∷ {Γ = (x , τᵢ , A) ∷ Γ} x∉Γ' τᵢ∷A (cons (proj₁ , proj₂ , proj₃) Γ⊆Γ') =
  cons (proj₁ , ((there proj₂) , proj₃)) (⊆Γ-∷ x∉Γ' τᵢ∷A Γ⊆Γ')

subΓ : ∀ {A Γ Γ'} {m : Λ A} {τ} -> Γ ⊩ m ∶ τ -> Γ ⊆Γ Γ' -> Γ' ⊩ m ∶ τ
subᵢΓ : ∀ {A Γ Γ'} {m : Λ A} {τ} -> Γ ⊩ᵢ m ∶ τ -> Γ ⊆Γ Γ' -> Γ' ⊩ᵢ m ∶ τ

subΓ (var wf-Γ τᵢ∈Γ τ⊆τᵢ) Γ⊆Γ' = var (⊆Γ-wfΓ' Γ⊆Γ') τᵢ'∈ (⊆ᵢ-trans τ⊆τᵢ τᵢ⊆τᵢ')
  where
  τᵢ'∈ = proj₁ (proj₂ (∈-⊆Γ-trans τᵢ∈Γ Γ⊆Γ'))
  τᵢ⊆τᵢ' = proj₂ (proj₂ (∈-⊆Γ-trans τᵢ∈Γ Γ⊆Γ'))

subΓ (app Γ⊩m∶τ x x₁ x₂) Γ⊆Γ' = app (subΓ Γ⊩m∶τ Γ⊆Γ') (subᵢΓ x Γ⊆Γ') x₁ x₂
subΓ {Γ' = Γ'} (abs {τ = τ} L cf (arr τ∷A τ'∷B)) Γ⊆Γ' = abs
  (L ++ dom Γ')
  (λ x∉ → subᵢΓ
    (cf (∉-cons-l _ _ x∉))
    (cons
      (τ , (here refl) , (⊆ᵢ-refl τ∷A))
      (⊆Γ-∷ (∉-cons-r L _ x∉) τ∷A Γ⊆Γ')))
  (arr τ∷A τ'∷B)
subΓ (Y x x₁ x₂ x₃) Γ⊆Γ' = Y (⊆Γ-wfΓ' Γ⊆Γ') x₁ x₂ x₃

subᵢΓ (nil wf-Γ) Γ⊆Γ' = nil (⊆Γ-wfΓ' Γ⊆Γ')
subᵢΓ (cons x Γ⊩ᵢm∶τ) Γ⊆Γ' = cons (subΓ x Γ⊆Γ') (subᵢΓ Γ⊩ᵢm∶τ Γ⊆Γ')

∈-⊆ᵢ-trans : ∀ {A τ τᵢ τⱼ} -> τ ∈ τᵢ -> (∩ τᵢ) ⊆ᵢ[ A ] (∩ τⱼ) -> ∃(λ τ' -> (τ' ∈ τⱼ) × τ ⊆[ A ] τ')
∈-⊆ᵢ-trans (here refl) (cons x _) = x
∈-⊆ᵢ-trans (there τ∈τᵢ) (cons _ τᵢ⊆τⱼ) = ∈-⊆ᵢ-trans τ∈τᵢ τᵢ⊆τⱼ

sub : ∀ {A Γ Γ'} {m : Λ A} {τ τ'} -> Γ ⊩ m ∶ τ -> τ' ⊆[ A ] τ -> Γ ⊆Γ Γ' -> Γ' ⊩ m ∶ τ'
subᵢ : ∀ {A Γ Γ'} {m : Λ A} {τ τ'} -> Γ ⊩ᵢ m ∶ τ -> τ' ⊆ᵢ[ A ] τ -> Γ ⊆Γ Γ' -> Γ' ⊩ᵢ m ∶ τ'

sub (var wf-Γ τᵢ∈Γ τ⊆τᵢ) τ'⊆τ Γ⊆Γ' =
  var (⊆Γ-wfΓ' Γ⊆Γ') τᵢ'∈ (⊆ᵢ-trans (⊆ᵢ-trans (⊆->⊆ᵢ τ'⊆τ) τ⊆τᵢ) τᵢ⊆τᵢ')
  where
  τᵢ'∈ = proj₁ (proj₂ (∈-⊆Γ-trans τᵢ∈Γ Γ⊆Γ'))
  τᵢ⊆τᵢ' = proj₂ (proj₂ (∈-⊆Γ-trans τᵢ∈Γ Γ⊆Γ'))

sub (app Γ⊩s∶τ₁~>τ₂ Γ⊩ᵢt∶τ₁ τ⊆τ₂ τ∷A) τ'⊆τ Γ⊆Γ' = app
  (subΓ Γ⊩s∶τ₁~>τ₂ Γ⊆Γ')
  (subᵢΓ Γ⊩ᵢt∶τ₁ Γ⊆Γ')
  (⊆ᵢ-trans (⊆->⊆ᵢ τ'⊆τ) τ⊆τ₂)
  τ∷A
sub {_} {Γ} {Γ'} (abs {τ = τ} {τ'} L {t} cf τ~>τ'∷A⟶B) (arr {A} {τ₁₁ = τ₁₁} τ⊆τ₁₁ τ₁₂⊆τ' (arr τ₁₁∷A τ₁₂∷B) x₃) Γ⊆Γ' = abs
  (L ++ dom Γ')
  (λ x∉ → subᵢ
    (cf (∉-cons-l _ _ x∉))
    τ₁₂⊆τ'
    (cons (τ₁₁ , (here refl) , τ⊆τ₁₁) (⊆Γ-∷ (∉-cons-r L _ x∉) τ₁₁∷A Γ⊆Γ')))
  (arr τ₁₁∷A τ₁₂∷B)
sub (Y wf-Γ (τ' , τ'∈τ₁ , τ~>τ⊆τ') τ₁∷A⟶A τ₂⊆τ) (arr {τ₁₁ = ∩ τ₁'} τ₁⊆τ₁' τ₂'⊆τ₂ (arr ∩τ₁'∷A⟶A τ₂'∷A) x₄) Γ⊆Γ' =
  Y ((⊆Γ-wfΓ' Γ⊆Γ')) (τ'' , (τ''∈τ₁' , ⊆-trans τ~>τ⊆τ' τ'⊆τ'')) ∩τ₁'∷A⟶A (⊆ᵢ-trans τ₂'⊆τ₂ τ₂⊆τ)
  where
  τ'' = proj₁ (∈-⊆ᵢ-trans τ'∈τ₁ τ₁⊆τ₁')
  τ''∈τ₁' = proj₁ (proj₂ (∈-⊆ᵢ-trans τ'∈τ₁ τ₁⊆τ₁'))
  τ'⊆τ'' = proj₂ (proj₂ (∈-⊆ᵢ-trans τ'∈τ₁ τ₁⊆τ₁'))

subᵢ Γ⊩ᵢm∶τ (nil x) Γ⊆Γ' = nil (⊆Γ-wfΓ' Γ⊆Γ')
subᵢ Γ⊩ᵢm∶τᵢ (cons (τ , τ∈τᵢ , τ'⊆τ) τ'ᵢ⊆τᵢ) Γ⊆Γ' with ⊩ᵢ-∈-⊩ Γ⊩ᵢm∶τᵢ τ∈τᵢ
... | Γ⊩m∶τ = cons (sub Γ⊩m∶τ τ'⊆τ Γ⊆Γ') (subᵢ Γ⊩ᵢm∶τᵢ τ'ᵢ⊆τᵢ Γ⊆Γ')

-- ⊩->β : ∀ {A Γ} {m m' : Λ A} {τ} -> Γ ⊩ m' ∶ τ -> m ->Λβ m' -> Γ ⊩ m ∶ τ
-- ⊩->β Γ⊩m'∶τ (redL x m->βm') = {!   !}
-- ⊩->β Γ⊩m'∶τ (redR x m->βm') = {!   !}
-- ⊩->β Γ⊩m'∶τ (abs L x) = {!   !}
-- ⊩->β Γ⊩m'∶τ (beta x x₁) = {!   !}
-- ⊩->β (app Γ⊩m'∶ω~>τ₂ (nil wf-Γ) τ⊆τ₂ nil) (Y trm-m) = {!   !}
-- ⊩->β (app Γ⊩m∶τ₃τᵢ~>τ₅ (cons _ (app (Y _ τ₂⊆τ₁ τ₁⊆τ) (cons _ Γ⊩m∶τ~>τ₁ (nil wf-Γ)) τ₃⊆τ₂ (cons τ~>τ₁∷A⟶A _)) Γ⊩ᵢYm∶∩τᵢ) τ₄⊆τ₅ τ₃τᵢ∷A) (Y trm-m) = {!   !}

-- ⊩->β Γ⊩m'∶τ (redL x m->βm') = {!   !}
-- ⊩->β Γ⊩m'∶τ (redR x m->βm') = {!   !}
-- ⊩->β Γ⊩m'∶τ (abs L x) = {!   !}
-- ⊩->β Γ⊩m'∶τ (beta x x₁) = {!   !}
-- -- ⊩->β (app Γ⊩m∶τ₁~>τ (app (Y wf-Γ (arr (arr ::' ::'') ::''') τ≤τ₁ τ₂≤τ₁) Γ⊩m'∶τ₂ x₄) x₅) (Y x₆) = {!   !}
-- ⊩->β (app {s = m} {τ₂ = τ} Γ⊩m∶τ₁~>τ (app {τ₂ = τ₁} (Y {τ = τ₂} {τ₃} wf-Γ (arr (arr τ₂∷A τ₃∷A) _) τ≤τ₁ τ₂≤τ₁) Γ⊩m∶τ₂~>τ₃ _) (arr {A = A} τ₁∷A τ∷A)) (Y x₆) =
--   app {A = A ⟶ A}
--     (Y {_} {A} {∩ (τ₂ ∷ τ₁ ∷ [])} {∩ (τ₃ ∷ τ ∷ [])} {τ}
--       wf-Γ
--       (arr (arr (∩-cons τ₂∷A (∩-cons τ₁∷A ∩-nil)) (∩-cons τ₃∷A (∩-cons τ∷A ∩-nil))) τ∷A)
--       {!   !}
--       (∩-∈ (there (here refl))))
--     {!   !}
--     (arr (arr (∩-cons τ₂∷A (∩-cons τ₁∷A ∩-nil)) (∩-cons τ₃∷A (∩-cons τ∷A ∩-nil))) τ∷A)
--
-- ⊩->β (app Γ⊩m'∶τ (∩-nil ¬Y-shape wf-Γ) x) (Y x₁) = ⊥-elim (¬Y-shape intro₁)
-- ⊩->β (app Γ⊩m'∶τ (∩-cons ¬Y-shape wf-Γ Γ⊩m'∶τ₁ Γ⊩m'∶τ₂) x) (Y x₁) = ⊥-elim (¬Y-shape intro₁)
-- ⊩->β (∩-nil ¬Y-shape wf-Γ) (Y x) = ⊥-elim (¬Y-shape intro₂)
-- ⊩->β (∩-cons ¬Y-shape wf-Γ Γ⊩m'∶τ Γ⊩m'∶τ₁) (Y x) = ⊥-elim (¬Y-shape intro₂)

-- ⊩->β Γ⊩m'∶τ (redL trm-n m->βm') = ⊩->β-redL Γ⊩m'∶τ m->βm'
--   where
--   ⊩->β-redL : ∀ {A B Γ} {m m' : Λ (A ⟶ B)} {n : Λ A} {τ} -> Γ ⊩ app m' n ∶ τ -> m ->Λβ m' -> Γ ⊩ app m n ∶ τ
--   ⊩->β-redL (app Γ⊩m'n∶τ Γ⊩m'n∶τ₁ x x₁) (redL x₂ m->Λβm') =
--     app (⊩->β-redL Γ⊩m'n∶τ m->Λβm') Γ⊩m'n∶τ₁ x x₁
--   ⊩->β-redL (∩-nil ¬Y-shape wf-Γ) (redL x m->Λβm') = {!   !}
--   ⊩->β-redL (∩-cons ¬Y-shape wf-Γ Γ⊩m'n∶τ Γ⊩m'n∶τ₁) (redL x m->Λβm') = {!   !}
--   ⊩->β-redL Γ⊩m'n∶τ (redR x m->Λβm') = {!   !}
--   ⊩->β-redL Γ⊩m'n∶τ (abs L x) = {!   !}
--   ⊩->β-redL Γ⊩m'n∶τ (beta x x₁) = {!   !}
--   ⊩->β-redL Γ⊩m'n∶τ (Y x) = {!   !}
-- ⊩->β Γ⊩m'∶τ (redR trm-m n->βn') = {!   !}
-- ⊩->β Γ⊩m'∶τ (abs L x) = {!   !}
-- ⊩->β Γ⊩m'∶τ (beta x x₁) = {!   !}
-- ⊩->β (app {s = m} {τ₂ = τ} Γ⊩m∶τ₁~>τ (app (Y {_} {_} {τ₂} {τ₃} {τ₁} wf-Γ τ₂∷A τ₃∷A τ₁∷A τ₂≤∩τ₃ τ₁≤∩τ₃) Γ⊩m∶τ₂~>τ₃ x τ₂~>τ₃∷A) (arr {A = A} _ τ∷A) _) (Y trm-m) =
--   -- app {A = A ⟶ A} (Y wf-Γ τ₁∷A τ∷A τ∷A {!   !} {!   !}) Γ⊩m∶τ₁~>τ (arr (arr τ₁∷A τ∷A) τ∷A) (arr τ₁∷A τ∷A)
--   app {A = A ⟶ A}
--     (Y {_} {A} {∩ (τ₁ ∷ τ₂ ∷ τ₃ ∷ [])} {∩ (τ ∷ τ₃ ∷ [])} {τ}
--       wf-Γ
--       {!   !}
--       (∩-cons τ∷A (∩-cons τ₃∷A ∩-nil))
--       τ∷A
--       {!   !}
--       {!   !})
--     {!   !}
--     (arr {!   !} {!   !})
--     {!   !}
--
-- ⊩->β (app Γ⊩m∶τ~>τ' (∩-nil ¬Y-shape wf-Γ) x τ∷A) (Y trm-m) = ⊥-elim (¬Y-shape intro₁)
-- ⊩->β (app Γ⊩m∶τ~>τ' (∩-cons ¬Y-shape wf-Γ Γ⊩Ym∶τ' Γ⊩Ym∶τ'') x τ∷A) (Y trm-m) = ⊥-elim (¬Y-shape intro₁)
-- ⊩->β (∩-nil ¬Y-shape wf-Γ) (Y x) = ⊥-elim (¬Y-shape intro₂)
-- ⊩->β (∩-cons ¬Y-shape wf-Γ Γ⊩m'∶τ Γ⊩m'∶τ₁) (Y x) = ⊥-elim (¬Y-shape intro₂)


Small cleanups

Small cleanups

module New.Correctness where

open import Relation.Binary.PropositionalEquality
open import Postulate.Extensionality
open import Data.Product

open import New.Lang
open import New.Changes
open import New.Derive
open import New.LangChanges

-- Lemmas
alternate : ∀ {Γ} → ⟦ Γ ⟧Context → eCh Γ → ⟦ ΔΓ Γ ⟧Context
alternate {∅} ∅ ∅ = ∅
alternate {τ • Γ} (v • ρ) (dv • dρ) = dv • v • alternate ρ dρ

⟦Γ≼ΔΓ⟧ : ∀ {Γ} (ρ : ⟦ Γ ⟧Context) (dρ : eCh Γ) →
  ρ ≡ ⟦ Γ≼ΔΓ ⟧≼ (alternate ρ dρ)
⟦Γ≼ΔΓ⟧ ∅ ∅ = refl
⟦Γ≼ΔΓ⟧ (v • ρ) (dv • dρ) = cong₂ _•_ refl (⟦Γ≼ΔΓ⟧ ρ dρ)

fit-sound : ∀ {Γ τ} → (t : Term Γ τ) →
  (ρ : ⟦ Γ ⟧Context) (dρ : eCh Γ) →
  ⟦ t ⟧Term ρ ≡ ⟦ fit t ⟧Term (alternate ρ dρ)
fit-sound t ρ dρ = trans
  (cong ⟦ t ⟧Term (⟦Γ≼ΔΓ⟧ ρ dρ))
  (sym (weaken-sound t _))

-- The change semantics is just the semantics composed with derivation!
changeSemVar : ∀ {Γ τ} → (t : Var Γ τ) → (ρ : ⟦ Γ ⟧Context) (dρ : eCh Γ) → Cht τ
changeSemVar t ρ dρ = ⟦ deriveVar t ⟧Var (alternate ρ dρ)

changeSem : ∀ {Γ τ} → (t : Term Γ τ) → (ρ : ⟦ Γ ⟧Context) (dρ : eCh Γ) → Cht τ
changeSem t ρ dρ = ⟦ derive t ⟧Term (alternate ρ dρ)

-- XXX Should try to simply relate the semantics to the nil change, and prove
-- that validity can be carried over, instead of proving separately validity and
-- correctness; elsewhere this does make things simpler.

validDeriveVar : ∀ {Γ τ} → (x : Var Γ τ) →
  (ρ : ⟦ Γ ⟧Context) (dρ : eCh Γ) →
  validΓ ρ dρ → valid (⟦ x ⟧Var ρ) (⟦ deriveVar x ⟧Var (alternate ρ dρ))

validDeriveVar this (v • ρ) (dv • dρ) (vdv , ρdρ) = vdv
validDeriveVar (that x) (v • ρ) (dv • dρ) (vdv , ρdρ) = validDeriveVar x ρ dρ ρdρ

correctDeriveVar : ∀ {Γ τ} → (v : Var Γ τ) →
  IsDerivative ⟦ v ⟧Var (changeSemVar v)
correctDeriveVar this (v • ρ) (dv • dρ) ρdρ = refl
correctDeriveVar (that x) (v • ρ) (dv • dρ) (vdv , ρdρ) = correctDeriveVar x ρ dρ ρdρ

validDerive : ∀ {Γ τ} → (t : Term Γ τ) →
  (ρ : ⟦ Γ ⟧Context) (dρ : eCh Γ) → validΓ ρ dρ →
    valid (⟦ t ⟧Term ρ) (⟦ derive t ⟧Term (alternate ρ dρ))
correctDerive : ∀ {Γ τ} → (t : Term Γ τ) →
  IsDerivative ⟦ t ⟧Term (changeSem t)

correctDerive (const ()) ρ dρ ρdρ
correctDerive (var x) ρ dρ ρdρ = correctDeriveVar x ρ dρ ρdρ
correctDerive (app s t) ρ dρ ρdρ rewrite sym (fit-sound t ρ dρ) =
  let
    open ≡-Reasoning
    a0 = ⟦ t ⟧Term ρ
    da0 = ⟦ derive t ⟧Term (alternate ρ dρ)
    a0da0 = validDerive t ρ dρ ρdρ
  in
    begin
      ⟦ s ⟧Term (ρ ⊕ dρ) (⟦ t ⟧Term (ρ ⊕ dρ))
    ≡⟨ correctDerive s ρ dρ ρdρ ⟨$⟩ correctDerive t ρ dρ ρdρ ⟩
      (⟦ s ⟧Term ρ ⊕ changeSem s ρ dρ) (⟦ t ⟧Term ρ ⊕ changeSem t ρ dρ)
    ≡⟨ proj₂ (validDerive s ρ dρ ρdρ a0 da0 a0da0)  ⟩
      ⟦ s ⟧Term ρ (⟦ t ⟧Term ρ) ⊕ (changeSem s ρ dρ) (⟦ t ⟧Term ρ) (changeSem t ρ dρ)
    ∎
  where
    open import Theorem.CongApp
correctDerive (abs t) ρ dρ ρdρ = ext (λ a →
  let
    open ≡-Reasoning
    ρ1 = a • ρ
    dρ1 = nil a • dρ
    ρ1dρ1 : valid ρ1 dρ1
    ρ1dρ1 = nil-valid a , ρdρ
  in
    begin
      ⟦ t ⟧Term (a • ρ ⊕ dρ)
    ≡⟨ cong (λ a′ → ⟦ t ⟧Term (a′ • ρ ⊕ dρ)) (sym (update-nil a)) ⟩
      ⟦ t ⟧Term (ρ1 ⊕ dρ1)
    ≡⟨ correctDerive t ρ1 dρ1 ρ1dρ1 ⟩
      ⟦ t ⟧Term ρ1 ⊕ changeSem t ρ1 dρ1
    ∎)

validDerive (app s t) ρ dρ ρdρ =
  let
    f = ⟦ s ⟧Term ρ
    df = ⟦ derive s ⟧Term (alternate ρ dρ)
    v = ⟦ t ⟧Term ρ
    dv = ⟦ derive t ⟧Term (alternate ρ dρ)
    vdv = validDerive t ρ dρ ρdρ
    fdf = validDerive s ρ dρ ρdρ
    fvdfv = proj₁ (fdf v dv vdv)
  in subst (λ v′ → valid (f v) (df v′ dv)) (fit-sound t ρ dρ) fvdfv
validDerive (abs t) ρ dρ ρdρ =
  λ a da ada →
  let
    fv = ⟦ t ⟧Term (a • ρ)
    dfvdv = ⟦ derive t ⟧Term (da • a • alternate ρ dρ)
    rdr = validDerive t (a • ρ) (da • dρ) (ada , ρdρ)
    ρ1 = a ⊕ da • ρ
    dρ1 = nil (a ⊕ da) • dρ
    ρ2 = a • ρ
    dρ2 = da • dρ
    ρ1dρ1 : valid ρ1 dρ1
    ρ1dρ1 = nil-valid (a ⊕ da) , ρdρ
    ρ2dρ2 : valid ρ2 dρ2
    ρ2dρ2 = ada , ρdρ
    open ≡-Reasoning
   in
     rdr ,
     (begin
       ⟦ t ⟧Term ρ1 ⊕
       ⟦ derive t ⟧Term (alternate ρ1 dρ1)
      ≡⟨ sym ( correctDerive t ρ1 dρ1 ρ1dρ1) ⟩
       ⟦ t ⟧Term (ρ1 ⊕ dρ1)
      ≡⟨⟩
       ⟦ t ⟧Term (a ⊕ da ⊕ (nil (a ⊕ da)) • ρ ⊕ dρ)
      ≡⟨ cong (λ a′ → ⟦ t ⟧Term (a′ • ρ ⊕ dρ)) (update-nil (a ⊕ da)) ⟩
       ⟦ t ⟧Term (a ⊕ da • ρ ⊕ dρ)
      ≡⟨ correctDerive t ρ2 dρ2 ρ2dρ2 ⟩
        ⟦ t ⟧Term (a • ρ) ⊕ ⟦ derive t ⟧Term (da • a • alternate ρ dρ)
      ∎)
validDerive (var x) ρ dρ ρdρ = validDeriveVar x ρ dρ ρdρ
validDerive (const ()) ρ dρ ρdρ

module New.Correctness where

open import Relation.Binary.PropositionalEquality
open import Postulate.Extensionality
open import Data.Product

open import New.Lang
open import New.Changes
open import New.Derive
open import New.LangChanges

-- Lemmas
alternate : ∀ {Γ} → ⟦ Γ ⟧Context → eCh Γ → ⟦ ΔΓ Γ ⟧Context
alternate {∅} ∅ ∅ = ∅
alternate {τ • Γ} (v • ρ) (dv • dρ) = dv • v • alternate ρ dρ

⟦Γ≼ΔΓ⟧ : ∀ {Γ} (ρ : ⟦ Γ ⟧Context) (dρ : eCh Γ) →
  ρ ≡ ⟦ Γ≼ΔΓ ⟧≼ (alternate ρ dρ)
⟦Γ≼ΔΓ⟧ ∅ ∅ = refl
⟦Γ≼ΔΓ⟧ (v • ρ) (dv • dρ) = cong₂ _•_ refl (⟦Γ≼ΔΓ⟧ ρ dρ)

fit-sound : ∀ {Γ τ} → (t : Term Γ τ) →
  (ρ : ⟦ Γ ⟧Context) (dρ : eCh Γ) →
  ⟦ t ⟧Term ρ ≡ ⟦ fit t ⟧Term (alternate ρ dρ)
fit-sound t ρ dρ = trans
  (cong ⟦ t ⟧Term (⟦Γ≼ΔΓ⟧ ρ dρ))
  (sym (weaken-sound t _))

-- The change semantics is just the semantics composed with derivation!
changeSemVar : ∀ {Γ τ} → (t : Var Γ τ) → (ρ : ⟦ Γ ⟧Context) (dρ : eCh Γ) → Cht τ
changeSemVar t ρ dρ = ⟦ deriveVar t ⟧Var (alternate ρ dρ)

changeSem : ∀ {Γ τ} → (t : Term Γ τ) → (ρ : ⟦ Γ ⟧Context) (dρ : eCh Γ) → Cht τ
changeSem t ρ dρ = ⟦ derive t ⟧Term (alternate ρ dρ)

-- XXX Should try to simply relate the semantics to the nil change, and prove
-- that validity can be carried over, instead of proving separately validity and
-- correctness; elsewhere this does make things simpler.

validDeriveVar : ∀ {Γ τ} → (x : Var Γ τ) →
  (ρ : ⟦ Γ ⟧Context) (dρ : eCh Γ) →
  validΓ ρ dρ → valid (⟦ x ⟧Var ρ) (⟦ deriveVar x ⟧Var (alternate ρ dρ))

validDeriveVar this (v • ρ) (dv • dρ) (vdv , ρdρ) = vdv
validDeriveVar (that x) (v • ρ) (dv • dρ) (vdv , ρdρ) = validDeriveVar x ρ dρ ρdρ

correctDeriveVar : ∀ {Γ τ} → (v : Var Γ τ) →
  IsDerivative ⟦ v ⟧Var (changeSemVar v)
correctDeriveVar this (v • ρ) (dv • dρ) ρdρ = refl
correctDeriveVar (that x) (v • ρ) (dv • dρ) (vdv , ρdρ) = correctDeriveVar x ρ dρ ρdρ

validDerive : ∀ {Γ τ} → (t : Term Γ τ) →
  (ρ : ⟦ Γ ⟧Context) (dρ : eCh Γ) → validΓ ρ dρ →
    valid (⟦ t ⟧Term ρ) (⟦ derive t ⟧Term (alternate ρ dρ))
correctDerive : ∀ {Γ τ} → (t : Term Γ τ) →
  IsDerivative ⟦ t ⟧Term (changeSem t)

correctDerive (const ()) ρ dρ ρdρ
correctDerive (var x) ρ dρ ρdρ = correctDeriveVar x ρ dρ ρdρ
correctDerive {Γ} (app {σ} {τ} s t) ρ dρ ρdρ rewrite sym (fit-sound t ρ dρ) =
  let
    open ≡-Reasoning
    a0 = ⟦ t ⟧Term ρ
    da0 = ⟦ derive t ⟧Term (alternate ρ dρ)
    a0da0 = validDerive t ρ dρ ρdρ
  in
    begin
      ⟦ s ⟧Term (ρ ⊕ dρ) (⟦ t ⟧Term (ρ ⊕ dρ))
    ≡⟨ correctDerive s ρ dρ ρdρ ⟨$⟩ correctDerive t ρ dρ ρdρ ⟩
      (⟦ s ⟧Term ρ ⊕ changeSem s ρ dρ) (⟦ t ⟧Term ρ ⊕ changeSem t ρ dρ)
    ≡⟨ proj₂ (validDerive s ρ dρ ρdρ a0 da0 a0da0)  ⟩
      ⟦ s ⟧Term ρ (⟦ t ⟧Term ρ) ⊕ (changeSem s ρ dρ) (⟦ t ⟧Term ρ) (changeSem t ρ dρ)
    ∎
  where
    open import Theorem.CongApp
correctDerive {Γ} (abs {σ} {τ} t) ρ dρ ρdρ = ext (λ a →
  let
    open ≡-Reasoning
    ρ1 = a • ρ
    dρ1 = nil a • dρ
    ρ1dρ1 : valid ρ1 dρ1
    ρ1dρ1 = nil-valid a , ρdρ
  in
    begin
      ⟦ t ⟧Term (a • ρ ⊕ dρ)
    ≡⟨ cong (λ a′ → ⟦ t ⟧Term (a′ • ρ ⊕ dρ)) (sym (update-nil a)) ⟩
      ⟦ t ⟧Term (ρ1 ⊕ dρ1)
    ≡⟨ correctDerive t ρ1 dρ1 ρ1dρ1 ⟩
      ⟦ t ⟧Term ρ1 ⊕ changeSem t ρ1 dρ1
    ∎)

validDerive (app s t) ρ dρ ρdρ =
  let
    f = ⟦ s ⟧Term ρ
    df = ⟦ derive s ⟧Term (alternate ρ dρ)
    v = ⟦ t ⟧Term ρ
    dv = ⟦ derive t ⟧Term (alternate ρ dρ)
    vdv = validDerive t ρ dρ ρdρ
    fdf = validDerive s ρ dρ ρdρ
    fvdfv = proj₁ (fdf v dv vdv)
  in subst (λ v′ → valid (f v) (df v′ dv)) (fit-sound t ρ dρ) fvdfv
validDerive {Γ = Γ} (abs {σ} {τ} t) ρ dρ ρdρ =
  λ a da ada →
  let
    fv = ⟦ t ⟧Term (a • ρ)
    dfvdv = ⟦ derive t ⟧Term (da • a • alternate ρ dρ)
    rdr = validDerive t (a • ρ) (da • dρ) (ada , ρdρ)
    ρ1 = a ⊕ da • ρ
    dρ1 = nil (a ⊕ da) • dρ
    ρ2 = a • ρ
    dρ2 = da • dρ
    ρ1dρ1 : valid ρ1 dρ1
    ρ1dρ1 = nil-valid (a ⊕ da) , ρdρ
    ρ2dρ2 : valid ρ2 dρ2
    ρ2dρ2 = ada , ρdρ
    open ≡-Reasoning
   in
     rdr ,
     (begin
       ⟦ t ⟧Term ρ1 ⊕
       ⟦ derive t ⟧Term (alternate ρ1 dρ1)
      ≡⟨ sym ( correctDerive t ρ1 dρ1 ρ1dρ1) ⟩
       ⟦ t ⟧Term (ρ1 ⊕ dρ1)
      ≡⟨⟩
       ⟦ t ⟧Term (a ⊕ da ⊕ (nil (a ⊕ da)) • ρ ⊕ dρ)
      ≡⟨ cong (λ a′ → ⟦ t ⟧Term (a′ • ρ ⊕ dρ)) (update-nil (a ⊕ da)) ⟩
       ⟦ t ⟧Term (a ⊕ da • ρ ⊕ dρ)
      ≡⟨ correctDerive t ρ2 dρ2 ρ2dρ2 ⟩
        ⟦ t ⟧Term (a • ρ) ⊕ ⟦ derive t ⟧Term (da • a • alternate ρ dρ)
      ∎
      )
validDerive (var x) ρ dρ ρdρ = validDeriveVar x ρ dρ ρdρ
validDerive (const ()) ρ dρ ρdρ


Restore the type params for ZK-chaum-pedersen-pok-elgamal-rnd

{-# OPTIONS --without-K #-}
module ZK.JSChecker where

open import Function         using (id; _∘′_; case_of_)
open import Data.Bool.Base   using (Bool; true; false; _∧_)
open import Data.List.Base   using (List; []; _∷_; and; foldr)
open import Data.String.Base using (String)

open import FFI.JS
open import FFI.JS.Check
-- open import FFI.JS.Proc using (URI; JSProc; showURI; server)
-- open import Control.Process.Type
import FFI.JS.Console as Console
import FFI.JS.Process as Process
import FFI.JS.FS as FS

import FFI.JS.BigI as BigI
open BigI using (BigI; bigI)

import Crypto.JS.BigI.ZqZp as ZqZp

-- TODO dynamise me
primality-test-probability-bound : Number
primality-test-probability-bound = readNumber "10"

-- TODO: check if this is large enough
min-bits-q : Number
min-bits-q = 256N

min-bits-p : Number
min-bits-p = 2048N

bigdec : JSValue → BigI
bigdec v = bigI (castString v) "10"

record ZK-chaum-pedersen-pok-elgamal-rnd (ℤq ℤp★ : Set) : Set where
  field
    m c s : ℤq
    g p q y α β A B : ℤp★

zk-check-chaum-pedersen-pok-elgamal-rnd! : ZK-chaum-pedersen-pok-elgamal-rnd BigI BigI → JS!
zk-check-chaum-pedersen-pok-elgamal-rnd! pf
      = trace "g=" g λ _ →
        trace "p=" I.p λ _ →
        trace "q=" I.q λ _ →
        trace "y=" y λ _ →
        trace "α=" α λ _ →
        trace "β=" β λ _ →
        trace "m=" m λ _ →
        trace "M=" M λ _ →
        trace "A=" A λ _ →
        trace "B=" B λ _ →
        trace "c=" c λ _ →
        trace "s=" s λ _ →
         checks!
      >> check! "g^s==A·α^c"     ((g ^ s) == (A · (α ^ c)))        (λ _ → "")
      >> check! "y^s==B·(β/M)^c" ((y ^ s) == (B · ((β ·/ M) ^ c))) (λ _ → "")
  module ZK-check-chaum-pedersen-pok-elgamal-rnd where
    module I = ZK-chaum-pedersen-pok-elgamal-rnd pf
    params = record
      { primality-test-probability-bound = primality-test-probability-bound
      ; min-bits-q = min-bits-q
      ; min-bits-p = min-bits-p
      ; qI = I.q
      ; pI = I.p
      ; gI = I.g
      }
    open module [ℤq]ℤp★ = ZqZp params
    A = BigI▹ℤp★ I.A
    B = BigI▹ℤp★ I.B
    α = BigI▹ℤp★ I.α
    β = BigI▹ℤp★ I.β
    y = BigI▹ℤp★ I.y
    s = BigI▹ℤq  I.s
    c = BigI▹ℤq  I.c
    m = BigI▹ℤq  I.m
    M = g ^ m

zk-check! : JSValue → JS!
zk-check! arg =
    check! "type of statement" (typ === fromString cpt)
                               (λ _ → "Expected type of statement: " ++ cpt ++ " not " ++ toString typ)
 >> zk-check-chaum-pedersen-pok-elgamal-rnd! pok
 module Zk-check where
    cpt = "chaum-pedersen-pok-elgamal-rnd"
    stm = arg ·« "statement" »
    typ = stm ·« "type" »
    dat = stm ·« "data" »
    g   = bigdec (dat ·« "g" »)
    p   = bigdec (dat ·« "p" »)
    q   = bigdec (dat ·« "q" »)
    y   = bigdec (dat ·« "y" »)
    m   = bigdec (dat ·« "plain" »)
    enc = dat ·« "enc" »
    α   = bigdec (enc ·« "alpha" »)
    β   = bigdec (enc ·« "beta"  »)
    prf = arg ·« "proof" »
    com = prf ·« "commitment" »
    A   = bigdec (com ·« "A" »)
    B   = bigdec (com ·« "B" »)
    c   = bigdec (prf ·« "challenge" »)
    s   = bigdec (prf ·« "response" »)
    pok = record { g = g; p = p; q = q; y = y; α = α; β = β; A = A; B = B; c = c; s = s; m = m }

{-
srv : URI → JSProc
srv d =
  recv d λ q →
  send d (fromBool (zk-check q))
  end
-}

-- Working around Agda.Primitive.lsuc being undefined
-- case_of_ : {A : Set} {B : Set} → A → (A → B) → B
-- case x of f = f x

main : JS!
main =
  Process.argv !₁ λ args →
  case JSArray▹ListString args of λ {
    (_node ∷ _run ∷ _test ∷ args') →
      case args' of λ {
        [] →
        Console.log "usage: No arguments"
        {- server "127.0.0.1" "1337" srv !₁ λ uri →
           Console.log (showURI uri)
         -}
      ; (arg ∷ args'') →
          case args'' of λ {
            [] →
              Console.log ("Reading input file: " ++ arg) >>
              FS.readFile arg nullJS !₂ λ err dat →
                check! "reading input file" (is-null err)
                       (λ _ → "readFile error: " ++ toString err) >>
                zk-check! (JSON-parse (toString dat))
          ; _ →
              Console.log "usage: Too many arguments"
          }
      }
  ; _ →
      Console.log "usage"
  }
-- -}
-- -}
-- -}
-- -}

{-# OPTIONS --without-K #-}
module ZK.JSChecker where

open import Function         using (id; _∘′_; case_of_)
open import Data.Bool.Base   using (Bool; true; false; _∧_)
open import Data.List.Base   using (List; []; _∷_; and; foldr)
open import Data.String.Base using (String)

open import FFI.JS
open import FFI.JS.Check
-- open import FFI.JS.Proc using (URI; JSProc; showURI; server)
-- open import Control.Process.Type
import FFI.JS.Console as Console
import FFI.JS.Process as Process
import FFI.JS.FS as FS

import FFI.JS.BigI as BigI
open BigI using (BigI; bigI)

import Crypto.JS.BigI.ZqZp as ZqZp

-- TODO dynamise me
primality-test-probability-bound : Number
primality-test-probability-bound = readNumber "10"

-- TODO: check if this is large enough
min-bits-q : Number
min-bits-q = 256N

min-bits-p : Number
min-bits-p = 2048N

bigdec : JSValue → BigI
bigdec v = bigI (castString v) "10"

-- TODO bug (undefined)!
record ZK-chaum-pedersen-pok-elgamal-rnd {--(ℤq ℤp★ : Set)--} : Set where
  field
    m c s : BigI {--ℤq--}
    g p q y α β A B : BigI --ℤp★

zk-check-chaum-pedersen-pok-elgamal-rnd! : ZK-chaum-pedersen-pok-elgamal-rnd {-BigI BigI-} → JS!
zk-check-chaum-pedersen-pok-elgamal-rnd! pf
      = trace "g=" g λ _ →
        trace "p=" I.p λ _ →
        trace "q=" I.q λ _ →
        trace "y=" y λ _ →
        trace "α=" α λ _ →
        trace "β=" β λ _ →
        trace "m=" m λ _ →
        trace "M=" M λ _ →
        trace "A=" A λ _ →
        trace "B=" B λ _ →
        trace "c=" c λ _ →
        trace "s=" s λ _ →
         checks!
      >> check! "g^s==A·α^c"     ((g ^ s) == (A · (α ^ c)))        (λ _ → "")
      >> check! "y^s==B·(β/M)^c" ((y ^ s) == (B · ((β ·/ M) ^ c))) (λ _ → "")
  module ZK-check-chaum-pedersen-pok-elgamal-rnd where
    module I = ZK-chaum-pedersen-pok-elgamal-rnd pf
    params = record
      { primality-test-probability-bound = primality-test-probability-bound
      ; min-bits-q = min-bits-q
      ; min-bits-p = min-bits-p
      ; qI = I.q
      ; pI = I.p
      ; gI = I.g
      }
    open module [ℤq]ℤp★ = ZqZp params
    A = BigI▹ℤp★ I.A
    B = BigI▹ℤp★ I.B
    α = BigI▹ℤp★ I.α
    β = BigI▹ℤp★ I.β
    y = BigI▹ℤp★ I.y
    s = BigI▹ℤq  I.s
    c = BigI▹ℤq  I.c
    m = BigI▹ℤq  I.m
    M = g ^ m

zk-check! : JSValue → JS!
zk-check! arg =
    check! "type of statement" (typ === fromString cpt)
                               (λ _ → "Expected type of statement: " ++ cpt ++ " not " ++ toString typ)
 >> zk-check-chaum-pedersen-pok-elgamal-rnd! pok
 module Zk-check where
    cpt = "chaum-pedersen-pok-elgamal-rnd"
    stm = arg ·« "statement" »
    typ = stm ·« "type" »
    dat = stm ·« "data" »
    g   = bigdec (dat ·« "g" »)
    p   = bigdec (dat ·« "p" »)
    q   = bigdec (dat ·« "q" »)
    y   = bigdec (dat ·« "y" »)
    m   = bigdec (dat ·« "plain" »)
    enc = dat ·« "enc" »
    α   = bigdec (enc ·« "alpha" »)
    β   = bigdec (enc ·« "beta"  »)
    prf = arg ·« "proof" »
    com = prf ·« "commitment" »
    A   = bigdec (com ·« "A" »)
    B   = bigdec (com ·« "B" »)
    c   = bigdec (prf ·« "challenge" »)
    s   = bigdec (prf ·« "response" »)
    pok = record { g = g; p = p; q = q; y = y; α = α; β = β; A = A; B = B; c = c; s = s; m = m }

{-
srv : URI → JSProc
srv d =
  recv d λ q →
  send d (fromBool (zk-check q))
  end
-}

-- Working around Agda.Primitive.lsuc being undefined
-- case_of_ : {A : Set} {B : Set} → A → (A → B) → B
-- case x of f = f x

main : JS!
main =
  Process.argv !₁ λ args →
  case JSArray▹ListString args of λ {
    (_node ∷ _run ∷ _test ∷ args') →
      case args' of λ {
        [] →
        Console.log "usage: No arguments"
        {- server "127.0.0.1" "1337" srv !₁ λ uri →
           Console.log (showURI uri)
         -}
      ; (arg ∷ args'') →
          case args'' of λ {
            [] →
              Console.log ("Reading input file: " ++ arg) >>
              FS.readFile arg nullJS !₂ λ err dat →
                check! "reading input file" (is-null err)
                       (λ _ → "readFile error: " ++ toString err) >>
                zk-check! (JSON-parse (toString dat))
          ; _ →
              Console.log "usage: Too many arguments"
          }
      }
  ; _ →
      Console.log "usage"
  }
-- -}
-- -}
-- -}
-- -}


Added doc.

Added doc.

Ignore-this: 4508bb8c9230c5e134fb68a3f18e1b46

darcs-hash:20120223034355-3bd4e-d6cf87bc79b145b0863c84b642a1ac9363302e23.gz

------------------------------------------------------------------------------
-- FOT (First Order Theories)
------------------------------------------------------------------------------

-- Code accompanying the paper Combining Interactive and Automatic
-- Reasoning in First Order Theories of Functional Programs by Ana
-- Bove, Peter Dybjer, and Andrés Sicard-Ramírez (FoSSaCS 2012).

-- The code presented here does not match the paper exactly.

module README where

------------------------------------------------------------------------------
-- Description

-- Examples of the formalization of first order theories showing the
-- combination of interactive proofs with automatics proofs carried
-- out by first order automatic theorem provers (ATPs).

------------------------------------------------------------------------------
-- Prerequisites, tested versions of the ATPS, and use

-- See http://www1.eafit.edu.co/asicard/code/fossacs-2012/.

------------------------------------------------------------------------------
-- Conventions

-- The following modules show the formalization of some first order
-- theories. If the module's name ends in 'I' the module contains
-- interactive proofs, if it ends in 'ATP' the module contains
-- combined proofs, otherwise the module contains definions and/or
-- interactive proofs that are used by the interactive and combined
-- proofs.

------------------------------------------------------------------------------
-- First order theories
------------------------------------------------------------------------------

-- 1. Predicate logic

-- 1.1 Definition of the connectives and quantifiers
open import PredicateLogic.Base

-- 1.2 Propositional logic theorems
open import PredicateLogic.Propositional.TheoremsATP
open import PredicateLogic.Propositional.TheoremsI

-- 1.3 Predicate logic theorems
open import PredicateLogic.TheoremsATP
open import PredicateLogic.TheoremsI

-- 1.4 Logical schemata
open import PredicateLogic.SchemataATP

-- 1.5 Non-empty domains
open import PredicateLogic.NonEmptyDomain.TheoremsATP
open import PredicateLogic.NonEmptyDomain.TheoremsI

-- 1.6 Classical predicate logic theorems
open import PredicateLogic.ClassicalATP
open import PredicateLogic.ClassicalI

------------------------------------------------------------------------------
-- 2. Equality

-- 2.1 Definition of equality and some properties about it
open import FOL.Relation.Binary.PropositionalEquality

-- 2.2 The equality reasoning
open import FOL.Relation.Binary.EqReasoning

------------------------------------------------------------------------------
-- 3. Group theory

-- 3.1 The axioms
open import GroupTheory.Base

-- 3.2 Basic properties
open import GroupTheory.PropertiesATP
open import GroupTheory.PropertiesI

-- 3.3 Commutator properties
open import GroupTheory.Commutator.PropertiesATP
open import GroupTheory.Commutator.PropertiesI

-- 3.4 Abelian groups
open import GroupTheory.AbelianGroup.PropertiesATP

------------------------------------------------------------------------------
-- 4. Stanovský example (distributive laws on a binary operation)

-- We prove the proposition 2 (task B) of [1]. Let _·_ be a
-- left-associative binary operation, the task B consist in given the
-- left and right distributive axioms

--   ∀ x y z → x ∙ (y ∙ z) ≡ (x ∙ y) ∙ (x ∙ z)
--   ∀ x y z → (x ∙ y) ∙ z ≡ (x ∙ z) ∙ (y ∙ z)

-- to prove the theorem

--   ∀ u x y z → (x ∙ y ∙ (z ∙ u)) ∙
--               (( x ∙ y ∙ ( z ∙ u)) ∙ (x ∙ z ∙ (y ∙ u))) ≡
--               x ∙ z ∙ (y ∙ u)

-- [1] David Stanovský. Distributive groupoids are symmetrical-by-medial:
--     An elementary proof. Commentations Mathematicae Universitatis
--     Carolinae, 49(4):541–546, 2008.

-- 4.1 The ATPs could not prove the theorem
open import DistributiveLaws.TaskB-ATP

-- 4.2 The interactive and combined proofs
open import DistributiveLaws.TaskB-HalvedStepsATP
open import DistributiveLaws.TaskB-I
open import DistributiveLaws.TaskB-TopDownATP

------------------------------------------------------------------------------
-- 5. Peano arithmetic (PA)

-- We write two formalizations of PA. In the axiomatic formalization
-- we use Agda postulates for Peano's axioms. In the inductive
-- formalization, we use Agda data types and primitive recursive
-- functions.

-- 5.1 Axiomatic PA
-- 5.1.1 The axioms
open import PA.Axiomatic.Standard.Base

-- 5.1.2 Some properties
open import PA.Axiomatic.Standard.PropertiesATP
open import PA.Axiomatic.Standard.PropertiesI

-- 5.2. Inductive PA
-- 5.2.1 Some properties
open import PA.Inductive.Properties
open import PA.Inductive.PropertiesATP
open import PA.Inductive.PropertiesI

open import PA.Inductive.PropertiesByInduction
open import PA.Inductive.PropertiesByInductionATP
open import PA.Inductive.PropertiesByInductionI

------------------------------------------------------------------------------
-- 6. FOTC

-- Formalization of (a version of) Azcel's First Order Theory of Combinators.

-- 6.1 The axioms
open import FOTC.Base

-- 6.2 Booleans

-- 6.2.1 The axioms
open import FOTC.Data.Bool

-- 6.2.2 The inductive predicate
open import FOTC.Data.Bool.Type

-- 6.2.3 Properties
open import FOTC.Data.Bool.PropertiesATP
open import FOTC.Data.Bool.PropertiesI

-- 6.3. Natural numbers

-- 6.3.1 The axioms
open import FOTC.Data.Nat

-- 6.3.2 The inductive predicate
open import FOTC.Data.Nat.Type

-- 6.3.3 Properties
open import FOTC.Data.Nat.PropertiesATP
open import FOTC.Data.Nat.PropertiesI

open import FOTC.Data.Nat.PropertiesByInductionATP
open import FOTC.Data.Nat.PropertiesByInductionI

-- 6.3.4 Divisibility relation
open import FOTC.Data.Nat.Divisibility.By0.Properties
open import FOTC.Data.Nat.Divisibility.By0.PropertiesATP
open import FOTC.Data.Nat.Divisibility.By0.PropertiesI
open import FOTC.Data.Nat.Divisibility.NotBy0.Properties
open import FOTC.Data.Nat.Divisibility.NotBy0.PropertiesATP
open import FOTC.Data.Nat.Divisibility.NotBy0.PropertiesI

-- 6.3.5 Induction
open import FOTC.Data.Nat.Induction.Acc.WellFoundedInductionI
open import FOTC.Data.Nat.Induction.NonAcc.LexicographicI

-- 6.3.6 Inequalites
open import FOTC.Data.Nat.Inequalities.EliminationProperties
open import FOTC.Data.Nat.Inequalities.PropertiesATP
open import FOTC.Data.Nat.Inequalities.PropertiesI

-- 6.3.7 Unary numbers
open import FOTC.Data.Nat.UnaryNumbers.Inequalities.PropertiesATP
open import FOTC.Data.Nat.UnaryNumbers.TotalityATP

-- 6.4 Lists

-- 6.4.1 The axioms
open import FOTC.Data.List

-- 6.4.2 The inductive predicate
open import FOTC.Data.List.Type

-- 6.4.3 Properties
open import FOTC.Data.List.PropertiesATP
open import FOTC.Data.List.PropertiesI

-- 6.4.4 Well-founded induction
open import FOTC.Data.List.LT-Cons.Induction.Acc.WellFoundedInductionI
open import FOTC.Data.List.LT-Cons.PropertiesI
open import FOTC.Data.List.LT-Length.Induction.Acc.WellFoundedInductionI
open import FOTC.Data.List.LT-Length.PropertiesI

-- 6.4.5 Lists of natural numbers

-- 6.4.5.1 The inductive predicate
open import FOTC.Data.Nat.List.Type

-- 6.4.5.2 Properties
open import FOTC.Data.Nat.List.PropertiesATP
open import FOTC.Data.Nat.List.PropertiesI

-- 6.5 Coinductive natural numbers

-- 6.5.1 The coinductive predicate
open import FOTC.Data.Conat

-- 6.5.2 Equality on coinductive natural numbers
open import FOTC.Data.Conat.Equality

-- 6.5.3 Properties
open import FOTC.Data.Conat.PropertiesI

-- 6.6 Streams

-- 6.6.1 The coinductive predicate (axioms)
open import FOTC.Data.Stream

-- 6.6.2 Equality on streams
open import FOTC.Data.Stream.Equality
open import FOTC.Data.Stream.Equality.PropertiesATP
open import FOTC.Data.Stream.Equality.PropertiesI

-- 6.6.3 Properties
open import FOTC.Data.Stream.PropertiesATP
open import FOTC.Data.Stream.PropertiesI

-- 6.7 Programs

-- 6.7.1 The Collatz function: A function without a termination proof
open import FOTC.Program.Collatz.PropertiesATP
open import FOTC.Program.Collatz.PropertiesI

-- 6.7.2 The GCD algorithm: A non-structurally recursive algorithm
open import FOTC.Program.GCD.Partial.ProofSpecificationATP
open import FOTC.Program.GCD.Partial.ProofSpecificationI
open import FOTC.Program.GCD.Total.ProofSpecificationATP
open import FOTC.Program.GCD.Total.ProofSpecificationI

-- 6.7.3 The McCarthy 91 function: A function with nested recursion
open import FOTC.Program.McCarthy91.Properties.MainATP

-- 6.7.4 The mirror function: A function with higher-order recursion
open import FOTC.Program.Mirror.PropertiesATP
open import FOTC.Program.Mirror.PropertiesI

-- 6.7.5 Burstall's sort list algorithm: A structurally recursive algorithm
open import FOTC.Program.SortList.ProofSpecificationATP
open import FOTC.Program.SortList.ProofSpecificationI

-- 6.7.6 The division algorithm: A non-structurally recursive algorithm
open import FOTC.Program.Division.ProofSpecificationATP
open import FOTC.Program.Division.ProofSpecificationI

-- 6.7.7 The map-iterate property: A property using coinduction
open import FOTC.Program.MapIterate.MapIterateATP

-- 6.7.8 The alternating bit protocol: A program using co-inductive types
open import FOTC.Program.ABP.ProofSpecificationATP
open import FOTC.Program.ABP.ProofSpecificationI

-- 6.8 Other modules
-- (These modules are not imported from any module).
open import FOTC.Program.Division.EquationsATP
open import FOTC.Program.GCD.Partial.EquationsATP
open import FOTC.Program.GCD.Total.EquationsATP

------------------------------------------------------------------------------
-- LTC-PCF (Almost a first order theory)

-- Formalization of (a version of) Azcel's Logical Theory of Constructions.
-- N.B. This was the theory shown in our PLPV'09 paper.

-- 7.1. The axioms
open import LTC-PCF.Base

-- 7.2. Natural numberes

-- 7.2.1 The axioms
open import LTC-PCF.Data.Nat

-- 7.2.2 The inductive predicate
open import LTC-PCF.Data.Nat.Type

-- 7.2.3 Properties
open import LTC-PCF.Data.Nat.PropertiesATP
open import LTC-PCF.Data.Nat.PropertiesI

-- 7.2.4 Divisibility relation
open import LTC-PCF.Data.Nat.Divisibility.NotBy0.Properties
open import LTC-PCF.Data.Nat.Divisibility.NotBy0.PropertiesATP
open import LTC-PCF.Data.Nat.Divisibility.NotBy0.PropertiesI

-- 7.2.5 Induction
open import LTC-PCF.Data.Nat.Induction.NonAcc.LexicographicI
open import LTC-PCF.Data.Nat.Induction.NonAcc.WellFoundedInductionI

-- 7.2.6 Inequalites
open import LTC-PCF.Data.Nat.Inequalities.EliminationProperties
open import LTC-PCF.Data.Nat.Inequalities.PropertiesATP
open import LTC-PCF.Data.Nat.Inequalities.PropertiesI

-- 7.2.7 The recursive operator
open import LTC-PCF.Data.Nat.Rec.EquationsATP
open import LTC-PCF.Data.Nat.Rec.EquationsI

-- 7.2.8 A looping combinator
open import LTC-PCF.Loop

-- 7.3 Programs

-- 7.3.1 The division algorithm: A non-structurally recursive algorithm
open import LTC-PCF.Program.Division.ProofSpecificationATP
open import LTC-PCF.Program.Division.ProofSpecificationI

-- 7.3.2 The GCD algorithm: A non-structurally recursive algorithm
open import LTC-PCF.Program.GCD.Partial.ProofSpecificationATP
open import LTC-PCF.Program.GCD.Partial.ProofSpecificationI

------------------------------------------------------------------------------
-- ATPs failures
------------------------------------------------------------------------------

-- The ATPs (E, Equinox, Metis, SPASS and Vampire) could not prove some
-- theorems.

open import DistributiveLaws.TaskB-ATP
open import FOTC.Program.ABP.MayorPremiseATP

------------------------------------------------------------------------------
-- Agsy examples
------------------------------------------------------------------------------

-- We cannot import the Agsy examples because some modules contain
-- unsolved metas, therefore see src/Agsy/README.txt

------------------------------------------------------------------------------
-- FOT (First Order Theories)
------------------------------------------------------------------------------

-- Code accompanying the paper Combining Interactive and Automatic
-- Reasoning in First Order Theories of Functional Programs by Ana
-- Bove, Peter Dybjer, and Andrés Sicard-Ramírez (FoSSaCS 2012).

-- The code presented here does not match the paper exactly.

module README where

------------------------------------------------------------------------------
-- Description

-- Examples of the formalization of first order theories showing the
-- combination of interactive proofs with automatics proofs carried
-- out by first order automatic theorem provers (ATPs).

------------------------------------------------------------------------------
-- Prerequisites and use

-- See http://www1.eafit.edu.co/asicard/code/fossacs-2012/.

------------------------------------------------------------------------------
-- Conventions

-- The following modules show the formalization of some first order
-- theories. If the module's name ends in 'I' the module contains
-- interactive proofs, if it ends in 'ATP' the module contains
-- combined proofs, otherwise the module contains definions and/or
-- interactive proofs that are used by the interactive and combined
-- proofs.

------------------------------------------------------------------------------
-- First order theories
------------------------------------------------------------------------------

-- 1. Predicate logic

-- 1.1 Definition of the connectives and quantifiers
open import PredicateLogic.Base

-- 1.2 Propositional logic theorems
open import PredicateLogic.Propositional.TheoremsATP
open import PredicateLogic.Propositional.TheoremsI

-- 1.3 Predicate logic theorems
open import PredicateLogic.TheoremsATP
open import PredicateLogic.TheoremsI

-- 1.4 Logical schemata
open import PredicateLogic.SchemataATP

-- 1.5 Non-empty domains
open import PredicateLogic.NonEmptyDomain.TheoremsATP
open import PredicateLogic.NonEmptyDomain.TheoremsI

-- 1.6 Classical predicate logic theorems
open import PredicateLogic.ClassicalATP
open import PredicateLogic.ClassicalI

------------------------------------------------------------------------------
-- 2. Equality

-- 2.1 Definition of equality and some properties about it
open import FOL.Relation.Binary.PropositionalEquality

-- 2.2 The equality reasoning
open import FOL.Relation.Binary.EqReasoning

------------------------------------------------------------------------------
-- 3. Group theory

-- 3.1 The axioms
open import GroupTheory.Base

-- 3.2 Basic properties
open import GroupTheory.PropertiesATP
open import GroupTheory.PropertiesI

-- 3.3 Commutator properties
open import GroupTheory.Commutator.PropertiesATP
open import GroupTheory.Commutator.PropertiesI

-- 3.4 Abelian groups
open import GroupTheory.AbelianGroup.PropertiesATP

------------------------------------------------------------------------------
-- 4. Stanovský example (distributive laws on a binary operation)

-- We prove the proposition 2 (task B) of [1]. Let _·_ be a
-- left-associative binary operation, the task B consist in given the
-- left and right distributive axioms

--   ∀ x y z → x ∙ (y ∙ z) ≡ (x ∙ y) ∙ (x ∙ z)
--   ∀ x y z → (x ∙ y) ∙ z ≡ (x ∙ z) ∙ (y ∙ z)

-- to prove the theorem

--   ∀ u x y z → (x ∙ y ∙ (z ∙ u)) ∙
--               (( x ∙ y ∙ ( z ∙ u)) ∙ (x ∙ z ∙ (y ∙ u))) ≡
--               x ∙ z ∙ (y ∙ u)

-- [1] David Stanovský. Distributive groupoids are symmetrical-by-medial:
--     An elementary proof. Commentations Mathematicae Universitatis
--     Carolinae, 49(4):541–546, 2008.

-- 4.1 The ATPs could not prove the theorem
open import DistributiveLaws.TaskB-ATP

-- 4.2 The interactive and combined proofs
open import DistributiveLaws.TaskB-HalvedStepsATP
open import DistributiveLaws.TaskB-I
open import DistributiveLaws.TaskB-TopDownATP

------------------------------------------------------------------------------
-- 5. Peano arithmetic (PA)

-- We write two formalizations of PA. In the axiomatic formalization
-- we use Agda postulates for Peano's axioms. In the inductive
-- formalization, we use Agda data types and primitive recursive
-- functions.

-- 5.1 Axiomatic PA
-- 5.1.1 The axioms
open import PA.Axiomatic.Standard.Base

-- 5.1.2 Some properties
open import PA.Axiomatic.Standard.PropertiesATP
open import PA.Axiomatic.Standard.PropertiesI

-- 5.2. Inductive PA
-- 5.2.1 Some properties
open import PA.Inductive.Properties
open import PA.Inductive.PropertiesATP
open import PA.Inductive.PropertiesI

open import PA.Inductive.PropertiesByInduction
open import PA.Inductive.PropertiesByInductionATP
open import PA.Inductive.PropertiesByInductionI

------------------------------------------------------------------------------
-- 6. FOTC

-- Formalization of (a version of) Azcel's First Order Theory of Combinators.

-- 6.1 The axioms
open import FOTC.Base

-- 6.2 Booleans

-- 6.2.1 The axioms
open import FOTC.Data.Bool

-- 6.2.2 The inductive predicate
open import FOTC.Data.Bool.Type

-- 6.2.3 Properties
open import FOTC.Data.Bool.PropertiesATP
open import FOTC.Data.Bool.PropertiesI

-- 6.3. Natural numbers

-- 6.3.1 The axioms
open import FOTC.Data.Nat

-- 6.3.2 The inductive predicate
open import FOTC.Data.Nat.Type

-- 6.3.3 Properties
open import FOTC.Data.Nat.PropertiesATP
open import FOTC.Data.Nat.PropertiesI

open import FOTC.Data.Nat.PropertiesByInductionATP
open import FOTC.Data.Nat.PropertiesByInductionI

-- 6.3.4 Divisibility relation
open import FOTC.Data.Nat.Divisibility.By0.Properties
open import FOTC.Data.Nat.Divisibility.By0.PropertiesATP
open import FOTC.Data.Nat.Divisibility.By0.PropertiesI
open import FOTC.Data.Nat.Divisibility.NotBy0.Properties
open import FOTC.Data.Nat.Divisibility.NotBy0.PropertiesATP
open import FOTC.Data.Nat.Divisibility.NotBy0.PropertiesI

-- 6.3.5 Induction
open import FOTC.Data.Nat.Induction.Acc.WellFoundedInductionI
open import FOTC.Data.Nat.Induction.NonAcc.LexicographicI

-- 6.3.6 Inequalites
open import FOTC.Data.Nat.Inequalities.EliminationProperties
open import FOTC.Data.Nat.Inequalities.PropertiesATP
open import FOTC.Data.Nat.Inequalities.PropertiesI

-- 6.3.7 Unary numbers
open import FOTC.Data.Nat.UnaryNumbers.Inequalities.PropertiesATP
open import FOTC.Data.Nat.UnaryNumbers.TotalityATP

-- 6.4 Lists

-- 6.4.1 The axioms
open import FOTC.Data.List

-- 6.4.2 The inductive predicate
open import FOTC.Data.List.Type

-- 6.4.3 Properties
open import FOTC.Data.List.PropertiesATP
open import FOTC.Data.List.PropertiesI

-- 6.4.4 Well-founded induction
open import FOTC.Data.List.LT-Cons.Induction.Acc.WellFoundedInductionI
open import FOTC.Data.List.LT-Cons.PropertiesI
open import FOTC.Data.List.LT-Length.Induction.Acc.WellFoundedInductionI
open import FOTC.Data.List.LT-Length.PropertiesI

-- 6.4.5 Lists of natural numbers

-- 6.4.5.1 The inductive predicate
open import FOTC.Data.Nat.List.Type

-- 6.4.5.2 Properties
open import FOTC.Data.Nat.List.PropertiesATP
open import FOTC.Data.Nat.List.PropertiesI

-- 6.5 Coinductive natural numbers

-- 6.5.1 The coinductive predicate
open import FOTC.Data.Conat

-- 6.5.2 Equality on coinductive natural numbers
open import FOTC.Data.Conat.Equality

-- 6.5.3 Properties
open import FOTC.Data.Conat.PropertiesI

-- 6.6 Streams

-- 6.6.1 The coinductive predicate (axioms)
open import FOTC.Data.Stream

-- 6.6.2 Equality on streams
open import FOTC.Data.Stream.Equality
open import FOTC.Data.Stream.Equality.PropertiesATP
open import FOTC.Data.Stream.Equality.PropertiesI

-- 6.6.3 Properties
open import FOTC.Data.Stream.PropertiesATP
open import FOTC.Data.Stream.PropertiesI

-- 6.7 Programs

-- 6.7.1 The Collatz function: A function without a termination proof
open import FOTC.Program.Collatz.PropertiesATP
open import FOTC.Program.Collatz.PropertiesI

-- 6.7.2 The GCD algorithm: A non-structurally recursive algorithm
open import FOTC.Program.GCD.Partial.ProofSpecificationATP
open import FOTC.Program.GCD.Partial.ProofSpecificationI
open import FOTC.Program.GCD.Total.ProofSpecificationATP
open import FOTC.Program.GCD.Total.ProofSpecificationI

-- 6.7.3 The McCarthy 91 function: A function with nested recursion
open import FOTC.Program.McCarthy91.Properties.MainATP

-- 6.7.4 The mirror function: A function with higher-order recursion
open import FOTC.Program.Mirror.PropertiesATP
open import FOTC.Program.Mirror.PropertiesI

-- 6.7.5 Burstall's sort list algorithm: A structurally recursive algorithm
open import FOTC.Program.SortList.ProofSpecificationATP
open import FOTC.Program.SortList.ProofSpecificationI

-- 6.7.6 The division algorithm: A non-structurally recursive algorithm
open import FOTC.Program.Division.ProofSpecificationATP
open import FOTC.Program.Division.ProofSpecificationI

-- 6.7.7 The map-iterate property: A property using coinduction
open import FOTC.Program.MapIterate.MapIterateATP

-- 6.7.8 The alternating bit protocol: A program using co-inductive types
open import FOTC.Program.ABP.ProofSpecificationATP
open import FOTC.Program.ABP.ProofSpecificationI

-- 6.8 Other modules
-- (These modules are not imported from any module).
open import FOTC.Program.Division.EquationsATP
open import FOTC.Program.GCD.Partial.EquationsATP
open import FOTC.Program.GCD.Total.EquationsATP

------------------------------------------------------------------------------
-- LTC-PCF (Almost a first order theory)

-- Formalization of (a version of) Azcel's Logical Theory of Constructions.
-- N.B. This was the theory shown in our PLPV'09 paper.

-- 7.1. The axioms
open import LTC-PCF.Base

-- 7.2. Natural numberes

-- 7.2.1 The axioms
open import LTC-PCF.Data.Nat

-- 7.2.2 The inductive predicate
open import LTC-PCF.Data.Nat.Type

-- 7.2.3 Properties
open import LTC-PCF.Data.Nat.PropertiesATP
open import LTC-PCF.Data.Nat.PropertiesI

-- 7.2.4 Divisibility relation
open import LTC-PCF.Data.Nat.Divisibility.NotBy0.Properties
open import LTC-PCF.Data.Nat.Divisibility.NotBy0.PropertiesATP
open import LTC-PCF.Data.Nat.Divisibility.NotBy0.PropertiesI

-- 7.2.5 Induction
open import LTC-PCF.Data.Nat.Induction.NonAcc.LexicographicI
open import LTC-PCF.Data.Nat.Induction.NonAcc.WellFoundedInductionI

-- 7.2.6 Inequalites
open import LTC-PCF.Data.Nat.Inequalities.EliminationProperties
open import LTC-PCF.Data.Nat.Inequalities.PropertiesATP
open import LTC-PCF.Data.Nat.Inequalities.PropertiesI

-- 7.2.7 The recursive operator
open import LTC-PCF.Data.Nat.Rec.EquationsATP
open import LTC-PCF.Data.Nat.Rec.EquationsI

-- 7.2.8 A looping combinator
open import LTC-PCF.Loop

-- 7.3 Programs

-- 7.3.1 The division algorithm: A non-structurally recursive algorithm
open import LTC-PCF.Program.Division.ProofSpecificationATP
open import LTC-PCF.Program.Division.ProofSpecificationI

-- 7.3.2 The GCD algorithm: A non-structurally recursive algorithm
open import LTC-PCF.Program.GCD.Partial.ProofSpecificationATP
open import LTC-PCF.Program.GCD.Partial.ProofSpecificationI

------------------------------------------------------------------------------
-- ATPs failures
------------------------------------------------------------------------------

-- The ATPs (E, Equinox, Metis, SPASS and Vampire) could not prove some
-- theorems.

open import DistributiveLaws.TaskB-ATP
open import FOTC.Program.ABP.MayorPremiseATP

------------------------------------------------------------------------------
-- Agsy examples
------------------------------------------------------------------------------

-- We cannot import the Agsy examples because some modules contain
-- unsolved metas, therefore see src/Agsy/README.txt