X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=a556471ee8c68830dc9a05ae78f45bd43b333491;hb=047864943968324c12c9252c69f32672bec241cb;hp=9ba7529954cb7c3f9f1164afb15b7a4378af1139;hpb=356ca3e99e13450f9c2d9c8cdf5e4177c2321bb0;p=ghc-hetmet.git diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 9ba7529..a556471 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -93,6 +93,7 @@ import Util ( split ) #endif import Data.Char +import System.FilePath import System.IO ( hPutStrLn, stderr ) -- ----------------------------------------------------------------------------- @@ -300,6 +301,7 @@ data DynFlags = DynFlags { extCoreName :: String, -- name of the .core output file verbosity :: Int, -- verbosity level optLevel :: Int, -- optimisation level + simplPhases :: Int, -- number of simplifier phases maxSimplIterations :: Int, -- max simplifier iterations ruleCheck :: Maybe String, @@ -479,6 +481,7 @@ defaultDynFlags = extCoreName = "", verbosity = 0, optLevel = 0, + simplPhases = 2, maxSimplIterations = 4, ruleCheck = Nothing, specConstrThreshold = Just 200, @@ -772,12 +775,17 @@ runWhen :: Bool -> CoreToDo -> CoreToDo runWhen True do_this = do_this runWhen False do_this = CoreDoNothing +runMaybe :: Maybe a -> (a -> CoreToDo) -> CoreToDo +runMaybe (Just x) f = f x +runMaybe Nothing _ = CoreDoNothing + getCoreToDo :: DynFlags -> [CoreToDo] getCoreToDo dflags | Just todo <- coreToDo dflags = todo -- set explicitly by user | otherwise = core_todo where opt_level = optLevel dflags + phases = simplPhases dflags max_iter = maxSimplIterations dflags strictness = dopt Opt_Strictness dflags full_laziness = dopt Opt_FullLaziness dflags @@ -787,8 +795,7 @@ getCoreToDo dflags rule_check = ruleCheck dflags vectorisation = dopt Opt_Vectorise dflags - maybe_rule_check phase | Just s <- rule_check = CoreDoRuleCheck phase s - | otherwise = CoreDoNothing + maybe_rule_check phase = runMaybe rule_check (CoreDoRuleCheck phase) simpl_phase phase iter = CoreDoPasses [ CoreDoSimplify (SimplPhase phase) [ @@ -797,6 +804,20 @@ getCoreToDo dflags maybe_rule_check phase ] + -- By default, we have 2 phases before phase 0. + + -- Want to run with inline phase 2 after the specialiser to give + -- maximum chance for fusion to work before we inline build/augment + -- in phase 1. This made a difference in 'ansi' where an + -- overloaded function wasn't inlined till too late. + + -- Need phase 1 so that build/augment get + -- 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 + | phase <- [phases, phases-1 .. 1] ] + -- initial simplify: mk specialiser happy: minimum effort please simpl_gently = CoreDoSimplify SimplGently [ @@ -825,7 +846,7 @@ getCoreToDo dflags -- We run vectorisation here for now, but we might also try to run -- it later - runWhen vectorisation (CoreDoPasses [ CoreDoVectorisation, simpl_gently]), + runWhen vectorisation (CoreDoPasses [ CoreDoVectorisation, simpl_gently ]), -- Specialisation is best done before full laziness -- so that overloaded functions have all their dictionary lambdas manifest @@ -835,17 +856,7 @@ getCoreToDo dflags CoreDoFloatInwards, - -- Want to run with inline phase 2 after the specialiser to give - -- maximum chance for fusion to work before we inline build/augment - -- in phase 1. This made a difference in 'ansi' where an - -- overloaded function wasn't inlined till too late. - simpl_phase 2 max_iter, - - -- Need inline-phase2 here so that build/augment get - -- 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_phase 1 max_iter, + simpl_phases, -- Phase 0: allow all Ids to be inlined now -- This gets foldr inlined before strictness analysis @@ -1130,6 +1141,8 @@ dynamic_flags = [ , ( "O" , OptIntSuffix (\mb_n -> upd (setOptLevel (mb_n `orElse` 1)))) -- If the number is missing, use 1 + , ( "fsimplifier-phases", IntSuffix (\n -> + upd (\dfs -> dfs{ simplPhases = n })) ) , ( "fmax-simplifier-iterations", IntSuffix (\n -> upd (\dfs -> dfs{ maxSimplIterations = n })) ) @@ -1323,7 +1336,10 @@ xFlags = [ impliedFlags :: [(DynFlag, [DynFlag])] impliedFlags = [ - ( Opt_GADTs, [Opt_RelaxedPolyRec] ) -- We want type-sig variables to be completely rigid for GADTs + ( Opt_GADTs, [Opt_RelaxedPolyRec] ) -- We want type-sig variables to + -- be completely rigid for GADTs + , ( Opt_ScopedTypeVariables, [Opt_RelaxedPolyRec] ) -- Ditto for scoped type variables; see + -- Note [Scoped tyvars] in TcBinds ] glasgowExtsFlags = [ @@ -1558,32 +1574,28 @@ setTmpDir :: FilePath -> DynFlags -> DynFlags setTmpDir dir dflags = dflags{ tmpDir = canonicalise dir } where #if !defined(mingw32_HOST_OS) - canonicalise p = normalisePath p + 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 = normalisePath (xltCygdrive (removeTrailingSlash 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.) - xltCygdrive path - | "/cygdrive/" `isPrefixOf` path = - case drop (length "/cygdrive/") path of - drive:xs@('/':_) -> drive:':':xs - _ -> path - | otherwise = path - - -- strip the trailing backslash (awful, but we only do this once). - removeTrailingSlash path = - case last path of - '/' -> init path - '\\' -> init path - _ -> path + -- 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 -----------------------------------------------------------------------------