Rakarake/churf
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Added a variable lookup.

Browse source
This commit is contained in:
Samuel Hammersberg 2023-03-28 15:36:08 +02:00
parent 5a70286802
commit cca2f853ea
2 changed files with 33 additions and 33 deletions
Download patch file Download diff file Expand all files Collapse all files

30
src/Codegen/Codegen.hs
View file

@ -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
@ -89,34 +92,31 @@ 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 (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
) : 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 =
CodeGenerator
{ instructions = defaultStart
, functions = getFunctions scs
, constructors = getConstructors scs
, customTypes = getTypes scs
, variableCount = 0
, labelCount = 0
}

12
src/Codegen/LlvmIr.hs
View file

@ -14,7 +14,7 @@ module Codegen.LlvmIr (
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"
@ -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,7 +77,7 @@ 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 = "%"
@ -92,7 +92,7 @@ data LLVMValue
| VIdent Ident LLVMType
| VConstant String
| VFunction Ident Visibility LLVMType
deriving (Show)
deriving (Show, Eq, Ord)
instance ToIr LLVMValue where
toIr :: LLVMValue -> String
@ -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