diff --git a/Grammar.cf b/Grammar.cf index 6870367..da285a0 100644 --- a/Grammar.cf +++ b/Grammar.cf @@ -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 ";" ; diff --git a/src/Monomorpher/MonomorpherIr.hs b/src/Monomorpher/MonomorpherIr.hs index 14c82ae..01fac01 100644 --- a/src/Monomorpher/MonomorpherIr.hs +++ b/src/Monomorpher/MonomorpherIr.hs @@ -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 diff --git a/src/TypeChecker/TypeCheckerIr.hs b/src/TypeChecker/TypeCheckerIr.hs index c85ebcc..7b0e445 100644 --- a/src/TypeChecker/TypeCheckerIr.hs +++ b/src/TypeChecker/TypeCheckerIr.hs @@ -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 diff --git a/tests/Tests.hs b/tests/Tests.hs index de9ab7c..edfd90b 100644 --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -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 +