quox/lib/Quox/Typing.idr

module Quox.Typing

import public Quox.Syntax
import public Quox.Context
import public Quox.Equal

import Data.Nat
import public Data.SortedMap
import Control.Monad.Reader
import Control.Monad.State

%default total


public export
data DContext : Nat -> Type where
  DNil  : DContext 0
  DBind : DContext d -> DContext (S d)
  DEq   : Dim d -> Dim d -> DContext d -> DContext d

public export
TContext : Nat -> Nat -> Type
TContext d = Context (Term d)

public export
QContext : Nat -> Type
QContext = Context' Qty

public export
QOutput : Nat -> Type
QOutput = QContext


public export
record Global where
  constructor MkGlobal
  qty         : Qty
  0 qtyGlobal : IsGlobal qty
  type, term  : forall d, n. Term d n

public export
Globals : Type
Globals = SortedMap Name Global


public export
record TyContext (d, n : Nat) where
  constructor MkTyContext
  globals : Globals
  dctx : DContext d
  tctx : TContext d n
  qctx : QContext n

%name TyContext ctx


namespace TContext
  export
  pushD : TContext d n -> TContext (S d) n
  pushD tel = map (/// shift 1) tel


namespace TyContext
  export
  extendTy : Term d n -> Qty -> TyContext d n -> TyContext d (S n)
  extendTy s rho = {tctx $= (:< s), qctx $= (:< rho)}

  export
  extendDim : TyContext d n -> TyContext (S d) n
  extendDim = {dctx $= DBind, tctx $= pushD}

  export
  eqDim : Dim d -> Dim d -> TyContext d n -> TyContext d n
  eqDim p q = {dctx $= DEq p q}


namespace QOutput
  export
  (+) : QOutput n -> QOutput n -> QOutput n
  (+) = zipWith (+)

  export
  (*) : Qty -> QOutput n -> QOutput n
  (*) pi = map (pi *)

  export
  zero : {n : Nat} -> QOutput n
  zero = pure Zero


public export
CheckResult : Nat -> Type
CheckResult = QOutput

public export
record InferResult d n where
  constructor InfRes
  type : Term d n
  qout : QOutput n


public export
data Error
= NotInScope   Name
| ExpectedTYPE (Term d n)
| ExpectedPi   (Term d n)
| BadUniverse  Universe Universe
| EqualError   (Equal.Error)
%hide Equal.Error