The code generator can now compile without the GC.
This commit is contained in:
parent
f9d28028b5
commit
de03a2cc34
5 changed files with 48 additions and 18 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)) ->
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue