X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=7fc2c9a01c493b07e49c231fe5cc525229aed3f5;hp=ed5f359b9c8fe87860443e84f525f259603eac2c;hb=30c122df62ec75f9ed7f392f24c2925675bf1d06;hpb=4dd7f35b7055e3ff9ff5fed9e90e1c8cbe5e6a9b

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index ed5f359..7fc2c9a 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -60,8 +60,6 @@ module DynFlags (
     compilerInfo,
   ) where
 
--- XXX This define is a bit of a hack, and should be done more nicely
-#define FAST_STRING_NOT_NEEDED 1
 #include "HsVersions.h"
 
 import Module
@@ -305,6 +303,7 @@ data DynFlags = DynFlags {
   ruleCheck		:: Maybe String,
 
   specConstrThreshold   :: Maybe Int,	-- Threshold for SpecConstr
+  specConstrCount	:: Maybe Int,	-- Max number of specialisations for any one function
   liberateCaseThreshold :: Maybe Int,   -- Threshold for LiberateCase 
 
   stolen_x86_regs	:: Int,		
@@ -496,6 +495,7 @@ defaultDynFlags =
         shouldDumpSimplPhase    = const False,
 	ruleCheck		= Nothing,
 	specConstrThreshold	= Just 200,
+	specConstrCount		= Just 3,
         liberateCaseThreshold   = Just 200,
 	stolen_x86_regs		= 4,
 	cmdlineHcIncludes	= [],
@@ -1185,6 +1185,10 @@ dynamic_flags = [
                 upd (\dfs -> dfs{ specConstrThreshold = Just n })))
   ,  ( "fno-spec-constr-threshold",   NoArg (
                 upd (\dfs -> dfs{ specConstrThreshold = Nothing })))
+  ,  ( "fspec-constr-count",   	      IntSuffix (\n ->
+                upd (\dfs -> dfs{ specConstrCount = Just n })))
+  ,  ( "fno-spec-constr-count",   NoArg (
+                upd (\dfs -> dfs{ specConstrCount = Nothing })))
   ,  ( "fliberate-case-threshold",    IntSuffix (\n ->
                 upd (\dfs -> dfs{ liberateCaseThreshold = Just n })))
   ,  ( "fno-liberate-case-threshold", NoArg (
@@ -1478,26 +1482,31 @@ setDumpSimplPhases :: String -> DynP ()
 setDumpSimplPhases s = do setDynFlag Opt_ForceRecomp
                           upd (\s -> s { shouldDumpSimplPhase = spec })
   where
+    spec :: SimplifierMode -> Bool
     spec = join (||)
-         . map (join (&&))
-         . map (map match)
-         . map (split ':')
+         . map (join (&&) . map match . split ':')
          . split ','
          $ case s of
              '=' : s' -> s'
              _        -> s
 
+    join :: (Bool -> Bool -> Bool)
+	 -> [SimplifierMode -> Bool]
+	 -> SimplifierMode -> Bool
     join _  [] = const True
     join op ss = foldr1 (\f g x -> f x `op` g x) ss
 
+    match :: String -> SimplifierMode -> Bool
     match "" = const True
     match s  = case reads s of
                 [(n,"")] -> phase_num  n
                 _        -> phase_name s
 
+    phase_num :: Int -> SimplifierMode -> Bool
     phase_num n (SimplPhase k _) = n == k
     phase_num _ _                = False
 
+    phase_name :: String -> SimplifierMode -> Bool
     phase_name s SimplGently       = s == "gentle"
     phase_name s (SimplPhase _ ss) = s `elem` ss