rhi/quox
rhi/quox
1
0
Fork 0
Code Issues 15 Pull requests 1 Releases Wiki Activity

check for 0=1 in typechecker

Browse source
This commit is contained in:
rhiannon morris 2023-02-19 17:51:44 +01:00
parent 195791e158
commit 858b5db530
5 changed files with 95 additions and 55 deletions
Download patch file Download diff file Expand all files Collapse all files

33
tests/Tests/Typechecker.idr
View file

@ -83,25 +83,29 @@ qoutEq qout res = unless (qout == res) $ throwError $ WrongQOut qout res
inferAs : TyContext Three d n -> (sg : SQty Three) ->
Elim Three d n -> Term Three d n -> M ()
inferAs ctx sg e ty = do
res <- inj $ infer ctx sg e
inferredTypeEq ctx ty res.type
inferAs ctx@(MkTyContext {dctx, _}) sg e ty = do
case !(inj $ infer ctx sg e) of
Just res => inferredTypeEq ctx ty res.type
Nothing => pure ()
inferAsQ : TyContext Three d n -> (sg : SQty Three) ->
Elim Three d n -> Term Three d n -> QOutput Three n -> M ()
inferAsQ ctx sg e ty qout = do
res <- inj $ infer ctx sg e
inferredTypeEq ctx ty res.type
qoutEq qout res.qout
inferAsQ ctx@(MkTyContext {dctx, _}) sg e ty qout = do
case !(inj $ infer ctx sg e) of
Just res => do
inferredTypeEq ctx ty res.type
qoutEq qout res.qout
Nothing => pure ()
infer_ : TyContext Three d n -> (sg : SQty Three) -> Elim Three d n -> M ()
infer_ ctx sg e = ignore $ inj $ infer ctx sg e
checkQ : TyContext Three d n -> SQty Three ->
Term Three d n -> Term Three d n -> QOutput Three n -> M ()
checkQ ctx sg s ty qout = do
res <- inj $ check ctx sg s ty
qoutEq qout res
checkQ ctx@(MkTyContext {dctx, _}) sg s ty qout = do
case !(inj $ check ctx sg s ty) of
Just res => qoutEq qout res
Nothing => pure ()
check_ : TyContext Three d n -> SQty Three ->
Term Three d n -> Term Three d n -> M ()
@ -117,7 +121,9 @@ tests = "typechecker" :- [
testTCFail "0 · ★₁ ⇍ ★₀" $ check_ (ctx [<]) szero (TYPE 1) (TYPE 0),
testTCFail "0 · ★₀ ⇍ ★₀" $ check_ (ctx [<]) szero (TYPE 0) (TYPE 0),
testTCFail "0 · ★_ ⇍ ★_" $ check_ (ctx [<]) szero (TYPE UAny) (TYPE UAny),
testTCFail "1 · ★₀ ⇍ ★₁" $ check_ (ctx [<]) sone (TYPE 0) (TYPE 1)
testTCFail "1 · ★₀ ⇍ ★₁" $ check_ (ctx [<]) sone (TYPE 0) (TYPE 1),
testTC "0=1 ⊢ 0 · ★₁ ⇐ ★₀" $
check_ (MkTyContext (ZeroIsOne {d = 0}) [<]) szero (TYPE 1) (TYPE 0)
],
"function types" :- [
@ -136,7 +142,10 @@ tests = "typechecker" :- [
(Pi One "x" (FT "A") $ TUsed $ E $ F "P" :@ BVT 0)
(TYPE 0),
testTCFail "0 · A ⊸ P ⇍ ★₀" $
check_ (ctx [<]) szero (Arr One (FT "A") $ FT "P") (TYPE 0)
check_ (ctx [<]) szero (Arr One (FT "A") $ FT "P") (TYPE 0),
testTC "0=1 ⊢ 0 · A ⊸ P ⇐ ★₀" $
check_ (MkTyContext (ZeroIsOne {d = 0}) [<]) szero
(Arr One (FT "A") $ FT "P") (TYPE 0)
],
"pair types" :- [