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
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,
shouldDumpSimplPhase = const False,
ruleCheck = Nothing,
specConstrThreshold = Just 200,
+ specConstrCount = Just 3,
liberateCaseThreshold = Just 200,
stolen_x86_regs = 4,
cmdlineHcIncludes = [],
data SimplifierMode -- See comments in SimplMonad
= SimplGently
- | SimplPhase Int
+ | SimplPhase Int [String]
data SimplifierSwitch
= MaxSimplifierIterations Int
maybe_rule_check phase = runMaybe rule_check (CoreDoRuleCheck phase)
- simpl_phase phase iter = CoreDoPasses
- [ CoreDoSimplify (SimplPhase phase) [
- MaxSimplifierIterations iter
- ],
- maybe_rule_check phase
- ]
+ simpl_phase phase names iter
+ = CoreDoPasses
+ [ CoreDoSimplify (SimplPhase phase names) [
+ MaxSimplifierIterations iter
+ ],
+ maybe_rule_check phase
+ ]
-- By default, we have 2 phases before phase 0.
-- inlined. I found that spectral/hartel/genfft lost some useful
-- strictness in the function sumcode' if augment is not inlined
-- before strictness analysis runs
- simpl_phases = CoreDoPasses [ simpl_phase phase max_iter
+ simpl_phases = CoreDoPasses [ simpl_phase phase ["main"] max_iter
| phase <- [phases, phases-1 .. 1] ]
core_todo =
if opt_level == 0 then
- [simpl_phase 0 max_iter]
+ [simpl_phase 0 ["final"] max_iter]
else {- opt_level >= 1 -} [
-- initial simplify: mk specialiser happy: minimum effort please
-- ==> let k = BIG in letrec go = \xs -> ...(k x).... in go xs
-- ==> let k = BIG in letrec go = \xs -> ...(BIG x).... in go xs
-- Don't stop now!
- simpl_phase 0 (max max_iter 3),
+ simpl_phase 0 ["main"] (max max_iter 3),
#ifdef OLD_STRICTNESS
CoreDoStrictness,
CoreDoWorkerWrapper,
CoreDoGlomBinds,
- simpl_phase 0 max_iter
+ simpl_phase 0 ["post-worker-wrapper"] max_iter
]),
runWhen full_laziness
-- strictness analysis and the simplification which follows it.
runWhen liberate_case (CoreDoPasses [
CoreLiberateCase,
- simpl_phase 0 max_iter
+ simpl_phase 0 ["post-liberate-case"] max_iter
]), -- Run the simplifier after LiberateCase to vastly
-- reduce the possiblility of shadowing
-- Reason: see Note [Shadowing] in SpecConstr.lhs
maybe_rule_check 0,
-- Final clean-up simplification:
- simpl_phase 0 max_iter
+ simpl_phase 0 ["final"] max_iter
]
-- -----------------------------------------------------------------------------
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 (
-- Whenver we -ddump, switch off the recompilation checker,
-- else you don't see the dump!
+setVerboseCore2Core :: DynP ()
setVerboseCore2Core = do setDynFlag Opt_ForceRecomp
setDynFlag Opt_D_verbose_core2core
upd (\s -> s { shouldDumpSimplPhase = const True })
+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 op [] = const True
+ 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 n (SimplPhase k) = n == k
- phase_num _ _ = False
+ phase_num :: Int -> SimplifierMode -> Bool
+ phase_num n (SimplPhase k _) = n == k
+ phase_num _ _ = False
- phase_name "gentle" SimplGently = True
- phase_name _ _ = False
+ phase_name :: String -> SimplifierMode -> Bool
+ phase_name s SimplGently = s == "gentle"
+ phase_name s (SimplPhase _ ss) = s `elem` ss
setVerbosity :: Maybe Int -> DynP ()
setVerbosity mb_n = upd (\dfs -> dfs{ verbosity = mb_n `orElse` 3 })
-- tmpDir, where we store temporary files.
setTmpDir :: FilePath -> DynFlags -> DynFlags
-setTmpDir dir dflags = dflags{ tmpDir = canonicalise dir }
- where
-#if !defined(mingw32_HOST_OS)
- canonicalise p = normalise p
-#else
- -- Canonicalisation of temp path under win32 is a bit more
- -- involved: (a) strip trailing slash,
- -- (b) normalise slashes
- -- (c) just in case, if there is a prefix /cygdrive/x/, change to x:
- canonicalise path = removeTrailingSlash $ normalise $ xltCygdrive path
-
- -- if we're operating under cygwin, and TMP/TEMP is of
- -- the form "/cygdrive/drive/path", translate this to
- -- "drive:/path" (as GHC isn't a cygwin app and doesn't
- -- understand /cygdrive paths.)
- cygdrivePrefix = [pathSeparator] ++ "/cygdrive/" ++ [pathSeparator]
- xltCygdrive path = case maybePrefixMatch cygdrivePrefix path of
- Just (drive:sep:xs)
- | isPathSeparator sep -> drive:':':pathSeparator:xs
- _ -> path
-
- -- strip the trailing backslash (awful, but we only do this once).
- removeTrailingSlash path
- | isPathSeparator (last path) = init path
- | otherwise = path
-#endif
+setTmpDir dir dflags = dflags{ tmpDir = normalise dir }
+ -- we used to fix /cygdrive/c/.. on Windows, but this doesn't
+ -- seem necessary now --SDM 7/2/2008
-----------------------------------------------------------------------------
-- Hpc stuff
projects / ghc-hetmet.git / blobdiff