From cca2f853ea8ef128110eec307c09fe48812d68b8 Mon Sep 17 00:00:00 2001
From: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date: Tue, 28 Mar 2023 15:36:08 +0200
Subject: [PATCH] Added a variable lookup.

---
 src/Codegen/Codegen.hs | 34 +++++++++++++++++-----------------
 src/Codegen/LlvmIr.hs  | 32 ++++++++++++++++----------------
 2 files changed, 33 insertions(+), 33 deletions(-)

diff --git a/src/Codegen/Codegen.hs b/src/Codegen/Codegen.hs
index 6dd9c2a..7f01d6b 100644
--- a/src/Codegen/Codegen.hs
+++ b/src/Codegen/Codegen.hs
@@ -13,6 +13,8 @@ import           Data.Coerce                   (coerce)
 import           Data.Map                      (Map)
 import qualified Data.Map                      as Map
 import           Data.Maybe                    (fromJust, fromMaybe)
+import           Data.Set                      (Set)
+import qualified Data.Set                      as Set
 import           Data.Tuple.Extra              (dupe, first, second)
 import           Grammar.ErrM                  (Err)
 import           Monomorphizer.MonomorphizerIr as MIR
@@ -22,6 +24,7 @@ import qualified TypeChecker.TypeCheckerIr     as TIR
 data CodeGenerator = CodeGenerator
     { instructions  :: [LLVMIr]
     , functions     :: Map MIR.Id FunctionInfo
+    , customTypes   :: Set LLVMType
     , constructors  :: Map TIR.Ident ConstructorInfo
     , variableCount :: Integer
     , labelCount    :: Integer
@@ -88,28 +91,24 @@ createArgs xs = fst $ foldl (\(acc, l) t -> (acc ++ [(TIR.Ident ("arg_" <> show
 getConstructors :: [MIR.Def] -> Map TIR.Ident ConstructorInfo
 getConstructors bs = Map.fromList $ go bs
   where
-    go []                                        = []
-    go (MIR.DData (MIR.Data t cons) : xs) =
-            fst
-                ( foldl
-                    ( \(acc, i) (Inj id xs) ->
-                        ( ( id
-                          , ConstructorInfo
+    go [] = []
+    go (MIR.DData (MIR.Data t cons) : xs) = fst
+                (foldl (\(acc, i) (Inj id xs) ->
+                        (( id, ConstructorInfo
                                 { numArgsCI = length (init . flattenType $ xs)
                                 , argumentsCI = createArgs (init . flattenType $ xs)
                                 , numCI = i
                                 , returnTypeCI = t --last . flattenType $ xs
                                 }
-                          )
-                            : acc
-                        , i + 1
-                        )
-                    )
-                    ([], 0)
-                    cons
-                )
-            <> go xs
-    go (_ : xs)                                  = go xs
+                          ) : acc, i + 1)) ([], 0) cons) <> go xs
+    go (_ : xs) = go xs
+
+getTypes :: [MIR.Def] -> Set LLVMType
+getTypes bs = Set.fromList $ go bs
+  where
+    go []                              = []
+    go (MIR.DData (MIR.Data t _) : xs) = type2LlvmType t : go xs
+    go (_:xs)                          = go xs
 
 initCodeGenerator :: [MIR.Def] -> CodeGenerator
 initCodeGenerator scs =
@@ -117,6 +116,7 @@ initCodeGenerator scs =
         { instructions = defaultStart
         , functions = getFunctions scs
         , constructors = getConstructors scs
+        , customTypes = getTypes scs
         , variableCount = 0
         , labelCount = 0
         }
diff --git a/src/Codegen/LlvmIr.hs b/src/Codegen/LlvmIr.hs
index 59850b6..15bdc01 100644
--- a/src/Codegen/LlvmIr.hs
+++ b/src/Codegen/LlvmIr.hs
@@ -11,15 +11,15 @@ module Codegen.LlvmIr (
     ToIr (..),
 ) where
 
-import Data.List (intercalate)
-import TypeChecker.TypeCheckerIr (Ident (..))
+import           Data.List                 (intercalate)
+import           TypeChecker.TypeCheckerIr (Ident (..))
 
-data CallingConvention = TailCC | FastCC | CCC | ColdCC deriving (Show)
+data CallingConvention = TailCC | FastCC | CCC | ColdCC deriving (Show, Eq, Ord)
 instance ToIr CallingConvention where
     toIr :: CallingConvention -> String
     toIr TailCC = "tailcc"
     toIr FastCC = "fastcc"
-    toIr CCC = "ccc"
+    toIr CCC    = "ccc"
     toIr ColdCC = "coldcc"
 
 -- | A datatype which represents some basic LLVM types
@@ -33,7 +33,7 @@ data LLVMType
     | Function LLVMType [LLVMType]
     | Array Integer LLVMType
     | CustomType Ident
-    deriving (Show)
+    deriving (Show, Eq, Ord)
 
 class ToIr a where
     toIr :: a -> String
@@ -62,7 +62,7 @@ data LLVMComp
     | LLSge
     | LLSlt
     | LLSle
-    deriving (Show)
+    deriving (Show, Eq, Ord)
 instance ToIr LLVMComp where
     toIr :: LLVMComp -> String
     toIr = \case
@@ -77,10 +77,10 @@ instance ToIr LLVMComp where
         LLSlt -> "slt"
         LLSle -> "sle"
 
-data Visibility = Local | Global deriving (Show)
+data Visibility = Local | Global deriving (Show, Eq, Ord)
 instance ToIr Visibility where
     toIr :: Visibility -> String
-    toIr Local = "%"
+    toIr Local  = "%"
     toIr Global = "@"
 
 {- | Represents a LLVM "value", as in an integer, a register variable,
@@ -92,16 +92,16 @@ data LLVMValue
     | VIdent Ident LLVMType
     | VConstant String
     | VFunction Ident Visibility LLVMType
-    deriving (Show)
+    deriving (Show, Eq, Ord)
 
 instance ToIr LLVMValue where
     toIr :: LLVMValue -> String
     toIr v = case v of
-        VInteger i -> show i
-        VChar i -> show i
-        VIdent (Ident n) _ -> "%" <> n
+        VInteger i                -> show i
+        VChar i                   -> show i
+        VIdent (Ident n) _        -> "%" <> n
         VFunction (Ident n) vis _ -> toIr vis <> n
-        VConstant s -> "c" <> show s
+        VConstant s               -> "c" <> show s
 
 type Params = [(Ident, LLVMType)]
 type Args = [(LLVMType, LLVMValue)]
@@ -136,7 +136,7 @@ data LLVMIr
     | Comment String
     | UnsafeRaw String -- This should generally be avoided, and proper
     -- instructions should be used in its place
-    deriving (Show)
+    deriving (Show, Eq, Ord)
 
 -- | Converts a list of LLVMIr instructions to a string
 llvmIrToString :: [LLVMIr] -> String
@@ -146,9 +146,9 @@ llvmIrToString = go 0
     go _ [] = mempty
     go i (x : xs) = do
         let (i', n) = case x of
-                Define{} -> (i + 1, 0)
+                Define{}  -> (i + 1, 0)
                 DefineEnd -> (i - 1, 0)
-                _ -> (i, i)
+                _         -> (i, i)
         insToString n x <> go i' xs
 
 -- \| Converts a LLVM inststruction to a String, allowing for printing etc.