align arrows
This commit is contained in:
parent
9275d39107
commit
645f923848
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue
Block a user