We can now print strings :)

src/Codegen/Auxillary.hs

@@ -10,6 +10,7 @@ type2LlvmType (MIR.TLit id@(TIR.Ident name)) = case name of
     "Int"  -> I64
     "Char" -> I8
     "Bool" -> I1
+    "Unit" -> I16
     _      -> CustomType id
 type2LlvmType (MIR.TFun t xs) = do
     let (t', xs') = function2LLVMType xs [type2LlvmType t]

src/Codegen/Codegen.hs

@@ -38,6 +38,7 @@ generateCode (MIR.Program scs) addGc = do
 
 detectPrelude :: Def -> Bool
 detectPrelude (DData (Data (TLit (Ident "Bool")) _))              = True
+detectPrelude (DData (Data (TLit (Ident "Unit")) _))              = True
 detectPrelude (DBind (Bind (Ident ('l' : 't' : '$' : _), _) _ _)) = True
 detectPrelude _                                                   = False
 
@@ -50,8 +51,11 @@ defaultStart :: [LLVMIr]
 defaultStart =
     [ UnsafeRaw "target triple = \"x86_64-pc-linux-gnu\"\n"
     , UnsafeRaw "target datalayout = \"e-m:o-i64:64-f80:128-n8:16:32:64-S128\"\n"
-    , UnsafeRaw "@.str = private unnamed_addr constant [3 x i8] c\"%i\n\", align 1\n"
+    , UnsafeRaw "@.str = private unnamed_addr constant [2 x i8] c\"%i\", align 1\n"
+    , UnsafeRaw "@.new_line = private unnamed_addr constant [1 x i8] c\"\n\", align 1\n"
     , UnsafeRaw "@.non_exhaustive_patterns = private unnamed_addr constant [41 x i8] c\"Non-exhaustive patterns in case at %i:%i\n\"\n"
+    , UnsafeRaw "@.char_print = private unnamed_addr constant [2 x i8] c\"%c\"\n"
+    , UnsafeRaw "@.char_print_no_nl = private unnamed_addr constant [3 x i8] c\"%c\0\"\n"
     , UnsafeRaw "declare i32 @printf(ptr noalias nocapture, ...)\n"
     , UnsafeRaw "declare i32 @exit(i32 noundef)\n"
     , UnsafeRaw "declare ptr @malloc(i32 noundef)\n"

src/Codegen/CompilerState.hs

@@ -174,9 +174,7 @@ getTypes bs = Map.fromList $ go bs
 getGlobals :: [MIR.Def] -> Map Ident (LLVMType, LLVMValue)
 getGlobals scs = Map.fromList [ go b | MIR.DBind b <- scs ]
   where
-    go bind | x == "main" = let typ = Function I64 []
+    go bind = (x, (typ, VFunction x Global typ))
-                            in (x, (typ, VFunction x Global typ))
-            | otherwise = (x, (typ, VFunction x Global typ))
       where
         typ = Function tr $ Ptr : ts
         Function tr ts = type2LlvmType' t

src/Codegen/Emits.hs

@@ -22,6 +22,8 @@ import           Data.Maybe                    (fromJust, fromMaybe, isNothing)
 import           Data.Tuple.Extra              (second)
 import           Grammar.Print                 (printTree)
 import           Monomorphizer.MonomorphizerIr
+import Debug.Trace (traceShow)
+import Data.List (isPrefixOf)
 
 
 compileScs :: [Def] -> CompilerState ()
@@ -111,7 +113,7 @@ compileScs (DBind bind : xs) = do
 
     let args' = zip (mkCxtName : map fst args) t_args
 
-    emit $ Define FastCC t_return name args'
+    emit $ Define FastCC (if isMain then I64 else t_return) name args'
     modify $ \s -> s  { locals = foldr insertArg s.locals args' }
 
     -- Dereference ptr arguments
@@ -133,10 +135,23 @@ compileScs (DBind bind : xs) = do
 
     result <- exprToValue exp
 
+    when isMain $ case t_return of
+        I64 -> do 
+            emit . UnsafeRaw $
+                   "call i32 (ptr, ...) @printf(ptr noundef @.str, i64 noundef " <> toIr result <> ")\n"
+        I8 -> do
+            emit . UnsafeRaw $
+                   "call i32 (ptr, ...) @printf(ptr noundef @.char_print, i8 noundef " <> toIr result <> ")\n"
+        _ -> do
+            emit $ Comment "TODO"
     if isMain
-        then mapM_ emit $ lastMainContent gcEnabled result
+        then do 
+            emit $ UnsafeRaw "call i32 (ptr, ...) @printf(ptr noundef @.new_line)\n"
+            mapM_ emit $ lastMainContent gcEnabled
+            emit $ Ret I64 (VInteger 0)
         else emit $ Ret t_return result
 
+
     emit DefineEnd
     -- Reset variable count and empty locals
     modify $ \s -> s { variableCount = 0, locals = mempty }
@@ -189,18 +204,9 @@ firstMainContent True =
     ]
 firstMainContent False = []
 
-lastMainContent :: Bool -> LLVMValue -> [LLVMIr]
+lastMainContent :: Bool -> [LLVMIr]
-lastMainContent True var =
+lastMainContent True = [UnsafeRaw "call void @cheap_dispose()\n"]
-    [ UnsafeRaw $
+lastMainContent False =[]
-        "call i32 (ptr, ...) @printf(ptr noundef @.str, i64 noundef " <> toIr var <> ")\n"
-    , UnsafeRaw "call void @cheap_dispose()\n"
-    , Ret I64 (VInteger 0)
-    ]
-lastMainContent False var =
-    [ UnsafeRaw $
-        "call i32 (ptr, ...) @printf(ptr noundef @.str, i64 noundef " <> toIr var <> ")\n"
-    , Ret I64 (VInteger 0)
-    ]
 
 compileExp :: T Exp -> CompilerState ()
 compileExp (ELit lit, _t)   = emitLit lit
@@ -322,6 +328,8 @@ emitECased t e cases = do
         emitCases rt ty label stackPtr vs (Branch (PLit $ LInt 1, t) exp)
     emitCases rt ty label stackPtr vs (Branch (PEnum (Ident "False$Bool"), t) exp) = do
         emitCases rt ty label stackPtr vs (Branch (PLit (LInt 0), t) exp)
+    emitCases rt ty label stackPtr vs (Branch (PEnum (Ident "Unit$Unit"), t) exp) = do
+        emitCases rt ty label stackPtr vs (Branch (PLit (LInt 0), t) exp)
     emitCases rt ty label stackPtr vs br@(Branch (PEnum consId, _) exp) = do
         emit $ Comment "Penum"
         cons <- gets constructors
@@ -356,6 +364,16 @@ emitECased t e cases = do
         lbl_failPos <- (\x -> Ident $ "failed_" <> show x) <$> getNewLabel
         emit $ Label lbl_failPos
 
+preludeFuns :: LLVMIr -> Ident -> LLVMValue -> LLVMValue -> CompilerState LLVMIr
+preludeFuns def (Ident xs) arg1 arg2
+  | "$langle$$langle$" `isPrefixOf` xs = pure $ Icmp LLSlt I8 arg1 arg2
+  | "$langle$" `isPrefixOf` xs =  pure $ Icmp LLSlt I8 arg1 arg2
+  | "$minus$" `isPrefixOf` xs = pure $ Sub I64 arg1 arg2
+  | "printChar$" `isPrefixOf` xs = pure . UnsafeRaw $
+        "call i32 (ptr, ...) @printf(ptr noundef @.char_print_no_nl, i8 noundef " <> toIr arg1 <> ")\n"
+  --char_print_no_nl
+  | otherwise = pure def
+
 emitApp :: Type -> T Exp -> T Exp -> CompilerState ()
 emitApp rt e1 e2 = do
     ((EVar name, t), args) <- go (EApp e1 e2, rt)
@@ -367,14 +385,7 @@ emitApp rt e1 e2 = do
                 Global <$ Map.lookup name consts
                     <|> Global <$ Map.lookup (name, t) funcs
         -- this piece of code could probably be improved, i.e remove the double `const Global`
-    call <- case name of
+    call <- do
-        Ident ('$' : 'l' : 'a' : 'n' : 'g' : 'l' : 'e' : '$' : _) ->
-            pure $ Icmp LLSlt I64 (snd (head args)) (snd (args !! 1))
-        Ident ('$' : 'm' : 'i' : 'n' : 'u' : 's' : '$' : '$' : _) ->
-            pure $ Sub I64 (snd (head args)) (snd (args !! 1))
-
-        -- FIXME
-        _ -> do
             let closure_call LocalElem { typ = Ptr, val } = (mkDerefName name, (Ptr, val) : args)
 
             (name, args) <- gets $ maybe (name, (Ptr, VNull) : args) closure_call
@@ -383,6 +394,8 @@ emitApp rt e1 e2 = do
 
             pure $ Call FastCC (type2LlvmType rt) visibility name args
     
+    call <- preludeFuns call name (snd (head args)) (snd (args !! 1))
+
     emit $ Comment $ show (type2LlvmType rt)
     emit $ SetVariable vs call
 
@@ -433,6 +446,7 @@ exprToValue et@(e, t) = case e of
 
     EVar "True$Bool" -> pure $ VInteger 1
     EVar "False$Bool" -> pure $ VInteger 0
+    EVar "Unit$Unit" -> pure $ VInteger 0
 
     EVar name -> gets (Map.lookup name . globals) >>= \case
         Just (typ@(Function _ ts), val) | length ts > 1 -> do

src/Codegen/LlvmIr.hs

@@ -29,6 +29,8 @@ data LLVMType
     | I8
     | I32
     | I64
+    | I16
+    | Void
     | Ptr
     | Ref LLVMType
     | Function LLVMType [LLVMType]
@@ -47,9 +49,11 @@ instance ToIr LLVMType where
     toIr = \case
         I1 -> "i1"
         I8 -> "i8"
+        I16 -> "i16"
         I32 -> "i32"
         I64 -> "i64"
         Ptr -> "ptr"
+        Void -> "void"
         Ref ty -> toIr ty <> "*"
         Function t xs -> toIr t <> " (" <> intercalate ", " (map toIr xs) <> ")*"
         Array n ty -> concat ["[", show n, " x ", toIr ty, "]"]

src/Main.hs

@@ -205,5 +205,9 @@ prelude =
         , "\n"
         , "printStr xs = case xs of"
         , "    Nil => Nil"
-        , "    Cons x xs => Cons (print x) (printStr xs)"
+        , "    Cons x xs => Cons (printChar x) (printStr xs)"
+        , "\n"
+        , "data List a where"
+        , "    Cons : a -> List a -> List a"
+        , "    Nil  : List a"
         ]