X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=3f975cd9842000eca150b78ff87f9fecd7cf26aa;hb=fd12b167cd246087858d50ab66840274ef609f79;hp=a4a338c3b40af62df4a3ee24c5d9ac4dbc3c1d8d;hpb=8305bb1641490429912a8ac5c3b1265a21937689;p=ghc-hetmet.git

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index a4a338c..3f975cd 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -35,6 +35,7 @@ module DynFlags (
         updOptLevel,
         setTmpDir,
         setPackageName,
+        doingTickyProfiling,
 
         -- ** Parsing DynFlags
         parseDynamicFlags,
@@ -84,10 +85,11 @@ import Util
 import Maybes           ( orElse )
 import SrcLoc
 import FastString
+import FiniteMap
 import Outputable
 import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage )
 
-import Data.IORef       ( readIORef )
+import Data.IORef
 import Control.Monad    ( when )
 
 import Data.Char
@@ -268,6 +270,11 @@ data DynFlag
    | Opt_RegsGraph                      -- do graph coloring register allocation
    | Opt_RegsIterative                  -- do iterative coalescing graph coloring register allocation
 
+   -- profiling opts
+   | Opt_AutoSccsOnAllToplevs
+   | Opt_AutoSccsOnExportedToplevs
+   | Opt_AutoSccsOnIndividualCafs
+
    -- misc opts
    | Opt_Cpp
    | Opt_Pp
@@ -428,6 +435,12 @@ data DynFlags = DynFlags {
   pkgDatabase           :: Maybe (UniqFM PackageConfig),
   pkgState              :: PackageState,
 
+  -- Temporary files
+  -- These have to be IORefs, because the defaultCleanupHandler needs to
+  -- know what to clean when an exception happens
+  filesToClean          :: IORef [FilePath],
+  dirsToClean           :: IORef (FiniteMap FilePath FilePath),
+
   -- hsc dynamic flags
   flags                 :: [DynFlag],
 
@@ -505,6 +518,11 @@ isNoLink :: GhcLink -> Bool
 isNoLink NoLink = True
 isNoLink _      = False
 
+-- Is it worth evaluating this Bool and caching it in the DynFlags value
+-- during initDynFlags?
+doingTickyProfiling :: DynFlags -> Bool
+doingTickyProfiling dflags = WayTicky `elem` wayNames dflags
+
 data PackageFlag
   = ExposePackage  String
   | HidePackage    String
@@ -534,10 +552,14 @@ initDynFlags dflags = do
  ways <- readIORef v_Ways
  build_tag <- readIORef v_Build_tag
  rts_build_tag <- readIORef v_RTS_Build_tag
+ refFilesToClean <- newIORef []
+ refDirsToClean <- newIORef emptyFM
  return dflags{
         wayNames        = ways,
         buildTag        = build_tag,
-        rtsBuildTag     = rts_build_tag
+        rtsBuildTag     = rts_build_tag,
+        filesToClean    = refFilesToClean,
+        dirsToClean     = refDirsToClean
         }
 
 -- | The normal 'DynFlags'. Note that they is not suitable for use in this form
@@ -636,6 +658,8 @@ defaultDynFlags =
         depExcludeMods    = [],
         depSuffixes       = [],
         -- end of ghc -M values
+        filesToClean   = panic "defaultDynFlags: No filesToClean",
+        dirsToClean    = panic "defaultDynFlags: No dirsToClean",
         haddockOptions = Nothing,
         flags = [
             Opt_AutoLinkPackages,
@@ -1484,6 +1508,38 @@ dynamic_flags = [
          (IntSuffix $ \n -> upd $ \dfs -> dfs{ ctxtStkDepth = n })
          Supported
 
+        ------ Profiling ----------------------------------------------------
+
+  -- XXX Should the -f* flags be deprecated?
+  -- They don't seem to be documented
+  , Flag "fauto-sccs-on-all-toplevs"
+         (NoArg (setDynFlag Opt_AutoSccsOnAllToplevs))
+         Supported
+  , Flag "auto-all"
+         (NoArg (setDynFlag Opt_AutoSccsOnAllToplevs))
+         Supported
+  , Flag "no-auto-all"
+         (NoArg (unSetDynFlag Opt_AutoSccsOnAllToplevs))
+         Supported
+  , Flag "fauto-sccs-on-exported-toplevs"
+         (NoArg (setDynFlag Opt_AutoSccsOnExportedToplevs))
+         Supported
+  , Flag "auto"
+         (NoArg (setDynFlag Opt_AutoSccsOnExportedToplevs))
+         Supported
+  , Flag "no-auto"
+         (NoArg (unSetDynFlag Opt_AutoSccsOnExportedToplevs))
+         Supported
+  , Flag "fauto-sccs-on-individual-cafs"
+         (NoArg (setDynFlag Opt_AutoSccsOnIndividualCafs))
+         Supported
+  , Flag "caf-all"
+         (NoArg (setDynFlag Opt_AutoSccsOnIndividualCafs))
+         Supported
+  , Flag "no-caf-all"
+         (NoArg (unSetDynFlag Opt_AutoSccsOnIndividualCafs))
+         Supported
+
         ------ DPH flags ----------------------------------------------------
 
   , Flag "fdph-seq"