quox/lib/Quox/Typing.idr

130 lines
4 KiB
Idris
Raw Normal View History

2021-12-23 13:05:50 -05:00
module Quox.Typing
2023-03-13 16:41:57 -04:00
import public Quox.Typing.Context as Typing
import public Quox.Typing.EqMode as Typing
import public Quox.Typing.Error as Typing
2021-12-23 13:05:50 -05:00
import public Quox.Syntax
2022-08-22 04:17:08 -04:00
import public Quox.Definition
import public Quox.Reduce
2021-12-23 13:05:50 -05:00
%default total
2021-12-23 13:05:50 -05:00
2022-04-23 18:21:30 -04:00
public export
2023-02-19 11:51:44 -05:00
CheckResult' : Type -> Nat -> Type
CheckResult' = QOutput
2022-04-23 18:21:30 -04:00
public export
2023-02-19 11:51:44 -05:00
CheckResult : DimEq d -> Type -> Nat -> Type
CheckResult eqs q n = IfConsistent eqs $ CheckResult' q n
public export
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
2023-02-19 11:51:44 -05:00
public export
InferResult : DimEq d -> TermLike
InferResult eqs q d n = IfConsistent eqs $ InferResult' q d n
2022-04-23 18:21:30 -04:00
2023-02-10 15:40:44 -05:00
export
lookupFree' : HasErr q m => Definitions' q g -> Name -> m (Definition' q g)
lookupFree' defs x =
case lookup x defs of
Just d => pure d
Nothing => throwError $ NotInScope x
2023-02-12 15:30:08 -05:00
public export
2023-02-10 15:40:44 -05:00
substCasePairRet : Term q d n -> ScopeTerm q d n -> Term q d (2 + n)
substCasePairRet dty retty =
let arg = Pair (BVT 0) (BVT 1) :# (dty // fromNat 2) in
retty.term // (arg ::: shift 2)
2023-02-11 12:15:50 -05:00
parameters {auto _ : HasErr q m} (defs : Definitions' q _)
export covering %inline
2023-03-13 14:39:29 -04:00
whnfT : {0 isRedex : RedexTest tm} -> Whnf tm isRedex WhnfError =>
tm q d n -> m (NonRedex tm q d n defs)
whnfT = either (throwError . WhnfError) pure . whnf defs
parameters (ctx : Lazy (TyContext q d1 n)) (th : Lazy (DSubst d2 d1))
export covering %inline
expectTYPE_ : Term q d2 n -> m Universe
expectTYPE_ s = case fst !(whnfT s) of
2023-02-11 12:15:50 -05:00
TYPE l => pure l
_ => throwError $ ExpectedTYPE ctx (s // th)
2023-02-11 12:15:50 -05:00
export covering %inline
expectPi_ : Term q d2 n -> m (q, Term q d2 n, ScopeTerm q d2 n)
expectPi_ s = case fst !(whnfT s) of
2023-02-11 12:15:50 -05:00
Pi {qty, arg, res, _} => pure (qty, arg, res)
_ => throwError $ ExpectedPi ctx (s // th)
2023-02-11 12:15:50 -05:00
export covering %inline
expectSig_ : Term q d2 n -> m (Term q d2 n, ScopeTerm q d2 n)
expectSig_ s = case fst !(whnfT s) of
2023-02-11 12:15:50 -05:00
Sig {fst, snd, _} => pure (fst, snd)
_ => throwError $ ExpectedSig ctx (s // th)
2023-02-11 12:15:50 -05:00
export covering %inline
expectEnum_ : Term q d2 n -> m (SortedSet TagVal)
expectEnum_ s = case fst !(whnfT s) of
Enum tags => pure tags
_ => throwError $ ExpectedEnum ctx (s // th)
export covering %inline
expectEq_ : Term q d2 n -> m (DScopeTerm q d2 n, Term q d2 n, Term q d2 n)
expectEq_ s = case fst !(whnfT s) of
2023-02-11 12:15:50 -05:00
Eq {ty, l, r, _} => pure (ty, l, r)
_ => throwError $ ExpectedEq ctx (s // th)
-- [fixme] refactor this stuff
parameters (ctx : TyContext q d n)
export covering %inline
expectTYPE : Term q d n -> m Universe
expectTYPE = expectTYPE_ ctx id
export covering %inline
expectPi : Term q d n -> m (q, Term q d n, ScopeTerm q d n)
expectPi = expectPi_ ctx id
export covering %inline
expectSig : Term q d n -> m (Term q d n, ScopeTerm q d n)
expectSig = expectSig_ ctx id
export covering %inline
expectEnum : Term q d n -> m (SortedSet TagVal)
expectEnum = expectEnum_ ctx id
export covering %inline
expectEq : Term q d n -> m (DScopeTerm q d n, Term q d n, Term q d n)
expectEq = expectEq_ ctx id
parameters (ctx : EqContext q n)
export covering %inline
expectTYPEE : Term q 0 n -> m Universe
2023-03-15 10:54:51 -04:00
expectTYPEE t = expectTYPE_ (toTyContext ctx) (shift0 ctx.dimLen) t
export covering %inline
expectPiE : Term q 0 n -> m (q, Term q 0 n, ScopeTerm q 0 n)
2023-03-15 10:54:51 -04:00
expectPiE t = expectPi_ (toTyContext ctx) (shift0 ctx.dimLen) t
export covering %inline
expectSigE : Term q 0 n -> m (Term q 0 n, ScopeTerm q 0 n)
2023-03-15 10:54:51 -04:00
expectSigE t = expectSig_ (toTyContext ctx) (shift0 ctx.dimLen) t
export covering %inline
expectEnumE : Term q 0 n -> m (SortedSet TagVal)
2023-03-15 10:54:51 -04:00
expectEnumE t = expectEnum_ (toTyContext ctx) (shift0 ctx.dimLen) t
export covering %inline
expectEqE : Term q 0 n -> m (DScopeTerm q 0 n, Term q 0 n, Term q 0 n)
2023-03-15 10:54:51 -04:00
expectEqE t = expectEq_ (toTyContext ctx) (shift0 ctx.dimLen) t