diff options
Diffstat (limited to 'compiler/nativeGen')
| -rw-r--r-- | compiler/nativeGen/AsmCodeGen.hs | 26 |
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) |