Attacked the code generator and added bool support.

sample-programs/lt_testing.crf

@@ -0,0 +1,3 @@
+main = case (lt 3 5) of
+    True  => 1
+    False => 0

src/Codegen/Auxillary.hs

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

src/Codegen/Codegen.hs

@@ -11,7 +11,8 @@ import Control.Monad.State (
  )
 import Data.List (sortBy)
 import Grammar.ErrM (Err)
-import Monomorphizer.MonomorphizerIr as MIR (Def (DBind, DData), Program (..))
+import Monomorphizer.MonomorphizerIr as MIR (Bind (..), Data (..), Def (DBind, DData), Program (..), Type (TLit))
+import TypeChecker.TypeCheckerIr (Ident (..))
 
 {- | Compiles an AST and produces a LLVM Ir string.
   An easy way to actually "compile" this output is to
@@ -19,8 +20,14 @@ import Monomorphizer.MonomorphizerIr as MIR (Def (DBind, DData), Program (..))
 -}
 generateCode :: MIR.Program -> Err String
 generateCode (MIR.Program scs) = do
-  let codegen = initCodeGenerator scs
+  let tree = filter (not . detectPrelude) (sortBy lowData scs)
-  llvmIrToString . instructions <$> execStateT (compileScs (sortBy lowData scs)) codegen
+  let codegen = initCodeGenerator tree
+  llvmIrToString . instructions <$> execStateT (compileScs tree) codegen
+
+detectPrelude :: Def -> Bool
+detectPrelude (DData (Data (TLit (Ident "Bool")) _)) = True
+detectPrelude (DBind (Bind (Ident ('l' : 't' : '$' : _), _) _ _)) = True
+detectPrelude _ = False
 
 lowData :: Def -> Def -> Ordering
 lowData (DData _) (DBind _) = LT

src/Codegen/Emits.hs

@@ -228,15 +228,15 @@ emitECased t e cases = do
         emit $ Store ty val Ptr stackPtr
         emit $ Br label
         emit $ Label lbl_failPos
-    emitCases _rt ty label stackPtr vs (Branch (MIR.PLit i, t) exp) = do
+    emitCases _rt ty label stackPtr vs (Branch (MIR.PLit (i, ct), t) exp) = do
         emit $ Comment "Plit"
         let i' = case i of
-                (MIR.LInt i, _) -> VInteger i
+                MIR.LInt i -> VInteger i
-                (MIR.LChar i, _) -> VChar (ord i)
+                MIR.LChar i -> VChar (ord i)
         ns <- getNewVar
         lbl_failPos <- (\x -> TIR.Ident $ "failed_" <> show x) <$> getNewLabel
         lbl_succPos <- (\x -> TIR.Ident $ "success_" <> show x) <$> getNewLabel
-        emit $ SetVariable ns (Icmp LLEq (type2LlvmType t) vs i')
+        emit $ SetVariable ns (Icmp LLEq (type2LlvmType ct) vs i')
         emit $ BrCond (VIdent ns ty) lbl_succPos lbl_failPos
         emit $ Label lbl_succPos
         val <- exprToValue exp
@@ -255,9 +255,13 @@ emitECased t e cases = do
         emit $ Br label
         lbl_failPos <- (\x -> TIR.Ident $ "failed_" <> show x) <$> getNewLabel
         emit $ Label lbl_failPos
+    emitCases rt ty label stackPtr vs (Branch (MIR.PEnum (TIR.Ident "True"), t) exp) = do
+        emitCases rt ty label stackPtr vs (Branch (MIR.PLit (MIR.LInt 1, TLit "Bool"), t) exp)
+    emitCases rt ty label stackPtr vs (Branch (MIR.PEnum (TIR.Ident "False"), _) exp) = do
+        emitCases rt ty label stackPtr vs (Branch (MIR.PLit (MIR.LInt 0, TLit "Bool"), t) exp)
     emitCases _rt ty label stackPtr _vs (Branch (MIR.PEnum _id, _) exp) = do
         -- //TODO Penum wrong, acts as a catch all
-        emit $ Comment "Penum"
+        emit $ Comment $ "Penum " <> show _id
         val <- exprToValue exp
         emit $ Store ty val Ptr stackPtr
         emit $ Br label
@@ -290,7 +294,10 @@ emitApp rt e1 e2 = appEmitter e1 e2 []
                                 <|> Global <$ Map.lookup (name, t) funcs
                     -- this piece of code could probably be improved, i.e remove the double `const Global`
                     args' = map (first valueGetType . dupe) args
-                    call = Call FastCC (type2LlvmType rt) visibility name args'
+                let call =
+                        case name of
+                            TIR.Ident ('l' : 't' : '$' : _) -> Icmp LLSlt I64 (snd (head args')) (snd (args' !! 1))
+                            _ -> Call FastCC (type2LlvmType rt) visibility name args'
                 emit $ Comment $ show rt
                 emit $ SetVariable vs call
             x -> error $ "The unspeakable happened: " <> show x

src/Main.hs

@@ -166,4 +166,4 @@ printToErr = hPutStrLn stderr
 fromErr :: Err a -> IO a
 fromErr = either (\s -> printToErr s >> exitFailure) pure
 
-prelude = "const x y = x\n\ndata Bool () where\n  True : Bool ()\n  False : Bool ()\n\nlt : Int -> Int -> Bool ()\nlt = \\x. \\y. const True (x + y)"
+prelude = "\n\nconst x y = x\n\ndata Bool () where\n  True : Bool ()\n  False : Bool ()\n\nlt : Int -> Int -> Bool ()\nlt = \\x. \\y. const True (x + y)"