X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=97cbfc8be335c9e52c05b0146615fc5246e3a772;hb=9ee6397787a1400c63e3d807de5996ca6ee9ecc8;hp=9ba7529954cb7c3f9f1164afb15b7a4378af1139;hpb=356ca3e99e13450f9c2d9c8cdf5e4177c2321bb0;p=ghc-hetmet.git diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 9ba7529..97cbfc8 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -29,6 +29,7 @@ module DynFlags ( GhcLink(..), isNoLink, PackageFlag(..), Option(..), + DynLibLoader(..), fFlags, xFlags, -- Configuration of the core-to-core and stg-to-stg phases @@ -93,6 +94,7 @@ import Util ( split ) #endif import Data.Char +import System.FilePath import System.IO ( hPutStrLn, stderr ) -- ----------------------------------------------------------------------------- @@ -195,6 +197,7 @@ data DynFlag | Opt_PArr -- Syntactic support for parallel arrays | Opt_Arrows -- Arrow-notation syntax | Opt_TemplateHaskell + | Opt_QuasiQuotes | Opt_ImplicitParams | Opt_Generics | Opt_ImplicitPrelude @@ -300,6 +303,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, @@ -331,6 +335,7 @@ data DynFlags = DynFlags { outputFile :: Maybe String, outputHi :: Maybe String, + dynLibLoader :: DynLibLoader, -- | This is set by DriverPipeline.runPipeline based on where -- its output is going. @@ -457,6 +462,12 @@ defaultObjectTarget | cGhcWithNativeCodeGen == "YES" = HscAsm | otherwise = HscC +data DynLibLoader + = Deployable + | Wrapped (Maybe String) + | SystemDependent + deriving Eq + initDynFlags dflags = do -- someday these will be dynamic flags ways <- readIORef v_Ways @@ -479,6 +490,7 @@ defaultDynFlags = extCoreName = "", verbosity = 0, optLevel = 0, + simplPhases = 2, maxSimplIterations = 4, ruleCheck = Nothing, specConstrThreshold = Just 200, @@ -502,6 +514,7 @@ defaultDynFlags = outputFile = Nothing, outputHi = Nothing, + dynLibLoader = Deployable, dumpPrefix = Nothing, dumpPrefixForce = Nothing, includePaths = [], @@ -598,6 +611,15 @@ setHcSuf f d = d{ hcSuf = f} setOutputFile f d = d{ outputFile = f} setOutputHi f d = d{ outputHi = f} +parseDynLibLoaderMode f d = + case splitAt 8 f of + ("deploy", "") -> d{ dynLibLoader = Deployable } + ("sysdep", "") -> d{ dynLibLoader = SystemDependent } + ("wrapped", "") -> d{ dynLibLoader = Wrapped Nothing } + ("wrapped:", "hard") -> d{ dynLibLoader = Wrapped Nothing } + ("wrapped:", flex) -> d{ dynLibLoader = Wrapped (Just flex) } + (_,_) -> error "Unknown dynlib loader" + setDumpPrefixForce f d = d { dumpPrefixForce = f} -- XXX HACK: Prelude> words "'does not' work" ===> ["'does","not'","work"] @@ -772,12 +794,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 +814,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 +823,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 +865,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 +875,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 @@ -982,6 +1012,7 @@ dynamic_flags = [ , ( "c" , NoArg (upd $ \d -> d{ ghcLink=NoLink } )) , ( "no-link" , NoArg (upd $ \d -> d{ ghcLink=NoLink } )) -- Dep. , ( "shared" , NoArg (upd $ \d -> d{ ghcLink=LinkDynLib } )) + , ( "dynload" , HasArg (upd . parseDynLibLoaderMode)) ------- Libraries --------------------------------------------------- , ( "L" , Prefix addLibraryPath ) @@ -1130,6 +1161,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 })) ) @@ -1287,6 +1320,7 @@ xFlags = [ ( "Arrows", Opt_Arrows ), ( "PArr", Opt_PArr ), ( "TemplateHaskell", Opt_TemplateHaskell ), + ( "QuasiQuotes", Opt_QuasiQuotes ), ( "Generics", Opt_Generics ), -- On by default: ( "ImplicitPrelude", Opt_ImplicitPrelude ), @@ -1323,7 +1357,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 +1595,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 -----------------------------------------------------------------------------