diff options
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' |