rachel
/
pi
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
src/Core/Check.idr
View File

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

6
src/Core/Convert.idr
View File

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

14
src/Core/Normalize.idr
View File

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