[commit: ghc] master: Tidy up Outputable.printDoc, and add printDoc_ (9433f1d)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/9433f1dae5b782d49d4af52f3aa7574272a10c6f/ghc

>---------------------------------------------------------------

commit 9433f1dae5b782d49d4af52f3aa7574272a10c6f
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Fri Jan 17 10:40:58 2014 +0000

    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).


>---------------------------------------------------------------

9433f1dae5b782d49d4af52f3aa7574272a10c6f
 compiler/main/DynFlags.hs                              |   11 +++++++----
 compiler/utils/Pretty.lhs                              |   15 +++++++++++----
 testsuite/tests/ghci.debugger/scripts/dynbrk009.stdout |    3 ---
 3 files changed, 18 insertions(+), 11 deletions(-)

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 35e9c7e..36f453f 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 0bac66e..fb7fe2b 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 f774e1e..65ab5e6 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