[commit: ghc] master: AsmCodeGen: Refactor worker in cmmNativeGens (7753273)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/775327350c6b16acdf01e49ac174722cc91e4973/ghc

>---------------------------------------------------------------

commit 775327350c6b16acdf01e49ac174722cc91e4973
Author: Ben Gamari <bgamari.foss at gmail.com>
Date:   Tue Nov 29 14:44:57 2016 -0500

    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


>---------------------------------------------------------------

775327350c6b16acdf01e49ac174722cc91e4973
 compiler/nativeGen/AsmCodeGen.hs | 23 +++++++++++++----------
 1 file changed, 13 insertions(+), 10 deletions(-)

diff --git a/compiler/nativeGen/AsmCodeGen.hs b/compiler/nativeGen/AsmCodeGen.hs
index 29bf26c..affb3e4 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 ()