Commit 6ba3d614 authored by Simon Marlow's avatar Simon Marlow
Browse files

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.
parent 87a00632
......@@ -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 =
......@@ -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.
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment