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

Added test of multiple instanciations of same polymorphic function

Browse source
This commit is contained in:
Rakarake 2023-03-10 17:20:23 +01:00
parent 224a165715
commit 96c4a2bddf
4 changed files with 64 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

3
Grammar.cf
View file

@ -17,7 +17,8 @@ ELet. Exp ::= "let" Ident "=" Exp "in" Exp ;
EAbs. Exp ::= "\\" Ident "." Exp ;
ECase. Exp ::= "case" Exp "of" "{" [Inj] "}";
LInt. Literal ::= Integer ;
LInt. Literal ::= Integer ;
LBool. Literal ::= "Ture" ;
Inj. Inj ::= Init "=>" Exp ;
terminator Inj ";" ;

1
src/Monomorpher/MonomorpherIr.hs
View file

@ -83,6 +83,7 @@ instance Print Exp where
prt i = \case
EId n -> prPrec i 3 $ concatD [prtId 0 n]
ELit _ (LInt i1) -> prPrec i 3 $ concatD [prt 0 i1]
ELit _ LBool -> prPrec i 0 (concatD [doc (showString "Ture")])
ELet bs e -> prPrec i 3 $ concatD
[ doc $ showString "let"
, prt 0 bs

1
src/TypeChecker/TypeCheckerIr.hs
View file

@ -69,6 +69,7 @@ instance Print Exp where
prt i = \case
EId n -> prPrec i 3 $ concatD [prtId 0 n]
ELit _ (LInt i1) -> prPrec i 3 $ concatD [prt 0 i1]
ELit _ LBool -> prPrec i 0 (concatD [doc (showString "Ture")])
ELet bs e -> prPrec i 3 $ concatD
[ doc $ showString "let"
, prt 0 bs

75
tests/Tests.hs
View file

@ -22,9 +22,25 @@ main = do
-- A simple demo
simpleDemo = do
demo "main = f 5" $ simpleProgram [f] "f" 5
demo "main = p 5" $ simpleProgram [p] "p" 5
demo "main = g 5" $ simpleProgram [g, p] "g" 5
demo "main = f 5" $ simpleProgram [f]
(mainApp (T.EId ("f", typeIntToInt)) lit5)
demo "main = bigId 5" $ simpleProgram [bigId]
(mainApp (T.EId ("bigId", typeIntToInt)) lit5)
demo "main = g 5" $ simpleProgram [g, bigId]
(mainApp (T.EId ("g", typeIntToInt)) lit5)
demo "main = (bigConst 5) ((bigConst 5) True)" $ simpleProgram [bigConst]
(T.EApp typeInt
-- (bigConst 5)
(T.EApp typeIntToInt (T.EId ("bigConst", typeIntToIntToInt)) lit5)
-- ((bigConst 5) True)
(T.EApp typeInt
(T.EApp typeBoolToInt
(T.EId ("bigConst", typeIntToBoolToInt))
lit5
)
litTrue
)
)
-- Nice demo 👍
demo :: String -> T.Program -> IO ()
@ -37,31 +53,60 @@ demo label prg = do
printToErr "##########\n"
-- Programs in the form of "main = 'func' 'x'"
simpleProgram :: [T.Bind] -> T.Ident -> Int -> T.Program
simpleProgram binds fToCall input = T.Program (T.Bind ("main", typeInt) [] (simpleProgramExp fToCall):binds)
simpleProgramExp func = T.EApp typeInt (T.EId (func, typeIntToInt)) (T.ELit typeInt $ LInt 5)
simpleProgram :: [T.Bind] -> T.Exp -> T.Program
simpleProgram binds input = T.Program (T.Bind ("main", typeInt) [] input:binds)
-- Applies two expressions, has type Int
mainApp :: T.Exp -> T.Exp -> T.Exp
mainApp = T.EApp typeInt
-- f :: Int -> Int
-- f x = x + x
f = T.Bind ("f", typeIntToInt) [("x", typeInt)] fExp
fExp = T.EAdd typeInt (T.EId ("x", typeInt)) (T.EId (Ident "x", typeInt))
fExp = T.EAdd typeInt (T.EId ("x", typeInt)) (T.EId ("x", typeInt))
-- p :: a -> a
-- p x = x + x
p = T.Bind (Ident "p", typeAToA) [(Ident "x", typeA)] pExp
pExp = T.EAdd typeA (T.EId (Ident "x", typeA)) (T.EId (Ident "x", typeA))
-- bigId :: a -> a
-- bigId x = x
bigId = T.Bind (Ident "bigId", typeAToA) [(Ident "x", typeA)] bigIdExp
bigIdExp = T.EAdd typeA (T.EId (Ident "x", typeA)) (T.EId ("x", typeA))
-- bigConst :: a -> a -> a
-- bigConst x y = x
bigConst = T.Bind ("bigConst", typeAToAToA) [("x", typeA), ("y", typeA)] bigConstExp
bigConstExp = T.EId ("x", typeA)
-- g :: a -> a
-- g x = x + (p x)
g = T.Bind (Ident "g", typeAToA) [("x", typeA)] gExp
gExp = T.EAdd typeA (T.EId (Ident "x", typeA)) (T.EApp typeA (T.EId (Ident "p", typeAToA)) (T.EId (Ident "x", typeA)))
-- g x = x + (bigId x)
g = T.Bind ("g", typeAToA) [("x", typeA)] gExp
gExp = T.EAdd typeA (T.EId ("x", typeA)) (T.EApp typeA (T.EId ("bigId", typeAToA)) (T.EId ("x", typeA)))
-- | Reusable test constructs for Monomorpher.
typeInt = T.TMono $ Ident "Int"
typeInt = T.TMono "Int"
typeIntToInt = T.TArr typeInt typeInt
typeIntToIntToInt = T.TArr typeInt typeIntToInt
typeA = T.TPol $ Ident "a"
typeAToA = T.TArr typeA typeA
typeAToAToA = T.TArr typeA typeAToA
typeBool = T.TMono "Bool"
typeBoolToBool = T.TArr typeBool typeBool
typeBoolToBoolToBool = T.TArr typeBool typeBoolToBool
lit5 = T.ELit typeInt $ T.LInt 5
litTrue = T.ELit typeBool T.LBool
typeBoolToInt = T.TArr typeBool typeInt
typeIntToBoolToInt = T.TArr typeInt typeBoolToInt