From d026dca42f7c07f3644eb0a1b3f546ebb16dff51 Mon Sep 17 00:00:00 2001
From: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date: Thu, 27 Apr 2023 13:49:00 +0200
Subject: [PATCH] Attacked the code generator and added bool support.

---
 sample-programs/lt_testing.crf |  3 +++
 src/Codegen/Auxillary.hs       |  1 +
 src/Codegen/Codegen.hs         | 13 ++++++++++---
 src/Codegen/Emits.hs           | 19 +++++++++++++------
 src/Main.hs                    |  2 +-
 5 files changed, 28 insertions(+), 10 deletions(-)
 create mode 100644 sample-programs/lt_testing.crf

diff --git a/sample-programs/lt_testing.crf b/sample-programs/lt_testing.crf
new file mode 100644
index 0000000..5edc1c9
--- /dev/null
+++ b/sample-programs/lt_testing.crf
@@ -0,0 +1,3 @@
+main = case (lt 3 5) of
+    True  => 1
+    False => 0
diff --git a/src/Codegen/Auxillary.hs b/src/Codegen/Auxillary.hs
index c95f4cb..c95be39 100644
--- a/src/Codegen/Auxillary.hs
+++ b/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]
diff --git a/src/Codegen/Codegen.hs b/src/Codegen/Codegen.hs
index 810d849..e3343d7 100644
--- a/src/Codegen/Codegen.hs
+++ b/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
-  llvmIrToString . instructions <$> execStateT (compileScs (sortBy lowData scs)) codegen
+  let tree = filter (not . detectPrelude) (sortBy lowData scs)
+  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
diff --git a/src/Codegen/Emits.hs b/src/Codegen/Emits.hs
index 481af4f..876471b 100644
--- a/src/Codegen/Emits.hs
+++ b/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.LChar i, _) -> VChar (ord i)
+                MIR.LInt i -> VInteger 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
diff --git a/src/Main.hs b/src/Main.hs
index 338272d..f5dd2eb 100644
--- a/src/Main.hs
+++ b/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)"