summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2014-01-17 10:40:58 +0000
committerSimon Peyton Jones <simonpj@microsoft.com>2014-01-17 14:06:26 +0000
commit9433f1dae5b782d49d4af52f3aa7574272a10c6f (patch)
treed5bfffb7761be7852c6077ee1b9aaf44def5beef
parent45d825bb8ba659696788aca712b6f5d2b15a05cf (diff)
downloadhaskell-9433f1dae5b782d49d4af52f3aa7574272a10c6f.tar.gz
Tidy up Outputable.printDoc, and add printDoc_
The former adds a newline at the end (restoring the previous behaviour) while the latter does not (which previously happened by turning the thuing into a string and only then printing it).
-rw-r--r--compiler/main/DynFlags.hs11
-rw-r--r--compiler/utils/Pretty.lhs15
-rw-r--r--testsuite/tests/ghci.debugger/scripts/dynbrk009.stdout3
3 files changed, 18 insertions, 11 deletions
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 35e9c7e226..36f453f63b 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -1485,13 +1485,16 @@ defaultLogAction dflags severity srcSpan style msg
putStrSDoc = defaultLogActionHPutStrDoc dflags stdout
defaultLogActionHPrintDoc :: DynFlags -> Handle -> SDoc -> PprStyle -> IO ()
-defaultLogActionHPrintDoc = defaultLogActionHPutStrDoc
+defaultLogActionHPrintDoc dflags h d sty
+ = defaultLogActionHPutStrDoc dflags h (d $$ text "") sty
+ -- Adds a newline
defaultLogActionHPutStrDoc :: DynFlags -> Handle -> SDoc -> PprStyle -> IO ()
defaultLogActionHPutStrDoc dflags h d sty
- = Pretty.printDoc Pretty.PageMode (pprCols dflags) h doc
- where
- doc = runSDoc d (initSDocContext dflags sty)
+ = Pretty.printDoc_ Pretty.PageMode (pprCols dflags) h doc
+ where -- Don't add a newline at the end, so that successive
+ -- calls to this log-action can output all on the same line
+ doc = runSDoc d (initSDocContext dflags sty)
newtype FlushOut = FlushOut (IO ())
diff --git a/compiler/utils/Pretty.lhs b/compiler/utils/Pretty.lhs
index 0bac66e04e..fb7fe2b7fb 100644
--- a/compiler/utils/Pretty.lhs
+++ b/compiler/utils/Pretty.lhs
@@ -173,7 +173,7 @@ module Pretty (
hang, punctuate,
- fullRender, printDoc, showDoc,
+ fullRender, printDoc, printDoc_, showDoc,
bufLeftRender -- performance hack
) where
@@ -985,9 +985,16 @@ spaces n | n <=# _ILIT(0) = ""
\begin{code}
printDoc :: Mode -> Int -> Handle -> Doc -> IO ()
-printDoc LeftMode _ hdl doc
+-- printDoc adds a newline to the end
+printDoc mode cols hdl doc = printDoc_ mode cols hdl (doc $$ text "")
+
+printDoc_ :: Mode -> Int -> Handle -> Doc -> IO ()
+-- printDoc_ does not add a newline at the end, so that
+-- successive calls can output stuff on the same line
+-- Rather like putStr vs putStrLn
+printDoc_ LeftMode _ hdl doc
= do { printLeftRender hdl doc; hFlush hdl }
-printDoc mode pprCols hdl doc
+printDoc_ mode pprCols hdl doc
= do { fullRender mode pprCols 1.5 put done doc ;
hFlush hdl }
where
@@ -999,7 +1006,7 @@ printDoc mode pprCols hdl doc
put (ZStr s) next = hPutFZS hdl s >> next
put (LStr s l) next = hPutLitString hdl s l >> next
- done = hPutChar hdl '\n'
+ done = return () -- hPutChar hdl '\n'
-- some versions of hPutBuf will barf if the length is zero
hPutLitString :: Handle -> Ptr a -> Int# -> IO ()
diff --git a/testsuite/tests/ghci.debugger/scripts/dynbrk009.stdout b/testsuite/tests/ghci.debugger/scripts/dynbrk009.stdout
index f774e1e642..65ab5e6126 100644
--- a/testsuite/tests/ghci.debugger/scripts/dynbrk009.stdout
+++ b/testsuite/tests/ghci.debugger/scripts/dynbrk009.stdout
@@ -3,9 +3,6 @@ _result :: Int = _
Stopped at dynbrk009.hs:8:27-36
_result :: Int = _
Stopped at dynbrk009.hs:8:31-35
-
Stopped at dynbrk009.hs:6:1-9
-
Stopped at dynbrk009.hs:6:9
-
3