X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=394965a8508f7256a7134e2357e96a2d9b0a4b46;hp=e8b4f2818c2f5f6b5b14c6651df277f1b9d77d35;hb=9d0c8f842e35dde3d570580cf62a32779f66a6de;hpb=53b0e839e67193e1ca7d5013ef6a26faeebf7949 diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index e8b4f28..394965a 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -1,14 +1,11 @@ - ------------------------------------------------------------------------------ --- +-- | -- Dynamic flags -- -- -- (c) The University of Glasgow 2005 -- ------------------------------------------------------------------------------ --- | Most flags are dynamic flags, which means they can change from +-- Most flags are dynamic flags, which means they can change from -- compilation to compilation using @OPTIONS_GHC@ pragmas, and in a -- multi-session GHC each session can be using different dynamic -- flags. Dynamic flags can also be set at the prompt in GHCi. @@ -23,7 +20,7 @@ module DynFlags ( Option(..), DynLibLoader(..), fFlags, xFlags, - DPHBackend(..), + dphPackage, -- ** Manipulating DynFlags defaultDynFlags, -- DynFlags @@ -33,13 +30,14 @@ module DynFlags ( dopt_set, dopt_unset, -- DynFlags -> DynFlag -> DynFlags getOpts, -- DynFlags -> (DynFlags -> [a]) -> [a] getVerbFlag, - getMainFun, updOptLevel, setTmpDir, setPackageName, + doingTickyProfiling, -- ** Parsing DynFlags parseDynamicFlags, + parseDynamicNoPackageFlags, allFlags, supportedLanguages, languageOptions, @@ -64,12 +62,13 @@ module DynFlags ( #include "HsVersions.h" +#ifndef OMIT_NATIVE_CODEGEN +import Platform +#endif import Module import PackageConfig -import PrelNames ( mAIN, main_RDR_Unqual ) -import RdrName ( RdrName, mkRdrUnqual ) -import OccName ( mkVarOccFS ) -#ifdef i386_TARGET_ARCH +import PrelNames ( mAIN ) +#if defined(i386_TARGET_ARCH) || (!defined(mingw32_TARGET_OS) && !defined(darwin_TARGET_OS)) import StaticFlags ( opt_Static ) #endif import StaticFlags ( opt_PIC, WayName(..), v_Ways, v_Build_tag, @@ -85,13 +84,15 @@ import Util import Maybes ( orElse ) import SrcLoc import FastString +import FiniteMap import Outputable import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage ) -import Data.IORef ( readIORef ) +import Data.IORef import Control.Monad ( when ) import Data.Char +import Data.List ( intersperse ) import System.FilePath import System.IO ( stderr, hPutChar ) @@ -115,6 +116,7 @@ data DynFlag | Opt_D_dump_asm_regalloc_stages | Opt_D_dump_asm_conflicts | Opt_D_dump_asm_stats + | Opt_D_dump_asm_expanded | Opt_D_dump_cpranal | Opt_D_dump_deriv | Opt_D_dump_ds @@ -147,6 +149,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 @@ -187,6 +190,10 @@ data DynFlag | Opt_WarnTabs | Opt_WarnUnrecognisedPragmas | Opt_WarnDodgyForeignImports + | Opt_WarnLazyUnliftedBindings + | Opt_WarnUnusedDoBind + | Opt_WarnWrongDoBind + -- language opts | Opt_OverlappingInstances @@ -194,9 +201,11 @@ data DynFlag | Opt_IncoherentInstances | Opt_MonomorphismRestriction | Opt_MonoPatBinds + | Opt_MonoLocalBinds | Opt_ExtendedDefaultRules -- Use GHC's extended rules for defaulting | Opt_ForeignFunctionInterface | Opt_UnliftedFFITypes + | Opt_GHCForeignImportPrim | Opt_PArr -- Syntactic support for parallel arrays | Opt_Arrows -- Arrow-notation syntax | Opt_TemplateHaskell @@ -215,8 +224,13 @@ data DynFlag | Opt_ViewPatterns | Opt_GADTs | Opt_RelaxedPolyRec + | Opt_StandaloneDeriving | Opt_DeriveDataTypeable + | Opt_DeriveFunctor + | Opt_DeriveTraversable + | Opt_DeriveFoldable + | Opt_TypeSynonymInstances | Opt_FlexibleContexts | Opt_FlexibleInstances @@ -241,6 +255,7 @@ data DynFlag | Opt_ImpredicativeTypes | Opt_TypeOperators | Opt_PackageImports + | Opt_NewQualifiedOperators | Opt_PrintExplicitForalls @@ -260,11 +275,17 @@ 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 | Opt_RegsIterative -- do iterative coalescing graph coloring register allocation + -- profiling opts + | Opt_AutoSccsOnAllToplevs + | Opt_AutoSccsOnExportedToplevs + | Opt_AutoSccsOnIndividualCafs + -- misc opts | Opt_Cpp | Opt_Pp @@ -272,6 +293,7 @@ data DynFlag | Opt_DryRun | Opt_DoAsmMangling | Opt_ExcessPrecision + | Opt_EagerBlackHoling | Opt_ReadUserPackageConf | Opt_NoHsMain | Opt_SplitObjs @@ -287,10 +309,14 @@ data DynFlag | Opt_PrintBindContents | Opt_GenManifest | Opt_EmbedManifest + + -- temporary flags + | Opt_RunCPS | Opt_RunCPSZ | Opt_ConvertToZipCfgAndBack | Opt_AutoLinkPackages | Opt_ImplicitImportQualified + | Opt_TryNewCodeGen -- keeping stuff | Opt_KeepHiDiffs @@ -298,6 +324,7 @@ data DynFlag | Opt_KeepSFiles | Opt_KeepRawSFiles | Opt_KeepTmpFiles + | Opt_KeepRawTokenStream deriving (Eq, Show) @@ -322,6 +349,9 @@ data DynFlags = DynFlags { specConstrCount :: Maybe Int, -- ^ Max number of specialisations for any one function liberateCaseThreshold :: Maybe Int, -- ^ Threshold for LiberateCase +#ifndef OMIT_NATIVE_CODEGEN + targetPlatform :: Platform, -- ^ The platform we're compiling for. Used by the NCG. +#endif stolen_x86_regs :: Int, cmdlineHcIncludes :: [String], -- ^ @\-\#includes@ importPaths :: [FilePath], @@ -331,13 +361,16 @@ data DynFlags = DynFlags { dphBackend :: DPHBackend, - thisPackage :: PackageId, + thisPackage :: PackageId, -- ^ name of package currently being compiled -- ways wayNames :: [WayName], -- ^ Way flags from the command line buildTag :: String, -- ^ The global \"way\" (e.g. \"p\" for prof) rtsBuildTag :: String, -- ^ The RTS \"way\" + -- For object splitting + splitInfo :: Maybe (String,Int), + -- paths etc. objectDir :: Maybe String, hiDir :: Maybe String, @@ -399,7 +432,6 @@ data DynFlags = DynFlags { depIncludePkgDeps :: Bool, depExcludeMods :: [ModuleName], depSuffixes :: [String], - depWarnings :: Bool, -- Package flags extraPkgConfs :: [FilePath], @@ -417,6 +449,12 @@ data DynFlags = DynFlags { pkgDatabase :: Maybe (UniqFM PackageConfig), pkgState :: PackageState, + -- Temporary files + -- These have to be IORefs, because the defaultCleanupHandler needs to + -- know what to clean when an exception happens + filesToClean :: IORef [FilePath], + dirsToClean :: IORef (FiniteMap FilePath FilePath), + -- hsc dynamic flags flags :: [DynFlag], @@ -426,12 +464,32 @@ data DynFlags = DynFlags { haddockOptions :: Maybe String } +-- | The target code type of the compilation (if any). +-- +-- Whenever you change the target, also make sure to set 'ghcLink' to +-- something sensible. +-- +-- 'HscNothing' can be used to avoid generating any output, however, note +-- that: +-- +-- * This will not run the desugaring step, thus no warnings generated in +-- this step will be output. In particular, this includes warnings related +-- to pattern matching. You can run the desugarer manually using +-- 'GHC.desugarModule'. +-- +-- * If a program uses Template Haskell the typechecker may try to run code +-- from an imported module. This will fail if no code has been generated +-- for this module. You can use 'GHC.needsTemplateHaskell' to detect +-- whether this might be the case and choose to either switch to a +-- different target or avoid typechecking such modules. (The latter may +-- preferable for security reasons.) +-- data HscTarget - = HscC - | HscAsm - | HscJava - | HscInterpreted - | HscNothing + = HscC -- ^ Generate C code. + | HscAsm -- ^ Generate assembly using the native code generator. + | HscJava -- ^ Generate Java bytecode. + | HscInterpreted -- ^ Generate bytecode. (Requires 'LinkInMemory') + | HscNothing -- ^ Don't generate any code. See notes above. deriving (Eq, Show) -- | Will this target result in an object file on the disk? @@ -452,6 +510,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 @@ -460,7 +523,8 @@ isOneShot _other = False data GhcLink = NoLink -- ^ Don't link at all | LinkBinary -- ^ Link object code into a binary - | LinkInMemory -- ^ Use the in-memory dynamic linker + | LinkInMemory -- ^ Use the in-memory dynamic linker (works for both + -- bytecode and object code). | LinkDynLib -- ^ Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms) deriving (Eq, Show) @@ -468,6 +532,11 @@ isNoLink :: GhcLink -> Bool isNoLink NoLink = True isNoLink _ = False +-- Is it worth evaluating this Bool and caching it in the DynFlags value +-- during initDynFlags? +doingTickyProfiling :: DynFlags -> Bool +doingTickyProfiling dflags = WayTicky `elem` wayNames dflags + data PackageFlag = ExposePackage String | HidePackage String @@ -497,10 +566,14 @@ initDynFlags dflags = do ways <- readIORef v_Ways build_tag <- readIORef v_Build_tag rts_build_tag <- readIORef v_RTS_Build_tag + refFilesToClean <- newIORef [] + refDirsToClean <- newIORef emptyFM return dflags{ wayNames = ways, buildTag = build_tag, - rtsBuildTag = rts_build_tag + rtsBuildTag = rts_build_tag, + filesToClean = refFilesToClean, + dirsToClean = refDirsToClean } -- | The normal 'DynFlags'. Note that they is not suitable for use in this form @@ -524,6 +597,9 @@ defaultDynFlags = specConstrThreshold = Just 200, specConstrCount = Just 3, liberateCaseThreshold = Just 200, +#ifndef OMIT_NATIVE_CODEGEN + targetPlatform = defaultTargetPlatform, +#endif stolen_x86_regs = 4, cmdlineHcIncludes = [], importPaths = ["."], @@ -545,7 +621,7 @@ defaultDynFlags = outputFile = Nothing, outputHi = Nothing, - dynLibLoader = Deployable, + dynLibLoader = SystemDependent, dumpPrefix = Nothing, dumpPrefixForce = Nothing, includePaths = [], @@ -558,7 +634,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 = [], @@ -574,11 +650,12 @@ defaultDynFlags = wayNames = panic "defaultDynFlags: No wayNames", buildTag = panic "defaultDynFlags: No buildTag", rtsBuildTag = panic "defaultDynFlags: No rtsBuildTag", + splitInfo = Nothing, -- initSysTools fills all these in ghcUsagePath = panic "defaultDynFlags: No ghciUsagePath", ghciUsagePath = panic "defaultDynFlags: No ghciUsagePath", topDir = panic "defaultDynFlags: No topDir", - systemPackageConfig = panic "defaultDynFlags: No systemPackageConfig", + systemPackageConfig = panic "no systemPackageConfig: call GHC.setSessionDynFlags", pgm_L = panic "defaultDynFlags: No pgm_L", pgm_P = panic "defaultDynFlags: No pgm_P", pgm_F = panic "defaultDynFlags: No pgm_F", @@ -597,8 +674,9 @@ defaultDynFlags = depIncludePkgDeps = False, depExcludeMods = [], depSuffixes = [], - depWarnings = True, -- end of ghc -M values + filesToClean = panic "defaultDynFlags: No filesToClean", + dirsToClean = panic "defaultDynFlags: No dirsToClean", haddockOptions = Nothing, flags = [ Opt_AutoLinkPackages, @@ -673,7 +751,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 @@ -686,6 +765,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} @@ -701,7 +781,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} @@ -741,9 +821,6 @@ addDepExcludeMod m d addDepSuffix :: FilePath -> DynFlags -> DynFlags addDepSuffix s d = d { depSuffixes = deOptDep s : depSuffixes d } -setDepWarnings :: Bool -> DynFlags -> DynFlags -setDepWarnings b d = d { depWarnings = b } - -- XXX Legacy code: -- We used to use "-optdep-flag -optdeparg", so for legacy applications -- we need to strip the "-optdep" off of the arg @@ -803,7 +880,16 @@ optLevelFlags , ([2], Opt_LiberateCase) , ([2], Opt_SpecConstr) - , ([2], Opt_StaticArgumentTransformation) + +-- , ([2], Opt_StaticArgumentTransformation) +-- Max writes: I think it's probably best not to enable SAT with -O2 for the +-- 6.10 release. The version of SAT in HEAD at the moment doesn't incorporate +-- several improvements to the heuristics, and I'm concerned that without +-- those changes SAT will interfere with some attempts to write "high +-- performance Haskell", as we saw in some posts on Haskell-Cafe earlier +-- this year. In particular, the version in HEAD lacks the tail call +-- criterion, so many things that look like reasonable loops will be +-- turned into functions with extra (unneccesary) thunk creation. , ([0,1,2], Opt_DoLambdaEtaExpansion) -- This one is important for a tiresome reason: @@ -824,7 +910,9 @@ standardWarnings Opt_WarnMissingFields, Opt_WarnMissingMethods, Opt_WarnDuplicateExports, - Opt_WarnDodgyForeignImports + Opt_WarnLazyUnliftedBindings, + Opt_WarnDodgyForeignImports, + Opt_WarnWrongDoBind ] minusWOpts :: [DynFlag] @@ -844,7 +932,8 @@ minusWallOpts Opt_WarnNameShadowing, Opt_WarnMissingSigs, Opt_WarnHiShadows, - Opt_WarnOrphans + Opt_WarnOrphans, + Opt_WarnUnusedDoBind ] -- minuswRemovesOpts should be every warning option @@ -885,22 +974,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: @@ -940,7 +1055,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. @@ -998,7 +1113,14 @@ getCoreToDo dflags -- so that overloaded functions have all their dictionary lambdas manifest CoreDoSpecialising, - runWhen full_laziness (CoreDoFloatOutwards (FloatOutSw False False)), + runWhen full_laziness (CoreDoFloatOutwards constantsOnlyFloatOutSwitches), + -- Was: gentleFloatOutSwitches + -- I have no idea why, but not floating constants to top level is + -- very bad in some cases. + -- Notably: p_ident in spectral/rewrite + -- Changing from "gentle" to "constantsOnly" improved + -- rewrite's allocation by 19%, and made 0.0% difference + -- to any other nofib benchmark CoreDoFloatInwards, @@ -1028,8 +1150,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 @@ -1140,7 +1261,7 @@ dynamic_flags = [ , Flag "dep-makefile" (HasArg (upd . setDepMakefile)) Supported , Flag "optdep-f" (HasArg (upd . setDepMakefile)) (Deprecated "Use -dep-makefile instead") - , Flag "optdep-w" (NoArg (upd (setDepWarnings False))) + , Flag "optdep-w" (NoArg (return ())) (Deprecated "-optdep-w doesn't do anything") , Flag "include-pkg-deps" (NoArg (upd (setDepIncludePkgDeps True))) Supported , Flag "optdep--include-prelude" (NoArg (upd (setDepIncludePkgDeps True))) @@ -1182,6 +1303,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 @@ -1210,20 +1332,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 @@ -1262,6 +1370,8 @@ dynamic_flags = [ Supported , Flag "ddump-asm-stats" (setDumpFlag Opt_D_dump_asm_stats) Supported + , Flag "ddump-asm-expanded" (setDumpFlag Opt_D_dump_asm_expanded) + Supported , Flag "ddump-cpranal" (setDumpFlag Opt_D_dump_cpranal) Supported , Flag "ddump-deriv" (setDumpFlag Opt_D_dump_deriv) @@ -1344,6 +1454,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 @@ -1354,7 +1466,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)) @@ -1425,13 +1537,48 @@ dynamic_flags = [ (IntSuffix $ \n -> upd $ \dfs -> dfs{ ctxtStkDepth = n }) Supported + ------ Profiling ---------------------------------------------------- + + -- XXX Should the -f* flags be deprecated? + -- They don't seem to be documented + , Flag "fauto-sccs-on-all-toplevs" + (NoArg (setDynFlag Opt_AutoSccsOnAllToplevs)) + Supported + , Flag "auto-all" + (NoArg (setDynFlag Opt_AutoSccsOnAllToplevs)) + Supported + , Flag "no-auto-all" + (NoArg (unSetDynFlag Opt_AutoSccsOnAllToplevs)) + Supported + , Flag "fauto-sccs-on-exported-toplevs" + (NoArg (setDynFlag Opt_AutoSccsOnExportedToplevs)) + Supported + , Flag "auto" + (NoArg (setDynFlag Opt_AutoSccsOnExportedToplevs)) + Supported + , Flag "no-auto" + (NoArg (unSetDynFlag Opt_AutoSccsOnExportedToplevs)) + Supported + , Flag "fauto-sccs-on-individual-cafs" + (NoArg (setDynFlag Opt_AutoSccsOnIndividualCafs)) + Supported + , Flag "caf-all" + (NoArg (setDynFlag Opt_AutoSccsOnIndividualCafs)) + Supported + , Flag "no-caf-all" + (NoArg (unSetDynFlag Opt_AutoSccsOnIndividualCafs)) + Supported + ------ DPH flags ---------------------------------------------------- , Flag "fdph-seq" - (NoArg (upd (setDPHBackend DPHSeq))) + (NoArg (setDPHBackend DPHSeq)) Supported , Flag "fdph-par" - (NoArg (upd (setDPHBackend DPHPar))) + (NoArg (setDPHBackend DPHPar)) + Supported + , Flag "fdph-this" + (NoArg (setDPHBackend DPHThis)) Supported ------ Compiler flags ----------------------------------------------- @@ -1454,6 +1601,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 ()) @@ -1502,6 +1666,10 @@ fFlags = [ ( "warn-orphans", Opt_WarnOrphans, const Supported ), ( "warn-tabs", Opt_WarnTabs, const Supported ), ( "warn-unrecognised-pragmas", Opt_WarnUnrecognisedPragmas, const Supported ), + ( "warn-lazy-unlifted-bindings", Opt_WarnLazyUnliftedBindings, + const $ Deprecated "lazy unlifted bindings will be an error in GHC 6.14, and this flag will no longer exist"), + ( "warn-unused-do-bind", Opt_WarnUnusedDoBind, const Supported ), + ( "warn-wrong-do-bind", Opt_WarnWrongDoBind, const Supported ), ( "print-explicit-foralls", Opt_PrintExplicitForalls, const Supported ), ( "strictness", Opt_Strictness, const Supported ), ( "static-argument-transformation", Opt_StaticArgumentTransformation, const Supported ), @@ -1518,7 +1686,9 @@ 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 ), + ( "eager-blackholing", Opt_EagerBlackHoling, const Supported ), ( "asm-mangling", Opt_DoAsmMangling, const Supported ), ( "print-bind-result", Opt_PrintBindResult, const Supported ), ( "force-recomp", Opt_ForceRecomp, const Supported ), @@ -1529,7 +1699,9 @@ fFlags = [ ( "break-on-error", Opt_BreakOnError, const Supported ), ( "print-evld-with-show", Opt_PrintEvldWithShow, const Supported ), ( "print-bind-contents", Opt_PrintBindContents, const Supported ), - ( "run-cps", Opt_RunCPSZ, const Supported ), + ( "run-cps", Opt_RunCPS, const Supported ), + ( "run-cpsz", Opt_RunCPSZ, const Supported ), + ( "new-codegen", Opt_TryNewCodeGen, const Supported ), ( "convert-to-zipper-and-back", Opt_ConvertToZipCfgAndBack, const Supported ), ( "vectorise", Opt_Vectorise, const Supported ), ( "regs-graph", Opt_RegsGraph, const Supported ), @@ -1594,6 +1766,7 @@ xFlags = [ ( "TransformListComp", Opt_TransformListComp, const Supported ), ( "ForeignFunctionInterface", Opt_ForeignFunctionInterface, const Supported ), ( "UnliftedFFITypes", Opt_UnliftedFFITypes, const Supported ), + ( "GHCForeignImportPrim", Opt_GHCForeignImportPrim, const Supported ), ( "LiberalTypeSynonyms", Opt_LiberalTypeSynonyms, const Supported ), ( "Rank2Types", Opt_Rank2Types, const Supported ), ( "RankNTypes", Opt_RankNTypes, const Supported ), @@ -1621,6 +1794,7 @@ xFlags = [ ( "MonomorphismRestriction", Opt_MonomorphismRestriction, const Supported ), -- On by default (which is not strictly H98): ( "MonoPatBinds", Opt_MonoPatBinds, const Supported ), + ( "MonoLocalBinds", Opt_MonoLocalBinds, const Supported ), ( "RelaxedPolyRec", Opt_RelaxedPolyRec, const Supported ), ( "ExtendedDefaultRules", Opt_ExtendedDefaultRules, const Supported ), ( "ImplicitParams", Opt_ImplicitParams, const Supported ), @@ -1632,6 +1806,9 @@ xFlags = [ ( "UnboxedTuples", Opt_UnboxedTuples, const Supported ), ( "StandaloneDeriving", Opt_StandaloneDeriving, const Supported ), ( "DeriveDataTypeable", Opt_DeriveDataTypeable, const Supported ), + ( "DeriveFunctor", Opt_DeriveFunctor, const Supported ), + ( "DeriveTraversable", Opt_DeriveTraversable, const Supported ), + ( "DeriveFoldable", Opt_DeriveFoldable, const Supported ), ( "TypeSynonymInstances", Opt_TypeSynonymInstances, const Supported ), ( "FlexibleContexts", Opt_FlexibleContexts, const Supported ), ( "FlexibleInstances", Opt_FlexibleInstances, const Supported ), @@ -1642,7 +1819,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)] @@ -1650,8 +1828,13 @@ impliedFlags = [ (Opt_GADTs, Opt_RelaxedPolyRec) -- We want type-sig variables to -- be completely rigid for GADTs + , (Opt_TypeFamilies, Opt_RelaxedPolyRec) -- Trac #2944 gives a nice example + , (Opt_TypeFamilies, Opt_KindSignatures) -- Type families use kind signatures + -- all over the place + , (Opt_ScopedTypeVariables, Opt_RelaxedPolyRec) -- Ditto for scoped type variables; see -- Note [Scoped tyvars] in TcBinds + , (Opt_ImpredicativeTypes, Opt_RankNTypes) ] glasgowExtsFlags :: [DynFlag] @@ -1666,6 +1849,9 @@ glasgowExtsFlags = [ , Opt_TypeSynonymInstances , Opt_StandaloneDeriving , Opt_DeriveDataTypeable + , Opt_DeriveFunctor + , Opt_DeriveFoldable + , Opt_DeriveTraversable , Opt_FlexibleContexts , Opt_FlexibleInstances , Opt_ConstrainedClassMethods @@ -1679,7 +1865,6 @@ glasgowExtsFlags = [ , Opt_PatternGuards , Opt_LiberalTypeSynonyms , Opt_RankNTypes - , Opt_ImpredicativeTypes , Opt_TypeOperators , Opt_RecursiveDo , Opt_ParallelListComp @@ -1691,9 +1876,30 @@ glasgowExtsFlags = [ -- ----------------------------------------------------------------------------- -- Parsing the dynamic flags. -parseDynamicFlags :: DynFlags -> [Located String] - -> IO (DynFlags, [Located String], [Located String]) -parseDynamicFlags dflags args = do +-- | 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). +parseDynamicFlags :: Monad m => + DynFlags -> [Located String] + -> m (DynFlags, [Located String], [Located String]) + -- ^ Updated 'DynFlags', left-over arguments, and + -- list of warnings. +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 @@ -1705,8 +1911,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) @@ -1734,24 +1945,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 @@ -1845,21 +2063,42 @@ setOptLevel n dflags -- sometimes -- -fdicts-cheap always inline dictionaries -- -fmax-simplifier-iterations20 this is necessary sometimes +-- -fsimplifier-phases=3 we use an additional simplifier phase +-- for fusion -- -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 + , simplPhases = 3 , specConstrThreshold = Nothing + , specConstrCount = Nothing }) `dopt_set` Opt_DictsCheap `dopt_unset` Opt_MethodSharing + `dopt_set` Opt_InlineIfEnoughArgs data DPHBackend = DPHPar | DPHSeq + | DPHThis + deriving(Eq, Ord, Enum, Show) + +setDPHBackend :: DPHBackend -> DynP () +setDPHBackend backend + = do + upd $ \dflags -> dflags { dphBackend = backend } + mapM_ exposePackage (dph_packages backend) + where + dph_packages DPHThis = [] + dph_packages DPHPar = ["dph-prim-par", "dph-par"] + dph_packages DPHSeq = ["dph-prim-seq", "dph-seq"] -setDPHBackend :: DPHBackend -> DynFlags -> DynFlags -setDPHBackend backend dflags = dflags { dphBackend = backend } - +dphPackage :: DynFlags -> PackageId +dphPackage dflags = case dphBackend dflags of + DPHPar -> dphParPackageId + DPHSeq -> dphSeqPackageId + DPHThis -> thisPackage dflags setMainIs :: String -> DynP () setMainIs arg @@ -1876,13 +2115,6 @@ setMainIs arg where (main_mod, main_fn) = splitLongestPrefix arg (== '.') --- | Get the unqualified name of the function to use as the \"main\" for the main module. --- Either returns the default name or the one configured on the command line with -main-is -getMainFun :: DynFlags -> RdrName -getMainFun dflags = case (mainFunIs dflags) of - Just fn -> mkRdrUnqual (mkVarOccFS (mkFastString fn)) - Nothing -> main_RDR_Unqual - ----------------------------------------------------------------------------- -- Paths & Libraries @@ -2041,7 +2273,13 @@ machdepCCOpts _dflags = ( [], ["-fomit-frame-pointer", "-G0"] ) #elif x86_64_TARGET_ARCH - = ( [], ["-fomit-frame-pointer", + = ( +#if darwin_TARGET_OS + ["-m64"], +#else + [], +#endif + ["-fomit-frame-pointer", "-fno-asynchronous-unwind-tables", -- the unwind tables are unnecessary for HC code, -- and get in the way of -split-objs. Another option @@ -2081,18 +2319,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__"] + | opt_PIC || not opt_Static + = ["-fPIC", "-U __PIC__", "-D__PIC__"] | otherwise = [] #endif