summaryrefslogtreecommitdiff
path: root/compiler/llvmGen
diff options
context:
space:
mode:
authorÖmer Sinan Ağacan <omeragacan@gmail.com>2019-08-21 15:32:09 +0300
committerÖmer Sinan Ağacan <omeragacan@gmail.com>2019-08-28 12:51:12 +0300
commit1c7ec4499ffec5e6b9c97e7a5c8d31062d1e2822 (patch)
tree1cc732f1ab66b6c5963970b33f816e5bbd998edf /compiler/llvmGen
parentee2fad9e503ffdf61a086f721553aa3c502d1cb8 (diff)
downloadhaskell-1c7ec4499ffec5e6b9c97e7a5c8d31062d1e2822.tar.gz
Return results of Cmm streams in backends
This generalizes code generators (outputAsm, outputLlvm, outputC, and the call site codeOutput) so that they'll return the return values of the passed Cmm streams. This allows accumulating data during Cmm generation and returning it to the call site in HscMain. Previously the Cmm streams were assumed to return (), so the code generators returned () as well. This change is required by !1304 and !1530. Skipping CI as this was tested before and I only updated the commit message. [skip ci]
Diffstat (limited to 'compiler/llvmGen')
-rw-r--r--compiler/llvmGen/LlvmCodeGen.hs14
-rw-r--r--compiler/llvmGen/LlvmCodeGen/Base.hs6
2 files changed, 12 insertions, 8 deletions
diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs
index 2a568f820f..f649069b97 100644
--- a/compiler/llvmGen/LlvmCodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen.hs
@@ -42,8 +42,8 @@ import System.IO
-- | Top-level of the LLVM Code generator
--
llvmCodeGen :: DynFlags -> Handle -> UniqSupply
- -> Stream.Stream IO RawCmmGroup ()
- -> IO ()
+ -> Stream.Stream IO RawCmmGroup a
+ -> IO a
llvmCodeGen dflags h us cmm_stream
= withTiming (pure dflags) (text "LLVM CodeGen") (const ()) $ do
bufh <- newBufHandle h
@@ -66,12 +66,14 @@ llvmCodeGen dflags h us cmm_stream
$+$ text "We will try though...")
-- run code generation
- runLlvm dflags ver bufh us $
+ a <- runLlvm dflags ver bufh us $
llvmCodeGen' (liftStream cmm_stream)
bFlush bufh
-llvmCodeGen' :: Stream.Stream LlvmM RawCmmGroup () -> LlvmM ()
+ return a
+
+llvmCodeGen' :: Stream.Stream LlvmM RawCmmGroup a -> LlvmM a
llvmCodeGen' cmm_stream
= do -- Preamble
renderLlvm header
@@ -79,13 +81,15 @@ llvmCodeGen' cmm_stream
cmmMetaLlvmPrelude
-- Procedures
- () <- Stream.consume cmm_stream llvmGroupLlvmGens
+ a <- Stream.consume cmm_stream llvmGroupLlvmGens
-- Declare aliases for forward references
renderLlvm . pprLlvmData =<< generateExternDecls
-- Postamble
cmmUsedLlvmGens
+
+ return a
where
header :: SDoc
header = sdocWithDynFlags $ \dflags ->
diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs
index 81f3b9f84c..7bed4c7b8d 100644
--- a/compiler/llvmGen/LlvmCodeGen/Base.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Base.hs
@@ -253,10 +253,10 @@ liftIO m = LlvmM $ \env -> do x <- m
return (x, env)
-- | Get initial Llvm environment.
-runLlvm :: DynFlags -> LlvmVersion -> BufHandle -> UniqSupply -> LlvmM () -> IO ()
+runLlvm :: DynFlags -> LlvmVersion -> BufHandle -> UniqSupply -> LlvmM a -> IO a
runLlvm dflags ver out us m = do
- _ <- runLlvmM m env
- return ()
+ (a, _) <- runLlvmM m env
+ return a
where env = LlvmEnv { envFunMap = emptyUFM
, envVarMap = emptyUFM
, envStackRegs = []