[commit: ghc] master: Put header and timestamp in dump files (51da4ee)

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/51da4ee2401983359db9caad3902a98a8f505431

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

commit 51da4ee2401983359db9caad3902a98a8f505431
Author: Ian Lynagh <[email protected]>
Date:   Wed Oct 17 01:10:49 2012 +0100

    Put header and timestamp in dump files

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

 compiler/main/ErrUtils.lhs |   14 ++++++++------
 1 files changed, 8 insertions(+), 6 deletions(-)

diff --git a/compiler/main/ErrUtils.lhs b/compiler/main/ErrUtils.lhs
index b13cded..7b1f55f 100644
--- a/compiler/main/ErrUtils.lhs
+++ b/compiler/main/ErrUtils.lhs
@@ -50,6 +50,7 @@ import Data.List
 import qualified Data.Set as Set
 import Data.IORef
 import Data.Ord
+import Data.Time
 import Control.Monad
 import System.IO
 
@@ -232,9 +233,6 @@ dumpSDoc :: DynFlags -> GeneralFlag -> String -> SDoc -> IO ()
 dumpSDoc dflags flag hdr doc
  = do let mFile = chooseDumpFile dflags flag
       case mFile of
-            -- write the dump to a file
-            -- don't add the header in this case, we can see what kind
-            -- of dump it is from the filename.
             Just fileName
                  -> do
                         let gdref = generatedDumps dflags
@@ -245,9 +243,13 @@ dumpSDoc dflags flag hdr doc
                             writeIORef gdref (Set.insert fileName gd)
                         createDirectoryIfMissing True (takeDirectory fileName)
                         handle <- openFile fileName mode
-                        let doc'
-                              | null hdr  = doc
-                              | otherwise = doc $$ blankLine
+                        doc' <- if null hdr
+                                then return doc
+                                else do t <- getCurrentTime
+                                        let d = text (show t)
+                                             $$ blankLine
+                                             $$ doc
+                                        return $ mkDumpDoc hdr d
                         defaultLogActionHPrintDoc dflags handle doc' defaultDumpStyle
                         hClose handle