Merge branch 'master' of http://darcs.haskell.org/ghc

6 files changed, 26 insertions, 24 deletions

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index b5ad8d11ce..6634efdca1 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -1017,7 +1017,7 @@ defaultLogAction :: LogAction
 defaultLogAction dflags severity srcSpan style msg
     = case severity of
       SevOutput -> printSDoc msg style
-      SevDump   -> hPrintDump dflags stdout msg
+      SevDump   -> printSDoc (msg $$ blankLine) style
       SevInfo   -> printErrs msg style
       SevFatal  -> printErrs msg style
       _         -> do hPutChar stderr '\n'
diff --git a/compiler/main/ErrUtils.lhs b/compiler/main/ErrUtils.lhs
index daa66f9d2f..1643128eb7 100644
--- a/compiler/main/ErrUtils.lhs
+++ b/compiler/main/ErrUtils.lhs
@@ -230,6 +230,9 @@ mkDumpDoc hdr doc
 -- | Write out a dump.
 --      If --dump-to-file is set then this goes to a file.
 --      otherwise emit to stdout.
+-- 
+-- When hdr is empty, we print in a more compact format (no separators and
+-- blank lines)
 dumpSDoc :: DynFlags -> DynFlag -> String -> SDoc -> IO ()
 dumpSDoc dflags dflag hdr doc
  = do let mFile = chooseDumpFile dflags dflag
@@ -247,12 +250,18 @@ dumpSDoc dflags dflag hdr doc
                             writeIORef gdref (Set.insert fileName gd)
                         createDirectoryIfMissing True (takeDirectory fileName)
                         handle <- openFile fileName mode
-                        hPrintDump dflags handle doc
+                        let doc'
+                              | null hdr  = doc
+                              | otherwise = doc $$ blankLine
+                        defaultLogActionHPrintDoc dflags handle doc' defaultDumpStyle
                         hClose handle
 
             -- write the dump to stdout
-            Nothing
-                 -> log_action dflags dflags SevDump noSrcSpan defaultDumpStyle (mkDumpDoc hdr doc)
+            Nothing -> do
+              let (doc', severity)
+                    | null hdr  = (doc, SevOutput)
+                    | otherwise = (mkDumpDoc hdr doc, SevDump)
+              log_action dflags dflags severity noSrcSpan defaultDumpStyle doc'
 
 
 -- | Choose where to put a dump file based on DynFlags
diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs
index d8c6732c34..731f55128c 100644
--- a/compiler/simplCore/SimplCore.lhs
+++ b/compiler/simplCore/SimplCore.lhs
@@ -586,7 +586,7 @@ simplifyPgmIO pass@(CoreDoSimplify max_iterations mode)
         -- about to begin, with '1' for the first
       | iteration_no > max_iterations   -- Stop if we've run out of iterations
       = WARN( debugIsOn && (max_iterations > 2)
-            , hang (ptext (sLit "Simplifier baling out after") <+> int max_iterations
+            , hang (ptext (sLit "Simplifier bailing out after") <+> int max_iterations
                     <+> ptext (sLit "iterations")
                     <+> (brackets $ hsep $ punctuate comma $
                          map (int . simplCountN) (reverse counts_so_far)))
diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index df9013cd08..f2ed224df4 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -1571,21 +1571,22 @@ tryRules env rules fn args call_cont
   where
     trace_dump dflags rule rule_rhs
       | dopt Opt_D_dump_rule_rewrites dflags
-      = liftIO . dumpSDoc dflags Opt_D_dump_rule_rewrites "" $
-           vcat [text "Rule fired",
-                 text "Rule:" <+> ftext (ru_name rule),
-                 text "Before:" <+> hang (ppr fn) 2 (sep (map pprParendExpr args)),
-                 text "After: " <+> pprCoreExpr rule_rhs,
-                 text "Cont:  " <+> ppr call_cont]
+      = log_rule dflags Opt_D_dump_rule_rewrites "Rule fired" $ vcat
+          [ text "Rule:" <+> ftext (ru_name rule)
+          , text "Before:" <+> hang (ppr fn) 2 (sep (map pprParendExpr args))
+          , text "After: " <+> pprCoreExpr rule_rhs
+          , text "Cont:  " <+> ppr call_cont ]
 
       | dopt Opt_D_dump_rule_firings dflags
-      = liftIO . dumpSDoc dflags Opt_D_dump_rule_firings "" $
-          vcat [text "Rule fired",
-                ftext (ru_name rule)]
+      = log_rule dflags Opt_D_dump_rule_firings "Rule fired:" $
+          ftext (ru_name rule)
 
       | otherwise
       = return ()
 
+    log_rule dflags dflag hdr details = liftIO . dumpSDoc dflags dflag "" $
+      sep [text hdr, nest 4 details]
+
 \end{code}
 
 Note [Rules for recursive functions]
diff --git a/compiler/specialise/Rules.lhs b/compiler/specialise/Rules.lhs
index 498302a5e9..0cf858e7b5 100644
--- a/compiler/specialise/Rules.lhs
+++ b/compiler/specialise/Rules.lhs
@@ -726,7 +726,7 @@ match_co :: RuleEnv
 match_co renv subst (CoVarCo cv) co
   = match_var renv subst cv (Coercion co)
 match_co _ _ co1 _
-  = pprTrace "match_co baling out" (ppr co1) Nothing
+  = pprTrace "match_co bailing out" (ppr co1) Nothing
 
 -------------
 rnMatchBndr2 :: RuleEnv -> RuleSubst -> Var -> Var -> RuleEnv
diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs
index f74aaa84fe..710780062a 100644
--- a/compiler/utils/Outputable.lhs
+++ b/compiler/utils/Outputable.lhs
@@ -38,7 +38,6 @@ module Outputable (
         colBinder, bold, keyword,
 
         -- * Converting 'SDoc' into strings and outputing it
-        hPrintDump,
         printForC, printForAsm, printForUser, printForUserPartWay,
         pprCode, mkCodeStyle,
         showSDoc, showSDocOneLine,
@@ -91,7 +90,7 @@ import qualified Data.IntMap as IM
 import Data.Set (Set)
 import qualified Data.Set as Set
 import Data.Word
-import System.IO        ( Handle, hFlush )
+import System.IO        ( Handle )
 import System.FilePath
 
 
@@ -330,13 +329,6 @@ ifPprDebug d = SDoc $ \ctx ->
 \end{code}
 
 \begin{code}
-hPrintDump :: DynFlags -> Handle -> SDoc -> IO ()
-hPrintDump dflags h doc = do
-   Pretty.printDoc PageMode (pprCols dflags) h
-     (runSDoc better_doc (initSDocContext dflags defaultDumpStyle))
-   hFlush h
- where
-   better_doc = doc $$ blankLine
 
 printForUser :: DynFlags -> Handle -> PrintUnqualified -> SDoc -> IO ()
 printForUser dflags handle unqual doc