summaryrefslogtreecommitdiff
path: root/compiler/nativeGen
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/nativeGen
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/nativeGen')
-rw-r--r--compiler/nativeGen/AsmCodeGen.hs26
1 files changed, 14 insertions, 12 deletions
diff --git a/compiler/nativeGen/AsmCodeGen.hs b/compiler/nativeGen/AsmCodeGen.hs
index 40a1e0b067..fe59a4d789 100644
--- a/compiler/nativeGen/AsmCodeGen.hs
+++ b/compiler/nativeGen/AsmCodeGen.hs
@@ -157,14 +157,14 @@ The machine-dependent bits break down as follows:
-}
--------------------
-nativeCodeGen :: DynFlags -> Module -> ModLocation -> Handle -> UniqSupply
- -> Stream IO RawCmmGroup ()
- -> IO UniqSupply
+nativeCodeGen :: forall a . DynFlags -> Module -> ModLocation -> Handle -> UniqSupply
+ -> Stream IO RawCmmGroup a
+ -> IO a
nativeCodeGen dflags this_mod modLoc h us cmms
= let platform = targetPlatform dflags
nCG' :: ( Outputable statics, Outputable instr
, Outputable jumpDest, Instruction instr)
- => NcgImpl statics instr jumpDest -> IO UniqSupply
+ => NcgImpl statics instr jumpDest -> IO a
nCG' ncgImpl = nativeCodeGen' dflags this_mod modLoc ncgImpl h us cmms
in case platformArch platform of
ArchX86 -> nCG' (x86NcgImpl dflags)
@@ -314,8 +314,8 @@ nativeCodeGen' :: (Outputable statics, Outputable instr,Outputable jumpDest,
-> NcgImpl statics instr jumpDest
-> Handle
-> UniqSupply
- -> Stream IO RawCmmGroup ()
- -> IO UniqSupply
+ -> Stream IO RawCmmGroup a
+ -> IO a
nativeCodeGen' dflags this_mod modLoc ncgImpl h us cmms
= do
-- BufHandle is a performance hack. We could hide it inside
@@ -323,9 +323,10 @@ nativeCodeGen' dflags this_mod modLoc ncgImpl h us cmms
-- printDocs here (in order to do codegen in constant space).
bufh <- newBufHandle h
let ngs0 = NGS [] [] [] [] [] [] emptyUFM mapEmpty
- (ngs, us') <- cmmNativeGenStream dflags this_mod modLoc ncgImpl bufh us
+ (ngs, us', a) <- cmmNativeGenStream dflags this_mod modLoc ncgImpl bufh us
cmms ngs0
- finishNativeGen dflags modLoc bufh us' ngs
+ _ <- finishNativeGen dflags modLoc bufh us' ngs
+ return a
finishNativeGen :: Instruction instr
=> DynFlags
@@ -386,20 +387,21 @@ cmmNativeGenStream :: (Outputable statics, Outputable instr
-> NcgImpl statics instr jumpDest
-> BufHandle
-> UniqSupply
- -> Stream IO RawCmmGroup ()
+ -> Stream IO RawCmmGroup a
-> NativeGenAcc statics instr
- -> IO (NativeGenAcc statics instr, UniqSupply)
+ -> IO (NativeGenAcc statics instr, UniqSupply, a)
cmmNativeGenStream dflags this_mod modLoc ncgImpl h us cmm_stream ngs
= do r <- Stream.runStream cmm_stream
case r of
- Left () ->
+ Left a ->
return (ngs { ngs_imports = reverse $ ngs_imports ngs
, ngs_natives = reverse $ ngs_natives ngs
, ngs_colorStats = reverse $ ngs_colorStats ngs
, ngs_linearStats = reverse $ ngs_linearStats ngs
},
- us)
+ us,
+ a)
Right (cmms, cmm_stream') -> do
(us', ngs'') <-
withTiming (return dflags)