{-# OPTIONS --cumulativity #-}
module ROmega.IndexCalculus.Rows where

open import Agda.Primitive

open import Relation.Binary.PropositionalEquality
  using (_≡_; refl; sym; trans)

open import Data.Nat using (; zero; suc)
open import Data.List
open import Data.Sum
  renaming (_⊎_ to _or_; inj₁ to left; inj₂ to right)
  hiding (map)
open import Data.Product
  using (_×_; ; ∃-syntax; Σ-syntax; _,_)
  renaming (proj₁ to fst; proj₂ to snd)
open import Data.Fin  renaming (zero to fzero; suc to fsuc)
  hiding (fold)  

--------------------------------------------------------------------------------
-- Syntax

infixl 5 _≲_
infix  5 _·_~_

--------------------------------------------------------------------------------
-- Rows are maps from indices to types.
Row :  { : Level} (A : Set )  Set 
Row A = Σ[ n   ] (Fin n  A)

-- An index in a Row.
Ix :  {} {A : Set }  Row {} A  Set 
Ix (n , _) = Fin n

-- The indices in a row.
ixs : (n : )  List (Fin n)
ixs zero = []
ixs (suc n) = fromℕ n  Data.List.map inject₁ (ixs n)

--------------------------------------------------------------------------------
-- Singletons.

sing :  {} {A : Set } 
       A  Row {} A
sing a = 1 , λ { fzero  a }

--------------------------------------------------------------------------------
-- Helpers, smart constructers, and syntax.

one = lsuc lzero
two = lsuc one
three = lsuc two

Row₀ = Row {one} Set
Row₁ = Row {two} Set₁
Row₂ = Row {three} Set₂

infix 2 Σi-syntax

Σi-syntax : { : Level} (n : )  (Fin n  Set )  Set 
Σi-syntax {} n P =  {lzero} {}  (j : Fin n)  P j)

-- The syntax
--   Σi[ i ≤ n ] P at ℓ
-- Says "there exists an index i : Fin n such that P i holds. At level ℓ.

syntax Σi-syntax {} n  i  B) = Σi[ i  n ] B at 

-- Sums say: "Of the types in this row, I can give you exactly one."
Σ :  {}  Row (Set )  Set 
Σ (n , P) = Σ[ i  Fin n ] (P i)

--------------------------------------------------------------------------------
-- The row z₁ is "in" row z₂ if, for all indices of z₁, I can give you an index
-- in z₂ where the types match.

_≲_ :  {}{A : Set }  Row {} A  Row {} A  Set 
_≲_ {} (n , P) (m , Q) =  (i : Fin n)  Σi[ j  m ] (P i  Q j) at 

--------------------------------------------------------------------------------
-- Evidence for x · y ~ z

_·_~_ :  {} {A : Set } 
        Row {} A 
        Row {} A 
        Row {} A 
        Set 
_·_~_ {} (l , P) (m , Q) (n , R) =
  (∀ (i : Fin n)  _or_ {} {} (Σi[ j  l ] (P j  R i) at ) (Σi[ j  m ] (Q j  R i) at )) ×
  (((l , P)  (n , R)) ×
   ((m , Q)  (n , R)))

--------------------------------------------------------------------------------
-- x · y ~ z implies x≲z in our (commutative) row theory.

·-to-≲L :  {} {A : Set }  {ρ₁ ρ₂ ρ₃  : Row {} A} 
         ρ₁ · ρ₂ ~ ρ₃ 
         ρ₁  ρ₃
·-to-≲L (_ , l , _) = l

·-to-≲R :  {} {A : Set }  {ρ₁ ρ₂ ρ₃  : Row {} A} 
         ρ₁ · ρ₂ ~ ρ₃ 
         ρ₂  ρ₃
·-to-≲R (_ , _ , r) = r

--------------------------------------------------------------------------------
-- "Punching out" an index from ρ.

_pick_ :  {} {A : Set }  (ρ : Row {} A)  Ix {} ρ  Row {} A
_pick_ {} {A} ρ i = sing (snd ρ i)

_delete_ :  {} {A : Set }  (ρ : Row {} A)  Ix {} ρ  Row {} A
_delete_ {} {A} (suc n , f) i = n ,  j  f (punchIn i j))

--------------------------------------------------------------------------------
-- Lifting functions (and arguments) to rows.

lift₁ :  {} {A B : Set }  Row {} (A  B)  A  Row {} B
lift₁ {A = A} {B = B} (n , P) a = (n ,  m  P m a))

lift₂ :  {} {A B : Set }  (A  B)  Row {} A  Row {} B
lift₂ {A = A} {B = B} f (n , P) = (n ,  m  f (P m)))