summaryrefslogtreecommitdiff
path: root/compiler/GHC/Driver/Session.hs
diff options
context:
space:
mode:
authorAndreas Klebinger <klebinger.andreas@gmx.at>2020-11-24 20:39:56 +0100
committerBen Gamari <ben@smart-cactus.org>2020-12-14 15:22:13 -0500
commitaf855ac1d37359df3db8c48dc6c9dd2f3fe24e77 (patch)
tree434a4cda6edcd19f282a1a38a9f2d864c1309b60 /compiler/GHC/Driver/Session.hs
parentd0e8c10d587e4b9984526d0dfcfcb258b75733b8 (diff)
downloadhaskell-wip/andreask/opt_dumps.tar.gz
Optimize dumping of consecutive whitespace.wip/andreask/opt_dumps
The naive way of putting out n characters of indent would be something like `hPutStr hdl (replicate n ' ')`. However this is quite inefficient as we allocate an absurd number of strings consisting of simply spaces as we don't cache them. To improve on this we now track if we can simply write ascii spaces via hPutBuf instead. This is the case when running with -ddump-to-file where we force the encoding to be UTF8. This avoids both the cost of going through encoding as well as avoiding allocation churn from all the white space. Instead we simply use hPutBuf on a preallocated unlifted string. When dumping stg like this: > nofib/spectral/simple/Main.hs -fforce-recomp -ddump-stg-final -ddump-to-file -c +RTS -s Allocations went from 1,778 MB to 1,702MB. About a 4% reduction of allocation! I did not measure the difference in runtime but expect it to be similar. Bumps the haddock submodule since the interface of GHC's Pretty slightly changed. ------------------------- Metric Decrease: T12227 -------------------------
Diffstat (limited to 'compiler/GHC/Driver/Session.hs')
-rw-r--r--compiler/GHC/Driver/Session.hs27
1 files changed, 15 insertions, 12 deletions
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index a1075f1cdb..c4b28b1210 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -1344,7 +1344,7 @@ defaultFatalMessager = hPutStrLn stderr
jsonLogAction :: LogAction
jsonLogAction dflags reason severity srcSpan msg
=
- defaultLogActionHPutStrDoc dflags stdout
+ defaultLogActionHPutStrDoc dflags True stdout
(withPprStyle (PprCode CStyle) (doc $$ text ""))
where
str = renderWithContext (initSDocContext dflags defaultUserStyle) msg
@@ -1367,9 +1367,9 @@ defaultLogAction dflags reason severity srcSpan msg
SevWarning -> printWarns
SevError -> printWarns
where
- printOut = defaultLogActionHPrintDoc dflags stdout
- printErrs = defaultLogActionHPrintDoc dflags stderr
- putStrSDoc = defaultLogActionHPutStrDoc dflags stdout
+ printOut = defaultLogActionHPrintDoc dflags False stdout
+ printErrs = defaultLogActionHPrintDoc dflags False stderr
+ putStrSDoc = defaultLogActionHPutStrDoc dflags False stdout
-- Pretty print the warning flag, if any (#10752)
message = mkLocMessageAnn flagMsg severity srcSpan msg
@@ -1409,16 +1409,19 @@ defaultLogAction dflags reason severity srcSpan msg
| otherwise = ""
-- | Like 'defaultLogActionHPutStrDoc' but appends an extra newline.
-defaultLogActionHPrintDoc :: DynFlags -> Handle -> SDoc -> IO ()
-defaultLogActionHPrintDoc dflags h d
- = defaultLogActionHPutStrDoc dflags h (d $$ text "")
-
-defaultLogActionHPutStrDoc :: DynFlags -> Handle -> SDoc -> IO ()
-defaultLogActionHPutStrDoc dflags h d
+defaultLogActionHPrintDoc :: DynFlags -> Bool -> Handle -> SDoc -> IO ()
+defaultLogActionHPrintDoc dflags asciiSpace h d
+ = defaultLogActionHPutStrDoc dflags asciiSpace h (d $$ text "")
+
+-- | The boolean arguments let's the pretty printer know if it can optimize indent
+-- by writing ascii ' ' characters without going through decoding.
+defaultLogActionHPutStrDoc :: DynFlags -> Bool -> Handle -> SDoc -> IO ()
+defaultLogActionHPutStrDoc dflags asciiSpace h d
-- Don't add a newline at the end, so that successive
-- calls to this log-action can output all on the same line
- = printSDoc ctx Pretty.PageMode h d
- where ctx = initSDocContext dflags defaultUserStyle
+ = printSDoc ctx (Pretty.PageMode asciiSpace) h d
+ where
+ ctx = initSDocContext dflags defaultUserStyle
newtype FlushOut = FlushOut (IO ())