quox/lib/Quox/Typing.idr

121 lines
2.4 KiB
Idris
Raw Normal View History

2021-12-23 13:05:50 -05:00
module Quox.Typing
import public Quox.Syntax
import public Quox.Context
2022-08-22 04:17:08 -04:00
import public Quox.Definition
2021-12-23 13:05:50 -05:00
import Data.Nat
2022-04-23 18:21:30 -04:00
import public Data.SortedMap
2023-01-08 14:44:25 -05:00
import Control.Monad.Either
2021-12-23 13:05:50 -05:00
import Control.Monad.Reader
import Control.Monad.State
import Generics.Derive
%hide TT.Name
%default total
%language ElabReflection
2021-12-23 13:05:50 -05:00
%default total
2022-02-26 19:28:19 -05:00
2021-12-23 13:05:50 -05:00
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
2023-01-08 14:44:25 -05:00
TContext : Type -> Nat -> Nat -> Type
TContext q d = Context (Term q d)
2021-12-23 13:05:50 -05:00
public export
2023-01-08 14:44:25 -05:00
QContext : Type -> Nat -> Type
QContext = Context'
2021-12-23 13:05:50 -05:00
public export
2023-01-08 14:44:25 -05:00
QOutput : Type -> Nat -> Type
2022-04-27 15:58:09 -04:00
QOutput = QContext
2021-12-23 13:05:50 -05:00
public export
2023-01-08 14:44:25 -05:00
record TyContext q d n where
2021-12-23 13:05:50 -05:00
constructor MkTyContext
dctx : DContext d
2023-01-08 14:44:25 -05:00
tctx : TContext q d n
qctx : QContext q n
2021-12-23 13:05:50 -05:00
%name TyContext ctx
namespace TContext
export
2023-01-08 14:44:25 -05:00
pushD : TContext q d n -> TContext q (S d) n
2021-12-23 13:05:50 -05:00
pushD tel = map (/// shift 1) tel
namespace TyContext
export
2023-01-08 14:44:25 -05:00
extendTy : Term q d n -> q -> TyContext q d n -> TyContext q d (S n)
2022-04-27 15:58:09 -04:00
extendTy s rho = {tctx $= (:< s), qctx $= (:< rho)}
2021-12-23 13:05:50 -05:00
export
2023-01-08 14:44:25 -05:00
extendDim : TyContext q d n -> TyContext q (S d) n
2021-12-23 13:05:50 -05:00
extendDim = {dctx $= DBind, tctx $= pushD}
export
2023-01-08 14:44:25 -05:00
eqDim : Dim d -> Dim d -> TyContext q d n -> TyContext q d n
2021-12-23 13:05:50 -05:00
eqDim p q = {dctx $= DEq p q}
namespace QOutput
2023-01-08 14:44:25 -05:00
parameters {auto _ : IsQty q}
export
(+) : QOutput q n -> QOutput q n -> QOutput q n
(+) = zipWith (+)
2021-12-23 13:05:50 -05:00
2023-01-08 14:44:25 -05:00
export
(*) : q -> QOutput q n -> QOutput q n
(*) pi = map (pi *)
2021-12-23 13:05:50 -05:00
2023-01-08 14:44:25 -05:00
export
zero : {n : Nat} -> QOutput q n
zero = pure zero
2022-04-23 18:21:30 -04:00
export
zeroFor : TyContext q _ n -> QOutput q n
zeroFor ctx = const zero <$> ctx.qctx
2022-04-23 18:21:30 -04:00
public export
2023-01-08 14:44:25 -05:00
CheckResult : Type -> Nat -> Type
2022-04-27 15:58:09 -04:00
CheckResult = QOutput
2022-04-23 18:21:30 -04:00
public export
2023-01-08 14:44:25 -05:00
record InferResult q d n where
2022-04-23 18:21:30 -04:00
constructor InfRes
2023-01-08 14:44:25 -05:00
type : Term q d n
qout : QOutput q n
2022-04-23 18:21:30 -04:00
public export
data EqMode = Equal | Sub
%runElab derive "EqMode" [Generic, Meta, Eq, Ord, DecEq, Show]
2022-04-23 18:21:30 -04:00
public export
2023-01-08 14:44:25 -05:00
data Error q
= ExpectedTYPE (Term q d n)
| ExpectedPi (Term q d n)
2023-01-20 20:34:28 -05:00
| ExpectedEq (Term q d n)
| BadUniverse Universe Universe
2023-01-08 14:44:25 -05:00
| ClashT EqMode (Term q d n) (Term q d n)
| ClashU EqMode Universe Universe
| ClashQ q q
2023-01-20 20:34:28 -05:00
| ClashD (Dim d) (Dim d)
| NotInScope Name
2023-01-08 14:44:25 -05:00
public export
0 HasErr : Type -> (Type -> Type) -> Type
HasErr q = MonadError (Error q)