Refactored HM to use TVar correctly, fixed unbound variable tests from
EAdd removal
This commit is contained in:
sebastian
parent
5000b05152
commit
c96f3fc593
4 changed files with 165 additions and 148 deletions
|
|
@ -76,14 +76,18 @@ rn_sig =
|
|||
rn_bind1 =
|
||||
specify "Rename simple bind" $
|
||||
shouldSatisfyOk
|
||||
"f x = (\\y. let y2 = y + 1 in y2) (x + 1)"
|
||||
( unlines
|
||||
[ ".+ x y = x"
|
||||
, "f x = (\\y. let y2 = y + 1 in y2) (x + 1)"
|
||||
]
|
||||
)
|
||||
|
||||
rn_bind2 = specify "Rename bind with case" . shouldSatisfyOk $
|
||||
D.do
|
||||
"data forall a. List a where"
|
||||
" Nil : List a "
|
||||
" Cons : a -> List a -> List a"
|
||||
|
||||
".+ x y = x"
|
||||
"length : forall a. List a -> Int"
|
||||
"length list = case list of"
|
||||
" Nil => 0"
|
||||
|
|
|
|||
|
|
@ -1,28 +1,28 @@
|
|||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# HLINT ignore "Use camelCase" #-}
|
||||
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
||||
|
||||
module TestTypeCheckerBidir (test, testTypeCheckerBidir) where
|
||||
|
||||
import Test.Hspec
|
||||
import Test.Hspec
|
||||
|
||||
import AnnForall (annotateForall)
|
||||
import Control.Monad ((<=<))
|
||||
import Desugar.Desugar (desugar)
|
||||
import Grammar.Abs (Program)
|
||||
import Grammar.ErrM (Err, pattern Bad, pattern Ok)
|
||||
import Grammar.Layout (resolveLayout)
|
||||
import Grammar.Par (myLexer, pProgram)
|
||||
import Grammar.Print (printTree)
|
||||
import Renamer.Renamer (rename)
|
||||
import ReportForall (reportForall)
|
||||
import TypeChecker.RemoveForall (removeForall)
|
||||
import TypeChecker.ReportTEVar (reportTEVar)
|
||||
import TypeChecker.TypeChecker (TypeChecker (Bi))
|
||||
import TypeChecker.TypeCheckerBidir (typecheck)
|
||||
import qualified TypeChecker.TypeCheckerIr as T
|
||||
import AnnForall (annotateForall)
|
||||
import Control.Monad ((<=<))
|
||||
import Desugar.Desugar (desugar)
|
||||
import Grammar.Abs (Program)
|
||||
import Grammar.ErrM (Err, pattern Bad, pattern Ok)
|
||||
import Grammar.Layout (resolveLayout)
|
||||
import Grammar.Par (myLexer, pProgram)
|
||||
import Grammar.Print (printTree)
|
||||
import Renamer.Renamer (rename)
|
||||
import ReportForall (reportForall)
|
||||
import TypeChecker.RemoveForall (removeForall)
|
||||
import TypeChecker.ReportTEVar (reportTEVar)
|
||||
import TypeChecker.TypeChecker (TypeChecker (Bi))
|
||||
import TypeChecker.TypeCheckerBidir (typecheck)
|
||||
import TypeChecker.TypeCheckerIr qualified as T
|
||||
|
||||
test = hspec testTypeCheckerBidir
|
||||
|
||||
|
|
@ -54,13 +54,19 @@ tc_id =
|
|||
tc_double =
|
||||
specify "Addition inference" $
|
||||
run
|
||||
["double x = x + x"]
|
||||
[ ".+ : Int -> Int -> Int"
|
||||
, ".+ x y = x"
|
||||
, "double x = x + x"
|
||||
]
|
||||
`shouldSatisfy` ok
|
||||
|
||||
tc_add_lam =
|
||||
specify "Addition lambda inference" $
|
||||
run
|
||||
["four = (\\x. x + x) 2"]
|
||||
[ ".+ : Int -> Int -> Int"
|
||||
, ".+ x y = x"
|
||||
, "four = (\\x. x + x) 2"
|
||||
]
|
||||
`shouldSatisfy` ok
|
||||
|
||||
tc_const =
|
||||
|
|
@ -88,6 +94,8 @@ tc_rank2 =
|
|||
run
|
||||
[ "const : a -> b -> a"
|
||||
, "const x y = x"
|
||||
, ".+ : Int -> Int -> Int"
|
||||
, ".+ x y = x"
|
||||
, "rank2 : a -> (forall c. c -> Int) -> b -> Int"
|
||||
, "rank2 x f y = f x + f y"
|
||||
, "main = rank2 3 (\\x. const 5 x : a -> Int) 'h'"
|
||||
|
|
@ -195,18 +203,21 @@ tc_pol_case = describe "Polymophic and recursive pattern matching" $ do
|
|||
-- run (fs ++ correct1) `shouldSatisfy` ok
|
||||
specify "Second correct case expression accepted" $
|
||||
run (fs ++ correct2) `shouldSatisfy` ok
|
||||
where
|
||||
-- specify "Third correct case expression accepted" $
|
||||
-- run (fs ++ correct3) `shouldSatisfy` ok
|
||||
-- specify "Forth correct case expression accepted" $
|
||||
-- run (fs ++ correct4) `shouldSatisfy` ok
|
||||
where
|
||||
|
||||
fs =
|
||||
[ "data List a where"
|
||||
, " Nil : List a"
|
||||
, " Cons : a -> List a -> List a"
|
||||
]
|
||||
wrong1 =
|
||||
[ "length : List c -> Int"
|
||||
[ ".+ : Int -> Int -> Int"
|
||||
, ".+ x y = x"
|
||||
, "length : List c -> Int"
|
||||
, "length = \\list. case list of"
|
||||
, " Nil => 0"
|
||||
, " Cons 6 xs => 1 + length xs"
|
||||
|
|
@ -254,10 +265,10 @@ tc_pol_case = describe "Polymophic and recursive pattern matching" $ do
|
|||
correct4 =
|
||||
[ "elems : List (List c) -> Int"
|
||||
, "elems = \\list. case list of"
|
||||
--, " Nil => 0"
|
||||
--, " Cons Nil Nil => 0"
|
||||
--, " Cons Nil xs => elems xs"
|
||||
, " Cons (Cons _ ys) xs => 1 + elems (Cons ys xs)"
|
||||
, -- , " Nil => 0"
|
||||
-- , " Cons Nil Nil => 0"
|
||||
-- , " Cons Nil xs => elems xs"
|
||||
" Cons (Cons _ ys) xs => 1 + elems (Cons ys xs)"
|
||||
]
|
||||
|
||||
tc_if = specify "Test if else case expression" $ do
|
||||
|
|
@ -298,12 +309,19 @@ tc_infer_case = describe "Infer case expression" $ do
|
|||
|
||||
tc_rec1 =
|
||||
specify "Infer simple recursive definition" $
|
||||
run ["test x = 1 + test (x + 1)"] `shouldSatisfy` ok
|
||||
run
|
||||
[ ".+ : Int -> Int -> Int"
|
||||
, ".+ x y = x"
|
||||
, "test x = 1 + test (x + 1)"
|
||||
]
|
||||
`shouldSatisfy` ok
|
||||
|
||||
tc_rec2 =
|
||||
specify "Infer recursive definition with pattern matching" $
|
||||
run
|
||||
[ "data Bool where"
|
||||
[ ".+ : Int -> Int -> Int"
|
||||
, ".+ x y = x"
|
||||
, "data Bool where"
|
||||
, " False : Bool"
|
||||
, " True : Bool"
|
||||
, "test = \\x. case x of"
|
||||
|
|
@ -329,5 +347,5 @@ runPrint =
|
|||
["double x = x + x"]
|
||||
|
||||
ok = \case
|
||||
Ok _ -> True
|
||||
Ok _ -> True
|
||||
Bad _ -> False
|
||||
|
|
|
|||
|
|
@ -57,6 +57,8 @@ goods =
|
|||
, testSatisfy
|
||||
"A basic arithmetic function should be able to be inferred"
|
||||
( D.do
|
||||
".+ : Int -> Int -> Int"
|
||||
".+ x y = x"
|
||||
"plusOne x = x + 1 ;"
|
||||
"main x = plusOne x ;"
|
||||
)
|
||||
|
|
@ -74,6 +76,8 @@ goods =
|
|||
, testSatisfy
|
||||
"length function on int list infers correct signature"
|
||||
( D.do
|
||||
".+ : Int -> Int -> Int"
|
||||
".+ x y = x"
|
||||
"data List where "
|
||||
" Nil : List"
|
||||
" Cons : Int -> List -> List"
|
||||
|
|
@ -114,6 +118,8 @@ bads =
|
|||
, testSatisfy
|
||||
"Using a concrete function (primitive type) on a skolem variable should not succeed"
|
||||
( D.do
|
||||
".+ : Int -> Int -> Int"
|
||||
".+ x y = x"
|
||||
"plusOne : Int -> Int ;"
|
||||
"plusOne x = x + 1 ;"
|
||||
"f : a -> Int ;"
|
||||
|
|
@ -131,6 +137,8 @@ bads =
|
|||
"Pattern matching on literal and _List should not succeed"
|
||||
( D.do
|
||||
_List
|
||||
".+ : Int -> Int -> Int"
|
||||
".+ x y = x"
|
||||
"length : List c -> Int;"
|
||||
"length _List = case _List of {"
|
||||
" 0 => 0;"
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue