projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Fix warnings in main/PprTyThing
[ghc-hetmet.git]
/
compiler
/
main
/
DynFlags.hs
diff --git
a/compiler/main/DynFlags.hs
b/compiler/main/DynFlags.hs
index
ed5f359
..
3645e08
100644
(file)
--- a/
compiler/main/DynFlags.hs
+++ b/
compiler/main/DynFlags.hs
@@
-305,6
+305,7
@@
data DynFlags = DynFlags {
ruleCheck :: Maybe String,
specConstrThreshold :: Maybe Int, -- Threshold for SpecConstr
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,
liberateCaseThreshold :: Maybe Int, -- Threshold for LiberateCase
stolen_x86_regs :: Int,
@@
-496,6
+497,7
@@
defaultDynFlags =
shouldDumpSimplPhase = const False,
ruleCheck = Nothing,
specConstrThreshold = Just 200,
shouldDumpSimplPhase = const False,
ruleCheck = Nothing,
specConstrThreshold = Just 200,
+ specConstrCount = Just 3,
liberateCaseThreshold = Just 200,
stolen_x86_regs = 4,
cmdlineHcIncludes = [],
liberateCaseThreshold = Just 200,
stolen_x86_regs = 4,
cmdlineHcIncludes = [],
@@
-1185,6
+1187,10
@@
dynamic_flags = [
upd (\dfs -> dfs{ specConstrThreshold = Just n })))
, ( "fno-spec-constr-threshold", NoArg (
upd (\dfs -> dfs{ specConstrThreshold = Nothing })))
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 (
, ( "fliberate-case-threshold", IntSuffix (\n ->
upd (\dfs -> dfs{ liberateCaseThreshold = Just n })))
, ( "fno-liberate-case-threshold", NoArg (
@@
-1478,26
+1484,31
@@
setDumpSimplPhases :: String -> DynP ()
setDumpSimplPhases s = do setDynFlag Opt_ForceRecomp
upd (\s -> s { shouldDumpSimplPhase = spec })
where
setDumpSimplPhases s = do setDynFlag Opt_ForceRecomp
upd (\s -> s { shouldDumpSimplPhase = spec })
where
+ spec :: SimplifierMode -> Bool
spec = join (||)
spec = join (||)
- . map (join (&&))
- . map (map match)
- . map (split ':')
+ . map (join (&&) . map match . split ':')
. split ','
$ case s of
'=' : s' -> s'
_ -> s
. 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
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
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_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
phase_name s SimplGently = s == "gentle"
phase_name s (SimplPhase _ ss) = s `elem` ss