diff options
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 |
commit | 1c7ec4499ffec5e6b9c97e7a5c8d31062d1e2822 (patch) | |
tree | 1cc732f1ab66b6c5963970b33f816e5bbd998edf /compiler/main/CodeOutput.hs | |
parent | ee2fad9e503ffdf61a086f721553aa3c502d1cb8 (diff) | |
download | haskell-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/main/CodeOutput.hs')
-rw-r--r-- | compiler/main/CodeOutput.hs | 37 |
1 files changed, 18 insertions, 19 deletions
diff --git a/compiler/main/CodeOutput.hs b/compiler/main/CodeOutput.hs index 66c11f08a4..839999a32c 100644 --- a/compiler/main/CodeOutput.hs +++ b/compiler/main/CodeOutput.hs @@ -54,10 +54,11 @@ codeOutput :: DynFlags -> [(ForeignSrcLang, FilePath)] -- ^ additional files to be compiled with with the C compiler -> [InstalledUnitId] - -> Stream IO RawCmmGroup () -- Compiled C-- + -> Stream IO RawCmmGroup a -- Compiled C-- -> IO (FilePath, (Bool{-stub_h_exists-}, Maybe FilePath{-stub_c_exists-}), - [(ForeignSrcLang, FilePath)]{-foreign_fps-}) + [(ForeignSrcLang, FilePath)]{-foreign_fps-}, + a) codeOutput dflags this_mod filenm location foreign_stubs foreign_fps pkg_deps cmm_stream @@ -87,15 +88,14 @@ codeOutput dflags this_mod filenm location foreign_stubs foreign_fps pkg_deps } ; stubs_exist <- outputForeignStubs dflags this_mod location foreign_stubs - ; case hscTarget dflags of { - HscAsm -> outputAsm dflags this_mod location filenm - linted_cmm_stream; - HscC -> outputC dflags filenm linted_cmm_stream pkg_deps; - HscLlvm -> outputLlvm dflags filenm linted_cmm_stream; - HscInterpreted -> panic "codeOutput: HscInterpreted"; - HscNothing -> panic "codeOutput: HscNothing" - } - ; return (filenm, stubs_exist, foreign_fps) + ; a <- case hscTarget dflags of + HscAsm -> outputAsm dflags this_mod location filenm + linted_cmm_stream + HscC -> outputC dflags filenm linted_cmm_stream pkg_deps + HscLlvm -> outputLlvm dflags filenm linted_cmm_stream + HscInterpreted -> panic "codeOutput: HscInterpreted" + HscNothing -> panic "codeOutput: HscNothing" + ; return (filenm, stubs_exist, foreign_fps, a) } doOutput :: String -> (Handle -> IO a) -> IO a @@ -111,13 +111,13 @@ doOutput filenm io_action = bracket (openFile filenm WriteMode) hClose io_action outputC :: DynFlags -> FilePath - -> Stream IO RawCmmGroup () + -> Stream IO RawCmmGroup a -> [InstalledUnitId] - -> IO () + -> IO a outputC dflags filenm cmm_stream packages = do - withTiming (return dflags) (text "C codegen") id $ do + withTiming (return dflags) (text "C codegen") (\a -> seq a () {- FIXME -}) $ do -- figure out which header files to #include in the generated .hc file: -- @@ -150,18 +150,17 @@ outputC dflags filenm cmm_stream packages -} outputAsm :: DynFlags -> Module -> ModLocation -> FilePath - -> Stream IO RawCmmGroup () - -> IO () + -> Stream IO RawCmmGroup a + -> IO a outputAsm dflags this_mod location filenm cmm_stream | platformMisc_ghcWithNativeCodeGen $ platformMisc dflags = do ncg_uniqs <- mkSplitUniqSupply 'n' debugTraceMsg dflags 4 (text "Outputing asm to" <+> text filenm) - _ <- {-# SCC "OutputAsm" #-} doOutput filenm $ + {-# SCC "OutputAsm" #-} doOutput filenm $ \h -> {-# SCC "NativeCodeGen" #-} nativeCodeGen dflags this_mod location h ncg_uniqs cmm_stream - return () | otherwise = panic "This compiler was built without a native code generator" @@ -174,7 +173,7 @@ outputAsm dflags this_mod location filenm cmm_stream ************************************************************************ -} -outputLlvm :: DynFlags -> FilePath -> Stream IO RawCmmGroup () -> IO () +outputLlvm :: DynFlags -> FilePath -> Stream IO RawCmmGroup a -> IO a outputLlvm dflags filenm cmm_stream = do ncg_uniqs <- mkSplitUniqSupply 'n' |