Deleted bad sample programs, added polymorphic call in polymorphic function test

language.cabal

@@ -39,6 +39,7 @@ executable language
       LambdaLifter.LambdaLifter
       Codegen.Codegen
       Codegen.LlvmIr
+      TreeConverter
 
     hs-source-dirs:   src
 

sample-programs/basic-1

@@ -1,2 +0,0 @@
-
-f = \x. x+1;

sample-programs/basic-2

@@ -1,3 +0,0 @@
-add x = \y. x+y;
-
-main = (\z. z+z) ((add 4) 6);

sample-programs/basic-3

@@ -1,2 +0,0 @@
-
-main = (\x. x+x+3) ((\x. x) 2)

sample-programs/basic-4

@@ -1,2 +0,0 @@
-
-f x = let g = (\y. y+1) in g (g x)

sample-programs/basic-5

@@ -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);

sample-programs/good1

@@ -0,0 +1,6 @@
+main : _Int ;
+main = (id : _Int -> _Int) 5 ;
+
+id : 'a -> 'a ;
+id x = (x : 'a);
+

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

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)
+--
+--
+

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
+-- p :: a -> a
--- f x = x + x
+-- 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)
+example1 = mainBoilerProg "f" [f]
-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]
 
 -- main = p 5
-example2Name = (Ident "main", typeInt)
+example2 = mainBoilerProg "p" [p]
-example2Exp :: T.Exp
+
-example2Exp = T.EApp typeInt (T.EId (Ident "p", typeIntToInt)) (T.ELit typeInt $ LInt 5)
+-- main = g 5
-example2 :: T.Program
+example3 = mainBoilerProg "g" [g, p]
-example2 = T.Program [T.Bind example2Name [] example2Exp, p]