X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FErrUtils.lhs;h=e4559d4a04364fd2c4a7b67cee6a2cc59c287364;hb=6a05ec5ef5373f61b7f9f5bdc344483417fa801b;hp=d93fb1bdefcdeb9d5510cbeb0450f67bfc19bb65;hpb=a8dc65d6582cc8dda6a1de2862e2d6da80a78d0c;p=ghc-hetmet.git diff --git a/compiler/main/ErrUtils.lhs b/compiler/main/ErrUtils.lhs index d93fb1b..e4559d4 100644 --- a/compiler/main/ErrUtils.lhs +++ b/compiler/main/ErrUtils.lhs @@ -4,6 +4,13 @@ \section[ErrsUtils]{Utilities for error reporting} \begin{code} +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + module ErrUtils ( Message, mkLocMessage, printError, Severity(..), @@ -16,7 +23,7 @@ module ErrUtils ( ghcExit, doIfSet, doIfSet_dyn, - dumpIfSet, dumpIfSet_core, dumpIfSet_dyn, dumpIfSet_dyn_or, mkDumpDoc, + dumpIfSet, dumpIfSet_core, dumpIfSet_dyn, dumpIfSet_dyn_or, mkDumpDoc, dumpSDoc, -- * Messages during compilation putMsg, @@ -199,13 +206,13 @@ dumpIfSet_core dflags flag hdr doc | dopt flag dflags || verbosity dflags >= 4 || dopt Opt_D_verbose_core2core dflags - = writeDump dflags flag (mkDumpDoc hdr doc) + = dumpSDoc dflags flag hdr doc | otherwise = return () dumpIfSet_dyn :: DynFlags -> DynFlag -> String -> SDoc -> IO () dumpIfSet_dyn dflags flag hdr doc | dopt flag dflags || verbosity dflags >= 4 - = writeDump dflags flag (mkDumpDoc hdr doc) + = dumpSDoc dflags flag hdr doc | otherwise = return () @@ -228,11 +235,13 @@ mkDumpDoc hdr doc -- | Write out a dump. -- If --dump-to-file is set then this goes to a file. -- otherwise emit to stdout. -writeDump :: DynFlags -> DynFlag -> SDoc -> IO () -writeDump dflags dflag doc +dumpSDoc :: DynFlags -> DynFlag -> String -> SDoc -> IO () +dumpSDoc dflags dflag hdr doc = do let mFile = chooseDumpFile dflags dflag 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 handle <- openFile fileName AppendMode hPrintDump handle doc @@ -240,7 +249,7 @@ writeDump dflags dflag doc -- write the dump to stdout Nothing - -> do printDump doc + -> do printDump (mkDumpDoc hdr doc) -- | Choose where to put a dump file based on DynFlags