Rakarake/churf
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

fixed a substitution bug where ap was incorrectly inferred.

Browse source 
also added cleaner fresh variables
This commit is contained in:
sebastian 2023-03-25 22:40:15 +01:00
parent 975dd34063
commit ac43af8110
6 changed files with 287 additions and 194 deletions
Download patch file Download diff file Expand all files Collapse all files

292
tests/Tests.hs
View file

@ -16,149 +16,153 @@ main :: IO ()
main = do
mapM_ hspec goods
mapM_ hspec bads
mapM_ hspec bes
goods =
[ specify "Basic polymorphism with multiple type variables" $
run
( D.do
_const
"main = const 'a' 65 ;"
)
`shouldSatisfy` ok
, specify "Head with a correct signature is accepted" $
run
( D.do
_list
_headSig
_head
)
`shouldSatisfy` ok
, specify "A basic arithmetic function should be able to be inferred" $
run
( D.do
"plusOne x = x + 1 ;"
"main x = plusOne x ;"
)
`shouldBe` run
( D.do
"plusOne : Int -> Int ;"
"plusOne x = x + 1 ;"
"main : Int -> Int ;"
"main x = plusOne x ;"
)
, specify "A basic arithmetic function should be able to be inferred" $
run
( D.do
"plusOne x = x + 1 ;"
)
`shouldBe` run
( D.do
"plusOne : Int -> Int ;"
"plusOne x = x + 1 ;"
)
, specify "Most simple inference possible" $
run
( D.do
_id
)
`shouldSatisfy` ok
, specify "Pattern matching on a nested list" $
run
( D.do
_list
"main : List (List (a)) -> Int ;"
"main xs = case xs of {"
" Cons Nil _ => 1 ;"
" _ => 0 ;"
"};"
)
`shouldSatisfy` ok
, specify "List of function Int -> Int functions should be inferred corretly" $
run
( D.do
_list
"main xs = case xs of {"
" Cons f _ => f 1 ;"
" Nil => 0 ;"
" };"
)
`shouldBe` run
( D.do
_list
"main : List (Int -> Int) -> Int ;"
"main xs = case xs of {"
" Cons f _ => f 1 ;"
" Nil => 0 ;"
" };"
)
[ testSatisfy
"Basic polymorphism with multiple type variables"
( D.do
_const
"main = const 'a' 65 ;"
)
ok
, testSatisfy
"Head with a correct signature is accepted"
( D.do
_List
_headSig
_head
)
ok
, testSatisfy
"Most simple inference possible"
( D.do
_id
)
ok
, testSatisfy
"Pattern matching on a nested list"
( D.do
_List
"main : List (List (a)) -> Int ;"
"main xs = case xs of {"
" Cons Nil _ => 1 ;"
" _ => 0 ;"
"};"
)
ok
]
bads =
[ specify "Infinite type unification should not succeed" $
run
( D.do
"main = \\x. x x ;"
)
`shouldSatisfy` bad
, specify "Pattern matching using different types should not succeed" $
run
( D.do
_list
"bad xs = case xs of {"
" 1 => 0 ;"
" Nil => 0 ;"
"};"
)
`shouldSatisfy` bad
, specify "Using a concrete function (data type) on a skolem variable should not succeed" $
run
( D.do
_bool
_not
"f : a -> Bool () ;"
"f x = not x ;"
)
`shouldSatisfy` bad
, specify "Using a concrete function (primitive type) on a skolem variable should not succeed" $
run
( D.do
"plusOne : Int -> Int ;"
"plusOne x = x + 1 ;"
"f : a -> Int ;"
" f x = plusOne x ;"
)
`shouldSatisfy` bad
, specify "A function without signature used in an incompatible context should not succeed" $
run
( D.do
"main = _id 1 2 ;"
"_id x = x ;"
)
`shouldSatisfy` bad
, specify "Pattern matching on literal and _list should not succeed" $
run
( D.do
_list
"length : List (c) -> Int;"
"length _list = case _list of {"
" 0 => 0;"
" Cons x xs => 1 + length xs;"
"};"
)
`shouldSatisfy` bad
, specify "List of function Int -> Int functions should not be usable on Char" $
run
( D.do
_list
"main : List (Int -> Int) -> Int ;"
"main xs = case xs of {"
" Cons f _ => f 'a' ;"
" Nil => 0 ;"
" };"
)
`shouldSatisfy` bad
[ testSatisfy
"Infinite type unification should not succeed"
( D.do
"main = \\x. x x ;"
)
bad
, testSatisfy
"Pattern matching using different types should not succeed"
( D.do
_List
"bad xs = case xs of {"
" 1 => 0 ;"
" Nil => 0 ;"
"};"
)
bad
, testSatisfy
"Using a concrete function (data type) on a skolem variable should not succeed"
( D.do
_Bool
_not
"f : a -> Bool () ;"
"f x = not x ;"
)
bad
, testSatisfy
"Using a concrete function (primitive type) on a skolem variable should not succeed"
( D.do
"plusOne : Int -> Int ;"
"plusOne x = x + 1 ;"
"f : a -> Int ;"
"f x = plusOne x ;"
)
bad
, testSatisfy
"A function without signature used in an incompatible context should not succeed"
( D.do
"main = _id 1 2 ;"
"_id x = x ;"
)
bad
, testSatisfy
"Pattern matching on literal and _List should not succeed"
( D.do
_List
"length : List (c) -> Int;"
"length _List = case _List of {"
" 0 => 0;"
" Cons x xs => 1 + length xs;"
"};"
)
bad
, testSatisfy
"List of function Int -> Int functions should not be usable on Char"
( D.do
_List
"main : List (Int -> Int) -> Int ;"
"main xs = case xs of {"
" Cons f _ => f 'a' ;"
" Nil => 0 ;"
" };"
)
bad
]
bes =
[ testBe
"A basic arithmetic function should be able to be inferred"
( D.do
"plusOne x = x + 1 ;"
"main x = plusOne x ;"
)
( D.do
"plusOne : Int -> Int ;"
"plusOne x = x + 1 ;"
"main : Int -> Int ;"
"main x = plusOne x ;"
)
, testBe
"A basic arithmetic function should be able to be inferred"
( D.do
"plusOne x = x + 1 ;"
)
( D.do
"plusOne : Int -> Int ;"
"plusOne x = x + 1 ;"
)
, testBe
"List of function Int -> Int functions should be inferred corretly"
( D.do
_List
"main xs = case xs of {"
" Cons f _ => f 1 ;"
" Nil => 0 ;"
" };"
)
( D.do
_List
"main : List (Int -> Int) -> Int ;"
"main xs = case xs of {"
" Cons f _ => f 1 ;"
" Nil => 0 ;"
" };"
)
]
testSatisfy desc test satisfaction = specify desc $ run test `shouldSatisfy` satisfaction
testBe desc test shouldbe = specify desc $ run test `shouldBe` run shouldbe
run = typecheck <=< pProgram . myLexer
ok (Right _) = True
@ -171,7 +175,7 @@ bad = not . ok
_const = D.do
"const : a -> b -> a ;"
"const x y = x ;"
_list = D.do
_List = D.do
"data List (a) where"
" {"
" Nil : List (a)"
@ -187,7 +191,7 @@ _head = D.do
" Cons x xs => x ;"
" };"
_bool = D.do
_Bool = D.do
"data Bool () where {"
" True : Bool ()"
" False : Bool ()"
@ -200,3 +204,15 @@ _not = D.do
" False => True ;"
"};"
_id = "id x = x ;"
_Maybe = D.do
"data Maybe (a) where {"
" Nothing : Maybe (a)"
" Just : a -> Maybe (a)"
" };"
_fmap = D.do
"fmap f ma = case ma of {"
" Nothing => Nothing ;"
" Just a => Just (f a) ;"
"};"