diff options
| author | Ben Gamari <bgamari.foss@gmail.com> | 2016-11-29 14:44:57 -0500 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2016-11-29 14:44:58 -0500 |
| commit | 775327350c6b16acdf01e49ac174722cc91e4973 (patch) | |
| tree | b03f5d0a20222f6ee055cdf3207924675048f814 /compiler/nativeGen | |
| parent | 4d4e7a512aa4ecbb5811cccc1dab335379e63efa (diff) | |
| download | haskell-775327350c6b16acdf01e49ac174722cc91e4973.tar.gz | |
AsmCodeGen: Refactor worker in cmmNativeGens
Test Plan: Validate
Reviewers: austin, simonmar, michalt
Reviewed By: simonmar, michalt
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D2736
Diffstat (limited to 'compiler/nativeGen')
| -rw-r--r-- | compiler/nativeGen/AsmCodeGen.hs | 23 |
1 files changed, 13 insertions, 10 deletions
diff --git a/compiler/nativeGen/AsmCodeGen.hs b/compiler/nativeGen/AsmCodeGen.hs index 29bf26c70c..affb3e4e4a 100644 --- a/compiler/nativeGen/AsmCodeGen.hs +++ b/compiler/nativeGen/AsmCodeGen.hs @@ -416,7 +416,8 @@ cmmNativeGenStream dflags this_mod modLoc ncgImpl h us cmm_stream ngs -- | Do native code generation on all these cmms. -- -cmmNativeGens :: (Outputable statics, Outputable instr, Instruction instr) +cmmNativeGens :: forall statics instr jumpDest. + (Outputable statics, Outputable instr, Instruction instr) => DynFlags -> Module -> ModLocation -> NcgImpl statics instr jumpDest @@ -428,12 +429,15 @@ cmmNativeGens :: (Outputable statics, Outputable instr, Instruction instr) -> Int -> IO (NativeGenAcc statics instr, UniqSupply) -cmmNativeGens _ _ _ _ _ _ us [] ngs !_ - = return (ngs, us) +cmmNativeGens dflags this_mod modLoc ncgImpl h dbgMap = go + where + go :: UniqSupply -> [RawCmmDecl] -> NativeGenAcc statics instr -> Int + -> IO (NativeGenAcc statics instr, UniqSupply) -cmmNativeGens dflags this_mod modLoc ncgImpl h dbgMap us - (cmm : cmms) ngs count - = do + go us [] ngs !_ = + return (ngs, us) + + go us (cmm : cmms) ngs count = do let fileIds = ngs_dwarfFiles ngs (us', fileIds', native, imports, colorStats, linearStats) <- {-# SCC "cmmNativeGen" #-} @@ -468,11 +472,10 @@ cmmNativeGens dflags this_mod modLoc ncgImpl h dbgMap us , ngs_labels = ngs_labels ngs ++ labels' , ngs_dwarfFiles = fileIds' } - cmmNativeGens dflags this_mod modLoc ncgImpl h dbgMap us' - cmms ngs' (count + 1) + go us' cmms ngs' (count + 1) - where seqString [] = () - seqString (x:xs) = x `seq` seqString xs + seqString [] = () + seqString (x:xs) = x `seq` seqString xs emitNativeCode :: DynFlags -> BufHandle -> SDoc -> IO () |