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

split check and checkType. UAny is kill

Browse source
This commit is contained in:
rhiannon morris 2023-03-05 13:14:25 +01:00
parent 21da2d1d21
commit 02b94ab705
6 changed files with 142 additions and 67 deletions
Download patch file Download diff file Expand all files Collapse all files

27
tests/Tests/Typechecker.idr
View file

@ -141,6 +141,9 @@ check_ : TyContext Three d n -> SQty Three ->
Term Three d n -> Term Three d n -> M ()
check_ ctx sg s ty = ignore $ inj $ check ctx sg s ty
checkType_ : TyContext Three d n -> Term Three d n -> Maybe Universe -> M ()
checkType_ ctx s u = inj $ checkType ctx s u
-- ω is not a subject qty
failing "Can't find an implementation"
@ -155,14 +158,22 @@ export
tests : Test
tests = "typechecker" :- [
"universes" :- [
testTC "0 · ★₀ ⇐ ★₁" $ check_ (ctx [<]) szero (TYPE 0) (TYPE 1),
testTC "0 · ★₀ ⇐ ★₂" $ check_ (ctx [<]) szero (TYPE 0) (TYPE 2),
testTC "0 · ★₀ ⇐ ★_" $ check_ (ctx [<]) szero (TYPE 0) (TYPE UAny),
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),
testTC "0=1 ⊢ 0 · ★₁ ⇐ ★₀" $ check_ (ctx01 [<]) szero (TYPE 1) (TYPE 0)
testTC "0 · ★₀ ⇐ ★₁ # by checkType" $
checkType_ (ctx [<]) (TYPE 0) (Just 1),
testTC "0 · ★₀ ⇐ ★₁ # by check" $
check_ (ctx [<]) szero (TYPE 0) (TYPE 1),
testTC "0 · ★₀ ⇐ ★₂" $
checkType_ (ctx [<]) (TYPE 0) (Just 2),
testTC "0 · ★₀ ⇐ ★_" $
checkType_ (ctx [<]) (TYPE 0) Nothing,
testTCFail "0 · ★₁ ⇍ ★₀" $
checkType_ (ctx [<]) (TYPE 1) (Just 0),
testTCFail "0 · ★₀ ⇍ ★₀" $
checkType_ (ctx [<]) (TYPE 0) (Just 0),
testTC "0=1 ⊢ 0 · ★₁ ⇐ ★₀" $
checkType_ (ctx01 [<]) (TYPE 1) (Just 0),
testTCFail "1 · ★₀ ⇍ ★₁ # by check" $
check_ (ctx [<]) sone (TYPE 0) (TYPE 1)
],
"function types" :- [

6
tests/TypingImpls.idr
View file

@ -50,6 +50,11 @@ PrettyHL q => ToInfo (Error q) where
("ty", prettyStr True ty),
("left", prettyStr True s),
("right", prettyStr True t)]
toInfo (ClashTy mode s t) =
[("type", "ClashTy"),
("mode", show mode),
("left", prettyStr True s),
("right", prettyStr True t)]
toInfo (ClashE mode e f) =
[("type", "ClashE"),
("mode", show mode),
@ -79,6 +84,7 @@ PrettyHL q => ToInfo (Error q) where
-- [todo] add nested yamls to TAP and include context here
toInfo (WhileChecking _ _ _ _ err) = toInfo err
toInfo (WhileCheckingTy _ _ _ err) = toInfo err
toInfo (WhileInferring _ _ _ err) = toInfo err
toInfo (WhileComparingT _ _ _ _ _ err) = toInfo err
toInfo (WhileComparingE _ _ _ _ err) = toInfo err