Fixed some small issues.

sample-programs/basic-1

@@ -1,6 +1,13 @@
 
-tripplemagic : Int -> Int -> Int -> Int;
+--tripplemagic : Int -> Int -> Int -> Int;
-tripplemagic x y z = ((\x:Int. x+x) x) + y + z;
+--tripplemagic x y z = ((\x:Int. x+x) x) + y + z;
+
+-- main : Int;
+-- main = tripplemagic ((\x:Int. x+x+3) ((\x:Int. x) 2)) 5 3
+
+apply : (Int -> Int) -> Int -> Int;
+apply f x = f x;
 
 main : Int;
-main = tripplemagic ((\x:Int. x+x+3) ((\x:Int. x) 2)) 5 3
+main = apply (\x:Int . x + 2) 5;
+

src/Compiler.hs

@@ -5,12 +5,16 @@ module Compiler (compile) where
 
 import Control.Monad.State (StateT, execStateT, gets, modify)
 import Data.Map (Map)
-import qualified Data.Map            as Map
+import Data.Map qualified as Map
 import Data.Tuple.Extra (second)
 import Grammar.ErrM (Err)
 import Grammar.Print (printTree)
-import           LlvmIr              (LLVMIr (..), LLVMType (..),
+import LlvmIr (
-                                      LLVMValue (..), llvmIrToString)
+    LLVMIr (..),
+    LLVMType (..),
+    LLVMValue (..),
+    llvmIrToString,
+ )
 import TypeChecker (partitionType)
 import TypeCheckerIr
 
@@ -118,32 +122,27 @@ compile (Program prg) = do
       where
         t_return = snd $ partitionType (length args) t
 
-
-
     go :: Exp -> CompilerState ()
     go (EInt int) = emitInt int
-    go (EAdd t e1 e2)  = emitAdd e1 e2
+    go (EAdd t e1 e2) = emitAdd t e1 e2
     -- go (ESub e1 e2)  = emitSub e1 e2
     -- go (EMul e1 e2)  = emitMul e1 e2
     -- go (EDiv e1 e2)  = emitDiv e1 e2
     -- go (EMod e1 e2)  = emitMod e1 e2
     go (EId (name, _)) = emitIdent name
-    go (EApp t e1 e2)  = emitApp e1 e2
+    go (EApp t e1 e2) = emitApp t e1 e2
+    go (EAbs t ti e) = emitAbs t ti e
+    go (ELet binds e) = emitLet binds e
+    go (EAnn _ _) = emitEAnn
 
     --- aux functions ---
-    emitAbs :: Ident -> Exp -> CompilerState ()
+    emitEAnn :: CompilerState ()
-    emitAbs id e = do
+    emitEAnn = emit . UnsafeRaw $ "why?"
-        emit $
+
-            Comment $
+    emitAbs :: Type -> Id -> Exp -> CompilerState ()
-                concat
+    emitAbs _t tid e = do
-                    [ "EAbs ("
+        emit . Comment $
-                    , show id
+            "Lambda escaped previous stages: \\" <> show tid <> " . " <> show e
-                    , ", "
-                    , show I64
-                    , ", "
-                    , show e
-                    , ") is not implemented!"
-                    ]
     emitLet :: [Bind] -> Exp -> CompilerState ()
     emitLet xs e = do
         emit $
@@ -156,18 +155,18 @@ compile (Program prg) = do
                     , ") is not implemented!"
                     ]
 
-    emitApp :: Exp -> Exp -> CompilerState ()
+    emitApp :: Type -> Exp -> Exp -> CompilerState ()
-    emitApp e1 e2 = appEmitter e1 e2 []
+    emitApp t e1 e2 = appEmitter t e1 e2 []
       where
-        appEmitter :: Exp -> Exp -> [Exp] -> CompilerState ()
+        appEmitter :: Type -> Exp -> Exp -> [Exp] -> CompilerState ()
-        appEmitter e1 e2 stack = do
+        appEmitter t e1 e2 stack = do
             let newStack = e2 : stack
             case e1 of
-                EApp t e1' e2' -> appEmitter e1' e2' newStack
+                EApp t' e1' e2' -> appEmitter t' e1' e2' newStack
                 EId (name, _) -> do
                     args <- traverse exprToValue newStack
                     vs <- getNewVar
-                    emit $ SetVariable (Ident $ show vs) (Call I64 name (map (I64,) args))
+                    emit $ SetVariable (Ident $ show vs) (Call (type2LlvmType t) name (map (I64,) args))
                 x -> do
                     emit . Comment $ "The unspeakable happened: "
                     emit . Comment $ show x
@@ -186,12 +185,12 @@ compile (Program prg) = do
         emit $ Comment "This should not have happened!"
         emit $ SetVariable (Ident (show varCount)) (Add I64 (VInteger i) (VInteger 0))
 
-    emitAdd :: Exp -> Exp -> CompilerState ()
+    emitAdd :: Type -> Exp -> Exp -> CompilerState ()
-    emitAdd e1 e2 = do
+    emitAdd t e1 e2 = do
         v1 <- exprToValue e1
         v2 <- exprToValue e2
         v <- getNewVar
-        emit $ SetVariable (Ident $ show v) (Add I64 v1 v2)
+        emit $ SetVariable (Ident $ show v) (Add (type2LlvmType t) v1 v2)
 
     -- emitMul :: Exp -> Exp -> CompilerState ()
     -- emitMul e1 e2 = do
@@ -256,4 +255,5 @@ compile (Program prg) = do
 type2LlvmType :: Type -> LLVMType
 type2LlvmType = \case
     TInt -> I64
-  t    -> error $ "missing type case: " ++ show t
+    TFun t _ -> type2LlvmType t
+    t -> CustomType $ Ident ("\"" ++ show t ++ "\"")

src/Main.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE LambdaCase #-}
+
 module Main where
 
 import Compiler (compile)
@@ -6,6 +7,7 @@ import           GHC.IO.Handle.Text (hPutStrLn)
 import Grammar.ErrM (Err)
 import Grammar.Par (myLexer, pProgram)
 import Grammar.Print (printTree)
+
 -- import           Interpreter        (interpret)
 import LambdaLifter (lambdaLift)
 import Renamer (rename)
@@ -15,7 +17,8 @@ import           System.IO          (stderr)
 import TypeChecker (typecheck)
 
 main :: IO ()
-main = getArgs >>= \case
+main =
+    getArgs >>= \case
         [] -> print "Required file path missing"
         (s : _) -> main' s
 
@@ -27,13 +30,13 @@ main' s = do
     parsed <- fromSyntaxErr . pProgram $ myLexer file
     printToErr $ printTree parsed
 
-  putStrLn "\n-- Renamer --"
+    printToErr "\n-- Renamer --"
     let renamed = rename parsed
-  putStrLn $ printTree renamed
+    printToErr $ printTree renamed
 
-  putStrLn "\n-- TypeChecker --"
+    printToErr "\n-- TypeChecker --"
     typechecked <- fromTypeCheckerErr $ typecheck renamed
-  putStrLn $ printTree typechecked
+    printToErr $ printTree typechecked
 
     printToErr "\n-- Lambda Lifter --"
     let lifted = lambdaLift typechecked
@@ -54,35 +57,41 @@ printToErr :: String -> IO ()
 printToErr = hPutStrLn stderr
 
 fromCompilerErr :: Err a -> IO a
-fromCompilerErr = either
+fromCompilerErr =
+    either
         ( \err -> do
             putStrLn "\nCOMPILER ERROR"
             putStrLn err
-    exitFailure)
+            exitFailure
+        )
         pure
 
 fromSyntaxErr :: Err a -> IO a
-fromSyntaxErr = either
+fromSyntaxErr =
+    either
         ( \err -> do
             putStrLn "\nSYNTAX ERROR"
             putStrLn err
-    exitFailure)
+            exitFailure
+        )
         pure
 
 fromTypeCheckerErr :: Err a -> IO a
-fromTypeCheckerErr = either
+fromTypeCheckerErr =
+    either
         ( \err -> do
             putStrLn "\nTYPECHECKER ERROR"
             putStrLn err
-    exitFailure)
+            exitFailure
+        )
         pure
 
 fromInterpreterErr :: Err a -> IO a
-fromInterpreterErr = either
+fromInterpreterErr =
+    either
         ( \err -> do
             putStrLn "\nINTERPRETER ERROR"
             putStrLn err
-    exitFailure)
+            exitFailure
+        )
         pure
-
-