X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=76658cc53aa1bddb08ddff5b00a1e9a5889c0f84;hb=b4229ab662b6d87b1477bafa85d2db46e5a9a152;hp=fb873917a3a9de76373ac7c6b8c1c156cd86363e;hpb=aed0554eb789d949b196230a9d25c38e2c6e14d9;p=ghc-hetmet.git

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index fb87391..76658cc 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -301,6 +301,7 @@ data DynFlags = DynFlags {
   optLevel		:: Int,		-- optimisation level
   simplPhases           :: Int,         -- number of simplifier phases
   maxSimplIterations    :: Int,		-- max simplifier iterations
+  shouldDumpSimplPhase  :: SimplifierMode -> Bool,
   ruleCheck		:: Maybe String,
 
   specConstrThreshold   :: Maybe Int,	-- Threshold for SpecConstr
@@ -492,6 +493,7 @@ defaultDynFlags =
 	optLevel		= 0,
         simplPhases             = 2,
 	maxSimplIterations	= 4,
+        shouldDumpSimplPhase    = const False,
 	ruleCheck		= Nothing,
 	specConstrThreshold	= Just 200,
         liberateCaseThreshold   = Just 200,
@@ -1116,7 +1118,7 @@ dynamic_flags = [
   ,  ( "ddump-rn",           	 setDumpFlag Opt_D_dump_rn)
   ,  ( "ddump-simpl",        	 setDumpFlag Opt_D_dump_simpl)
   ,  ( "ddump-simpl-iterations", setDumpFlag Opt_D_dump_simpl_iterations)
-  ,  ( "ddump-simpl-phases",     setDumpFlag Opt_D_dump_simpl_phases)
+  ,  ( "ddump-simpl-phases",     OptPrefix setDumpSimplPhases)
   ,  ( "ddump-spec",         	 setDumpFlag Opt_D_dump_spec)
   ,  ( "ddump-prep",          	 setDumpFlag Opt_D_dump_prep)
   ,  ( "ddump-stg",          	 setDumpFlag Opt_D_dump_stg)
@@ -1135,7 +1137,7 @@ dynamic_flags = [
   ,  ( "ddump-simpl-stats",      setDumpFlag Opt_D_dump_simpl_stats)
   ,  ( "ddump-bcos",             setDumpFlag Opt_D_dump_BCOs)
   ,  ( "dsource-stats",          setDumpFlag Opt_D_source_stats)
-  ,  ( "dverbose-core2core",     setDumpFlag Opt_D_verbose_core2core)
+  ,  ( "dverbose-core2core",     NoArg setVerboseCore2Core)
   ,  ( "dverbose-stg2stg",       setDumpFlag Opt_D_verbose_stg2stg)
   ,  ( "ddump-hi",               setDumpFlag Opt_D_dump_hi)
   ,  ( "ddump-minimal-imports",  setDumpFlag Opt_D_dump_minimal_imports)
@@ -1466,6 +1468,36 @@ setDumpFlag dump_flag
 	-- Whenver we -ddump, switch off the recompilation checker,
 	-- else you don't see the dump!
 
+setVerboseCore2Core = do setDynFlag Opt_ForceRecomp
+                         setDynFlag Opt_D_verbose_core2core
+                         upd (\s -> s { shouldDumpSimplPhase = const True })
+
+setDumpSimplPhases s = do setDynFlag Opt_ForceRecomp
+                          upd (\s -> s { shouldDumpSimplPhase = spec })
+  where
+    spec = join (||)
+         . map (join (&&))
+         . map (map match)
+         . map (split '+')
+         . split ','
+         $ case s of
+             '=' : s' -> s'
+             _        -> s
+
+    join op [] = const True
+    join op ss = foldr1 (\f g x -> f x `op` g x) ss
+
+    match "" = const True
+    match s  = case reads s of
+                [(n,"")] -> phase_num  n
+                _        -> phase_name s
+
+    phase_num n (SimplPhase k) = n == k
+    phase_num _ _              = False
+
+    phase_name "gentle" SimplGently = True
+    phase_name _        _           = False
+
 setVerbosity :: Maybe Int -> DynP ()
 setVerbosity mb_n = upd (\dfs -> dfs{ verbosity = mb_n `orElse` 3 })