import Digraph
import qualified Pretty
+import BufWrite
import Outputable
import FastString
import UniqSet
= 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
(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 =
hang, punctuate,
-- renderStyle, -- Haskell 1.3 only
- render, fullRender, printDoc, showDocWith
+ render, fullRender, printDoc, showDocWith,
+ bufLeftRender -- performance hack
) where
import BufWrite
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.