import Data.List
import Data.Map (Map)
import qualified Data.Map as Map
+import Data.Set (Set)
+import qualified Data.Set as Set
import System.FilePath
import System.IO ( stderr, hPutChar )
filesToClean :: IORef [FilePath],
dirsToClean :: IORef (Map FilePath FilePath),
+ -- Names of files which were generated from -ddump-to-file; used to
+ -- track which ones we need to truncate because it's our first run
+ -- through
+ generatedDumps :: IORef (Set FilePath),
+
-- hsc dynamic flags
flags :: [DynFlag],
-- Don't change this without updating extensionFlags:
ways <- readIORef v_Ways
refFilesToClean <- newIORef []
refDirsToClean <- newIORef Map.empty
+ refGeneratedDumps <- newIORef Set.empty
return dflags{
ways = ways,
buildTag = mkBuildTag (filter (not . wayRTSOnly) ways),
rtsBuildTag = mkBuildTag ways,
filesToClean = refFilesToClean,
- dirsToClean = refDirsToClean
+ dirsToClean = refDirsToClean,
+ generatedDumps = refGeneratedDumps
}
-- | The normal 'DynFlags'. Note that they is not suitable for use in this form
-- end of ghc -M values
filesToClean = panic "defaultDynFlags: No filesToClean",
dirsToClean = panic "defaultDynFlags: No dirsToClean",
+ generatedDumps = panic "defaultDynFlags: No generatedDumps",
haddockOptions = Nothing,
flags = defaultFlags,
language = Nothing,
import System.Exit ( ExitCode(..), exitWith )
import Data.List
+import qualified Data.Set as Set
+import Data.IORef
+import Control.Monad
import System.IO
-- -----------------------------------------------------------------------------
-- otherwise emit to stdout.
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
- hClose handle
-
- -- write the dump to stdout
- Nothing
- -> do printDump (mkDumpDoc 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
+ let gdref = generatedDumps dflags
+ gd <- readIORef gdref
+ let append = Set.member fileName gd
+ mode = if append then AppendMode else WriteMode
+ when (not append) $
+ writeIORef gdref (Set.insert fileName gd)
+ handle <- openFile fileName mode
+ hPrintDump handle doc
+ hClose handle
+
+ -- write the dump to stdout
+ Nothing
+ -> printDump (mkDumpDoc hdr doc)
-- | Choose where to put a dump file based on DynFlags