The code generator can now compile without the GC.

This commit is contained in:
Samuel Hammersberg 2023-04-28 14:52:47 +02:00
parent f9d28028b5
commit de03a2cc34
5 changed files with 48 additions and 18 deletions

View file

@ -21,7 +21,7 @@ import TypeChecker.TypeCheckerIr (Ident (..))
generateCode :: MIR.Program -> Bool -> Err String
generateCode (MIR.Program scs) addGc = do
let tree = filter (not . detectPrelude) (sortBy lowData scs)
let codegen = initCodeGenerator tree
let codegen = initCodeGenerator addGc tree
llvmIrToString . instructions <$> execStateT (compileScs tree) codegen
detectPrelude :: Def -> Bool

View file

@ -22,6 +22,7 @@ data CodeGenerator = CodeGenerator
, constructors :: Map TIR.Ident ConstructorInfo
, variableCount :: Integer
, labelCount :: Integer
, gcEnabled :: Bool
}
-- | A state type synonym
@ -115,15 +116,16 @@ getTypes bs = Map.fromList $ go bs
variantTypes fi = init $ map type2LlvmType (flattenType fi)
biggestVariant ts = 8 + maximum (sum . (\(Inj _ fi) -> typeByteSize <$> variantTypes fi) <$> ts)
initCodeGenerator :: [MIR.Def] -> CodeGenerator
initCodeGenerator scs =
initCodeGenerator :: Bool -> [MIR.Def] -> CodeGenerator
initCodeGenerator addGc scs =
CodeGenerator
{ instructions = defaultStart
{ instructions = defaultStart <> if addGc then gcStart else []
, functions = getFunctions scs
, constructors = getConstructors scs
, customTypes = getTypes scs
, variableCount = 0
, labelCount = 0
, gcEnabled = addGc
}
defaultStart :: [LLVMIr]
@ -135,7 +137,11 @@ defaultStart =
, UnsafeRaw "declare i32 @printf(ptr noalias nocapture, ...)\n"
, UnsafeRaw "declare i32 @exit(i32 noundef)\n"
, UnsafeRaw "declare ptr @malloc(i32 noundef)\n"
, UnsafeRaw "declare external void @cheap_init()\n"
]
gcStart :: [LLVMIr]
gcStart =
[ UnsafeRaw "declare external void @cheap_init()\n"
, UnsafeRaw "declare external ptr @cheap_alloc(i64)\n"
, UnsafeRaw "declare external void @cheap_dispose()\n"
, UnsafeRaw "declare external ptr @cheap_the()\n"

View file

@ -77,7 +77,8 @@ compileScs [] = do
Just s -> do
emit $ Comment "Malloc and store"
heapPtr <- getNewVar
emit $ SetVariable heapPtr (Malloca s)
useGc <- gets gcEnabled
emit $ SetVariable heapPtr (if useGc then GcMalloc s else Malloc s)
emit $ Store arg_t' (VIdent (TIR.Ident arg_n) arg_t') Ptr heapPtr
emit $ Store (Ref arg_t') (VIdent heapPtr arg_t') Ptr elemPtr
Nothing -> do
@ -103,10 +104,11 @@ compileScs (MIR.DBind (MIR.Bind (name, t) args exp) : xs) = do
emit . Comment $ show name <> ": " <> show exp
let args' = map (second type2LlvmType) args
emit $ Define FastCC t_return name args'
when (name == "main") (mapM_ emit firstMainContent)
useGc <- gets gcEnabled
when (name == "main") (mapM_ emit (firstMainContent useGc))
functionBody <- exprToValue exp
if name == "main"
then mapM_ emit $ lastMainContent functionBody
then mapM_ emit $ lastMainContent useGc functionBody
else emit $ Ret t_return functionBody
emit DefineEnd
modify $ \s -> s{variableCount = 0}
@ -126,20 +128,26 @@ compileScs (MIR.DData (MIR.Data typ ts) : xs) = do
ts
compileScs xs
firstMainContent :: [LLVMIr]
firstMainContent =
firstMainContent :: Bool -> [LLVMIr]
firstMainContent True =
[ UnsafeRaw "%prof = call ptr @cheap_the()\n"
, UnsafeRaw "call void @cheap_set_profiler(ptr %prof, i1 true)\n"
, UnsafeRaw "call void @cheap_init()\n"
]
firstMainContent False = []
lastMainContent :: LLVMValue -> [LLVMIr]
lastMainContent var =
lastMainContent :: Bool -> LLVMValue -> [LLVMIr]
lastMainContent True var =
[ UnsafeRaw $
"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 :: ExpT -> CompilerState ()
compileExp (MIR.ELit lit, _t) = emitLit lit
@ -175,7 +183,8 @@ emitECased t e cases = do
-- emit $ Label crashLbl
var_num <- getVarCount
emit . UnsafeRaw $ "call i32 (ptr, ...) @printf(ptr noundef @.non_exhaustive_patterns, i64 noundef " <> show var_num <> ", i64 noundef 6)\n"
emit . UnsafeRaw $ "call void @cheap_dispose()\n"
useGc <- gets gcEnabled
when useGc (emit . UnsafeRaw $ "call void @cheap_dispose()\n")
emit . UnsafeRaw $ "call i32 @exit(i32 noundef 1)\n"
mapM_ (const increaseVarCount) [0 .. 1]
emit $ Br label

View file

@ -133,7 +133,8 @@ data LLVMIr
| Bitcast LLVMType LLVMValue LLVMType
| Ret LLVMType LLVMValue
| Comment String
| Malloca Integer
| Malloc Integer
| GcMalloc Integer
| UnsafeRaw String -- This should generally be avoided, and proper
-- instructions should be used in its place
deriving (Show, Eq, Ord)
@ -223,7 +224,10 @@ llvmIrToString = go 0
, ")\n"
]
(Alloca t) -> unwords ["alloca", toIr t, "\n"]
(Malloca t) ->
(Malloc t) ->
concat
[ "call ptr @malloc(i64 ", show t, ")\n"]
(GcMalloc t) ->
concat
[ "call ptr @cheap_alloc(i64 ", show t, ")\n"]
(Store t1 val t2 (Ident id2)) ->

View file

@ -10,8 +10,19 @@ import System.Process.Extra (
optimize :: String -> IO String
optimize = readCreateProcess (shell "opt --O3 --tailcallopt -S")
compileClang :: String -> IO String
compileClang =
compileClang :: Bool -> String -> IO String
compileClang False =
readCreateProcess . shell $
unwords
[ "clang++" -- , "-Lsrc/GC/lib/", "-l:libgcoll.a"
, "-fno-rtti"
, "-x"
, "ir" -- , "-Lsrc/GC/lib -l:gcoll.a"
, "-o"
, "output/hello_world"
, "-"
]
compileClang True =
readCreateProcess . shell $
unwords
[ "clang++" -- , "-Lsrc/GC/lib/", "-l:libgcoll.a"
@ -30,4 +41,4 @@ compileClang =
]
compile :: String -> Bool -> IO String
compile s addGc = optimize s >>= compileClang
compile s addGc = optimize s >>= compileClang addGc