diff --git a/language.cabal b/language.cabal index 2f00ced..05860dd 100644 --- a/language.cabal +++ b/language.cabal @@ -39,6 +39,7 @@ executable language LambdaLifter.LambdaLifter Codegen.Codegen Codegen.LlvmIr + TreeConverter hs-source-dirs: src diff --git a/sample-programs/basic-1 b/sample-programs/basic-1 deleted file mode 100644 index f109950..0000000 --- a/sample-programs/basic-1 +++ /dev/null @@ -1,2 +0,0 @@ - -f = \x. x+1; diff --git a/sample-programs/basic-2 b/sample-programs/basic-2 deleted file mode 100644 index f7d0807..0000000 --- a/sample-programs/basic-2 +++ /dev/null @@ -1,3 +0,0 @@ -add x = \y. x+y; - -main = (\z. z+z) ((add 4) 6); diff --git a/sample-programs/basic-3 b/sample-programs/basic-3 deleted file mode 100644 index 9443439..0000000 --- a/sample-programs/basic-3 +++ /dev/null @@ -1,2 +0,0 @@ - -main = (\x. x+x+3) ((\x. x) 2) diff --git a/sample-programs/basic-4 b/sample-programs/basic-4 deleted file mode 100644 index 1de7a8c..0000000 --- a/sample-programs/basic-4 +++ /dev/null @@ -1,2 +0,0 @@ - -f x = let g = (\y. y+1) in g (g x) diff --git a/sample-programs/basic-5 b/sample-programs/basic-5 deleted file mode 100644 index 9984ddd..0000000 --- a/sample-programs/basic-5 +++ /dev/null @@ -1,9 +0,0 @@ -id x = x; - -add x y = x + y; - -double n = n + n; - -apply f x = \y. f x y; - -main = apply (id add) ((\x. x + 1) 1) (double 3); diff --git a/sample-programs/good1 b/sample-programs/good1 new file mode 100644 index 0000000..b7aff4b --- /dev/null +++ b/sample-programs/good1 @@ -0,0 +1,6 @@ +main : _Int ; +main = (id : _Int -> _Int) 5 ; + +id : 'a -> 'a ; +id x = (x : 'a); + diff --git a/src/Main.hs b/src/Main.hs index 7d8f94f..74f6b91 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -38,6 +38,10 @@ main' s = do typechecked <- fromTypeCheckerErr $ typecheck renamed printToErr $ printTree typechecked + --printToErr "\n-- TreeConverter --" + --converted <- fromTypeCheckerErr $ convertToTypecheckerIR renamed + --printToErr $ printTree converted + printToErr "\n-- Lambda Lifter --" let lifted = lambdaLift typechecked printToErr $ printTree lifted diff --git a/src/TreeConverter.hs b/src/TreeConverter.hs new file mode 100644 index 0000000..2dfa7d2 --- /dev/null +++ b/src/TreeConverter.hs @@ -0,0 +1,13 @@ +module TreeConverter where + +--import qualified Grammar.Abs as G +--import qualified TypeChecker.TypeCheckerIr as T +-- +--convertToTypecheckerIR :: G.Program -> Either String T.Program +--convertToTypecheckerIR (G.Program defs) = T.Program (map convertDef defs) +-- +--convertDef :: G.Bind -> T.Bind +--convertDef (G.Bind name t _ args exp) = T.Bind (name, t) (map (\i -> (i, T.TMono "Int"))) (convertExp exp) +-- +-- + diff --git a/tests/Tests.hs b/tests/Tests.hs index cbe80e7..261014c 100644 --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -9,40 +9,41 @@ import Monomorpher.Monomorpher (monomorphize) import Grammar.Print (printTree) import System.IO (stderr) import GHC.IO.Handle.Text (hPutStrLn) -import Test.Hspec printToErr :: String -> IO () printToErr = hPutStrLn stderr -- A simple demo simpleDemo = do - printToErr "# Monomorphic function f" + printToErr "#### f" printToErr "-- Lifted Tree --" printToErr $ printTree example1 printToErr "-- Monomorphized Tree --" printToErr $ printTree (monomorphize example1) - printToErr "# Polymorphic function p" + printToErr "#### p" printToErr "-- Lifted Tree --" printToErr $ printTree example2 printToErr "-- Monomorphized Tree --" printToErr $ printTree (monomorphize example2) + printToErr "#### g" + printToErr "-- Lifted Tree --" + printToErr $ printTree example3 + printToErr "-- Monomorphized Tree --" + printToErr $ printTree (monomorphize example3) + main :: IO () main = do return () -- | Reusable test constructs for Monomorpher. -typeInt :: T.Type typeInt = T.TMono $ Ident "Int" -typeIntToInt :: T.Type typeIntToInt = T.TArr typeInt typeInt -typeA :: T.Type typeA = T.TPol $ Ident "a" -typeAToA :: T.Type typeAToA = T.TArr typeA typeA -- f :: Int -> Int @@ -50,35 +51,37 @@ typeAToA = T.TArr typeA typeA fName = (Ident "f", typeIntToInt) fArg1 = (Ident "x", typeInt) fArgs = [fArg1] -fExp :: T.Exp fExp = T.EAdd typeInt (T.EId (Ident "x", typeInt)) (T.EId (Ident "x", typeInt)) -f :: T.Bind f = T.Bind fName fArgs fExp --- f :: a -> a --- f x = x + x +-- p :: a -> a +-- p x = x + x pName = (Ident "p", typeAToA) pArg1 = (Ident "x", typeA) pArgs = [pArg1] -pExp :: T.Exp pExp = T.EAdd typeA (T.EId (Ident "x", typeA)) (T.EId (Ident "x", typeA)) -p :: T.Bind p = T.Bind pName pArgs pExp +-- g :: a -> a +-- g x = x + (p x) +gName = (Ident "g", typeAToA) +gArg1 = (Ident "x", typeA) +gArgs = [gArg1] +gExp = T.EAdd typeA (T.EId (Ident "x", typeA)) (T.EApp typeA (T.EId (Ident "p", typeAToA)) (T.EId (Ident "x", typeA))) +g = T.Bind gName gArgs gExp -- | Examples +mainName = (Ident "main", typeInt) +-- func 5 +mainBoilerProg func binds = T.Program (T.Bind mainName [] (mainBoilerExp func) : binds) +mainBoilerExp func = T.EApp typeInt (T.EId (Ident func, typeIntToInt)) (T.ELit typeInt $ LInt 5) -- main = f 5 -example1Name = (Ident "main", typeInt) -example1Exp :: T.Exp -example1Exp = T.EApp typeInt (T.EId (Ident "f", typeIntToInt)) (T.ELit typeInt $ LInt 5) -example1 :: T.Program -example1 = T.Program [T.Bind example1Name [] example1Exp, f] +example1 = mainBoilerProg "f" [f] -- main = p 5 -example2Name = (Ident "main", typeInt) -example2Exp :: T.Exp -example2Exp = T.EApp typeInt (T.EId (Ident "p", typeIntToInt)) (T.ELit typeInt $ LInt 5) -example2 :: T.Program -example2 = T.Program [T.Bind example2Name [] example2Exp, p] +example2 = mainBoilerProg "p" [p] + +-- main = g 5 +example3 = mainBoilerProg "g" [g, p]