[commit: ghc] master: Make nativeCodeGen return the rest of its UniqSupply (6bdac1c)

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/6bdac1c375dc754ad3a540f704437650b43474c1

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

commit 6bdac1c375dc754ad3a540f704437650b43474c1
Author: Ian Lynagh <[email protected]>
Date:   Thu Dec 6 19:34:27 2012 +0000

    Make nativeCodeGen return the rest of its UniqSupply

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

 compiler/main/CodeOutput.lhs      |    5 +++--
 compiler/nativeGen/AsmCodeGen.lhs |   16 +++++++++-------
 2 files changed, 12 insertions(+), 9 deletions(-)

diff --git a/compiler/main/CodeOutput.lhs b/compiler/main/CodeOutput.lhs
index 230ba71..f76b0ef 100644
--- a/compiler/main/CodeOutput.lhs
+++ b/compiler/main/CodeOutput.lhs
@@ -83,7 +83,7 @@ codeOutput dflags this_mod location foreign_stubs pkg_deps cmm_stream
         ; return stubs_exist
         }
 
-doOutput :: String -> (Handle -> IO ()) -> IO ()
+doOutput :: String -> (Handle -> IO a) -> IO a
 doOutput filenm io_action = bracket (openFile filenm WriteMode) hClose io_action
 \end{code}
 
@@ -144,9 +144,10 @@ outputAsm dflags filenm cmm_stream
  | cGhcWithNativeCodeGen == "YES"
   = do ncg_uniqs <- mkSplitUniqSupply 'n'
 
-       {-# SCC "OutputAsm" #-} doOutput filenm $
+       _ <- {-# SCC "OutputAsm" #-} doOutput filenm $
            \f -> {-# SCC "NativeCodeGen" #-}
                  nativeCodeGen dflags f ncg_uniqs cmm_stream
+       return ()
 
  | otherwise
   = panic "This compiler was built without a native code generator"
diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs
index 863af12..9917619 100644
--- a/compiler/nativeGen/AsmCodeGen.lhs
+++ b/compiler/nativeGen/AsmCodeGen.lhs
@@ -151,10 +151,11 @@ data NcgImpl statics instr jumpDest = NcgImpl {
     }
 
 --------------------
-nativeCodeGen :: DynFlags -> Handle -> UniqSupply -> Stream IO RawCmmGroup () -> IO ()
+nativeCodeGen :: DynFlags -> Handle -> UniqSupply -> Stream IO RawCmmGroup ()
+              -> IO UniqSupply
 nativeCodeGen dflags h us cmms
  = let platform = targetPlatform dflags
-       nCG' :: (Outputable statics, Outputable instr, Instruction instr) => NcgImpl statics instr jumpDest -> IO ()
+       nCG' :: (Outputable statics, Outputable instr, Instruction instr) => NcgImpl statics instr jumpDest -> IO UniqSupply
        nCG' ncgImpl = nativeCodeGen' dflags ncgImpl h us cmms
        x86NcgImpl = NcgImpl {
                          cmmTopCodeGen             = X86.CodeGen.cmmTopCodeGen
@@ -239,7 +240,7 @@ noAllocMoreStack amount _
 nativeCodeGen' :: (Outputable statics, Outputable instr, Instruction instr)
                => DynFlags
                -> NcgImpl statics instr jumpDest
-               -> Handle -> UniqSupply -> Stream IO RawCmmGroup () -> IO ()
+               -> Handle -> UniqSupply -> Stream IO RawCmmGroup () -> IO UniqSupply
 nativeCodeGen' dflags ncgImpl h us cmms
  = do
         let platform = targetPlatform dflags
@@ -248,7 +249,7 @@ nativeCodeGen' dflags ncgImpl h us cmms
         -- Pretty if it weren't for the fact that we do lots of little
         -- printDocs here (in order to do codegen in constant space).
         bufh <- newBufHandle h
-        (imports, prof) <- cmmNativeGenStream dflags ncgImpl bufh us split_cmms [] [] 0
+        (imports, prof, us') <- cmmNativeGenStream dflags ncgImpl bufh us split_cmms [] [] 0
         bFlush bufh
 
         let (native, colorStats, linearStats)
@@ -293,7 +294,7 @@ nativeCodeGen' dflags ncgImpl h us cmms
                 $ withPprStyleDoc dflags (mkCodeStyle AsmStyle)
                 $ makeImportsDoc dflags (concat imports)
 
-        return  ()
+        return us'
 
  where  add_split tops
                 | gopt Opt_SplitObjs dflags = split_marker : tops
@@ -316,13 +317,14 @@ cmmNativeGenStream :: (Outputable statics, Outputable instr, Instruction instr)
               -> IO ( [[CLabel]],
                       [([NatCmmDecl statics instr],
                       Maybe [Color.RegAllocStats statics instr],
-                      Maybe [Linear.RegAllocStats])] )
+                      Maybe [Linear.RegAllocStats])],
+                      UniqSupply )
 
 cmmNativeGenStream dflags ncgImpl h us cmm_stream impAcc profAcc count
  = do
         r <- Stream.runStream cmm_stream
         case r of
-          Left () -> return (reverse impAcc, reverse profAcc)
+          Left () -> return (reverse impAcc, reverse profAcc, us)
           Right (cmms, cmm_stream') -> do
             (impAcc,profAcc,us') <- cmmNativeGens dflags ncgImpl h us cmms
                                               impAcc profAcc count