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

open import Prelude
open import GSeTT.Syntax
open import GSeTT.Rules
open import GSeTT.Uniqueness-Derivations

module MCaTT.Desuspension where

  ↓GC : ∀ (Γ : Pre-Ctx) → Γ ⊢C → Pre-Ctx
  ↓GT : ∀ (Γ : Pre-Ctx) (A : Pre-Ty) → Γ ⊢T A → Pre-Ty
  ↓Gt : ∀ (Γ : Pre-Ctx) (A : Pre-Ty) (x : ℕ) → Γ ⊢t (Var x) # A → ℕ
  count-points : ∀ (Γ : Pre-Ctx) → ℕ

  ↓GC nil _ = nil
  ↓GC (Γ :: (x , ∗)) (cc Γ⊢ _ _) = ↓GC Γ Γ⊢
  ↓GC Γ+@(Γ :: (x , A@(_ ⇒[ _ ] _))) Γ+⊢@(cc Γ⊢ Γ⊢A _) = ↓GC Γ Γ⊢ :: (↓Gt Γ+ A x (var Γ+⊢ (inr (idp , idp))) , ↓GT Γ A Γ⊢A)

  ↓GT Γ ∗ Γ⊢∗ = ∗
  ↓GT Γ (_ ⇒[ ∗ ] _) _ = ∗
  ↓GT Γ (Var x ⇒[ A@(_ ⇒[ _ ] _) ] Var y) (ar Γ⊢A Γ⊢x Γ⊢y) = Var (↓Gt Γ A x Γ⊢x) ⇒[ ↓GT Γ A Γ⊢A ] Var (↓Gt Γ A y Γ⊢y)

  count-points nil = 0
  count-points (Γ :: (x , ∗)) = S (count-points Γ)
  count-points (Γ :: (x , _ ⇒[ _ ] _)) = count-points Γ

-- goes to Prelude
  _-_ : ℕ → ℕ → ℕ
  n - O = n
  O - S m = O
  S n - S m = n - m

  Sn-m : ∀ (n m : ℕ) → m ≤ n → (S n - m) == S (n - m)
  Sn-m n O _ = idp
  Sn-m O (S m) Sm≤0 = ⊥-elim (Sn≰0 _ Sm≤0)
  Sn-m (S n) (S m) (S≤ m≤n) = Sn-m n m m≤n
-- end of Prelude partA x₁ x₂

  ↓Gt (Γ :: (y , B)) A x (var _ (inr (_ , _))) = x - (count-points Γ)
  ↓Gt (Γ :: (y , B)) A x (var (cc Γ⊢ _ _) (inl x∈Γ)) = ↓Gt Γ A x (var Γ⊢ x∈Γ)

  count-points≤length : ∀ (Γ : Pre-Ctx) → count-points Γ ≤ length Γ
  count-points≤length nil = 0≤ 0
  count-points≤length (Γ :: (_ , ∗)) = S≤ (count-points≤length Γ)
  count-points≤length (Γ :: (_ , _ ⇒[ _ ] _)) = n≤m→n≤Sm (count-points≤length Γ)

  ↓length : ∀ (Γ : Pre-Ctx) (Γ⊢ : Γ ⊢C) → (length Γ - count-points Γ) == length (↓GC Γ Γ⊢)
  ↓length nil _ = idp
  ↓length (Γ :: (_ , ∗)) (cc Γ⊢ _ _) = ↓length Γ Γ⊢
  ↓length (Γ :: (x , _ ⇒[ _ ] _)) (cc Γ⊢ _ _) = Sn-m (length Γ) (count-points Γ) (count-points≤length Γ) >> ap S (↓length Γ Γ⊢)

  wk↓GT : ∀ (Γ : Pre-Ctx) (B : Pre-Ty) (y : ℕ) (A : Pre-Ty) (Γ⊢A : Γ ⊢T A) (Γ+⊢A : (Γ :: (y , B)) ⊢T A) → ↓GT Γ A Γ⊢A == ↓GT (Γ :: (y , B)) A Γ+⊢A
  wk↓Gt : ∀ (Γ : Pre-Ctx) (B : Pre-Ty) (y : ℕ) (x : ℕ) (A : Pre-Ty) (Γ⊢x : Γ ⊢t (Var x) # A) (Γ+⊢x : (Γ :: (y , B)) ⊢t (Var x) # A) → ↓Gt Γ A x Γ⊢x == ↓Gt (Γ :: (y , B)) A x Γ+⊢x

  wk↓GT Γ B y ∗ Γ⊢A Γ+⊢A = idp
  wk↓GT Γ B y (_ ⇒[ ∗ ] _) _ _ = idp
  wk↓GT Γ B y (Var x ⇒[ A@(_ ⇒[ _ ] _)] Var x') (ar Γ⊢A Γ⊢x Γ⊢x') (ar Γ+⊢A Γ+⊢x Γ+⊢x') = ⇒= (wk↓GT Γ B y A Γ⊢A Γ+⊢A) (Var= (wk↓Gt Γ B y x A Γ⊢x Γ+⊢x)) (Var= (wk↓Gt Γ B y x' A Γ⊢x' Γ+⊢x'))

  wk↓Gt (Γ :: (z , C)) B y x A (var (cc Γ⊢ _ _) (inl x∈Γ)) (var (cc Γ+⊢ _ _) (inl (inl x∈Γ+))) = wk↓Gt Γ C z x A (var Γ⊢ x∈Γ) (var Γ+⊢ (inl (x∈Γ+)))
  wk↓Gt (Γ :: (.(length Γ) , C)) B .(length (Γ :: (length Γ , C))) .(length Γ) .C (var (cc Γ⊢ _ idp) (inl x∈Γ)) (var (cc _ _ idp) (inl (inr (idp , idp)))) = ⊥-elim (lΓ∉Γ Γ⊢ x∈Γ)
  wk↓Gt (Γ :: (z , C)) B .(length (Γ :: (z , C))) .(length (Γ :: (z , C))) .B (var (cc Γ⊢ _ _) (inl x∈Γ)) (var (cc _ _ idp) (inr (idp , idp))) = ⊥-elim (n∉Γ Γ⊢ (n≤Sn _) x∈Γ)
  wk↓Gt (Γ :: (.(length Γ) , C)) B .(length (Γ :: (length Γ , C))) .(length Γ) .C (var (cc Γ⊢ _ idp) (inr (idp , idp))) (var (cc _ _ idp) (inl (inl lΓ∈Γ))) = ⊥-elim (lΓ∉Γ Γ⊢ lΓ∈Γ)
  wk↓Gt (Γ :: (.(length Γ) , C)) B .(length (Γ :: (length Γ , C))) .(length Γ) .C (var (cc Γ⊢ _ idp) (inr (idp , idp))) (var (cc _ _ idp) (inl (inr _))) = idp
  wk↓Gt (Γ :: (.(length Γ) , C)) B .(length (Γ :: (length Γ , C))) .(length Γ) .C (var (cc Γ⊢ _ idp) (inr (idp , idp))) (var (cc Γ+⊢ _ idp) (inr (contra , _))) = ⊥-elim (n≠Sn _ contra)

  ↓⊢C : ∀ (Γ : Pre-Ctx) (Γ⊢ : Γ ⊢C) → (↓GC Γ Γ⊢) ⊢C
  ↓⊢T : ∀ (Γ : Pre-Ctx) (A : Pre-Ty) (A≠∗ : A ≠ ∗) (Γ⊢ : Γ ⊢C) (Γ⊢A : Γ ⊢T A) → (↓GC Γ Γ⊢) ⊢T (↓GT Γ A Γ⊢A)
  ↓⊢t : ∀ (Γ : Pre-Ctx) (A : Pre-Ty) (x : ℕ) (A≠∗ : A ≠ ∗) (Γ⊢ : Γ ⊢C) (Γ⊢A : Γ ⊢T A) (Γ⊢x : Γ ⊢t (Var x) # A) → (↓GC Γ Γ⊢) ⊢t Var (↓Gt Γ A x Γ⊢x) # (↓GT Γ A Γ⊢A)

  ↓wkt : ∀ (Γ : Pre-Ctx) (C : Pre-Ty) (y : ℕ) {A B : Pre-Ty} {t u : Pre-Tm} (Γ⊢ : Γ ⊢C) (Γ+⊢ : (Γ :: (y , C)) ⊢C) (↓Γ⊢t : ↓GC Γ Γ⊢ ⊢t t # A) → A == B → t == u → ↓GC (Γ :: (y , C)) Γ+⊢ ⊢t u # B
  ↓wkt Γ ∗ y {A = A} {t = t} Γ⊢ (cc Γ⊢' _ _) ↓Γ⊢t idp idp = transport {B = λ p → ↓GC Γ p ⊢t t # A} (has-all-paths-⊢C Γ⊢ Γ⊢') ↓Γ⊢t
  ↓wkt Γ (_ ⇒[ C ] _) y {A = A} {t = t} Γ⊢ Γ+⊢@(cc Γ⊢' _ _) ↓Γ⊢t idp idp = wkt (transport {B = λ p → ↓GC Γ p ⊢t t # A} (has-all-paths-⊢C Γ⊢ Γ⊢') ↓Γ⊢t) (↓⊢C _ Γ+⊢)

  ↓⊢C nil ec = ec
  ↓⊢C (Γ :: (x , ∗)) (cc Γ⊢ _ _) = ↓⊢C Γ Γ⊢
  ↓⊢C (Γ :: (x , A@(_ ⇒[ _ ] _))) (cc Γ⊢ Γ⊢A idp) = cc (↓⊢C Γ Γ⊢) (↓⊢T Γ A (λ{()}) Γ⊢ Γ⊢A)  (↓length Γ Γ⊢)

  ↓⊢T Γ ∗ A≠∗ Γ⊢A = ⊥-elim (A≠∗ idp)
  ↓⊢T Γ (_ ⇒[ ∗ ] _) A≠∗ Γ⊢ (ar Γ⊢A _ _) = ob (↓⊢C Γ Γ⊢)
  ↓⊢T Γ (Var x ⇒[ A@(_ ⇒[ _ ] _) ] Var y) A≠∗ Γ⊢ (ar Γ⊢A Γ⊢x Γ⊢y) = ar (↓⊢T Γ A (λ{()}) Γ⊢ Γ⊢A) (↓⊢t Γ A x (λ{()}) Γ⊢ Γ⊢A Γ⊢x) (↓⊢t Γ A y (λ{()}) Γ⊢ Γ⊢A Γ⊢y)

  ↓⊢t (Γ :: (y , B)) A x A≠∗ Γ+⊢@(cc Γ⊢ x₁ x₂) Γ+⊢A Γ+⊢x@(var _ (inl x∈Γ)) =
    let Γ⊢x = var Γ⊢ x∈Γ in
    let Γ⊢A = Γ⊢t:A→Γ⊢A Γ⊢x in
    ↓wkt Γ B y Γ⊢ Γ+⊢ (↓⊢t Γ A x A≠∗ Γ⊢ Γ⊢A Γ⊢x) (wk↓GT Γ B y A Γ⊢A Γ+⊢A) (Var= (wk↓Gt Γ B y x A Γ⊢x Γ+⊢x))
  ↓⊢t Γ+@(Γ :: (x , ∗)) .∗ .x A≠∗ Γ+⊢@(cc _ _ _) Γ⊢A (var _ (inr (idp , idp))) = ⊥-elim (A≠∗ idp)
  ↓⊢t Γ+@(Γ :: (.(length Γ) , A@(_ ⇒[ _ ] _))) .(_ ⇒[ _ ] _) .(length Γ) A≠∗ Γ+⊢@(cc Γ⊢ Γ⊢A idp) Γ+⊢A@(ar _ _ _) (var (cc _ _ _) (inr (idp , idp))) =
    var (↓⊢C Γ+ Γ+⊢) (inr (idp , (wk↓GT Γ A (length Γ) A Γ⊢A Γ+⊢A ^)))


------------------------------------------------------------------------
-- Unit tests for Tactic.By.Parametrised
------------------------------------------------------------------------

-- Nothing is exported from this module.

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

open import Equality

module Tactic.By.Parametrised.Tests
  {c⁺} (eq : ∀ {a p} → Equality-with-J a p c⁺) where

open Derived-definitions-and-properties eq

open import Prelude

open import Maybe eq
open import Monad eq
open import TC-monad eq hiding (Type)

open import Tactic.By.Parametrised eq

------------------------------------------------------------------------
-- Some unit tests

private

  module Tests
    (assumption : 48 ≡ 42)
    (lemma      : ∀ n → n + 8 ≡ n + 2)
    (f          : ℕ → ℕ → ℕ → ℕ)
    where

    g : ℕ → ℕ → ℕ → ℕ
    g zero    _ _ = 12
    g (suc _) _ _ = 12

    fst : ∀ {a b} {A : Type a} {B : A → Type b} →
          Σ A B → A
    fst = proj₁

    {-# NOINLINE fst #-}

    record R (F : Type → Type) : Type₁ where
      field
        p : {A : Type} {x : F A} → x ≡ x

    open R ⦃ … ⦄ public

    test₁ : ⟨ 40 + 2 ⟩ ≡ 42
    test₁ = ⟨by⟩ refl

    test₂ : 48 ≡ 42 → ⟨ 42 ⟩ ≡ 48
    test₂ eq = ⟨by⟩ eq

    test₃ : (f : ℕ → ℕ) → f ⟨ 42 ⟩ ≡ f 48
    test₃ f = ⟨by⟩ assumption

    test₄ : (f : ℕ → ℕ) → f ⟨ 48 ⟩ ≡ f 42
    test₄ f = ⟨by⟩ assumption

    test₅ : (f : ℕ → ℕ → ℕ) → f ⟨ 42 ⟩ ⟨ 42 ⟩ ≡ f 48 48
    test₅ f = ⟨by⟩ assumption

    test₆ : (f : ℕ → ℕ → ℕ → ℕ) → f ⟨ 48 ⟩ 45 ⟨ 48 ⟩ ≡ f 42 45 42
    test₆ f = ⟨by⟩ assumption

    test₇ : f ⟨ 48 ⟩ (f ⟨ 48 ⟩ 45 ⟨ 48 ⟩) ⟨ 48 ⟩ ≡ f 42 (f 42 45 42) 42
    test₇ = ⟨by⟩ assumption

    test₈ : ∀ n → g n (g n 45 ⟨ 48 ⟩) ⟨ 48 ⟩ ≡ g n (g n 45 42) 42
    test₈ n = ⟨by⟩ assumption

    test₉ : (f : ℕ → ℕ) → f ⟨ 42 ⟩ ≡ f 48
    test₉ f = ⟨by⟩ (lemma 40)

    test₁₀ : (f : ℕ → ℕ) → f ⟨ 42 ⟩ ≡ f 48
    test₁₀ f = ⟨by⟩ (λ (_ : ⊤) → assumption)

    test₁₁ : (f : ℕ × ℕ → ℕ × ℕ) → (∀ x → ⟨ _≡_ ⟩ (f x) x) →
             fst ⟨ f (12 , 73) ⟩ ≡ fst {B = λ _ → ℕ} (12 , 73)
    test₁₁ _ hyp = ⟨by⟩ hyp

    test₁₂ : (h : ℕ → Maybe ℕ) →
             ((xs : ℕ) → h xs ≡ just xs) →
             (xs : ℕ) → suc ⟨$⟩ h xs ≡ suc ⟨$⟩ return xs
    test₁₂ h hyp xs =
      suc ⟨$⟩ ⟨ h xs ⟩   ≡⟨ ⟨by⟩ (hyp xs) ⟩∎
      suc ⟨$⟩ return xs  ∎

    test₁₃ : (h : List ⊤ → Maybe (List ⊤)) →
             ((xs : List ⊤) → h xs ≡ just xs) →
             (x : ⊤) (xs : List ⊤) → _
    test₁₃ h hyp x xs =
      _∷_ ⟨$⟩ return x ⊛ ⟨ h xs ⟩   ≡⟨ ⟨by⟩ (hyp xs) ⟩∎
      _∷_ ⟨$⟩ return x ⊛ return xs  ∎

    test₁₄ : (h : List ℕ → Maybe (List ℕ)) →
             ((xs : List ℕ) → h xs ≡ just xs) →
             (x : ℕ) (xs : List ℕ) → _
    test₁₄ h hyp x xs =
      _∷_ ⟨$⟩ ⟨ h xs ⟩   ≡⟨ ⟨by⟩ (hyp xs) ⟩∎
      _∷_ ⟨$⟩ return xs  ∎

    test₁₅ :
      (F : Type → Type → Type)
      (G : Bool → Type → Type) →
      ((A : Type) → F (G false A) A ≡ G false (F A A)) →
      (A : Type) →
      G false (F (G false A) A) ≡
      G false (G false (F A A))
    test₁₅ F G hyp A =
      G false ⟨ F (G false A) A ⟩  ≡⟨ ⟨by⟩ hyp ⟩∎
      G false (G false (F A A))    ∎

    test₁₆ : 48 ≡ 42 →
             _≡_ {A = ℕ → ℕ} (λ x → x + ⟨ 42 ⟩) (λ x → x + 48)
    test₁₆ hyp = ⟨by⟩ hyp

    test₁₇ :
      (P : ℕ → Type)
      (f : ∀ {n} → P n → P n)
      (p : P 0) →
      f ⟨ subst P (refl _) p ⟩ ≡ f p
    test₁₇ _ _ _ = ⟨by⟩ subst-refl

    test₁₈ :
      (subst′ :
         ∀ {a p} {A : Type a} {x y : A}
         (P : A → Type p) → x ≡ y → P x → P y) →
      (∀ {a p} {A : Type a} {x : A} (P : A → Type p) (p : P x) →
       subst′ P (refl x) p ≡ p) →
      (P : ℕ → Type)
      (f : ∀ {n} → P n → P n)
      (p : P 0) →
      f ⟨ subst′ P (refl 0) p ⟩ ≡ f p
    test₁₈ _ subst′-refl _ _ _ = ⟨by⟩ subst′-refl

    -- test₁₉ :
    --   {F : Type → Type} ⦃ r : R F ⦄ {A : Type} {x₁ x₂ : F A}
    --   (p₁ p₂ : x₁ ≡ x₂) (assumption : p₁ ≡ p₂) →
    --   trans p p₁ ≡ trans p p₂
    -- test₁₉ p₁ p₂ assumption =
    --   trans p p₁      ≡⟨⟩
    --   trans p ⟨ p₁ ⟩  ≡⟨ ⟨by⟩ assumption ⟩∎
    --   trans p p₂      ∎


module Not-named-according-to-the-Haskell-lexical-syntax where

postulate
  IO : Set -> Set

{-# BUILTIN IO IO #-}
{-# COMPILE GHC IO = type IO #-}

postulate
  return : {A : Set} -> A -> IO A

{-# COMPILE GHC return = \ _ -> return :: a -> IO a #-}

data Unit : Set where
  unit : Unit

{-# COMPILE GHC Unit = data () (()) #-}


data Bool : Set where
  true false : Bool

{-# BUILTIN BOOL Bool #-}
{-# BUILTIN TRUE true #-}
{-# BUILTIN FALSE true #-}  -- hmm, no


data Nat : Set where
  zero : Nat
  suc  : Nat → Nat

{-# BUILTIN NATURAL Nat #-}

data _≡_ {A : Set} (x : A) : A → Set where
  refl : x ≡ x

{-# NON_TERMINATING #-}
loop : Nat → Nat
loop n = loop n

thm : ∀ n → loop n ≡ 42
thm n = refl


module _ where

module M where

  data D : Set where
    c : D

  private

    pattern c′ = c

open M

x : D
x = c′


module Issue289 where

data D : Set where
  d : D

record ⊤ : Set where

foo : (x y : D) → ⊤
foo d y = {!y!}

-- WAS:
-- Right hand side must be a single hole when making a case
-- distinction.
-- when checking that the expression ? has type ⊤

-- NOW: (Andreas, 2013-03-22)
-- Since goal is solved, further case distinction is not supported;
-- try `Solve constraints' instead
-- when checking that the expression ? has type ⊤


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

------------------------------------------------------------------------
-- Re-exports of the Data.List.Kleene module, renamed to duplicate the
-- Data.List API.

module Data.List.Kleene.AsList where

import Data.List.Kleene.Base as Kleene
open import Data.List.Kleene.Base
  using
    ( []
    )
  renaming
    ( _⋆ to List
    ; foldr⋆ to foldr
    ; foldl⋆ to foldl
    ; _⋆++⋆_ to _++_
    ; map⋆ to map
    ; pure⋆ to pure
    ; _⋆<*>⋆_ to _<*>_
    ; _⋆>>=⋆_ to _>>=_
    ; mapAccumL⋆ to mapAccumL
    ; _[_]⋆ to _[_]
    ; applyUpTo⋆ to applyUpTo
    ; upTo⋆ to upTo
    ; intersperse⋆ to intersperse
    ; _⋆<|>⋆_ to _<|>_
    ; ⋆zipWith⋆ to zipWith
    ; unzipWith⋆ to unzipWith
    ; partitionSumsWith⋆ to partitionSumsWith
    ; ⋆transpose⋆ to transpose
    ; reverse⋆ to reverse
    )
  public

infixr 5 _∷_
pattern _∷_ x xs = Kleene.∹ x Kleene.& xs

scanr : ∀ {a b} {A : Set a} {B : Set b} → (A → B → B) → B → List A → List B
scanr f b xs = Kleene.∹ Kleene.scanr⋆ f b xs

scanl : ∀ {a b} {A : Set a} {B : Set b} → (B → A → B) → B → List A → List B
scanl f b xs = Kleene.∹ Kleene.scanl⋆ f b xs

tails : ∀ {a} {A : Set a} → List A → List (List A)
tails xs = foldr (λ x xs → (Kleene.∹ x) ∷ xs) ([] ∷ []) (Kleene.tails⋆ xs)

import Data.List.Kleene.Syntax

module Syntax = Data.List.Kleene.Syntax using (_]; _,_) renaming (⋆[_ to [_)


{-# OPTIONS --safe #-}

module Cubical.Algebra.MonoidSolver.Reflection where

open import Cubical.Foundations.Prelude hiding (Type)

open import Agda.Builtin.Reflection hiding (Type)
open import Agda.Builtin.String

open import Cubical.Reflection.Base

open import Cubical.Data.Maybe
open import Cubical.Data.Sigma
open import Cubical.Data.List
open import Cubical.Data.Nat
open import Cubical.Data.FinData using () renaming (zero to fzero; suc to fsuc)
open import Cubical.Data.Bool
open import Cubical.Data.Vec using (Vec) renaming ([] to emptyVec; _∷_ to _∷vec_) public

open import Cubical.Algebra.Monoid.Base
open import Cubical.Algebra.CommMonoid.Base
open import Cubical.Algebra.MonoidSolver.Solver renaming (solve to naiveSolve)
open import Cubical.Algebra.MonoidSolver.CommSolver renaming (solve to naiveCommSolve)
open import Cubical.Algebra.MonoidSolver.MonoidExpression

private
  variable
    ℓ : Level

module ReflectionSolver (op unit solver : Name) where

  _==_ = primQNameEquality
  {-# INLINE _==_ #-}

  record VarInfo : Type ℓ-zero where
    field
      varName : String
      varType : Arg Term
      index : ℕ

  {-
    `getLastTwoArgsOf` maps a term 'def n (z₁ ∷ … ∷ zₙ ∷ x ∷ y ∷ [])' to the pair '(x,y)'
    non-visible arguments are ignored.
  -}
  getLastTwoArgsOf : Name → Term → Maybe (Term × Term)
  getLastTwoArgsOf n' (def n xs) =
    if n == n'
    then go xs
    else nothing
      where
      go : List (Arg Term) → Maybe (Term × Term)
      go (varg x ∷ varg y ∷ []) = just (x , y)
      go (x ∷ xs)               = go xs
      go _                      = nothing
  getLastTwoArgsOf n' _ = nothing

  {-
    `getArgs` maps a term 'x ≡ y' to the pair '(x,y)'
  -}
  getArgs : Term → Maybe (Term × Term)
  getArgs = getLastTwoArgsOf (quote PathP)

  firstVisibleArg : List (Arg Term) → Maybe Term
  firstVisibleArg [] = nothing
  firstVisibleArg (varg x ∷ l) = just x
  firstVisibleArg (x ∷ l) = firstVisibleArg l

  {-
    If the solver needs to be applied during equational reasoning,
    the right hand side of the equation to solve cannot be given to
    the solver directly. The following function extracts this term y
    from a more complex expression as in:
      x ≡⟨ solve ... ⟩ (y ≡⟨ ... ⟩ z ∎)
  -}
  getRhs : Term → Maybe Term
  getRhs reasoningToTheRight@(def n xs) =
    if n == (quote _∎)
    then firstVisibleArg xs
    else (if n == (quote _≡⟨_⟩_)
         then firstVisibleArg xs
         else nothing)
  getRhs _ = nothing

  private
    solverCallAsTerm : Term → Arg Term → Term → Term → Term
    solverCallAsTerm M varList lhs rhs =
      def
         solver
         (varg M ∷ varg lhs ∷ varg rhs
           ∷ varList
           ∷ varg (def (quote refl) []) ∷ [])

  solverCallWithLambdas : ℕ → List VarInfo → Term → Term → Term → Term
  solverCallWithLambdas n varInfos M lhs rhs =
    encloseWithIteratedLambda
      (map VarInfo.varName varInfos)
      (solverCallAsTerm M (variableList (rev varInfos)) lhs rhs)
    where
      encloseWithIteratedLambda : List String → Term → Term
      encloseWithIteratedLambda (varName ∷ xs) t = lam visible (abs varName (encloseWithIteratedLambda xs t))
      encloseWithIteratedLambda [] t = t

      variableList : List VarInfo → Arg Term
      variableList [] = varg (con (quote emptyVec) [])
      variableList (varInfo ∷ varInfos)
        = varg (con (quote _∷vec_) (varg (var (VarInfo.index varInfo) []) ∷ (variableList varInfos) ∷ []))

  solverCallByVarIndices : ℕ → List ℕ → Term → Term → Term → Term
  solverCallByVarIndices n varIndices R lhs rhs =
      solverCallAsTerm R (variableList (rev varIndices)) lhs rhs
      where
        variableList : List ℕ → Arg Term
        variableList [] = varg (con (quote emptyVec) [])
        variableList (varIndex ∷ varIndices)
          = varg (con (quote _∷vec_) (varg (var (varIndex) []) ∷ (variableList varIndices) ∷ []))

  module _ (monoid : Term) where

    `ε⊗` : Term
    `ε⊗` = con (quote ε⊗) []

    mutual

      `_⊗_` : List (Arg Term) → Term
      `_⊗_` (harg _ ∷ xs) = `_⊗_` xs
      `_⊗_` (varg _ ∷ varg x ∷ varg y ∷ []) =
        con
          (quote _⊗_) (varg (buildExpression x) ∷ varg (buildExpression y) ∷ [])
      `_⊗_` _ = unknown

      finiteNumberAsTerm : ℕ → Term
      finiteNumberAsTerm ℕ.zero = con (quote fzero) []
      finiteNumberAsTerm (ℕ.suc n) = con (quote fsuc) (varg (finiteNumberAsTerm n) ∷ [])

      buildExpression : Term → Term
      buildExpression (var index _) = con (quote ∣) (varg (finiteNumberAsTerm index) ∷ [])
      buildExpression t@(def n xs) =
        if (n == op)
          then `_⊗_` xs
        else if (n == unit)
          then `ε⊗`
        else
          unknown
      buildExpression t = unknown

    toMonoidExpression : Maybe (Term × Term) → Maybe (Term × Term)
    toMonoidExpression nothing = nothing
    toMonoidExpression (just (lhs , rhs)) = just (buildExpression lhs , buildExpression rhs)

  adjustDeBruijnIndex : (n : ℕ) → Term → Term
  adjustDeBruijnIndex n (var k args) = var (k + n) args
  adjustDeBruijnIndex n _ = unknown

  extractVarIndices : Maybe (List Term) → Maybe (List ℕ)
  extractVarIndices (just ((var index _) ∷ l)) with extractVarIndices (just l)
  ... | just indices = just (index ∷ indices)
  ... | nothing = nothing
  extractVarIndices (just []) = just []
  extractVarIndices _ = nothing

  getVarsAndEquation : Term → Maybe (List VarInfo × Term)
  getVarsAndEquation t =
    let
      (rawVars , equationTerm) = extractVars t
      maybeVars = addIndices (length rawVars) rawVars
    in map-Maybe (_, equationTerm) maybeVars
    where
          extractVars : Term → List (String × Arg Term) × Term
          extractVars (pi argType (abs varName t)) with extractVars t
          ...                                         | xs , equation
                                                        = (varName , argType) ∷ xs , equation
          extractVars equation = [] , equation

          addIndices : ℕ → List (String × Arg Term) → Maybe (List VarInfo)
          addIndices ℕ.zero         []        = just []
          addIndices (ℕ.suc countVar) ((varName , argType) ∷ list) =
            map-Maybe (λ varList → record { varName = varName ; varType = argType ; index = countVar }
                                   ∷ varList)
                      (addIndices countVar list)
          addIndices _ _ = nothing

  toListOfTerms : Term → Maybe (List Term)
  toListOfTerms (con c []) = if (c == (quote [])) then just [] else nothing
  toListOfTerms (con c (varg t ∷ varg s ∷ args)) with toListOfTerms s
  ... | just terms = if (c == (quote _∷_)) then just (t ∷ terms) else nothing
  ... | nothing = nothing
  toListOfTerms (con c (harg t ∷ args)) = toListOfTerms (con c args)
  toListOfTerms _ = nothing

  solve-macro : Term → Term → TC Unit
  solve-macro monoid hole =
    do
      hole′ ← inferType hole >>= normalise
      just (varInfos , equation) ← returnTC (getVarsAndEquation hole′)
        where
          nothing
            → typeError (strErr "Something went wrong when getting the variable names in "
                           ∷ termErr hole′ ∷ [])
      {-
        The call to the monoid solver will be inside a lamba-expression.
        That means, that we have to adjust the deBruijn-indices of the variables in 'monoid'
      -}
      adjustedMonoid ← returnTC (adjustDeBruijnIndex (length varInfos) monoid)
      just (lhs , rhs) ← returnTC (toMonoidExpression adjustedMonoid (getArgs equation))
        where
          nothing
            → typeError(
                strErr "Error while trying to build ASTs for the equation " ∷
                termErr equation ∷ [])
      let solution = solverCallWithLambdas (length varInfos) varInfos adjustedMonoid lhs rhs
      unify hole solution

macro
  solveMonoid : Term → Term → TC _
  solveMonoid = ReflectionSolver.solve-macro (quote MonoidStr._·_) (quote MonoidStr.ε) (quote naiveSolve)

  solveCommMonoid : Term → Term → TC _
  solveCommMonoid = ReflectionSolver.solve-macro (quote CommMonoidStr._·_) (quote CommMonoidStr.ε) (quote naiveCommSolve)


module Lib.Monad where

open import Lib.Nat
open import Lib.List
open import Lib.IO hiding (IO; mapM)
open import Lib.Maybe
open import Lib.Prelude

infixr 40 _>>=_ _>>_
infixl 90 _<*>_ _<$>_

-- Wrapper type, used to ensure that ElM is constructor-headed.

record IO (A : Set) : Set where
  constructor io
  field unIO : Lib.IO.IO A

open IO

-- State monad transformer

data StateT (S : Set)(M : Set -> Set)(A : Set) : Set where
  stateT : (S -> M (A × S)) -> StateT S M A

runStateT : forall {S M A} -> StateT S M A -> S -> M (A × S)
runStateT (stateT f) = f

-- Reader monad transformer

data ReaderT (E : Set)(M : Set -> Set)(A : Set) : Set where
  readerT : (E -> M A) -> ReaderT E M A

runReaderT : forall {E M A} -> ReaderT E M A -> E -> M A
runReaderT (readerT f) = f

-- The monad class

data Monad : Set1 where
  maybe  : Monad
  list   : Monad
  io     : Monad
  state  : Set -> Monad -> Monad
  reader : Set -> Monad -> Monad

ElM : Monad -> Set -> Set
ElM maybe        = Maybe
ElM list         = List
ElM io           = IO
ElM (state S m)  = StateT S (ElM m)
ElM (reader E m) = ReaderT E (ElM m)

return : {m : Monad}{A : Set} -> A -> ElM m A
return {maybe}      x = just x
return {list}       x = x :: []
return {io}         x = io (returnIO x)
return {state _ m}  x = stateT \s -> return (x , s)
return {reader _ m} x = readerT \_ -> return x

_>>=_ : {m : Monad}{A B : Set} -> ElM m A -> (A -> ElM m B) -> ElM m B
_>>=_ {maybe}     nothing    k = nothing
_>>=_ {maybe}     (just x)   k = k x
_>>=_ {list}      xs         k = foldr (\x ys -> k x ++ ys) [] xs
_>>=_ {io}        (io m)     k = io (bindIO m (unIO ∘ k))
_>>=_ {state S m} (stateT f) k = stateT \s -> f s >>= rest
  where
    rest : _ × _ -> ElM m _
    rest (x , s) = runStateT (k x) s
_>>=_ {reader E m} (readerT f) k = readerT \e -> f e >>= \x -> runReaderT (k x) e

-- State monad class

data StateMonad (S : Set) : Set1 where
  state : Monad -> StateMonad S
  reader : Set -> StateMonad S -> StateMonad S

ElStM : {S : Set} -> StateMonad S -> Monad
ElStM {S} (state m)    = state S m
ElStM     (reader E m) = reader E (ElStM m)

ElSt : {S : Set} -> StateMonad S -> Set -> Set
ElSt m = ElM (ElStM m)

get : {S : Set}{m : StateMonad S} -> ElSt m S
get {m = state m}    = stateT \s -> return (s , s)
get {m = reader E m} = readerT \_ -> get

put : {S : Set}{m : StateMonad S} -> S -> ElSt m Unit
put {m = state m}    s = stateT  \_ -> return (unit , s)
put {m = reader E m} s = readerT \_ -> put s

-- Reader monad class

data ReaderMonad (E : Set) : Set1 where
  reader : Monad -> ReaderMonad E
  state  : Set -> ReaderMonad E -> ReaderMonad E

ElRdM : {E : Set} -> ReaderMonad E -> Monad
ElRdM {E} (reader m)  = reader E m
ElRdM     (state S m) = state S (ElRdM m)

ElRd : {E : Set} -> ReaderMonad E -> Set -> Set
ElRd m = ElM (ElRdM m)

ask : {E : Set}{m : ReaderMonad E} -> ElRd m E
ask {m = reader m } = readerT \e -> return e
ask {m = state S m} = stateT \s -> ask >>= \e -> return (e , s)

local : {E A : Set}{m : ReaderMonad E} -> (E -> E) -> ElRd m A -> ElRd m A
local {m = reader _ } f (readerT m) = readerT \e -> m (f e)
local {m = state S _} f (stateT m)  = stateT \s -> local f (m s)

-- Derived functions

-- Monad operations

_>>_ : {m : Monad}{A B : Set} -> ElM m A -> ElM m B -> ElM m B
m₁ >> m₂ = m₁ >>= \_ -> m₂

_<*>_ : {m : Monad}{A B : Set} -> ElM m (A -> B) -> ElM m A -> ElM m B
mf <*> mx = mf >>= \f -> mx >>= \x -> return (f x)

_<$>_ : {m : Monad}{A B : Set} -> (A -> B) -> ElM m A -> ElM m B
f <$> m = return f <*> m

mapM : {m : Monad}{A B : Set} -> (A -> ElM m B) -> List A -> ElM m (List B)
mapM f []        = return []
mapM f (x :: xs) = _::_ <$> f x <*> mapM f xs

-- State monad operations

modify : {S : Set}{m : StateMonad S} -> (S -> S) -> ElSt m Unit
modify f = get >>= \s -> put (f s)

-- Test

-- foo : Nat -> Maybe (Nat × Nat)
-- foo s = runReaderT (runStateT m s) s
--  where

-- m₁ : StateT Nat (ReaderT Nat Maybe) Nat
-- m₁ = local suc (ask >>= \s -> put (s + 3) >> get)

-- The problem: nested injective function don't seem to work
-- as well as one could hope. In this case:
--   ElM (ElRd ?0) == ReaderT Nat Maybe
-- inverts to
--    ElRd ?0 == reader Nat ?1
--    ElM ?1 == Maybe
-- it seems that the injectivity of ElRd isn't taken into account(?)
-- m : ReaderT Nat Maybe Nat
-- m = ask


postulate
  T     : Set
  pre   : (T → T) → T
  pre!_ : (T → T) → T
  _post : T → Set
  _+_   : T → T → T
  _>>=_ : T → (T → T) → T

infix 5 pre!_ _>>=_
infix 4 _post
infixl 3 _+_

-- add parens
test-1a : Set
test-1a = {!pre λ x → x!} post

-- no parens
test-1b : Set
test-1b = {!pre (λ x → x)!} post

-- add parens
test-1c : Set
test-1c = {!pre! λ x → x!} post

-- no parens
test-1d : Set
test-1d = {!pre! (λ x → x)!} post

-- add parens
test-1e : T → Set
test-1e e = {!e >>= λ x → x!} post

-- no parens
test-1f : T → Set
test-1f e = {!e >>= (λ x → x)!} post

-- add parens
test-2a : Set
test-2a = pre {!λ x → x!} post

-- add parens
test-2b : Set
test-2b = pre! {!λ x → x!} post

-- no parens
test-3a : T
test-3a = pre {!λ x → x!}

-- no parens
test-3b : T
test-3b = pre! {!λ x → x!}

-- no parens
test-4a : T → T
test-4a e = e + {!pre λ x → x!}

-- no parens
test-4b : T → T
test-4b e = e + {!pre! λ x → x!}


{-# OPTIONS --no-unicode #-}

open import Agda.Builtin.Nat

pred : Nat -> Nat
pred = \ { n -> {!!} }


-- Andreas, 2016-09-20 test whether --no-eta-equality is respected

{-# OPTIONS --no-eta-equality #-}

record ⊤ : Set where

test : ⊤
test = _ -- should remain unsolved


-- {-# OPTIONS -v tc.lhs:10 -v tc.lhs.split:50 #-}

postulate A : Set

record R : Set where
  field f : A

test : _ → A
test record{f = a} = a
-- This could succeed, but Agda currently does not try to guess
-- the type type of the record pattern from its field names.


module _ where

data X : Set where
data R (x : X) : Set where

module SUListSepElemTypes where

  module M2 (Elem : Set) where
    data InclWith : Set where

  module M1 where
    module InclZip1 (R : X → Set) where
      open M2 X public
      module InclZipUnion (Y : Set) where

module SepElemTypes = SUListSepElemTypes

module Zip⊆ = SepElemTypes.M1.InclZip1 R
module Zip⊆∪ = Zip⊆.InclZipUnion X


-- This is an example emphasizing the important of a linearity check
-- in the positivity check.
--
-- Currently it does not type check since there is no universe subtyping.

module PositivityCheckNeedsLinearityCheck where

data Eq (S : Set2) : Set2 -> Set where
  refl : Eq S S

subst' : {S S' : Set2} -> Eq S S' -> S -> S'
subst' refl s = s

-- what happens if Eq is considered covariant in its first argument?
-- then because of subtyping,

p : Eq Set1 Set
p = refl

S : Set
S = subst' p Set

-- now S, which evaluates to Set, is in Set


-- MIT License

-- Copyright (c) 2021 Luca Ciccone and Luca Padovani

-- Permission is hereby granted, free of charge, to any person
-- obtaining a copy of this software and associated documentation
-- files (the "Software"), to deal in the Software without
-- restriction, including without limitation the rights to use,
-- copy, modify, merge, publish, distribute, sublicense, and/or sell
-- copies of the Software, and to permit persons to whom the
-- Software is furnished to do so, subject to the following
-- conditions:

-- The above copyright notice and this permission notice shall be
-- included in all copies or substantial portions of the Software.

-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-- EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
-- OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-- NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-- HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-- WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
-- FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
-- OTHER DEALINGS IN THE SOFTWARE.

{-# OPTIONS --guardedness #-}

open import Level

open import Data.Empty
open import Data.Unit
open import Data.Product
open import Data.Sum
open import Data.Bool
open import Data.List using (List)

open import Relation.Nullary
open import Relation.Nullary.Decidable
open import Relation.Unary using (Pred; _∈_; _⊆_; Empty; Satisfiable)
open import Relation.Binary.PropositionalEquality using (_≡_; refl ; subst ; cong)

open import Common

module SessionType {ℙ : Set} (message : Message ℙ)
  where

data    SessionType : Set
record ∞SessionType : Set where
  constructor box_
  coinductive
  field force : SessionType
open ∞SessionType public

Continuation : Set
Continuation = ℙ -> ∞SessionType

data SessionType where
  nil : SessionType
  inp : (f : Continuation) -> SessionType
  out : (f : Continuation) -> SessionType

data Defined : SessionType -> Set where
  inp : ∀{f} -> Defined (inp f)
  out : ∀{f} -> Defined (out f)

Defined? : (T : SessionType) -> Dec (Defined T)
Defined? nil     = no λ ()
Defined? (inp _) = yes inp
Defined? (out _) = yes out

Defined-eq : ∀{T : SessionType} (p : Defined T) (q : Defined T) -> p ≡ q
Defined-eq inp inp = refl
Defined-eq out out = refl

dom : Continuation -> Pred ℙ Level.zero
dom f x = Defined (f x .force)

_∈?_ : (x : ℙ) (f : Continuation) -> Dec (x ∈ dom f)
x ∈? f with f x .force
... | nil   = no λ ()
... | inp _ = yes inp
... | out _ = yes out

EmptyContinuation : Continuation -> Set
EmptyContinuation f = Empty (dom f)

Witness : Continuation -> Set
Witness f = Satisfiable (dom f)

Empty? : (f : Continuation) -> EmptyContinuation f ⊎ Witness f
Empty? f with excluded-middle {Witness f}
... | yes w = inj₂ w
... | no nw = inj₁ λ x def -> nw (x , def)

-- WARNING: Win and End must be different predicates, because
-- client-wise they are different, whereas Server-wise they are
-- equivalent. inp cannot be End or else an ended client may receive
-- a message and fail!

data Win : SessionType -> Set where
  out : ∀{f} (U : EmptyContinuation f) -> Win (out f)

data End : SessionType -> Set where
  inp : ∀{f} (U : EmptyContinuation f) -> End (inp f)
  out : ∀{f} (U : EmptyContinuation f) -> End (out f)

win : SessionType
win = out λ _ -> λ where .force -> nil

Win-win : Win win
Win-win = out λ { _ () }

win->defined : ∀{T} -> Win T -> Defined T
win->defined (out _) = out

-- if T is not Defined, then it is nil
not-def->nil : ∀{T} → ¬ (Defined T) → T ≡ nil
not-def->nil {nil} nd = refl
not-def->nil {inp f} nd = ⊥-elim (nd inp)
not-def->nil {out f} nd = ⊥-elim (nd out)

not-nil-defined : Defined nil → ⊥
not-nil-defined ()

open Message message

if-≡-ch : (x y : ℙ) → SessionType → SessionType → SessionType
if-≡-ch x y S T with x ?= y
... | no ¬p = T
... | yes refl = S

sample-cont : ℙ → SessionType → SessionType → Continuation
force (sample-cont t S T x) = if-≡-ch x t S T

cont-not-def : ∀{t} → ¬ (Defined (sample-cont t nil win t .force))
cont-not-def {t} ok with t ?= t
cont-not-def {t} () | yes refl
... | no ¬eq = ⊥-elim (¬eq refl)

force-eq : ∀{t S T} → S ≡ (sample-cont t S T) t .force
force-eq {t} with t ?= t
... | no ¬p = ⊥-elim (¬p refl)
... | yes refl = refl

wit-cont : ∀{t S T} → Defined S → Witness (sample-cont t S T)
wit-cont {t} def = t , subst Defined force-eq def

sample-in : (t : ℙ) → SessionType → SessionType
sample-in t S = inp (sample-cont t S nil)

sample-out : (t : ℙ) → SessionType → SessionType
sample-out t S = out (sample-cont t S nil)

full-cont : SessionType → Continuation
force (full-cont S _) = S


-- Andreas, 2016-10-14, issue #2257, reported by m0davis
-- Bisected by Nisse.

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

-- {-# OPTIONS -v tc.ip:20 #-}
-- {-# OPTIONS -v tc:20 #-}

record R (A : Set) : Set₁ where
  field
    a : A
    F : ∀ {f} → Set

  foo : Set
  foo = ∀ {f} → {!!}

  field
    bar : Set


--{-# OPTIONS --rewriting #-}
--{-# OPTIONS --exact-split #-}
--{-# OPTIONS --show-implicit #-}
--{-# OPTIONS --allow-unsolved-metas #-}

module NaturalDeduction where

open import OscarPrelude
open import Delay
open import Successor
open import Membership
open import DecidableMembership renaming (DecidableMembership to RDecidableMembership)
open import VariableName
open import FunctionName
open import PredicateName
open import Arity
open import Vector
open import 𝕃ist
open import TermByFunctionNames
open import Term
--open import TermUnification
open import MGU-revised
open import HasNegation
open import Formula
open import IsFormula
open import 𝓕ormula
open import HasNeitherNor
open import IsLiteralFormula
open import LiteralFormula
open import IsPropositionalFormula
open import 𝓐ssertion
open import 𝓢equent
open import Sequent
open import 𝑱udgement
open import IsLiteralSequent
open import LiteralSequent
open import Problem
open import IsLiteralProblem
open import LiteralProblem
open import Element
open import Elements
open import TruthValue
open import Interpretation
open import HasSatisfaction
open import InterpretationEqualityExceptAtVariableName
open import HasDecidableSatisfaction
open import Validation
open import HasDecidableValidation
open import HasSubstantiveDischarge
open import HasDecidableSubstantiveDischarge
open import HasVacuousDischarge
open import HasSalvation
open import SubstantiveDischargeIsConsistent
open import SubstantiveDischargeIsReflexive
open import HasDecidableVacuousDischarge
open import HasDecidableSalvation
open import TermCode
open import TermNode
open import FindTermNode
open import Theorem1

-- infixr 1 ,_
-- pattern  ,_ p = _ , p

-- pattern ◁pattern c₁∈xs c₁≽s c₂∈xs c₂≽~s = , (((, (c₁∈xs , c₁≽s)) , (, (c₂∈xs , c₂≽~s))))

-- negationEliminationRule : (I : Interpretation) (φ : Formula) → I ⊨ ~ (~ φ) → I ⊨ φ
-- negationEliminationRule I φ (¬[I⊭φ×I⊭φ] , _) with I ⊨? φ
-- … | yes I⊨φ = I⊨φ
-- … | no I⊭φ = ⊥-elim $ ¬[I⊭φ×I⊭φ] $ I⊭φ , I⊭φ

-- -- justifieds simplification and ... more?
-- simplificationRule₁ : (I : Interpretation) (φ₁ φ₂ : Formula) → I ⊨ Formula.logical φ₁ φ₂ → I ⊨ Formula.logical φ₁ φ₁
-- simplificationRule₁ I φ₁ φ₂ x = (fst x) , (fst x)

-- simplificationRule₂ : (I : Interpretation) (φ₁ φ₂ : Formula) → I ⊨ Formula.logical φ₁ φ₂ → I ⊨ Formula.logical φ₂ φ₂
-- simplificationRule₂ I φ₁ φ₂ x = snd x , snd x

-- -- logical (logical (logical p p) q) (logical (logical p p) q)
-- {-
-- conditionalizationRule : (I : Interpretation) (p q : Formula) → I ⊨ q → I ⊨ (p ⊃ q ╱ (p ∷ []) )
-- conditionalizationRule I p q ⊨q (_ , _) = let prf = λ { (_ , ⊭q) → ⊭q ⊨q} in prf , prf
-- --let ⊨p = {!-⊨p p (here [])!} in (λ { (x , ~q) → ~q ⊨q}) , (λ { (x , y) → y ⊨q})
-- -}

-- modusPonens : (I : Interpretation) (p q : Formula) → I ⊨ p → I ⊨ (p ⊃ q) → I ⊨ q
-- modusPonens I p q P (~[~p&~p&~q] , ~[~p&~p&~q]²) with I ⊨? q
-- modusPonens I p q P (~[~p&~p&~q] , ~[~p&~p&~q]²) | yes x = x
-- modusPonens I p q P (~[~p&~p&~q] , ~[~p&~p&~q]²) | no x = ⊥-elim (~[~p&~p&~q] ((λ { (x₁ , y) → y P}) , (λ x₁ → x x₁)))

-- -- -- -- -- -- data SkolemFormula {ι : Size} (α : Alphabet) : Set where
-- -- -- -- -- --   atomic : Predication α → SkolemFormula α
-- -- -- -- -- --   logical : {ι¹ : Size< ι} → SkolemFormula {ι¹} α → {ι² : Size< ι} → SkolemFormula {ι²} α → SkolemFormula {ι} α

-- -- -- -- -- -- record Alphabet₊ᵥ (α : Alphabet) : Set where
-- -- -- -- -- --   constructor α₊ᵥ⟨_⟩
-- -- -- -- -- --   field
-- -- -- -- -- --     alphabet : Alphabet
-- -- -- -- -- --     .one-variable-is-added : (number ∘ variables $ alphabet) ≡ suc (number ∘ variables $ α)
-- -- -- -- -- --     .there-are-no-functions-of-maximal-arity : number (functions alphabet) zero ≡ zero
-- -- -- -- -- --     .shifted-function-matches : ∀ {ytira₀ ytira₁} → finToNat ytira₁ ≡ finToNat ytira₀ → number (functions alphabet) (suc ytira₁) ≡ number (functions α) ytira₀
-- -- -- -- -- -- open Alphabet₊ᵥ

-- -- -- -- -- -- record Alphabet₊ₛ (α : Alphabet) : Set where
-- -- -- -- -- --   constructor α₊ₛ⟨_⟩
-- -- -- -- -- --   field
-- -- -- -- -- --     alphabet : Alphabet
-- -- -- -- -- -- open Alphabet₊ₛ

-- -- -- -- -- -- {-
-- -- -- -- -- --   toSkolemFormula
-- -- -- -- -- --   ∀x(F x v₀ v₁) ⟿ F v₀ v₁ v₂
-- -- -- -- -- --   ∃x(F x v₀ v₁) ⟿ F (s₀͍₂ v₀ v₁) v₀ v₁
-- -- -- -- -- --   ∀x(F x (s₀͍₂ v₀ v₁) v₁) ⟿ F v₀ (s₀͍₂ v₁ v₂) v₂
-- -- -- -- -- --   ∃x(F x (s₀͍₂ v₀ v₁) v₁) ⟿ F (s₀͍₂ v₀ v₁) (s₁͍₂ v₁ v₂) v₂
-- -- -- -- -- --   F v₀ ⊗ G v₀ ⟿ F v₀ ⊗ G v₀
-- -- -- -- -- --   ∀x(F x v₀ v₁) ⊗ ∀x(G x (s₀͍₂ x v₁) v₁) ⟿ F v₀ v₂ v₃ ⊗ G v₁ (s₀͍₂ v₀ v₃) v₃

-- -- -- -- -- --   ∀x(F x v₀ v₁) ⊗ ∃x(G x (s₀͍₂ x v₁) v₁) ⟿ F v₀ v₁ v₂ ⊗ G (s₀͍₁ v₂) (s₁͍₂ (s₀͍₂ v₂) v₂) v₂

-- -- -- -- -- --   Φ₀ = ∃x(G x (s₀͍₂ x v₁) v₁) has alphabet of 2 variables, skolem functions: 0, 0, 1
-- -- -- -- -- --   this is existential {α₊ₛ} Φ₁, where
-- -- -- -- -- --     Φ₁ = G (s₀͍₂ v₀ v₁) (s₁͍₂ (s₀͍₂ v₀ v₁)) v₁
-- -- -- -- -- --     α₊ₛ = ⟨ 2 , 0 ∷ 0 ∷ 2 ∷ [] ⟩

-- -- -- -- -- --   maybe Φ₋₁ = ∀y∃x(G x (s₀͍₂ x v₀) v₀)
-- -- -- -- -- --    and  Φ₋₂ = ∀z∀y∃x(G x (s₀͍₂ x z) z), finally having no free variables, but nevertheless having skolem functions! these are user-defined functions, so this notion of Alphabet is somehow wrong. we have also left out constants (i.e. user-defined skolem-functions of arity 0)

-- -- -- -- -- --   Instead, take the alphabet as defining
-- -- -- -- -- --     a stack of free variables
-- -- -- -- -- --     a matrix (triangle?) of skolem functions

-- -- -- -- -- --   Let's try to reverse Φ₁ from a Skolem to a 1st-order formula. Is there a unique way to do it?
-- -- -- -- -- --   Φ₀' = ∀x(G (s₀͍₂ x v₀) (s₁͍₂ (s₀͍₂ x v₀)) v₀

-- -- -- -- -- --   Nope!

-- -- -- -- -- --   toSkolemFormula of

-- -- -- -- -- -- -}

-- -- -- -- -- -- -- toSkolemFormula (logical Φ₁ Φ₂) ⟿
-- -- -- -- -- -- --   let α' , φ₁ = toSkolemFormula Φ₁
-- -- -- -- -- -- --       Φ₂' = transcodeToAugmentedAlphabet Φ₂ α'
-- -- -- -- -- -- --       α'' , φ₂' = toSkolemFormula Φ₂'
-- -- -- -- -- -- --       φ₁' = transcodeToAugmentedAlphabet φ₁ α''

-- -- -- -- -- -- {-
-- -- -- -- -- -- given Δv = #varibles α' - #variables α
-- -- -- -- -- -- for every variable v in α, v in Φ, v stays the same in Φ'
-- -- -- -- -- -- for the added variable v⁺ in α₊ - α, v⁺ in Φ, v⁺ ⟿ v⁺ + Δv in transcode (universal {α₊} Φ)
-- -- -- -- -- -- α'₊ = α' + 1 variable
-- -- -- -- -- -- -}

-- -- -- -- -- -- -- record AddVariable (A : Alphabet → Set) : Set where
-- -- -- -- -- -- --   field
-- -- -- -- -- -- --     addVariableToAlphabet : {α : Alphabet} → A α → {α₊ : Alphabet} → Alphabet₊ᵥ α₊ → A α₊

-- -- -- -- -- -- -- instance
-- -- -- -- -- -- --   AddVariableFirstOrderFormula : AddVariable FirstOrderFormula
-- -- -- -- -- -- --   AddVariableFirstOrderFormula = {!!}

-- -- -- -- -- -- -- #variables = number ∘ variables

-- -- -- -- -- -- -- #functions_ofArity_ : Alphabet → Nat → Nat
-- -- -- -- -- -- -- #functions α⟨ V⟨ #variables ⟩ , S⟨ #functions ⟩ ⟩ ofArity arity = if′ lessNat arity (suc #variables) then #functions (natToFin arity) else 0

-- -- -- -- -- -- -- record _⊇_ (α' α : Alphabet) : Set where
-- -- -- -- -- -- --   field
-- -- -- -- -- -- --     at-least-as-many-variables : #variables α' ≥ #variables α
-- -- -- -- -- -- --     at-least-as-many-functions : ∀ {arity} → arity < #variables α → #functions α' ofArity arity ≥ #functions α ofArity arity

-- -- -- -- -- -- -- record AddAlphabet (α-top α-bottom : Alphabet) : Set where
-- -- -- -- -- -- --   field
-- -- -- -- -- -- --     alphabet : Alphabet

-- -- -- -- -- -- -- record Transcodeable (A : Alphabet → Set) : Set where
-- -- -- -- -- -- --   field
-- -- -- -- -- -- --     transcode : {α' α : Alphabet} → ⦃ _ : α' ⊇ α ⦄ → A α → A α'

-- -- -- -- -- -- -- open Transcodeable ⦃ … ⦄

-- -- -- -- -- -- -- record TransferAlphabet {α' α : Alphabet} (α'⊇α : α' ⊇ α) (α₊ : Alphabet₊ᵥ α) (Φ : FirstOrderFormula (alphabet α₊)) : Set where
-- -- -- -- -- -- --   field
-- -- -- -- -- -- --     alphabet : Alphabet
-- -- -- -- -- -- --     firstOrderFormula : FirstOrderFormula alphabet

-- -- -- -- -- -- -- instance
-- -- -- -- -- -- --   TranscodeablePredication : Transcodeable Predication
-- -- -- -- -- -- --   TranscodeablePredication = {!!}

-- -- -- -- -- -- --   TranscodeableAlphabet+Variable : Transcodeable Alphabet₊ᵥ
-- -- -- -- -- -- --   TranscodeableAlphabet+Variable = {!!}

-- -- -- -- -- -- --   TranscodeableSkolemFormula : Transcodeable SkolemFormula
-- -- -- -- -- -- --   TranscodeableSkolemFormula = {!!}

-- -- -- -- -- -- --   TranscodeableFirstOrderFormula : Transcodeable FirstOrderFormula
-- -- -- -- -- -- --   Transcodeable.transcode TranscodeableFirstOrderFormula (atomic p) = atomic (transcode p)
-- -- -- -- -- -- --   Transcodeable.transcode TranscodeableFirstOrderFormula (logical Φ₁ Φ₂) = logical (transcode Φ₁) (transcode Φ₂)
-- -- -- -- -- -- --   Transcodeable.transcode TranscodeableFirstOrderFormula {α'} {α} ⦃ α'⊇α ⦄ (universal {α₊} Φ) = {!!} -- universal {_} {_} {transcode α₊} (transcode Φ)

-- -- -- -- -- -- --   Transcodeable.transcode TranscodeableFirstOrderFormula (existential Φ) = {!!}

-- -- -- -- -- -- -- --(α' α : Alphabet) (α'⊇α : α' ⊇ α) (α₊ : Alphabet+Variable α) (Φ : FirstOrderFormula (alphabet α₊)) → Σ _ λ (α''' : Alphabet) → FirstOrderFormula α'''

-- -- -- -- -- -- -- --FirstOrderFormula (alphabet α₊)
-- -- -- -- -- -- -- {-
-- -- -- -- -- -- -- -}

-- -- -- -- -- -- -- -- --transcodeIntoAugmentedAlphabet :

-- -- -- -- -- -- -- -- --toSkolemFormula : {α : Alphabet} → FirstOrderFormula α → Σ _ λ (α¹ : AugmentedAlphabet α) → SkolemFormula (alphabet α¹)

-- -- -- -- -- -- -- -- --record IsEquivalentFormulas {α₀ : Alphabet} (φ₀ : SkolemFormula α₀) {α₁ : Alphabet} (Φ₁ : FirstOrderFormula α₁) : Set where
-- -- -- -- -- -- -- -- --  field
-- -- -- -- -- -- -- -- --    .atomicCase : {p : Predication α₀} → φ₀ ≡ atomic p → Φ₁ ≡ atomic p

-- -- -- -- -- -- -- -- -- --
-- -- -- -- -- -- -- -- -- -- record Alphabet+Alphabet (α₀ α₁ α₂ : Alphabet) : Set where
-- -- -- -- -- -- -- -- -- --   field
-- -- -- -- -- -- -- -- -- --     alphabet :

-- -- -- -- -- -- -- -- -- -- ∀xφ₁(x) ⊗ φ₂ ⟿ ∀x(φ₁ ⊗ φ₂)

-- -- -- -- -- -- -- -- -- -- hasQuantifiers : FirstOrderFormula α → Bool

-- -- -- -- -- -- -- -- -- --record Skolemization {α : Alphabet} (φ : FirstOrderFormula α) : Set where
-- -- -- -- -- -- -- -- -- --  field
-- -- -- -- -- -- -- -- -- --    alphabet : Alphabet
-- -- -- -- -- -- -- -- -- --    skolemization : SkolemFormula alphabet

-- -- -- -- -- -- -- -- -- record _IsAugmentationOf_ (α₁ α₀ : Alphabet) : Set where

-- -- -- -- -- -- -- -- -- record AugmentedAlphabet (α : Alphabet) : Set where
-- -- -- -- -- -- -- -- --   constructor ⟨_⟩
-- -- -- -- -- -- -- -- --   field
-- -- -- -- -- -- -- -- --     alphabet : Alphabet
-- -- -- -- -- -- -- -- --     ..laws : alphabet ≡ α
-- -- -- -- -- -- -- -- -- open AugmentedAlphabet

-- -- -- -- -- -- -- -- -- trivialAugmentation : (α : Alphabet) → AugmentedAlphabet α
-- -- -- -- -- -- -- -- -- trivialAugmentation = {!!}

-- -- -- -- -- -- -- -- -- record DisjointRelativeUnion {α : Alphabet} (α¹ α² : AugmentedAlphabet α) : Set where
-- -- -- -- -- -- -- -- --   constructor ⟨_⟩
-- -- -- -- -- -- -- -- --   field
-- -- -- -- -- -- -- -- --     augmentation : AugmentedAlphabet α
-- -- -- -- -- -- -- -- --     .laws : {!!}
-- -- -- -- -- -- -- -- -- open DisjointRelativeUnion

-- -- -- -- -- -- -- -- -- disjointRelativeUnion : {α : Alphabet} → (α¹ α² : AugmentedAlphabet α) → DisjointRelativeUnion α¹ α²
-- -- -- -- -- -- -- -- -- disjointRelativeUnion = {!!}

-- -- -- -- -- -- -- -- -- -- inAugmentedAlphabet : {α : Alphabet} → (α¹ : AugmentedAlphabet α) → SkolemFormula α → SkolemFormula (alphabet α¹)
-- -- -- -- -- -- -- -- -- -- inAugmentedAlphabet = {!!}

-- -- -- -- -- -- -- -- -- -- toSkolemFormula : {α : Alphabet} → FirstOrderFormula α → Σ _ λ (α¹ : AugmentedAlphabet α) → SkolemFormula (alphabet α¹)
-- -- -- -- -- -- -- -- -- -- toSkolemFormula {α₀} (atomic 𝑃) = trivialAugmentation α₀ , atomic 𝑃
-- -- -- -- -- -- -- -- -- -- toSkolemFormula {α₀} (logical φ₁ φ₂) with toSkolemFormula φ₁ | toSkolemFormula φ₂
-- -- -- -- -- -- -- -- -- -- toSkolemFormula {α₀} (logical φ₁ φ₂) | α¹ , Φ₁ | α² , Φ₂ = augmentation (disjointRelativeUnion α¹ α²) , logical {!inAugmentedAlphabet (augmentation (disjointRelativeUnion α¹ α²)) Φ₁!} {!Φ₂!}
-- -- -- -- -- -- -- -- -- -- toSkolemFormula {α₀} (universal x) = {!!}
-- -- -- -- -- -- -- -- -- -- toSkolemFormula {α₀} (existential x) = {!!}

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- toNQFormula : ∀ {alphabet₀} → QFormula alphabet₀ → Σ _ λ alphabet₁ → NQFormula alphabet₁
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- toNQFormula {alphabet₀} (atomic name terms) = alphabet₀ , atomic name terms
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- toNQFormula {alphabet₀} (logical formula₁ formula₂) with toNQFormula formula₁ | toNQFormula formula₂
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- … | alphabet₁ , nqFormula₁ | alphabet₂ , nqFormula₂ = {!!}
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- toNQFormula {alphabet₀} (universal formula) = {!!}
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- toNQFormula {alphabet₀} (existential formula) = {!!}

-- -- -- -- -- -- -- -- -- -- -- -- -- --VariableName = Fin ∘ |v|
-- -- -- -- -- -- -- -- -- -- -- -- -- --FunctionArity = Fin ∘ suc ∘ size
-- -- -- -- -- -- -- -- -- -- -- -- -- --FunctionName = λ alphabet ytira → Fin (|f| alphabet ytira)

-- -- -- -- -- -- -- -- -- -- -- -- -- -- record Alphabet : Set where
-- -- -- -- -- -- -- -- -- -- -- -- -- --   constructor ⟨_,_⟩
-- -- -- -- -- -- -- -- -- -- -- -- -- --   field
-- -- -- -- -- -- -- -- -- -- -- -- -- --     |v| : Nat -- number of variables
-- -- -- -- -- -- -- -- -- -- -- -- -- --     |f| : Fin (suc |v|) → Nat -- number of functions of each arity, |v| through 0

-- -- -- -- -- -- -- -- -- -- -- -- -- -- open Alphabet

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- VariableName = Fin ∘ |v|
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- FunctionArity = Fin ∘ suc ∘ |v|
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- FunctionName = λ alphabet ytira → Fin (|f| alphabet ytira)

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- data Term {i : Size} (alphabet : Alphabet) : Set where
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --   variable : VariableName alphabet → Term alphabet
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --   function : ∀ {arity : FunctionArity alphabet} →
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --              FunctionName alphabet (natToFin (|v| alphabet) - arity) →
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --              ∀ {j : Size< i} → Vec (Term {j} alphabet) (finToNat arity) →
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --              Term {i} alphabet

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- PredicateArity = Nat
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- PredicateName = Nat

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- a zeroth-order formula? (i.e. no quantifiers)
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- data NQFormula {i : Size} (alphabet : Alphabet) : Set where
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --   atomic : PredicateName → ∀ {arity} → Vec (Term alphabet) arity → NQFormula alphabet
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --   logical : {j : Size< i} → NQFormula {j} alphabet → {k : Size< i} → NQFormula {k} alphabet → NQFormula {i} alphabet

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- record AugmentedByVariable (alphabet₀ alphabet₁ : Alphabet) : Set where
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --   field
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --     one-variable-is-added : |v| alphabet₁ ≡ suc (|v| alphabet₀)
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --     function-domain-is-zero-at-new-variable : |f| alphabet₁ zero ≡ 0
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --     shifted-function-matches : ∀ {ytira₀ ytira₁} → finToNat ytira₁ ≡ finToNat ytira₀ → |f| alphabet₁ (suc ytira₁) ≡ |f| alphabet₀ ytira₀

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- record AugmentVariables (alphabet₀ : Alphabet) : Set where
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --   field
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --     alphabet₁ : Alphabet
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --     augmentation : AugmentedByVariable alphabet₀ alphabet₁

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- open AugmentVariables

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- augmentVariables : (alphabet : Alphabet) → AugmentVariables alphabet
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- augmentVariables ⟨ |v| , |f| ⟩ =
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --   record
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --   { alphabet₁ = ⟨ suc |v| , (λ { zero → zero ; (suc ytira) → |f| ytira}) ⟩
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --   ; augmentation =
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --     record
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --     { one-variable-is-added = refl
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --     ; function-domain-is-zero-at-new-variable = refl
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --     ; shifted-function-matches = cong |f| ∘ finToNat-inj } }

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- |f|₀ = |f|₀ + 1
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- augmentFunctions : Alphabet → Alphabet
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- augmentFunctions ⟨ |v| , |f| ⟩ = ⟨ |v| , (λ { zero → suc (|f| zero) ; (suc ytira) → |f| (suc ytira) }) ⟩

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- data QFormula {i : Size} (alphabet : Alphabet) : Set where
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --   atomic : PredicateName → ∀ {arity} → Vec (Term alphabet) arity → QFormula alphabet
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --   logical : {j : Size< i} → QFormula {j} alphabet → {k : Size< i} → QFormula {k} alphabet → QFormula {i} alphabet
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --   universal : QFormula (alphabet₁ (augmentVariables alphabet)) → QFormula alphabet
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --   existential : QFormula (augmentFunctions alphabet) → QFormula alphabet

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- record Assignment (alphabet : Alphabet) : Set where
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --   constructor ⟨_,_⟩
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --   field
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --     μ : VariableName alphabet → Domain
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --     𝑓 : ∀ {arity} → FunctionName alphabet arity → Vec Domain (finToNat arity) → Domain

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- evaluateTerm : ∀ {i alphabet} → Assignment alphabet → Term {i} alphabet → Domain
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- evaluateTerm ⟨ μ , _ ⟩ (variable x) = μ x
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- evaluateTerm 𝑎@(⟨ μ , 𝑓 ⟩) (function f x) = 𝑓 f (evaluateTerm 𝑎 <$> x)

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- record Interpretation (alphabet : Alphabet) : Set where
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --   constructor ⟨_,_⟩
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --   open Assignment
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --   field
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --     𝑎 : Assignment alphabet
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --     𝑃 : PredicateName → ∀ {arity} → Vec Domain arity → Bool

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- evaluateNQFormula : ∀ {i alphabet} → Interpretation alphabet → NQFormula {i} alphabet → Bool
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- evaluateNQFormula ⟨ 𝑎 , 𝑃 ⟩ (atomic name terms) = 𝑃 name $ evaluateTerm 𝑎 <$> terms
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- evaluateNQFormula I (logical formula₁ formula₂) = not (evaluateNQFormula I formula₁) && not (evaluateNQFormula I formula₂)

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- toNQFormula : ∀ {alphabet₀} → QFormula alphabet₀ → Σ _ λ alphabet₁ → NQFormula alphabet₁
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- toNQFormula {alphabet₀} (atomic name terms) = alphabet₀ , atomic name terms
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- toNQFormula {alphabet₀} (logical formula₁ formula₂) with toNQFormula formula₁ | toNQFormula formula₂
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- … | alphabet₁ , nqFormula₁ | alphabet₂ , nqFormula₂ = {!!}
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- toNQFormula {alphabet₀} (universal formula) = {!!}
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- toNQFormula {alphabet₀} (existential formula) = {!!}

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- record IsADisjointUnionOfNQFormulas
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --        {alphabet₁ alphabet₂ alphabet₁₊₂ : Alphabet}
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --        (formula₁ : NQFormula alphabet₁)
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --        (formula₂ : NQFormula alphabet₂)
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --        (formula₁₊₂ : NQFormula alphabet₁₊₂)
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --        : Set where
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --   field
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --     alphabet-size : |v| alphabet₁₊₂ ≡ |v| alphabet₁ + |v| alphabet₂
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --     --|f| alphabet₁₊₂ ytira

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- ----record AlphabetSummed  (alphabet₀ alphabet₁ : Alphabet)
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --addAlphabets : Alphabet → Alphabet → Alphabet
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --addAlphabets ⟨ |v|₁ , |f|₁ ⟩ ⟨ |v|₂ , |f|₂ ⟩ = ⟨ (|v|₁ + |v|₂) , (λ x → if′ finToNat x ≤? |v|₁ && finToNat x ≤? |v|₂ then {!!} else {!!}) ⟩

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- sup : ∀ {alphabet₁} → Formula alphabet₁ → ∀ {alphabet₂} → Formula alphabet₂ → Σ _ λ alphabet₁₊₂ → Formula alphabet₁₊₂ × Formula alphabet₁₊₂
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- sup {⟨ |v|₁ , |a|₁ , |f|₁ ⟩} φ₁ {⟨ |v|₂ , |a|₂ , |f|₂ ⟩} φ₂ = {!!}

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- pnf : ∀ {alphabet} → Formula alphabet → Σ _ λ alphabet+ → Formula₀ alphabet+
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- pnf = {!!}

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- {-
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --universal (P 0) = ∀ x → P x
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- (∀ x ∃ y (P x y)) ∨ (∀ x ∃ y (P x y))
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- P x₀ (s₀͍₁ x₀) ∨ P x₁ (s₁͍₁ x₁)

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -}

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --   extended|f| : (arity : Arity) → Vec ℕ (suc |a|) → Vec ℕ (++arity (max arity |a|))
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --   extended|f| = {!!}

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- add a variable to the alphabet
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- augmentVariables : Alphabet → Alphabet
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- augmentVariables = {!!}

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- increaseTabulationAtN : ∀ {n} → Fin n → (Fin n → Nat) → Fin n → Nat
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- increaseTabulationAtN = {!!}
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- {-
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- record AugmentedFunctions {|a| : Arity} (arity : Arity) (|f| : Vec ℕ (++arity |a|)) : Set where
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --   field
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --     maxA : ℕ
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --     maxA-law : max arity |a| ≡ maxA
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --     ++|f| : Vec ℕ maxA
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --     f-law : increaseTabulationAt arity (indexVec |f|)
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -}
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- {-

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- define
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- a ⊗ b ≡ False a and False b

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- now, we can define
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- ¬a = a ⊗ a ≡ False a and False a
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- a ∨ b = ¬(a ⊗ b) ≡ False (False a and False b) and False (False a and False b)
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- a ∧ b = ¬(¬a ∨ ¬b) = ¬(¬(¬a ⊗ ¬b)) = ¬a ⊗ ¬b = False (False a and False a) and False (False b and False b)
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- a → b = ¬a ∨ b = (a ⊗ a) ∨ b = ¬((a ⊗ a) ⊗ b) = ((a ⊗ a) ⊗ b) ⊗ ((a ⊗ a) ⊗ b)

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- conversion to prenex
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- ∀xF ⊗ G ⟿ ∃x(F ⊗ wk(G))
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- ∃xF ⊗ G ⟿ ∀x(F ⊗ wk(G))
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- F ⊗ ∀xG ⟿ ∃x(wk(F) ⊗ G)
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- F ⊗ ∃xG ⟿ ∀x(wk(F) ⊗ G)
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- ========================
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- (a ⊗ ∀xB) ⊗ c ⟿ ∃x(wk(a) ⊗ B) ⊗ c ⟿ ∀x((wk(a) ⊗ B) ⊗ wk(c))
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -}

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- augmentF : (arity : Arity) → ∀ {|a| : Arity} → Vec ℕ (++arity |a|) → Vec ℕ (++arity (max arity |a|))
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- augmentF arity {|a|} |f|
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --  with decBool (lessNat |a| arity)
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- augmentF arity {|a|} |f| | yes x with compare arity |a|
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- augmentF arity {.(suc (k + arity))} |f| | yes x | less (diff k refl) = {!!}
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- augmentF arity {.arity} |f| | yes x | equal refl with lessNat arity arity
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- augmentF arity {.arity} |f| | yes x | equal refl | false = {!!}
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- augmentF zero {.zero} |f| | yes true | equal refl | true = {!!} ∷ []
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- augmentF (suc arity) {.(suc arity)} |f| | yes true | equal refl | true = {!!}
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- augmentF arity {|a|} |f| | yes x | greater gt = {!!}
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- augmentF arity {|a|} |f| | no x with decBool (lessNat arity |a|)
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- augmentF arity {|a|} |f| | no x₁ | yes x = {!!}
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- augmentF arity {|a|} |f| | no x₁ | no x = {!!}

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- = case arity <? |a| of λ { false → {!!} ; true → {!!} }

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- add a function of a given arity to the alphabet
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- augmentFunctions : Arity → Alphabet → Alphabet
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- augmentFunctions arity ⟨ |v| , |a| , |f| ⟩ = ⟨ |v| , max arity |a| , augmentF arity |f| ⟩

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- record Alphabet : Set where

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- data DomainSignifier : Set where
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --   free : Nat → DomainSignifier

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- data PartiallyAppliedFunction : Nat → Set where
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --   constant : PartiallyAppliedFunction 0
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --   function : ∀ {n} → PartiallyAppliedFunction 0 → PartiallyAppliedFunction (suc n)

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- Term = PartiallyAppliedFunction 0

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- data PartialyAppliedPredicate : Nat → Set where
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --   statement : PartialyAppliedPredicate 0
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --   partial : ∀

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- record Language : Set where
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --   field

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- Name = String

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- record Function : Set where
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --   field
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --     name : Name
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --     number-of-arguments : Nat

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- Vec

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- data Function : Set where

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- data Term : Set where
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --   function : Function →

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- data Sentence : Set where
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --   predication : Name →

-- -- -- -- -- -- {-

-- -- -- -- -- -- record Variables : Set where
-- -- -- -- -- --   constructor V⟨_⟩
-- -- -- -- -- --   field
-- -- -- -- -- --     number : Nat
-- -- -- -- -- -- open Variables

-- -- -- -- -- -- record Functions (υ : Variables) : Set where
-- -- -- -- -- --   constructor S⟨_⟩
-- -- -- -- -- --   field
-- -- -- -- -- --     number : Fin (suc (number υ)) → Nat
-- -- -- -- -- -- open Functions

-- -- -- -- -- -- record Alphabet : Set where
-- -- -- -- -- --   constructor α⟨_,_⟩
-- -- -- -- -- --   field
-- -- -- -- -- --     variables : Variables
-- -- -- -- -- --     functions : Functions variables
-- -- -- -- -- -- open Alphabet

-- -- -- -- -- -- record Variable (α : Alphabet) : Set where
-- -- -- -- -- --   constructor v⟨_⟩
-- -- -- -- -- --   field
-- -- -- -- -- --     name : Fin (number (variables α))
-- -- -- -- -- -- open Variable

-- -- -- -- -- -- record Function (α : Alphabet) : Set where
-- -- -- -- -- --   constructor s⟨_,_⟩
-- -- -- -- -- --   field
-- -- -- -- -- --     arity : Fin ∘ suc ∘ number ∘ variables $ α
-- -- -- -- -- --     name : Fin $ number (functions α) arity
-- -- -- -- -- -- open Function

-- -- -- -- -- -- data Term (𝑽 : Nat) : Set where
-- -- -- -- -- --   variable : Fin 𝑽 → Term 𝑽
-- -- -- -- -- --   function : (𝑓 : Function α) → {ι₋₁ : Size< ι₀} → Vec (Term {ι₋₁} α) (finToNat (arity 𝑓)) →
-- -- -- -- -- --              Term {ι₀} α

-- -- -- -- -- -- record Predication (alphabet : Alphabet) : Set where
-- -- -- -- -- --   constructor P⟨_,_,_⟩
-- -- -- -- -- --   field
-- -- -- -- -- --     name : Nat
-- -- -- -- -- --     arity : Nat
-- -- -- -- -- --     terms : Vec (Term alphabet) arity
-- -- -- -- -- -- open Predication
-- -- -- -- -- -- -}

-- -- module NotUsed where

-- --   -- thought it might be easier to use this
-- --   module UsingContainerList where

-- --     record TermNode : Set
-- --      where
-- --       inductive
-- --       field
-- --         children : List (TermCode × TermNode)
-- --         number : Nat

-- --     open TermNode

-- --     _child∈_ : TermCode → TermNode → Set
-- --     _child∈_ 𝔠 𝔫 = Any ((𝔠 ≡_) ∘ fst) (children 𝔫)

-- --   -- this still has a lambda problem, albeit weirder
-- --   module RememberChildren where

-- --     record TermNode : Set
-- --      where
-- --       inductive
-- --       field
-- --         tests : List TermCode
-- --         children : ∀ {𝔠} → 𝔠 ∈ tests → TermNode
-- --         number : Nat
-- --     open TermNode

-- --     addChild : {𝔠 : TermCode} (𝔫 : TermNode) → 𝔠 ∉ tests 𝔫 → TermNode → TermNode
-- --     addChild {𝔠} 𝔫 𝔠∉tests𝔫 𝔫' =
-- --       record 𝔫
-- --       { tests = 𝔠 ∷ tests 𝔫
-- --       ; children = λ
-- --         { (here _) → 𝔫'
-- --         ; (there _ 𝔠'∈tests) → children 𝔫 𝔠'∈tests }}

-- --     setChild : {𝔠 : TermCode} (𝔫 : TermNode) → 𝔠 ∈ tests 𝔫 → TermNode → TermNode
-- --     setChild {𝔠} 𝔫 𝔠∈tests𝔫 𝔫' =
-- --       record 𝔫
-- --       { children = λ {𝔠'} 𝔠'∈tests𝔫' → ifYes 𝔠' ≟ 𝔠 then 𝔫' else children 𝔫 𝔠'∈tests𝔫' }

-- --     storeTermCodes : List TermCode → Nat → StateT TermNode Identity Nat
-- --     storeTermCodes [] 𝔑 = return 𝔑
-- --     storeTermCodes (𝔠 ∷ 𝔠s) 𝔑 =
-- --       𝔫 ← get -|
-- --       case 𝔠 ∈? tests 𝔫 of λ
-- --       { (no 𝔠∉tests) →
-- --         let 𝔑' , 𝔫' = runIdentity $
-- --                       runStateT
-- --                         (storeTermCodes 𝔠s $ suc 𝔑)
-- --                         (record
-- --                           { tests = []
-- --                           ; children = λ ()
-- --                           ; number = suc 𝔑 }) in
-- --         put (addChild 𝔫 𝔠∉tests 𝔫') ~|
-- --         return 𝔑'
-- --       ; (yes 𝔠∈tests) →
-- --         let 𝔑' , 𝔫' = runIdentity $
-- --                       runStateT
-- --                         (storeTermCodes 𝔠s $ suc 𝔑)
-- --                         (children 𝔫 𝔠∈tests) in
-- --         put (setChild 𝔫 𝔠∈tests 𝔫') ~|
-- --         return 𝔑' }

-- --     topNode : TermNode
-- --     topNode = record { tests = [] ; children = λ () ; number = 0 }

-- --     example-store : TermNode
-- --     example-store = snd ∘ runIdentity $ runStateT (storeTermCodes example-TermCodes 0) topNode

-- --     foo : TermNode × TermNode
-- --     foo =
-- --       {!example-store!} ,
-- --       {!snd ∘ runIdentity $ runStateT (storeTermCodes example-TermCodes 10) example-store!}

-- --   -- using a lambda for the children results in extra unnecessary structure when adding to an existing node; perhaps using an explicit mapping? or use another field to state what codes are present in the mapping?
-- --   module NoParents where

-- --     mutual

-- --       record TermNode : Set
-- --        where
-- --         inductive
-- --         field
-- --           children : TermCode → Maybe TermNode -- Map TermCode TermNode
-- --           self : TermCode
-- --           number : Nat

-- --       record TopTermNode : Set
-- --        where
-- --         inductive
-- --         field
-- --           children : TermCode → Maybe TermNode

-- --     open TermNode
-- --     open TopTermNode

-- --     storeTermCodes : List TermCode → Nat → StateT TermNode Identity ⊤
-- --     storeTermCodes [] _ = return tt
-- --     storeTermCodes (𝔠 ∷ 𝔠s) 𝔑 =
-- --       𝔫 ← get -|
-- --       case children 𝔫 𝔠 of λ
-- --       { nothing →
-- --         put
-- --           (record 𝔫
-- --             { children =
-- --               λ 𝔠' →
-- --               ifYes 𝔠' ≟ 𝔠 then
-- --                 just ∘ snd ∘ runIdentity $
-- --                 (runStateT
-- --                   (storeTermCodes 𝔠s (suc 𝔑))
-- --                     (record
-- --                       { self = 𝔠
-- --                       ; children = const nothing
-- --                       ; number = suc 𝔑 }))
-- --               else
-- --                 children 𝔫 𝔠' } ) ~|
-- --         return tt
-- --       ; (just 𝔫') →
-- --         put (record 𝔫
-- --               { children =
-- --                 λ 𝔠' →
-- --                 ifYes 𝔠' ≟ 𝔠 then
-- --                   just ∘ snd ∘ runIdentity $
-- --                   runStateT (storeTermCodes 𝔠s 𝔑) 𝔫'
-- --                 else
-- --                   children 𝔫 𝔠' }) ~|
-- --         return tt }

-- --     storeTermCodesAtTop : List TermCode → Nat → StateT TopTermNode Identity ⊤
-- --     storeTermCodesAtTop [] _ = return tt
-- --     storeTermCodesAtTop (𝔠 ∷ 𝔠s) 𝔑 =
-- --       𝔫 ← get -|
-- --       case children 𝔫 𝔠 of λ
-- --       { nothing →
-- --         put
-- --           (record 𝔫
-- --             { children =
-- --               λ 𝔠' →
-- --               ifYes 𝔠' ≟ 𝔠 then
-- --                 just ∘ snd ∘ runIdentity $
-- --                 (runStateT
-- --                   (storeTermCodes 𝔠s (suc 𝔑))
-- --                     (record
-- --                       { self = 𝔠
-- --                       ; children = const nothing
-- --                       ; number = suc 𝔑 }))
-- --               else
-- --                 children 𝔫 𝔠' } ) ~|
-- --         return tt
-- --       ; (just 𝔫') →
-- --         put (record 𝔫
-- --               { children =
-- --                 λ 𝔠' →
-- --                 ifYes 𝔠' ≟ 𝔠 then
-- --                   just ∘ snd ∘ runIdentity $
-- --                   runStateT (storeTermCodes 𝔠s 𝔑) 𝔫'
-- --                 else
-- --                   children 𝔫 𝔠' }) ~|
-- --         return tt }

-- --     initialTopNode : TopTermNode
-- --     initialTopNode = record { children = const nothing }

-- --     example-store : TopTermNode
-- --     example-store = snd ∘ runIdentity $ runStateT (storeTermCodesAtTop example-TermCodes 0) initialTopNode

-- --     foo : TopTermNode × TopTermNode
-- --     foo =
-- --       {!example-store!} ,
-- --       {!snd ∘ runIdentity $ runStateT (storeTermCodesAtTop example-TermCodes 10) example-store!}

-- --   -- it's tricky to keep the parents up to date when the children change (viz adolescence)
-- --   module FirstTryWithParent where
-- --     mutual

-- --       record TermNode : Set
-- --        where
-- --         inductive
-- --         field
-- --           parent : TopTermNode ⊎ TermNode
-- --           self : TermCode
-- --           children : TermCode → Maybe TermNode -- Map TermCode TermNode
-- --           number : Nat

-- --       record TopTermNode : Set
-- --        where
-- --         inductive
-- --         field
-- --           children : TermCode → Maybe TermNode

-- --     open TermNode
-- --     open TopTermNode

-- --     storeTermCodes : List TermCode → Nat → StateT TermNode Identity ⊤
-- --     storeTermCodes [] _ = return tt
-- --     storeTermCodes (𝔠 ∷ 𝔠s) 𝔑 =
-- --       𝔫 ← get -|
-- --       case children 𝔫 𝔠 of λ
-- --       { nothing →
-- --         put
-- --           (record 𝔫
-- --             { children =
-- --               λ 𝔠' →
-- --               ifYes 𝔠' ≟ 𝔠 then
-- --                 just ∘ snd ∘ runIdentity $
-- --                 (runStateT
-- --                   (storeTermCodes 𝔠s (suc 𝔑))
-- --                     (record
-- --                       { parent = right 𝔫
-- --                       ; self = 𝔠
-- --                       ; children = const nothing
-- --                       ; number = suc 𝔑 }))
-- --               else
-- --                 children 𝔫 𝔠' } ) ~|
-- --         return tt
-- --       ; (just 𝔫') →
-- --         put (record 𝔫
-- --               { children =
-- --                 λ 𝔠' →
-- --                 ifYes 𝔠' ≟ 𝔠 then
-- --                   just ∘ snd ∘ runIdentity $
-- --                   runStateT (storeTermCodes 𝔠s 𝔑) 𝔫'
-- --                 else
-- --                   children 𝔫 𝔠' }) ~|
-- --         return tt }

-- --     storeTermCodesAtTop : List TermCode → Nat → StateT TopTermNode Identity ⊤
-- --     storeTermCodesAtTop [] _ = return tt
-- --     storeTermCodesAtTop (𝔠 ∷ 𝔠s) 𝔑 =
-- --       𝔫 ← get -|
-- --       case children 𝔫 𝔠 of λ
-- --       { nothing →
-- --         put
-- --           (record 𝔫
-- --             { children =
-- --               λ 𝔠' →
-- --               ifYes 𝔠' ≟ 𝔠 then
-- --                 just ∘ snd ∘ runIdentity $
-- --                 (runStateT
-- --                   (storeTermCodes 𝔠s (suc 𝔑))
-- --                     (record
-- --                       { parent = left 𝔫
-- --                       ; self = 𝔠
-- --                       ; children = const nothing
-- --                       ; number = suc 𝔑 }))
-- --               else
-- --                 children 𝔫 𝔠' } ) ~|
-- --         return tt
-- --       ; (just 𝔫') →
-- --         put (record 𝔫
-- --               { children =
-- --                 λ 𝔠' →
-- --                 ifYes 𝔠' ≟ 𝔠 then
-- --                   just ∘ snd ∘ runIdentity $
-- --                   runStateT (storeTermCodes 𝔠s 𝔑) 𝔫'
-- --                 else
-- --                   children 𝔫 𝔠' }) ~|
-- --         return tt }

-- --     initialTopNode : TopTermNode
-- --     initialTopNode = record { children = const nothing }

-- --     example-store : TopTermNode
-- --     example-store = snd ∘ runIdentity $ runStateT (storeTermCodesAtTop example-TermCodes 0) initialTopNode

-- --     foo : TopTermNode
-- --     foo = {!example-store!}
-- --
-- --
-- -- _⟪_⟫_ : ∀ {a b c} {A : Set a} {B : Set b} {C : Set c} →
-- --         A → (A → B → C) → B → C
-- -- x ⟪ f ⟫ y = f x y
-- --
-- -- {-
-- -- infixr 9 _∘₂′_
-- -- _∘₂′_ : ∀ {a b c d} {A : Set a} {B : Set b} {C : Set c} {D : Set d} →
-- --          (C → D) → (A → B → C) → (A → B → D)
-- -- _∘₂′_ = _∘′_ ∘ _∘′_
-- -- {-# INLINE _∘₂′_ #-}
-- --
-- -- infixr 9 _∘₂′_
-- -- _∘₂′_ : ∀ {a b c d} {A : Set a} {B : Set b} {C : Set c} {D : Set d} →
-- --          (C → D) → (A → B → C) → (A → B → D)
-- -- _∘₂′_ = _∘′_ ∘ _∘′_
-- -- {-# INLINE _∘₂′_ #-}
-- -- -}
-- -- {-
-- -- infixr 9 _∘₂_
-- -- _∘₂_ : ∀ {a b c d} {A : Set a} {B : A → Set b} {C : ∀ x → B x → Set c} {D : ∀ x → B x → C x
-- --          (f : ∀ {x} (y : B x) → C x y) (g : ∀ x → B x) →
-- --          ∀ x → C x (g x)
-- -- _∘₂_ = _∘′_ ∘ _∘′_
-- -- {-# INLINE _∘₂′_ #-}
-- -- -}


{-# OPTIONS --cubical --no-import-sorts --safe #-}
module Cubical.Data.Empty.Base where

open import Cubical.Core.Everything
open import Cubical.Foundations.Prelude

private
  variable
    ℓ : Level

data ⊥ : Type₀ where

⊥* : Type ℓ
⊥* = Lift ⊥

rec : {A : Type ℓ} → ⊥ → A
rec ()

elim : {A : ⊥ → Type ℓ} → (x : ⊥) → A x
elim ()


data D : Set where
  c_c_ : D → D

test : D → D
test c x c_ = x


{-# OPTIONS --no-positivity-check #-}

module STLC.Coquand.Normalisation where

open import STLC.Coquand.Substitution public

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

record 𝔐 : Set₁ where
  field
    𝒲      : Set

    𝒢      : 𝒲 → Set

    _⊒_    : 𝒲 → 𝒲 → Set

    idₐ    : ∀ {w} → w ⊒ w

    _◇_    : ∀ {w w′ w″} → w″ ⊒ w′ → w′ ⊒ w → w″ ⊒ w

    lid◇   : ∀ {w w′} → (ξ : w′ ⊒ w)
                      → idₐ ◇ ξ ≡ ξ

    rid◇   : ∀ {w w′} → (ξ : w′ ⊒ w)
                      → ξ ◇ idₐ ≡ ξ

    assoc◇ : ∀ {w w′ w″ w‴} → (ξ₁ : w‴ ⊒ w″) (ξ₂ : w″ ⊒ w′) (ξ₃ : w′ ⊒ w)
                            → ξ₁ ◇ (ξ₂ ◇ ξ₃) ≡ (ξ₁ ◇ ξ₂) ◇ ξ₃

module _ {{𝔪 : 𝔐}} where
  open 𝔐 𝔪

  infix 3 _⊩_
  data _⊩_ : 𝒲 → 𝒯 → Set
    where
      ⟦G⟧ : ∀ {w} → (h : ∀ {w′} → (ξ : w′ ⊒ w)
                                 → 𝒢 w′)
                  → w ⊩ ⎵

      ⟦ƛ⟧ : ∀ {A B w} → (h : ∀ {w′} → (ξ : w′ ⊒ w) (a : w′ ⊩ A)
                                     → w′ ⊩ B)
                      → w ⊩ A ⇒ B

  ⟦g⟧⟨_⟩ : ∀ {w w′} → w′ ⊒ w → w ⊩ ⎵ → 𝒢 w′
  ⟦g⟧⟨ ξ ⟩ (⟦G⟧ f) = f ξ

  _⟦∙⟧⟨_⟩_ : ∀ {A B w w′} → w ⊩ A ⇒ B → w′ ⊒ w → w′ ⊩ A → w′ ⊩ B
  (⟦ƛ⟧ f) ⟦∙⟧⟨ ξ ⟩ a = f ξ a

  -- ⟦putᵣ⟧ can’t be stated here
  -- ⟦getᵣ⟧ can’t be stated here
  -- ⟦wkᵣ⟧ can’t be stated here
  -- ⟦liftᵣ⟧ can’t be stated here
  -- idₐ = ⟦idᵣ⟧

  -- acc = ⟦ren⟧
  acc : ∀ {A w w′} → w′ ⊒ w → w ⊩ A → w′ ⊩ A
  acc {⎵}      ξ f = ⟦G⟧ (λ ξ′   → ⟦g⟧⟨ ξ′ ◇ ξ ⟩ f)
  acc {A ⇒ B} ξ f = ⟦ƛ⟧ (λ ξ′ a → f ⟦∙⟧⟨ ξ′ ◇ ξ ⟩ a)

  -- ⟦wk⟧ can’t be stated here
  -- _◇_ = _⟦○⟧_

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

module _ {{𝔪 : 𝔐}} where
  open 𝔐 𝔪

  mutual
    data Eq : ∀ {A w} → w ⊩ A → w ⊩ A → Set
      where
        eq⎵ : ∀ {w} → {f₁ f₂ : w ⊩ ⎵}
                    → (h : ∀ {w′} → (ξ : w′ ⊒ w)
                                   → ⟦g⟧⟨ ξ ⟩ f₁ ≡ ⟦g⟧⟨ ξ ⟩ f₂)
                    → Eq f₁ f₂

        eq⊃ : ∀ {A B w} → {f₁ f₂ : w ⊩ A ⇒ B}
                        → (h : ∀ {w′} → (ξ : w′ ⊒ w) {a : w′ ⊩ A} (u : Un a)
                                       → Eq (f₁ ⟦∙⟧⟨ ξ ⟩ a) (f₂ ⟦∙⟧⟨ ξ ⟩ a))
                        → Eq f₁ f₂

    data Un : ∀ {A w} → w ⊩ A → Set
      where
        un⎵ : ∀ {w} → {f : w ⊩ ⎵}
                    → Un f

        un⊃ : ∀ {A B w} → {f : w ⊩ A ⇒ B}
                        → (h₁ : ∀ {w′} → (ξ : w′ ⊒ w)
                                           {a : w′ ⊩ A}
                                           (u : Un a)
                                        → Un (f ⟦∙⟧⟨ ξ ⟩ a))
                        → (h₂ : ∀ {w′} → (ξ : w′ ⊒ w)
                                           {a₁ a₂ : w′ ⊩ A}
                                           (p : Eq a₁ a₂)
                                           (u₁ : Un a₁)
                                           (u₂ : Un a₂)
                                        → Eq (f ⟦∙⟧⟨ ξ ⟩ a₁) (f ⟦∙⟧⟨ ξ ⟩ a₂))
                        → (h₃ : ∀ {w′ w″} → (ξ₁ : w″ ⊒ w′)
                                              (ξ₂ : w′ ⊒ w)
                                              {a : w′ ⊩ A}
                                              (u : Un a)
                                           → Eq (acc ξ₁ (f ⟦∙⟧⟨ ξ₂ ⟩ a))
                                                 (f ⟦∙⟧⟨ ξ₁ ◇ ξ₂ ⟩ (acc ξ₁ a)))
                        → Un f

  reflEq : ∀ {A w} → {a : w ⊩ A}
                   → Un a
                   → Eq a a
  reflEq un⎵            = eq⎵ (λ ξ → refl)
  reflEq (un⊃ h₁ h₂ h₃) = eq⊃ (λ ξ u → reflEq (h₁ ξ u))

  _⁻¹Eq : ∀ {A w} → {a₁ a₂ : w ⊩ A}
                  → Eq a₁ a₂
                  → Eq a₂ a₁
  _⁻¹Eq {⎵}      (eq⎵ h) = eq⎵ (λ ξ → h ξ ⁻¹)
  _⁻¹Eq {A ⇒ B} (eq⊃ h) = eq⊃ (λ ξ u → h ξ u ⁻¹Eq)

  _⦙Eq_ : ∀ {A w} → {a₁ a₂ a₃ : w ⊩ A}
                  → Eq a₁ a₂ → Eq a₂ a₃
                  → Eq a₁ a₃
  _⦙Eq_ {⎵}      (eq⎵ h₁) (eq⎵ h₂) = eq⎵ (λ ξ → h₁ ξ ⦙ h₂ ξ)
  _⦙Eq_ {A ⇒ B} (eq⊃ h₁) (eq⊃ h₂) = eq⊃ (λ ξ u → h₁ ξ u ⦙Eq h₂ ξ u)

  ≡→Eq : ∀ {A w} → {a₁ a₂ : w ⊩ A}
                  → a₁ ≡ a₂ → Un a₁
                  → Eq a₁ a₂
  ≡→Eq refl u = reflEq u

  instance
    perEq : ∀ {A w} → PER (w ⊩ A) Eq
    perEq =
      record
        { _⁻¹ = _⁻¹Eq
        ; _⦙_ = _⦙Eq_
        }

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

module _ {{𝔪 : 𝔐}} where
  open 𝔐 𝔪

  -- (cong⟦∙⟧⟨_⟩Eq)
  postulate
    cong⟦∙⟧Eq : ∀ {A B w w′} → {f₁ f₂ : w ⊩ A ⇒ B} {a₁ a₂ : w′ ⊩ A}
                             → (ξ : w′ ⊒ w)
                             → Eq f₁ f₂ → Un f₁ → Un f₂
                             → Eq a₁ a₂ → Un a₁ → Un a₂
                             → Eq (f₁ ⟦∙⟧⟨ ξ ⟩ a₁)
                                   (f₂ ⟦∙⟧⟨ ξ ⟩ a₂)

  cong⟦∙⟧Un : ∀ {A B w w′} → {f : w ⊩ A ⇒ B} {a : w′ ⊩ A}
                           → (ξ : w′ ⊒ w) → Un f → Un a
                           → Un (f ⟦∙⟧⟨ ξ ⟩ a)
  cong⟦∙⟧Un ξ (un⊃ h₁ h₂ h₃) u = h₁ ξ u

  -- (cong↑⟨_⟩Eq)
  postulate
    congaccEq : ∀ {A w w′} → {a₁ a₂ : w ⊩ A}
                           → (ξ : w′ ⊒ w) → Eq a₁ a₂
                           → Eq (acc ξ a₁) (acc ξ a₂)

  -- (cong↑⟨_⟩𝒰)
  postulate
    congaccUn : ∀ {A w w′} → {a : w ⊩ A}
                           → (ξ : w′ ⊒ w) → Un a
                           → Un (acc ξ a)

  -- (aux₄₁₁)
  postulate
    lidaccEq : ∀ {A w} → {a : w ⊩ A}
                       → Un a
                       → Eq (acc idₐ a) a

  -- (aux₄₁₂)
  postulate
    acc◇Eq : ∀ {A w w′ w″} → {a : w ⊩ A}
                           → (ξ₁ : w″ ⊒ w′) (ξ₂ : w′ ⊒ w) → Un a
                           → Eq (acc (ξ₁ ◇ ξ₂) a)
                                 ((acc ξ₁ ∘ acc ξ₂) a)

  -- (aux₄₁₃)
  postulate
    acc⟦∙⟧idEq : ∀ {A B w w′} → {f : w ⊩ A ⇒ B} {a : w′ ⊩ A}
                              → (ξ : w′ ⊒ w) → Un f → Un a
                              → Eq (acc ξ f ⟦∙⟧⟨ idₐ ⟩ a)
                                    (f ⟦∙⟧⟨ ξ ⟩ a)

  acc⟦∙⟧Eq : ∀ {A B w w′ w″} → {f : w ⊩ A ⇒ B} {a : w′ ⊩ A}
                             → (ξ₁ : w′ ⊒ w) (ξ₂ : w″ ⊒ w′) → Un f → Un a
                             → Eq (acc ξ₁ f ⟦∙⟧⟨ ξ₂ ⟩ acc ξ₂ a)
                                   (acc ξ₂ (f ⟦∙⟧⟨ ξ₁ ⟩ a))
  acc⟦∙⟧Eq ξ₁ ξ₂ (un⊃ h₁ h₂ h₃) u = h₃ ξ₂ ξ₁ u ⁻¹

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

module _ {{𝔪 : 𝔐}} where
  open 𝔐 𝔪

  infix 3 _⊩⋆_
  data _⊩⋆_ : 𝒲 → 𝒞 → Set
    where
      ∅   : ∀ {w} → w ⊩⋆ ∅

      _,_ : ∀ {Ξ A w} → (ρ : w ⊩⋆ Ξ) (a : w ⊩ A) →
                         w ⊩⋆ Ξ , A

  -- ⟦putₛ⟧ can’t be stated here

  -- getᵥ = ⟦getₛ⟧ (lookup)
  getᵥ : ∀ {Ξ A w} → w ⊩⋆ Ξ → Ξ ∋ A → w ⊩ A
  getᵥ (ρ , a) zero    = a
  getᵥ (ρ , a) (suc i) = getᵥ ρ i

  -- unwkᵥ ≡ ⟦unwkₛ⟧
  unwkᵥ : ∀ {Ξ A w} → w ⊩⋆ Ξ , A → w ⊩⋆ Ξ
  unwkᵥ (ρ , a) = ρ

  -- ⟦wkₛ⟧ can’t be stated here
  -- ⟦liftₛ⟧ can’t be stated here
  -- ⟦idₛ⟧ can’t be stated here
  -- ⟦sub⟧ can’t be stated here
  -- ⟦cut⟧ can’t be stated here
  -- _◆_ can’t be stated here

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

module _ {{𝔪 : 𝔐}} where
  open 𝔐 𝔪

  -- (⟦_◑_⟧ / ↑⟨_⟩⊩⋆)
  _⬗_ : ∀ {Ξ w w′} → w′ ⊒ w → w ⊩⋆ Ξ → w′ ⊩⋆ Ξ
  ξ ⬗ ∅       = ∅
  ξ ⬗ (ρ , a) = ξ ⬗ ρ , acc ξ a

  -- (⟦_◐_⟧ / ↓⟨_⟩⊩⋆)
  _⬖_ : ∀ {Ξ Ξ′ w} → w ⊩⋆ Ξ′ → Ξ′ ∋⋆ Ξ → w ⊩⋆ Ξ
  ρ ⬖ ∅       = ∅
  ρ ⬖ (η , i) = ρ ⬖ η , getᵥ ρ i

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

module _ {{𝔪 : 𝔐}} where
  open 𝔐 𝔪

  zap⬖ : ∀ {Ξ Ξ′ A w} → (ρ : w ⊩⋆ Ξ′) (η : Ξ′ ∋⋆ Ξ) (a : w ⊩ A)
                      → (ρ , a) ⬖ wkᵣ η ≡ ρ ⬖ η
  zap⬖ ρ ∅       a = refl
  zap⬖ ρ (η , i) a = (_, getᵥ ρ i) & zap⬖ ρ η a

  rid⬖ : ∀ {Ξ w} → (ρ : w ⊩⋆ Ξ)
                 → ρ ⬖ idᵣ ≡ ρ
  rid⬖ ∅       = refl
  rid⬖ (ρ , a) = (_, a) & ( zap⬖ ρ idᵣ a
                          ⦙ rid⬖ ρ
                          )

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

module _ {{𝔪 : 𝔐}} where
  open 𝔐 𝔪

  get⬖ : ∀ {Ξ Ξ′ A w} → (ρ : w ⊩⋆ Ξ′) (η : Ξ′ ∋⋆ Ξ) (i : Ξ ∋ A)
                      → getᵥ (ρ ⬖ η) i ≡ (getᵥ ρ ∘ getᵣ η) i
  get⬖ ρ (η , j) zero    = refl
  get⬖ ρ (η , j) (suc i) = get⬖ ρ η i

  comp⬖○ : ∀ {Ξ Ξ′ Ξ″ w} → (ρ : w ⊩⋆ Ξ″) (η₁ : Ξ″ ∋⋆ Ξ′) (η₂ : Ξ′ ∋⋆ Ξ)
                         → ρ ⬖ (η₁ ○ η₂) ≡ (ρ ⬖ η₁) ⬖ η₂
  comp⬖○ σ η₁ ∅        = refl
  comp⬖○ σ η₁ (η₂ , i) = _,_ & comp⬖○ σ η₁ η₂
                             ⊗ (get⬖ σ η₁ i ⁻¹)

  -- wk⬖ can’t be stated here
  -- lift⬖ can’t be stated here
  -- wkrid⬖ can’t be stated here
  -- liftwkrid⬖ can’t be stated here
  -- sub⬖ can’t be stated here
  -- subwk⬖ can’t be stated here
  -- sublift⬖ can’t be stated here
  -- subliftwk⬖ can’t be stated here

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

module _ {{𝔪 : 𝔐}} where
  open 𝔐 𝔪

  data Eq⋆ : ∀ {Ξ w} → w ⊩⋆ Ξ → w ⊩⋆ Ξ → Set
    where
      ∅   : ∀ {w} → Eq⋆ (∅ {w}) ∅

      _,_ : ∀ {Ξ A w} → {ρ₁ ρ₂ : w ⊩⋆ Ξ} {a₁ a₂ : w ⊩ A}
                      → (χ : Eq⋆ ρ₁ ρ₂) (p : Eq a₁ a₂)
                      → Eq⋆ (ρ₁ , a₁) (ρ₂ , a₂)

  data Un⋆ : ∀ {Ξ w} → w ⊩⋆ Ξ → Set
    where
      ∅   : ∀ {w} → Un⋆ (∅ {w})

      _,_ : ∀ {Ξ A w} → {ρ : w ⊩⋆ Ξ} {a : w ⊩ A}
                      → (υ : Un⋆ ρ) (u : Un a)
                      → Un⋆ (ρ , a)

  reflEq⋆ : ∀ {Ξ w} → {ρ : w ⊩⋆ Ξ}
                    → Un⋆ ρ
                    → Eq⋆ ρ ρ
  reflEq⋆ ∅       = ∅
  reflEq⋆ (υ , u) = reflEq⋆ υ , reflEq u

  _⁻¹Eq⋆ : ∀ {Ξ w} → {ρ₁ ρ₂ : w ⊩⋆ Ξ}
                   → Eq⋆ ρ₁ ρ₂
                   → Eq⋆ ρ₂ ρ₁
  ∅       ⁻¹Eq⋆ = ∅
  (χ , p) ⁻¹Eq⋆ = χ ⁻¹Eq⋆ , p ⁻¹Eq

  _⦙Eq⋆_ : ∀ {Ξ w} → {ρ₁ ρ₂ ρ₃ : w ⊩⋆ Ξ}
                   → Eq⋆ ρ₁ ρ₂ → Eq⋆ ρ₂ ρ₃
                   → Eq⋆ ρ₁ ρ₃
  ∅        ⦙Eq⋆ ∅        = ∅
  (χ₁ , p) ⦙Eq⋆ (χ₂ , q) = χ₁ ⦙Eq⋆ χ₂ , p ⦙Eq q

  ≡→Eq⋆ : ∀ {Ξ w} → {ρ₁ ρ₂ : w ⊩⋆ Ξ}
                   → ρ₁ ≡ ρ₂ → Un⋆ ρ₁
                   → Eq⋆ ρ₁ ρ₂
  ≡→Eq⋆ refl υ = reflEq⋆ υ

  instance
    perEq⋆ : ∀ {Ξ w} → PER (w ⊩⋆ Ξ) Eq⋆
    perEq⋆ =
      record
        { _⁻¹ = _⁻¹Eq⋆
        ; _⦙_ = _⦙Eq⋆_
        }

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

module _ {{𝔪 : 𝔐}} where
  open 𝔐 𝔪

  -- (conglookupEq)
  postulate
    conggetEq : ∀ {Ξ A w} → {ρ₁ ρ₂ : w ⊩⋆ Ξ}
                          → (i : Ξ ∋ A) → Eq⋆ ρ₁ ρ₂
                          → Eq (getᵥ ρ₁ i) (getᵥ ρ₂ i)

  -- (cong↑⟨_⟩Eq⋆)
  postulate
    cong⬗Eq⋆ : ∀ {Ξ w w′} → {ρ₁ ρ₂ : w ⊩⋆ Ξ}
                          → (ξ : w′ ⊒ w) → Eq⋆ ρ₁ ρ₂
                          → Eq⋆ (ξ ⬗ ρ₁) (ξ ⬗ ρ₂)

  -- (cong↓⟨_⟩Eq⋆)
  postulate
    cong⬖Eq⋆ : ∀ {Ξ Ξ′ w} → {ρ₁ ρ₂ : w ⊩⋆ Ξ′}
                          → Eq⋆ ρ₁ ρ₂ → (η : Ξ′ ∋⋆ Ξ)
                          → Eq⋆ (ρ₁ ⬖ η) (ρ₂ ⬖ η)

  -- (conglookup𝒰)
  postulate
    conggetUn : ∀ {Ξ A w} → {ρ : w ⊩⋆ Ξ}
                          → (i : Ξ ∋ A) → Un⋆ ρ
                          → Un (getᵥ ρ i)

  -- (cong↑⟨_⟩𝒰⋆)
  postulate
    cong⬗Un⋆ : ∀ {Ξ w w′} → {ρ : w ⊩⋆ Ξ}
                          → (ξ : w′ ⊒ w) → Un⋆ ρ
                          → Un⋆ (ξ ⬗ ρ)

  -- (cong↓⟨_⟩𝒰⋆)
  postulate
    cong⬖Un⋆ : ∀ {Ξ Ξ′ w} → {ρ : w ⊩⋆ Ξ′}
                          → (η : Ξ′ ∋⋆ Ξ) → Un⋆ ρ
                          → Un⋆ (ρ ⬖ η)

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

module _ {{𝔪 : 𝔐}} where
  open 𝔐 𝔪

  -- (aux₄₂₁)
  postulate
    get⬖Eq : ∀ {Ξ Ξ′ A w} → {ρ : w ⊩⋆ Ξ′}
                          → (η : Ξ′ ∋⋆ Ξ) (i : Ξ′ ∋ A) (j : Ξ ∋ A) → Un⋆ ρ
                          → Eq (getᵥ (ρ ⬖ η) j)
                                (getᵥ ρ i)

  -- (conglookup↑⟨_⟩Eq)
  postulate
    get⬗Eq : ∀ {Ξ A w w′} → {ρ : w ⊩⋆ Ξ}
                          → (ξ : w′ ⊒ w) (i : Ξ ∋ A) → Un⋆ ρ
                          → Eq (getᵥ (ξ ⬗ ρ) i)
                                (acc ξ (getᵥ ρ i))

  -- (aux₄₂₃)
  postulate
    zap⬖Eq⋆ : ∀ {Ξ Ξ′ A w} → {ρ : w ⊩⋆ Ξ′} {a : w ⊩ A}
                           → (η₁ : Ξ′ , A ∋⋆ Ξ) (η₂ : Ξ′ ∋⋆ Ξ) → Un⋆ ρ
                           → Eq⋆ ((ρ , a) ⬖ η₁)
                                  (ρ ⬖ η₂)

  -- (aux₄₂₄)
  postulate
    rid⬖Eq⋆ : ∀ {Ξ w} → {ρ : w ⊩⋆ Ξ}
                      → Un⋆ ρ
                      → Eq⋆ (ρ ⬖ idᵣ) ρ

  -- (aux₄₂₅)
  postulate
    lid⬗Eq⋆ : ∀ {Ξ w} → {ρ : w ⊩⋆ Ξ}
                      → Un⋆ ρ
                      → Eq⋆ (idₐ ⬗ ρ) ρ

  -- (aux₄₂₆)
  postulate
    comp⬖○Eq⋆ : ∀ {Ξ Ξ′ Ξ″ w} → {ρ : w ⊩⋆ Ξ″}
                              → (η₁ : Ξ″ ∋⋆ Ξ′) (η₂ : Ξ′ ∋⋆ Ξ) → Un⋆ ρ
                              → Eq⋆ (ρ ⬖ (η₁ ○ η₂))
                                     ((ρ ⬖ η₁) ⬖ η₂)

  -- (aux₄₂₇)
  postulate
    comp⬗◇Eq⋆ : ∀ {Ξ w w′ w″} → {ρ : w ⊩⋆ Ξ}
                              → (ξ₁ : w″ ⊒ w′) (ξ₂ : w′ ⊒ w) → Un⋆ ρ
                              → Eq⋆ (ξ₁ ⬗ (ξ₂ ⬗ ρ))
                                     ((ξ₁ ◇ ξ₂) ⬗ ρ)

  -- (aux₄₂₈)
  postulate
    comp⬗⬖Eq⋆ : ∀ {Ξ Ξ′ w w′} → {ρ : w ⊩⋆ Ξ′}
                              → (ξ : w′ ⊒ w) (η : Ξ′ ∋⋆ Ξ) → Un⋆ ρ
                              → Eq⋆ (ξ ⬗ (ρ ⬖ η))
                                     ((ξ ⬗ ρ) ⬖ η)

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

module _ {{𝔪 : 𝔐}} where
  open 𝔐 𝔪

  ⟦_⟧ : ∀ {Ξ A w} → Ξ ⊢ A → w ⊩⋆ Ξ → w ⊩ A
  ⟦ 𝓋 i ⟧   ρ = getᵥ ρ i
  ⟦ ƛ M ⟧   ρ = ⟦ƛ⟧ (λ ξ a → ⟦ M ⟧ (ξ ⬗ ρ , a))
  ⟦ M ∙ N ⟧ ρ = ⟦ M ⟧ ρ ⟦∙⟧⟨ idₐ ⟩ ⟦ N ⟧ ρ

  ⟦_⟧⋆ : ∀ {Ξ Φ w} → Ξ ⊢⋆ Φ → w ⊩⋆ Ξ → w ⊩⋆ Φ
  ⟦ ∅ ⟧⋆     ρ = ∅
  ⟦ σ , M ⟧⋆ ρ = ⟦ σ ⟧⋆ ρ , ⟦ M ⟧ ρ

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

instance
  canon : 𝔐
  canon = record
    { 𝒲      = 𝒞
    ; 𝒢      = _⊢ ⎵
    ; _⊒_    = _∋⋆_
    ; idₐ    = idᵣ
    ; _◇_    = _○_
    ; lid◇   = lid○
    ; rid◇   = rid○
    ; assoc◇ = assoc○
    }

mutual
  reify : ∀ {A Γ} → Γ ⊩ A → Γ ⊢ A
  reify {⎵}      f = ⟦g⟧⟨ idᵣ ⟩ f
  reify {A ⇒ B} f = ƛ (reify (f ⟦∙⟧⟨ wkᵣ idᵣ ⟩ ⟪𝓋 0 ⟫))

  ⟪_⟫ : ∀ {A Γ} → (∀ {Γ′} → Γ′ ∋⋆ Γ → Γ′ ⊢ A) → Γ ⊩ A
  ⟪_⟫ {⎵}      f = ⟦G⟧ (λ η   → f η)
  ⟪_⟫ {A ⇒ B} f = ⟦ƛ⟧ (λ η a → ⟪ (λ η′ → f (η′ ○ η) ∙ reify (acc η′ a)) ⟫)

  ⟪𝓋_⟫ : ∀ {Γ A} → Γ ∋ A → Γ ⊩ A
  ⟪𝓋 i ⟫ = ⟪ (λ η → ren η (𝓋 i)) ⟫

aux₄₄₁ : ∀ {A Γ} → (f₁ f₂ : ∀ {Γ′} → Γ′ ∋⋆ Γ → Γ′ ⊢ A)
                 → (∀ {Γ′} → (η : Γ′ ∋⋆ Γ) → f₁ η ≡ f₂ η)
                 → Eq (⟪ f₁ ⟫) (⟪ f₂ ⟫)
aux₄₄₁ {⎵}      f₁ f₂ h = eq⎵ (λ η → h η)
aux₄₄₁ {A ⇒ B} f₁ f₂ h =
  eq⊃ (λ η′ {a} u →
    aux₄₄₁ (λ η″ → f₁ (η″ ○ η′) ∙ reify (acc η″ a))
           (λ η″ → f₂ (η″ ○ η′) ∙ reify (acc η″ a))
           (λ η″ → (_∙ reify (acc η″ a)) & h (η″ ○ η′)))

aux₄₄₂ : ∀ {A Γ Γ′} → (η : Γ′ ∋⋆ Γ) (f : (∀ {Γ′} → Γ′ ∋⋆ Γ → Γ′ ⊢ A))
                    → Eq (acc η ⟪ f ⟫) (⟪ (λ η′ → f (η′ ○ η)) ⟫)
aux₄₄₂ {⎵}      η f = eq⎵ (λ η′ → f & refl)
aux₄₄₂ {A ⇒ B} η f =
  eq⊃ (λ η′ {a} u →
    aux₄₄₁ (λ η″ → f (η″ ○ (η′ ○ η)) ∙ reify (acc η″ a))
           (λ η″ → f ((η″ ○ η′) ○ η) ∙ reify (acc η″ a))
           (λ η″ → (_∙ reify (acc η″ a)) & (f & assoc○ η″ η′ η)))

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

-- Theorem 1.
mutual
  thm₁ : ∀ {Γ A} → {a₁ a₂ : Γ ⊩ A}
                 → Eq a₁ a₂
                 → reify a₁ ≡ reify a₂
  thm₁ (eq⎵ h) = h idᵣ
  thm₁ (eq⊃ h) = ƛ & thm₁ (h (wkᵣ idᵣ) ⟪𝓋 0 ⟫ᵤ)

  ⟪𝓋_⟫ᵤ : ∀ {Γ A} → (i : Γ ∋ A)
                  → Un (⟪𝓋 i ⟫)
  ⟪𝓋 i ⟫ᵤ = aux₄₄₃ (λ η → 𝓋 (getᵣ η i))

  aux₄₄₃ : ∀ {A Γ} → (f : ∀ {Γ′} → Γ′ ∋⋆ Γ → Γ′ ⊢ A)
                   → Un (⟪ f ⟫)
  aux₄₄₃ {⎵}      f = un⎵
  aux₄₄₃ {A ⇒ B} f =
    un⊃ (λ η {a} u →
          aux₄₄₃ (λ η′ → f (η′ ○ η) ∙ reify (acc η′ a)))
        (λ η {a₁} {a₂} p u₁ u₂ →
          aux₄₄₁ (λ η′ → f (η′ ○ η) ∙ reify (acc η′ a₁))
                 (λ η′ → f (η′ ○ η) ∙ reify (acc η′ a₂))
                 (λ η′ → (f (η′ ○ η) ∙_) & thm₁ (congaccEq η′ p)))
        (λ η₁ η₂ {a} u →
          aux₄₄₂ η₁ (λ η′ → f (η′ ○ η₂) ∙ reify (acc η′ a))
        ⦙ aux₄₄₁ (λ η′ → f ((η′ ○ η₁) ○ η₂) ∙ reify (acc (η′ ○ η₁) a))
                 (λ η′ → f (η′ ○ (η₁ ○ η₂)) ∙ reify (acc η′ (acc η₁ a)))
                 (λ η′ → _∙_ & (f & assoc○ η′ η₁ η₂ ⁻¹)
                              ⊗ thm₁ (acc◇Eq η′ η₁ u)))

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

⌊_⌋ᵥ : ∀ {Γ Γ′} → Γ′ ∋⋆ Γ → Γ′ ⊩⋆ Γ
⌊ ∅ ⌋ᵥ     = ∅
⌊ η , i ⌋ᵥ = ⌊ η ⌋ᵥ , ⟪𝓋 i ⟫

idᵥ : ∀ {Γ} → Γ ⊩⋆ Γ
idᵥ = ⌊ idᵣ ⌋ᵥ

nf : ∀ {Γ A} → Γ ⊢ A → Γ ⊢ A
nf M = reify (⟦ M ⟧ idᵥ)

-- Corollary 1.
cor₁ : ∀ {Γ A} → (M₁ M₂ : Γ ⊢ A) → Eq (⟦ M₁ ⟧ idᵥ) (⟦ M₂ ⟧ idᵥ)
               → nf M₁ ≡ nf M₂
cor₁ M₁ M₂ = thm₁

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