X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=df9efcbde2b45f53677f5e39c5a6cee7ceb786f9;hp=3fcb628dbca0f66a21dea6eda1c5eaadc90de508;hb=9bcd95bad83ee937c178970e8b729732e680fe1e;hpb=9c966bfa8c0328cb4d2e01806a8eca242b9e6f66 diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 3fcb628..df9efcb 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -21,7 +21,7 @@ module DynFlags ( Option(..), DynLibLoader(..), fFlags, xFlags, - DPHBackend(..), + dphPackage, -- ** Manipulating DynFlags defaultDynFlags, -- DynFlags @@ -38,6 +38,7 @@ module DynFlags ( -- ** Parsing DynFlags parseDynamicFlags, + parseDynamicNoPackageFlags, allFlags, supportedLanguages, languageOptions, @@ -90,6 +91,7 @@ import Data.IORef ( readIORef ) import Control.Monad ( when ) import Data.Char +import Data.List ( intersperse ) import System.FilePath import System.IO ( stderr, hPutChar ) @@ -145,6 +147,7 @@ data DynFlag | Opt_D_dump_BCOs | Opt_D_dump_vect | Opt_D_dump_hpc + | Opt_D_dump_rtti | Opt_D_source_stats | Opt_D_verbose_core2core | Opt_D_verbose_stg2stg @@ -239,6 +242,7 @@ data DynFlag | Opt_ImpredicativeTypes | Opt_TypeOperators | Opt_PackageImports + | Opt_NewQualifiedOperators | Opt_PrintExplicitForalls @@ -258,6 +262,7 @@ data DynFlag | Opt_UnboxStrictFields | Opt_MethodSharing | Opt_DictsCheap + | Opt_InlineIfEnoughArgs | Opt_EnableRewriteRules -- Apply rewrite rules during simplification | Opt_Vectorise | Opt_RegsGraph -- do graph coloring register allocation @@ -296,6 +301,7 @@ data DynFlag | Opt_KeepSFiles | Opt_KeepRawSFiles | Opt_KeepTmpFiles + | Opt_KeepRawTokenStream deriving (Eq, Show) @@ -450,6 +456,11 @@ data GhcMode | MkDepend -- ^ @ghc -M@, see "Finder" for why we need this deriving Eq +instance Outputable GhcMode where + ppr CompManager = ptext (sLit "CompManager") + ppr OneShot = ptext (sLit "OneShot") + ppr MkDepend = ptext (sLit "MkDepend") + isOneShot :: GhcMode -> Bool isOneShot OneShot = True isOneShot _other = False @@ -556,7 +567,7 @@ defaultDynFlags = opt_L = [], opt_P = (if opt_PIC - then ["-D__PIC__"] + then ["-D__PIC__", "-U __PIC__"] -- this list is reversed else []), opt_F = [], opt_c = [], @@ -671,7 +682,8 @@ getVerbFlag dflags | verbosity dflags >= 3 = "-v" | otherwise = "" -setObjectDir, setHiDir, setStubDir, setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode, +setObjectDir, setHiDir, setStubDir, setOutputDir, + setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode, setPgmP, setPgmL, setPgmF, setPgmc, setPgmm, setPgms, setPgma, setPgml, setPgmdll, setPgmwindres, addOptL, addOptP, addOptF, addOptc, addOptm, addOpta, addOptl, addOptwindres, addCmdlineFramework, addHaddockOpts @@ -684,6 +696,7 @@ setHiDir f d = d{ hiDir = Just f} setStubDir f d = d{ stubDir = Just f, includePaths = f : includePaths d } -- -stubdir D adds an implicit -I D, so that gcc can find the _stub.h file -- \#included from the .hc file when compiling with -fvia-C. +setOutputDir f = setObjectDir f . setHiDir f . setStubDir f setObjectSuf f d = d{ objectSuf = f} setHiSuf f d = d{ hiSuf = f} @@ -699,7 +712,7 @@ parseDynLibLoaderMode f d = ("wrapped", "") -> d{ dynLibLoader = Wrapped Nothing } ("wrapped:", "hard") -> d{ dynLibLoader = Wrapped Nothing } ("wrapped:", flex) -> d{ dynLibLoader = Wrapped (Just flex) } - (_,_) -> error "Unknown dynlib loader" + _ -> ghcError (CmdLineError ("Unknown dynlib loader: " ++ f)) setDumpPrefixForce f d = d { dumpPrefixForce = f} @@ -892,22 +905,48 @@ data CoreToDo -- These are diff core-to-core passes, | CoreCSE | CoreDoRuleCheck Int{-CompilerPhase-} String -- Check for non-application of rules -- matching this string - | CoreDoVectorisation DPHBackend + | CoreDoVectorisation PackageId | CoreDoNothing -- Useful when building up | CoreDoPasses [CoreToDo] -- lists of these things + data SimplifierMode -- See comments in SimplMonad = SimplGently | SimplPhase Int [String] +instance Outputable SimplifierMode where + ppr SimplGently = ptext (sLit "gentle") + ppr (SimplPhase n ss) = int n <+> brackets (text (concat $ intersperse "," ss)) + + data SimplifierSwitch = MaxSimplifierIterations Int | NoCaseOfCase -data FloatOutSwitches - = FloatOutSw Bool -- True <=> float lambdas to top level - Bool -- True <=> float constants to top level, - -- even if they do not escape a lambda + +data FloatOutSwitches = FloatOutSwitches { + floatOutLambdas :: Bool, -- ^ True <=> float lambdas to top level + floatOutConstants :: Bool -- ^ True <=> float constants to top level, + -- even if they do not escape a lambda + } + +instance Outputable FloatOutSwitches where + ppr = pprFloatOutSwitches + +pprFloatOutSwitches :: FloatOutSwitches -> SDoc +pprFloatOutSwitches sw = pp_not (floatOutLambdas sw) <+> text "lambdas" <> comma + <+> pp_not (floatOutConstants sw) <+> text "constants" + where + pp_not True = empty + pp_not False = text "not" + +-- | Switches that specify the minimum amount of floating out +gentleFloatOutSwitches :: FloatOutSwitches +gentleFloatOutSwitches = FloatOutSwitches False False + +-- | Switches that do not specify floating out of lambdas, just of constants +constantsOnlyFloatOutSwitches :: FloatOutSwitches +constantsOnlyFloatOutSwitches = FloatOutSwitches False True -- The core-to-core pass ordering is derived from the DynFlags: @@ -947,7 +986,7 @@ getCoreToDo dflags vectorisation = runWhen (dopt Opt_Vectorise dflags) - $ CoreDoPasses [ simpl_gently, CoreDoVectorisation (dphBackend dflags) ] + $ CoreDoPasses [ simpl_gently, CoreDoVectorisation (dphPackage dflags) ] -- By default, we have 2 phases before phase 0. @@ -1005,7 +1044,7 @@ getCoreToDo dflags -- so that overloaded functions have all their dictionary lambdas manifest CoreDoSpecialising, - runWhen full_laziness (CoreDoFloatOutwards (FloatOutSw False False)), + runWhen full_laziness (CoreDoFloatOutwards gentleFloatOutSwitches), CoreDoFloatInwards, @@ -1035,8 +1074,7 @@ getCoreToDo dflags ]), runWhen full_laziness - (CoreDoFloatOutwards (FloatOutSw False -- Not lambdas - True)), -- Float constants + (CoreDoFloatOutwards constantsOnlyFloatOutSwitches), -- nofib/spectral/hartel/wang doubles in speed if you -- do full laziness late in the day. It only happens -- after fusion and other stuff, so the early pass doesn't @@ -1189,6 +1227,7 @@ dynamic_flags = [ , Flag "hidir" (HasArg (upd . setHiDir)) Supported , Flag "tmpdir" (HasArg (upd . setTmpDir)) Supported , Flag "stubdir" (HasArg (upd . setStubDir)) Supported + , Flag "outputdir" (HasArg (upd . setOutputDir)) Supported , Flag "ddump-file-prefix" (HasArg (upd . setDumpPrefixForce . Just)) Supported @@ -1217,20 +1256,6 @@ dynamic_flags = [ , Flag "no-recomp" (NoArg (setDynFlag Opt_ForceRecomp)) (Deprecated "Use -fforce-recomp instead") - ------- Packages ---------------------------------------------------- - , Flag "package-conf" (HasArg extraPkgConf_) Supported - , Flag "no-user-package-conf" (NoArg (unSetDynFlag Opt_ReadUserPackageConf)) - Supported - , Flag "package-name" (HasArg (upd . setPackageName)) Supported - , Flag "package" (HasArg exposePackage) Supported - , Flag "hide-package" (HasArg hidePackage) Supported - , Flag "hide-all-packages" (NoArg (setDynFlag Opt_HideAllPackages)) - Supported - , Flag "ignore-package" (HasArg ignorePackage) - Supported - , Flag "syslib" (HasArg exposePackage) - (Deprecated "Use -package instead") - ------ HsCpp opts --------------------------------------------------- , Flag "D" (AnySuffix (upd . addOptP)) Supported , Flag "U" (AnySuffix (upd . addOptP)) Supported @@ -1351,6 +1376,8 @@ dynamic_flags = [ Supported , Flag "ddump-hi-diffs" (setDumpFlag Opt_D_dump_hi_diffs) Supported + , Flag "ddump-rtti" (setDumpFlag Opt_D_dump_rtti) + Supported , Flag "dcore-lint" (NoArg (setDynFlag Opt_DoCoreLinting)) Supported @@ -1361,7 +1388,7 @@ dynamic_flags = [ , Flag "dasm-lint" (NoArg (setDynFlag Opt_DoAsmLinting)) Supported , Flag "dshow-passes" - (NoArg (do setDynFlag Opt_ForceRecomp + (NoArg (do forceRecompile setVerbosity (Just 2))) Supported , Flag "dfaststring-stats" (NoArg (setDynFlag Opt_D_faststring_stats)) @@ -1464,6 +1491,23 @@ dynamic_flags = [ ++ map (mkFlag True "X" setDynFlag ) xFlags ++ map (mkFlag False "XNo" unSetDynFlag) xFlags +package_flags :: [Flag DynP] +package_flags = [ + ------- Packages ---------------------------------------------------- + Flag "package-conf" (HasArg extraPkgConf_) Supported + , Flag "no-user-package-conf" (NoArg (unSetDynFlag Opt_ReadUserPackageConf)) + Supported + , Flag "package-name" (HasArg (upd . setPackageName)) Supported + , Flag "package" (HasArg exposePackage) Supported + , Flag "hide-package" (HasArg hidePackage) Supported + , Flag "hide-all-packages" (NoArg (setDynFlag Opt_HideAllPackages)) + Supported + , Flag "ignore-package" (HasArg ignorePackage) + Supported + , Flag "syslib" (HasArg exposePackage) + (Deprecated "Use -package instead") + ] + mkFlag :: Bool -- ^ True <=> it should be turned on -> String -- ^ The flag prefix -> (DynFlag -> DynP ()) @@ -1528,6 +1572,7 @@ fFlags = [ ( "unbox-strict-fields", Opt_UnboxStrictFields, const Supported ), ( "method-sharing", Opt_MethodSharing, const Supported ), ( "dicts-cheap", Opt_DictsCheap, const Supported ), + ( "inline-if-enough-args", Opt_InlineIfEnoughArgs, const Supported ), ( "excess-precision", Opt_ExcessPrecision, const Supported ), ( "asm-mangling", Opt_DoAsmMangling, const Supported ), ( "print-bind-result", Opt_PrintBindResult, const Supported ), @@ -1652,7 +1697,8 @@ xFlags = [ ( "OverlappingInstances", Opt_OverlappingInstances, const Supported ), ( "UndecidableInstances", Opt_UndecidableInstances, const Supported ), ( "IncoherentInstances", Opt_IncoherentInstances, const Supported ), - ( "PackageImports", Opt_PackageImports, const Supported ) + ( "PackageImports", Opt_PackageImports, const Supported ), + ( "NewQualifiedOperators", Opt_NewQualifiedOperators, const Supported ) ] impliedFlags :: [(DynFlag, DynFlag)] @@ -1701,7 +1747,7 @@ glasgowExtsFlags = [ -- ----------------------------------------------------------------------------- -- Parsing the dynamic flags. --- | Parse dynamic flags from a list of command line argument. Returns the +-- | Parse dynamic flags from a list of command line arguments. Returns the -- the parsed 'DynFlags', the left-over arguments, and a list of warnings. -- Throws a 'UsageError' if errors occurred during parsing (such as unknown -- flags or missing arguments). @@ -1710,7 +1756,21 @@ parseDynamicFlags :: Monad m => -> m (DynFlags, [Located String], [Located String]) -- ^ Updated 'DynFlags', left-over arguments, and -- list of warnings. -parseDynamicFlags dflags args = do +parseDynamicFlags dflags args = parseDynamicFlags_ dflags args True + +-- | Like 'parseDynamicFlags' but does not allow the package flags (-package, +-- -hide-package, -ignore-package, -hide-all-packages, -package-conf). +parseDynamicNoPackageFlags :: Monad m => + DynFlags -> [Located String] + -> m (DynFlags, [Located String], [Located String]) + -- ^ Updated 'DynFlags', left-over arguments, and + -- list of warnings. +parseDynamicNoPackageFlags dflags args = parseDynamicFlags_ dflags args False + +parseDynamicFlags_ :: Monad m => + DynFlags -> [Located String] -> Bool + -> m (DynFlags, [Located String], [Located String]) +parseDynamicFlags_ dflags args pkg_flags = do -- XXX Legacy support code -- We used to accept things like -- optdep-f -optdepdepend @@ -1722,8 +1782,13 @@ parseDynamicFlags dflags args = do f (x : xs) = x : f xs f xs = xs args' = f args + + -- Note: -ignore-package (package_flags) must precede -i* (dynamic_flags) + flag_spec | pkg_flags = package_flags ++ dynamic_flags + | otherwise = dynamic_flags + let ((leftover, errs, warns), dflags') - = runCmdLine (processArgs dynamic_flags args') dflags + = runCmdLine (processArgs flag_spec args') dflags when (not (null errs)) $ ghcError $ errorsToGhcException errs return (dflags', leftover, warns) @@ -1751,24 +1816,31 @@ unSetDynFlag f = upd (\dfs -> dopt_unset dfs f) -------------------------- setDumpFlag :: DynFlag -> OptKind DynP setDumpFlag dump_flag - | force_recomp = NoArg (setDynFlag Opt_ForceRecomp >> setDynFlag dump_flag) - | otherwise = NoArg (setDynFlag dump_flag) + = NoArg (setDynFlag dump_flag >> when want_recomp forceRecompile) where - -- Whenver we -ddump, switch off the recompilation checker, - -- else you don't see the dump! - -- However, certain dumpy-things are really interested in what's going + -- Certain dumpy-things are really interested in what's going -- on during recompilation checking, so in those cases we -- don't want to turn it off. - force_recomp = dump_flag `notElem` [Opt_D_dump_if_trace, - Opt_D_dump_hi_diffs] + want_recomp = dump_flag `notElem` [Opt_D_dump_if_trace, + Opt_D_dump_hi_diffs] + +forceRecompile :: DynP () +-- Whenver we -ddump, force recompilation (by switching off the +-- recompilation checker), else you don't see the dump! However, +-- don't switch it off in --make mode, else *everything* gets +-- recompiled which probably isn't what you want +forceRecompile = do { dfs <- getCmdLineState + ; when (force_recomp dfs) (setDynFlag Opt_ForceRecomp) } + where + force_recomp dfs = isOneShot (ghcMode dfs) setVerboseCore2Core :: DynP () -setVerboseCore2Core = do setDynFlag Opt_ForceRecomp - setDynFlag Opt_D_verbose_core2core +setVerboseCore2Core = do setDynFlag Opt_D_verbose_core2core + forceRecompile upd (\s -> s { shouldDumpSimplPhase = const True }) setDumpSimplPhases :: String -> DynP () -setDumpSimplPhases s = do setDynFlag Opt_ForceRecomp +setDumpSimplPhases s = do forceRecompile upd (\s -> s { shouldDumpSimplPhase = spec }) where spec :: SimplifierMode -> Bool @@ -1864,6 +1936,7 @@ setOptLevel n dflags -- -fmax-simplifier-iterations20 this is necessary sometimes -- -fno-spec-constr-threshold run SpecConstr even for big loops -- -fno-spec-constr-count SpecConstr as much as possible +-- -finline-enough-args hack to prevent excessive inlining -- setDPHOpt :: DynFlags -> DynFlags setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations = 20 @@ -1872,6 +1945,7 @@ setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations = 20 }) `dopt_set` Opt_DictsCheap `dopt_unset` Opt_MethodSharing + `dopt_set` Opt_InlineIfEnoughArgs data DPHBackend = DPHPar | DPHSeq @@ -1888,6 +1962,12 @@ setDPHBackend backend dph_packages DPHPar = ["dph-prim-par", "dph-par"] dph_packages DPHSeq = ["dph-prim-seq", "dph-seq"] +dphPackage :: DynFlags -> PackageId +dphPackage dflags = case dphBackend dflags of + DPHPar -> dphParPackageId + DPHSeq -> dphSeqPackageId + DPHThis -> thisPackage dflags + setMainIs :: String -> DynP () setMainIs arg | not (null main_fn) && isLower (head main_fn) @@ -2108,18 +2188,18 @@ picCCOpts _dflags -- in dynamic libraries. | opt_PIC - = ["-fno-common", "-D__PIC__"] + = ["-fno-common", "-U __PIC__","-D__PIC__"] | otherwise = ["-mdynamic-no-pic"] #elif mingw32_TARGET_OS -- no -fPIC for Windows | opt_PIC - = ["-D__PIC__"] + = ["-U __PIC__","-D__PIC__"] | otherwise = [] #else | opt_PIC - = ["-fPIC", "-D__PIC__"] + = ["-fPIC", "-U __PIC__", "-D__PIC__"] | otherwise = [] #endif