60 lines
1.8 KiB
Idris
60 lines
1.8 KiB
Idris
module Check
|
|
|
|
import Control.Monad.RWS
|
|
import Control.Monad.Either
|
|
import Control.Monad.Identity
|
|
import Data.Vect
|
|
import Data.Fin
|
|
|
|
import Term
|
|
import Value
|
|
import Normalize
|
|
import Misc
|
|
import Convert
|
|
|
|
|
|
%default total
|
|
|
|
mutual
|
|
public export
|
|
-- terms types expected term
|
|
check : Ctx n -> Ctx n -> Value -> Term n -> PI Bool
|
|
check trs tys xpt' tr = do
|
|
xpt <- whnf xpt'
|
|
case tr of
|
|
TLam sc => case xpt of
|
|
VClos env (TPi a b) => do
|
|
v <- VGen <$> fresh
|
|
check (v :: trs) (VClos env a :: tys) (VClos (v :: env) b) sc
|
|
_ => oops "expected pi"
|
|
|
|
TPi a b => case xpt of
|
|
VType => do
|
|
v <- VGen <$> fresh
|
|
(&&) <$> check trs tys VType a
|
|
<*> delay <$> check (v :: trs) (VClos trs a :: tys) VType b
|
|
|
|
|
|
_ => oops "expected type"
|
|
|
|
_ => convert xpt =<< infer trs tys tr
|
|
|
|
-- terms types term
|
|
infer : Ctx n -> Ctx n -> Term n -> PI Value
|
|
infer trs tys (TVar i _) = pure (index (natToFinLT i) tys)
|
|
infer trs tys TType = pure VType
|
|
infer trs tys (TApp f x) = infer trs tys f >>= whnf >>=
|
|
\case
|
|
VClos env (TPi a b) => do
|
|
if !(check trs tys (VClos env a) x)
|
|
then pure (VClos (VClos trs x :: env) b)
|
|
else oops "application"
|
|
|
|
_ => oops "expected infer pi"
|
|
infer trs tys _ = oops "cannot infer type"
|
|
|
|
public export
|
|
typecheck : Term 0 -> Term 0 -> Either String (Bool, List String)
|
|
typecheck tr ty = resolve $ (&&) <$> check [] [] VType ty
|
|
<*> delay <$> check [] [] (VClos [] ty) tr
|