align arrows

master
Rachel Lambda Samuelsson 2022-08-06 02:32:09 +02:00
parent 9275d39107
commit 645f923848
3 changed files with 27 additions and 27 deletions

View File

@ -17,24 +17,24 @@ import Core.Convert
%default total
-- extend environment, used to ensure environment is always in normal form
extV : {auto deftrs : RefA DTR Value}
-> {auto frst : Ref NST Nat}
-> Ctx n -> Value -> PI (Ctx (S n))
extV : {auto deftrs : RefA DTR Value}
-> {auto frst : Ref NST Nat}
-> Ctx n -> Value -> PI (Ctx (S n))
extV ctx val = whnf val >>= pure . (`Data.Vect.(::)` ctx)
-- to extend, closure env, term
extT : {auto deftrs : RefA DTR Value}
-> {auto frst : Ref NST Nat}
-> Ctx m -> Ctx n -> Term n -> PI (Ctx (S m))
extT : {auto deftrs : RefA DTR Value}
-> {auto frst : Ref NST Nat}
-> Ctx m -> Ctx n -> Term n -> PI (Ctx (S m))
extT ctx env = extV ctx . VClos env
mutual
public export
-- terms types expected term
check : {auto deftrs : RefA DTR Value}
-> {auto deftys : RefA DTY Value}
-> {auto frst : Ref NST Nat}
-> Ctx n -> Ctx n -> Value -> Term n -> PI Bool
-> {auto deftys : RefA DTY Value}
-> {auto frst : Ref NST Nat}
-> Ctx n -> Ctx n -> Value -> Term n -> PI Bool
check trs tys xpt' tr = do
xpt <- whnf xpt'
case tr of
@ -58,10 +58,10 @@ mutual
-- terms types term
public export
infer : {auto deftrs : RefA DTR Value}
-> {auto deftys : RefA DTY Value}
-> {auto frst : Ref NST Nat}
-> Ctx n -> Ctx n -> Term n -> PI Value
infer : {auto deftrs : RefA DTR Value}
-> {auto deftys : RefA DTY Value}
-> {auto frst : Ref NST Nat}
-> Ctx n -> Ctx n -> Term n -> PI Value
infer trs tys TType = pure VType
infer trs tys TTop = pure VType
infer trs tys TBot = pure VType
@ -158,9 +158,9 @@ mutual
infer trs tys x = oops ("cannot infer type " ++ show x)
public export
typecheck : {auto deftrs : RefA DTR Value}
-> {auto deftys : RefA DTY Value}
-> {auto frst : Ref NST Nat}
-> Term 0 -> Term 0 -> IO (Either String Bool)
typecheck : {auto deftrs : RefA DTR Value}
-> {auto deftys : RefA DTY Value}
-> {auto frst : Ref NST Nat}
-> Term 0 -> Term 0 -> IO (Either String Bool)
typecheck tr ty = resolve $ (&&) <$> check [] [] VType ty
<*> delay <$> check [] [] (VClos [] ty) tr

View File

@ -17,9 +17,9 @@ import Data.IORef
%default total
public export
convert : {auto deftrs : RefA DTR Value}
-> {auto frst : Ref NST Nat}
-> Value -> Value -> PI Bool
convert : {auto deftrs : RefA DTR Value}
-> {auto frst : Ref NST Nat}
-> Value -> Value -> PI Bool
convert u1 u2 = do
u1' <- whnf u1
u2' <- whnf u2

View File

@ -17,9 +17,9 @@ import Data.IORef
mutual
public export
app : {auto deftrs : RefA DTR Value}
-> {auto frst : Ref NST Nat}
-> Value -> Value -> PI Value
app : {auto deftrs : RefA DTR Value}
-> {auto frst : Ref NST Nat}
-> Value -> Value -> PI Value
app (VClos env (TLam sc)) x = eval (x :: env) sc
app (VClos env (TTopInd c st)) VTop = eval env st
@ -41,8 +41,8 @@ mutual
public export
eval : {auto deftrs : RefA DTR Value}
-> {auto frst : Ref NST Nat}
-> Ctx n -> Term n -> PI Value
-> {auto frst : Ref NST Nat}
-> Ctx n -> Term n -> PI Value
eval env (TVar i) = pure (index i env)
eval env (TDef i) = do
res <- getArr DTR i
@ -67,8 +67,8 @@ mutual
public export
whnf : {auto deftrs : RefA DTR Value}
-> {auto frst : Ref NST Nat}
-> Value -> PI Value
-> {auto frst : Ref NST Nat}
-> Value -> PI Value
whnf (VClos env tr) = eval env tr
whnf (VApp f x) = do
f' <- whnf f