Optimise writing out the .s file

I noticed while working on the new IO library that GHC was writing out
the .s file in lots of little chunks.  It turns out that this is a
result of using multiple printDocs to avoid space leaks in the NCG,
where each printDoc is finishing up with an hFlush.

What's worse, is that this makes poor use of the optimisation inside
printDoc that uses its own buffering to avoid hitting the Handle all
the time.

So I hacked around this by making the buffering optimisation inside
Pretty visible from the outside, for use in the NCG.  The changes are
quite small.

diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs
index 29f4be4..70b042b 100644 (file)
--- a/compiler/nativeGen/AsmCodeGen.lhs
+++ b/compiler/nativeGen/AsmCodeGen.lhs
@@ -53,6 +53,7 @@ import Module
 
 import Digraph
 import qualified Pretty
+import BufWrite
 import Outputable
 import FastString
 import UniqSet
@@ -127,8 +128,12 @@ nativeCodeGen dflags h us cmms
  = do
        let split_cmms  = concat $ map add_split cmms
 
-       (imports, prof)
-               <- cmmNativeGens dflags h us split_cmms [] [] 0
+        -- BufHandle is a performance hack.  We could hide it inside
+        -- 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) <- cmmNativeGens dflags bufh us split_cmms [] [] 0
+        bFlush bufh
 
        let (native, colorStats, linearStats)
                = unzip3 prof
@@ -186,7 +191,7 @@ cmmNativeGens dflags h us (cmm : cmms) impAcc profAcc count
        (us', native, imports, colorStats, linearStats)
                <- cmmNativeGen dflags us cmm count
 
-       Pretty.printDoc Pretty.LeftMode h
+       Pretty.bufLeftRender h
                $ {-# SCC "pprNativeCode" #-} Pretty.vcat $ map pprNatCmmTop native
 
        let lsPprNative =

diff --git a/compiler/utils/Pretty.lhs b/compiler/utils/Pretty.lhs
index 7aec715..3e08814 100644 (file)
--- a/compiler/utils/Pretty.lhs
+++ b/compiler/utils/Pretty.lhs
@@ -176,7 +176,8 @@ module Pretty (
         hang, punctuate,
 
 --      renderStyle,            -- Haskell 1.3 only
-        render, fullRender, printDoc, showDocWith
+        render, fullRender, printDoc, showDocWith,
+        bufLeftRender -- performance hack
   ) where
 
 import BufWrite
@@ -1042,9 +1043,12 @@ hPutLitString handle a l = if l ==# _ILIT(0)
 printLeftRender :: Handle -> Doc -> IO ()
 printLeftRender hdl doc = do
   b <- newBufHandle hdl
-  layLeft b (reduceDoc doc)
+  bufLeftRender b doc
   bFlush b
 
+bufLeftRender :: BufHandle -> Doc -> IO ()
+bufLeftRender b doc = layLeft b (reduceDoc doc)
+
 -- HACK ALERT!  the "return () >>" below convinces GHC to eta-expand
 -- this function with the IO state lambda.  Otherwise we end up with
 -- closures in all the case branches.