X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=1e405ea414c5a70f3bcf4e02feaa1a702e6b8d2c;hp=8264ff93443e8f843249683a565ac5d154d2223b;hb=aedb94f5f220b5e442b23ecc445fd38c8d9b6ba0;hpb=a7f88c2f7900257d6791286f653cf141ebcb81c4 diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 8264ff9..1e405ea 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -1,19 +1,17 @@ ------------------------------------------------------------------------------ --- +-- | -- Dynamic flags -- --- 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. -- -- (c) The University of Glasgow 2005 -- ------------------------------------------------------------------------------ +-- 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. module DynFlags ( - -- Dynamic flags + -- * Dynamic flags and associated configuration types DynFlag(..), DynFlags(..), HscTarget(..), isObjectTarget, defaultObjectTarget, @@ -23,41 +21,53 @@ module DynFlags ( Option(..), DynLibLoader(..), fFlags, xFlags, + dphPackage, - -- Configuration of the core-to-core and stg-to-stg phases - CoreToDo(..), - StgToDo(..), - SimplifierSwitch(..), - SimplifierMode(..), FloatOutSwitches(..), - getCoreToDo, getStgToDo, - - -- Manipulating DynFlags + -- ** Manipulating DynFlags defaultDynFlags, -- DynFlags initDynFlags, -- DynFlags -> IO DynFlags dopt, -- DynFlag -> DynFlags -> Bool dopt_set, dopt_unset, -- DynFlags -> DynFlag -> DynFlags - getOpts, -- (DynFlags -> [a]) -> IO [a] + getOpts, -- DynFlags -> (DynFlags -> [a]) -> [a] getVerbFlag, + getMainFun, updOptLevel, setTmpDir, setPackageName, - -- parsing DynFlags + -- ** Parsing DynFlags parseDynamicFlags, + parseDynamicNoPackageFlags, allFlags, - -- misc stuff + supportedLanguages, languageOptions, + + -- ** DynFlag C compiler options machdepCCOpts, picCCOpts, - supportedLanguages, - compilerInfo, + + -- * Configuration of the core-to-core passes + CoreToDo(..), + SimplifierMode(..), + SimplifierSwitch(..), + FloatOutSwitches(..), + getCoreToDo, + + -- * Configuration of the stg-to-stg passes + StgToDo(..), + getStgToDo, + + -- * Compiler configuration suitable for display to the user + compilerInfo ) where #include "HsVersions.h" import Module import PackageConfig -import PrelNames ( mAIN ) +import PrelNames ( mAIN, main_RDR_Unqual ) +import RdrName ( RdrName, mkRdrUnqual ) +import OccName ( mkVarOccFS ) #ifdef i386_TARGET_ARCH import StaticFlags ( opt_Static ) #endif @@ -68,25 +78,27 @@ import DriverPhases ( Phase(..), phaseInputExt ) import Config import CmdLineParser import Constants ( mAX_CONTEXT_REDUCTION_DEPTH ) -import Panic ( panic, GhcException(..) ) +import Panic import UniqFM ( UniqFM ) import Util -import Maybes ( orElse, fromJust ) -import SrcLoc ( SrcSpan ) +import Maybes ( orElse ) +import SrcLoc +import FastString import Outputable import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage ) import Data.IORef ( readIORef ) -import Control.Exception ( throwDyn ) import Control.Monad ( when ) import Data.Char +import Data.List ( intersperse ) import System.FilePath -import System.IO ( hPutStrLn, stderr ) +import System.IO ( stderr, hPutChar ) -- ----------------------------------------------------------------------------- -- DynFlags +-- | Enumerates the simple on-or-off dynamic flags data DynFlag -- debugging flags @@ -135,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 @@ -168,10 +181,13 @@ data DynFlag | Opt_WarnUnusedBinds | Opt_WarnUnusedImports | Opt_WarnUnusedMatches - | Opt_WarnDeprecations + | Opt_WarnWarningsDeprecations + | Opt_WarnDeprecatedFlags | Opt_WarnDodgyImports | Opt_WarnOrphans | Opt_WarnTabs + | Opt_WarnUnrecognisedPragmas + | Opt_WarnDodgyForeignImports -- language opts | Opt_OverlappingInstances @@ -187,7 +203,7 @@ data DynFlag | Opt_TemplateHaskell | Opt_QuasiQuotes | Opt_ImplicitParams - | Opt_Generics + | Opt_Generics -- "Derivable type classes" | Opt_ImplicitPrelude | Opt_ScopedTypeVariables | Opt_UnboxedTuples @@ -214,17 +230,19 @@ data DynFlag | Opt_MagicHash | Opt_EmptyDataDecls | Opt_KindSignatures - | Opt_PatternSignatures | Opt_ParallelListComp | Opt_TransformListComp | Opt_GeneralizedNewtypeDeriving | Opt_RecursiveDo + | Opt_PostfixOperators | Opt_PatternGuards | Opt_LiberalTypeSynonyms | Opt_Rank2Types | Opt_RankNTypes | Opt_ImpredicativeTypes | Opt_TypeOperators + | Opt_PackageImports + | Opt_NewQualifiedOperators | Opt_PrintExplicitForalls @@ -244,11 +262,17 @@ data DynFlag | Opt_UnboxStrictFields | Opt_MethodSharing | Opt_DictsCheap - | Opt_RewriteRules + | 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 @@ -256,6 +280,7 @@ data DynFlag | Opt_DryRun | Opt_DoAsmMangling | Opt_ExcessPrecision + | Opt_EagerBlackHoling | Opt_ReadUserPackageConf | Opt_NoHsMain | Opt_SplitObjs @@ -271,8 +296,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 @@ -280,41 +311,49 @@ data DynFlag | Opt_KeepSFiles | Opt_KeepRawSFiles | Opt_KeepTmpFiles + | Opt_KeepRawTokenStream deriving (Eq, Show) +-- | Contains not only a collection of 'DynFlag's but also a plethora of +-- information relating to the compilation of a single file or GHC session data DynFlags = DynFlags { ghcMode :: GhcMode, ghcLink :: GhcLink, coreToDo :: Maybe [CoreToDo], -- reserved for -Ofile stgToDo :: Maybe [StgToDo], -- similarly hscTarget :: HscTarget, - hscOutName :: String, -- name of the output file - 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 + hscOutName :: String, -- ^ Name of the output file + extCoreName :: String, -- ^ Name of the .hcr output file + verbosity :: Int, -- ^ Verbosity level: see "DynFlags#verbosity_levels" + optLevel :: Int, -- ^ Optimisation level + simplPhases :: Int, -- ^ Number of simplifier phases + maxSimplIterations :: Int, -- ^ Max simplifier iterations shouldDumpSimplPhase :: SimplifierMode -> Bool, 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 + 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, - cmdlineHcIncludes :: [String], -- -#includes + cmdlineHcIncludes :: [String], -- ^ @\-\#includes@ importPaths :: [FilePath], mainModIs :: Module, mainFunIs :: Maybe String, - ctxtStkDepth :: Int, -- Typechecker context stack depth + ctxtStkDepth :: Int, -- ^ Typechecker context stack depth + + dphBackend :: DPHBackend, - thisPackage :: PackageId, + thisPackage :: PackageId, -- ^ name of package currently being compiled -- ways - wayNames :: [WayName], -- way flags from the cmd line - buildTag :: String, -- the global "way" (eg. "p" for prof) - rtsBuildTag :: String, -- the RTS "way" + 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, @@ -329,12 +368,12 @@ data DynFlags = DynFlags { outputHi :: Maybe String, dynLibLoader :: DynLibLoader, - -- | This is set by DriverPipeline.runPipeline based on where + -- | This is set by 'DriverPipeline.runPipeline' based on where -- its output is going. dumpPrefix :: Maybe FilePath, - -- | Override the dumpPrefix set by runPipeline. - -- Set by -ddump-file-prefix + -- | Override the 'dumpPrefix' set by 'DriverPipeline.runPipeline'. + -- Set by @-ddump-file-prefix@ dumpPrefixForce :: Maybe FilePath, includePaths :: [String], @@ -346,7 +385,7 @@ data DynFlags = DynFlags { ghcUsagePath :: FilePath, -- Filled in by SysTools ghciUsagePath :: FilePath, -- ditto - hpcDir :: String, -- ^ path to store the .mix files + hpcDir :: String, -- ^ Path to store the .mix files -- options for particular phases opt_L :: [String], @@ -356,7 +395,6 @@ data DynFlags = DynFlags { opt_m :: [String], opt_a :: [String], opt_l :: [String], - opt_dep :: [String], opt_windres :: [String], -- commands for particular phases @@ -373,15 +411,21 @@ data DynFlags = DynFlags { pgm_sysman :: String, pgm_windres :: String, + -- For ghc -M + depMakefile :: FilePath, + depIncludePkgDeps :: Bool, + depExcludeMods :: [ModuleName], + depSuffixes :: [String], + -- Package flags extraPkgConfs :: [FilePath], topDir :: FilePath, -- filled in by SysTools systemPackageConfig :: FilePath, -- ditto - -- The -package-conf flags given on the command line, in the order + -- ^ The @-package-conf@ flags given on the command line, in the order -- they appeared. packageFlags :: [PackageFlag], - -- The -package and -hide-package flags from the command-line + -- ^ The @-package@ and @-hide-package@ flags from the command-line -- Package state -- NB. do not modify this field, it is calculated by @@ -392,21 +436,41 @@ data DynFlags = DynFlags { -- hsc dynamic flags flags :: [DynFlag], - -- message output + -- | Message output action: use "ErrUtils" instead of this if you can log_action :: Severity -> SrcSpan -> PprStyle -> Message -> IO (), 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? +-- | Will this target result in an object file on the disk? isObjectTarget :: HscTarget -> Bool isObjectTarget HscC = True isObjectTarget HscAsm = True @@ -419,21 +483,27 @@ isObjectTarget _ = False -- imported modules, but in multi-module mode we look for source files -- in order to check whether they need to be recompiled. data GhcMode - = CompManager -- ^ --make, GHCi, etc. - | OneShot -- ^ ghc -c Foo.hs - | MkDepend -- ^ ghc -M, see Finder for why we need this + = CompManager -- ^ @\-\-make@, GHCi, etc. + | OneShot -- ^ @ghc -c Foo.hs@ + | 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 --- | What kind of linking to do. -data GhcLink -- What to do in the link step, if there is one - = NoLink -- Don't link at all - | LinkBinary -- Link object code into a binary - | LinkInMemory -- Use the in-memory dynamic linker - | LinkDynLib -- Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms) +-- | What to do in the link step, if there is one. +data GhcLink + = NoLink -- ^ Don't link at all + | LinkBinary -- ^ Link object code into a binary + | 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) isNoLink :: GhcLink -> Bool @@ -449,7 +519,7 @@ data PackageFlag defaultHscTarget :: HscTarget defaultHscTarget = defaultObjectTarget --- | the 'HscTarget' value corresponding to the default way to create +-- | The 'HscTarget' value corresponding to the default way to create -- object files on the current platform. defaultObjectTarget :: HscTarget defaultObjectTarget @@ -462,6 +532,7 @@ data DynLibLoader | SystemDependent deriving Eq +-- | Used by 'GHC.newSession' to partially initialize a new 'DynFlags' value initDynFlags :: DynFlags -> IO DynFlags initDynFlags dflags = do -- someday these will be dynamic flags @@ -474,6 +545,8 @@ initDynFlags dflags = do rtsBuildTag = rts_build_tag } +-- | The normal 'DynFlags'. Note that they is not suitable for use in this form +-- and must be fully initialized by 'GHC.newSession' first. defaultDynFlags :: DynFlags defaultDynFlags = DynFlags { @@ -500,6 +573,8 @@ defaultDynFlags = mainFunIs = Nothing, ctxtStkDepth = mAX_CONTEXT_REDUCTION_DEPTH, + dphBackend = DPHPar, + thisPackage = mainPackageId, objectDir = Nothing, @@ -525,14 +600,13 @@ 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 = [], opt_a = [], opt_m = [], opt_l = [], - opt_dep = [], opt_windres = [], extraPkgConfs = [], @@ -542,11 +616,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", @@ -560,8 +635,15 @@ defaultDynFlags = pgm_sysman = panic "defaultDynFlags: No pgm_sysman", pgm_windres = panic "defaultDynFlags: No pgm_windres", -- end of initSysTools values + -- ghc -M values + depMakefile = "Makefile", + depIncludePkgDeps = False, + depExcludeMods = [], + depSuffixes = [], + -- end of ghc -M values haddockOptions = Nothing, flags = [ + Opt_AutoLinkPackages, Opt_ReadUserPackageConf, Opt_MonoPatBinds, -- Experimentally, I'm making this non-standard @@ -585,12 +667,18 @@ defaultDynFlags = log_action = \severity srcSpan style msg -> case severity of - SevInfo -> hPutStrLn stderr (show (msg style)) - SevFatal -> hPutStrLn stderr (show (msg style)) - _ -> hPutStrLn stderr ('\n':show ((mkLocMessage srcSpan msg) style)) + SevInfo -> printErrs (msg style) + SevFatal -> printErrs (msg style) + _ -> do + hPutChar stderr '\n' + printErrs ((mkLocMessage srcSpan msg) style) + -- careful (#2302): printErrs prints in UTF-8, whereas + -- converting to string first and using hPutStr would + -- just emit the low 8 bits of each unicode char. } {- + #verbosity_levels# Verbosity levels: 0 | print errors & warnings only @@ -601,27 +689,36 @@ defaultDynFlags = 5 | "ghc -v -ddump-all" -} +-- | Test whether a 'DynFlag' is set dopt :: DynFlag -> DynFlags -> Bool dopt f dflags = f `elem` (flags dflags) +-- | Set a 'DynFlag' dopt_set :: DynFlags -> DynFlag -> DynFlags dopt_set dfs f = dfs{ flags = f : flags dfs } +-- | Unset a 'DynFlag' dopt_unset :: DynFlags -> DynFlag -> DynFlags dopt_unset dfs f = dfs{ flags = filter (/= f) (flags dfs) } -getOpts :: DynFlags -> (DynFlags -> [a]) -> [a] +-- | Retrieve the options corresponding to a particular @opt_*@ field in the correct order +getOpts :: DynFlags -- ^ 'DynFlags' to retrieve the options from + -> (DynFlags -> [a]) -- ^ Relevant record accessor: one of the @opt_*@ accessors + -> [a] -- ^ Correctly ordered extracted options getOpts dflags opts = reverse (opts dflags) -- We add to the options from the front, so we need to reverse the list +-- | Gets the verbosity flag for the current verbosity level. This is fed to +-- other tools, so GHC-specific verbosity flags like @-ddump-most@ are not included getVerbFlag :: DynFlags -> String 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, addOptdep, addOptwindres, + addOptL, addOptP, addOptF, addOptc, addOptm, addOpta, addOptl, addOptwindres, addCmdlineFramework, addHaddockOpts :: String -> DynFlags -> DynFlags setOutputFile, setOutputHi, setDumpPrefixForce @@ -631,7 +728,8 @@ setObjectDir f d = d{ objectDir = Just f} 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. + -- \#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} @@ -647,7 +745,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} @@ -672,9 +770,29 @@ addOptc f d = d{ opt_c = f : opt_c d} addOptm f d = d{ opt_m = f : opt_m d} addOpta f d = d{ opt_a = f : opt_a d} addOptl f d = d{ opt_l = f : opt_l d} -addOptdep f d = d{ opt_dep = f : opt_dep d} addOptwindres f d = d{ opt_windres = f : opt_windres d} +setDepMakefile :: FilePath -> DynFlags -> DynFlags +setDepMakefile f d = d { depMakefile = deOptDep f } + +setDepIncludePkgDeps :: Bool -> DynFlags -> DynFlags +setDepIncludePkgDeps b d = d { depIncludePkgDeps = b } + +addDepExcludeMod :: String -> DynFlags -> DynFlags +addDepExcludeMod m d + = d { depExcludeMods = mkModuleName (deOptDep m) : depExcludeMods d } + +addDepSuffix :: FilePath -> DynFlags -> DynFlags +addDepSuffix s d = d { depSuffixes = deOptDep s : depSuffixes d } + +-- XXX Legacy code: +-- We used to use "-optdep-flag -optdeparg", so for legacy applications +-- we need to strip the "-optdep" off of the arg +deOptDep :: String -> String +deOptDep x = case maybePrefixMatch "-optdep" x of + Just rest -> rest + Nothing -> x + addCmdlineFramework f d = d{ cmdlineFrameworks = f : cmdlineFrameworks d} addHaddockOpts f d = d{ haddockOptions = Just f} @@ -682,13 +800,12 @@ addHaddockOpts f d = d{ haddockOptions = Just f} -- ----------------------------------------------------------------------------- -- Command-line options --- When invoking external tools as part of the compilation pipeline, we +-- | When invoking external tools as part of the compilation pipeline, we -- pass these a sequence of options on the command-line. Rather than -- just using a list of Strings, we use a type that allows us to distinguish --- between filepaths and 'other stuff'. [The reason being, of course, that +-- between filepaths and 'other stuff'. The reason for this is that -- this type gives us a handle on transforming filenames, and filenames only, --- to whatever format they're expected to be on a particular platform.] - +-- to whatever format they're expected to be on a particular platform. data Option = FileOption -- an entry that _contains_ filename(s) / filepaths. String -- a non-filepath prefix that shouldn't be @@ -700,7 +817,7 @@ data Option -- Setting the optimisation level updOptLevel :: Int -> DynFlags -> DynFlags --- Set dynflags appropriate to the optimisation level +-- ^ Sets the 'DynFlags' to be appropriate to the optimisation level updOptLevel n dfs = dfs2{ optLevel = final_n } where @@ -717,8 +834,8 @@ optLevelFlags , ([0], Opt_OmitInterfacePragmas) , ([1,2], Opt_IgnoreAsserts) - , ([1,2], Opt_RewriteRules) -- Off for -O0; see Note [Scoping for Builtin rules] - -- in PrelRules + , ([1,2], Opt_EnableRewriteRules) -- Off for -O0; see Note [Scoping for Builtin rules] + -- in PrelRules , ([1,2], Opt_DoEtaReduction) , ([1,2], Opt_CaseMerge) , ([1,2], Opt_Strictness) @@ -727,7 +844,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: @@ -741,11 +867,14 @@ optLevelFlags standardWarnings :: [DynFlag] standardWarnings - = [ Opt_WarnDeprecations, + = [ Opt_WarnWarningsDeprecations, + Opt_WarnDeprecatedFlags, + Opt_WarnUnrecognisedPragmas, Opt_WarnOverlappingPatterns, Opt_WarnMissingFields, Opt_WarnMissingMethods, - Opt_WarnDuplicateExports + Opt_WarnDuplicateExports, + Opt_WarnDodgyForeignImports ] minusWOpts :: [DynFlag] @@ -776,6 +905,7 @@ minuswRemovesOpts Opt_WarnIncompletePatternsRecUpd, Opt_WarnSimplePatterns, Opt_WarnMonomorphism, + Opt_WarnUnrecognisedPragmas, Opt_WarnTabs ] @@ -805,22 +935,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 + | 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: @@ -846,8 +1002,7 @@ getCoreToDo dflags spec_constr = dopt Opt_SpecConstr dflags liberate_case = dopt Opt_LiberateCase dflags rule_check = ruleCheck dflags - vectorisation = dopt Opt_Vectorise dflags - -- static_args = dopt Opt_StaticArgumentTransformation dflags + static_args = dopt Opt_StaticArgumentTransformation dflags maybe_rule_check phase = runMaybe rule_check (CoreDoRuleCheck phase) @@ -859,6 +1014,11 @@ getCoreToDo dflags maybe_rule_check phase ] + vectorisation + = runWhen (dopt Opt_Vectorise dflags) + $ CoreDoPasses [ simpl_gently, CoreDoVectorisation (dphPackage dflags) ] + + -- By default, we have 2 phases before phase 0. -- Want to run with inline phase 2 after the specialiser to give @@ -893,7 +1053,7 @@ getCoreToDo dflags core_todo = if opt_level == 0 then - [runWhen vectorisation (CoreDoPasses [ simpl_gently, CoreDoVectorisation ]), + [vectorisation, simpl_phase 0 ["final"] max_iter] else {- opt_level >= 1 -} [ @@ -901,21 +1061,20 @@ getCoreToDo dflags -- may expose extra opportunities to float things outwards. However, to fix -- up the output of the transformation we need at do at least one simplify -- after this before anything else - -- runWhen static_args CoreDoStaticArgs, - -- XXX disabled, see #2321 - - -- initial simplify: mk specialiser happy: minimum effort please - simpl_gently, + runWhen static_args (CoreDoPasses [ simpl_gently, CoreDoStaticArgs ]), -- We run vectorisation here for now, but we might also try to run -- it later - runWhen vectorisation (CoreDoPasses [ CoreDoVectorisation, simpl_gently ]), + vectorisation, + + -- initial simplify: mk specialiser happy: minimum effort please + simpl_gently, -- Specialisation is best done before full laziness -- so that overloaded functions have all their dictionary lambdas manifest CoreDoSpecialising, - runWhen full_laziness (CoreDoFloatOutwards (FloatOutSw False False)), + runWhen full_laziness (CoreDoFloatOutwards gentleFloatOutSwitches), CoreDoFloatInwards, @@ -945,8 +1104,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 @@ -1011,12 +1169,11 @@ allFlags = map ('-':) $ [ flagName flag | flag <- dynamic_flags, ok (flagOptKind flag) ] ++ map ("fno-"++) flags ++ map ("f"++) flags ++ - map ("X"++) xs ++ - map ("XNo"++) xs + map ("X"++) supportedLanguages ++ + map ("XNo"++) supportedLanguages where ok (PrefixPred _ _) = False ok _ = True - flags = map fst fFlags - xs = map fst xFlags + flags = [ name | (name, _, _) <- fFlags ] dynamic_flags :: [Flag DynP] dynamic_flags = [ @@ -1045,13 +1202,32 @@ dynamic_flags = [ , Flag "optm" (HasArg (upd . addOptm)) Supported , Flag "opta" (HasArg (upd . addOpta)) Supported , Flag "optl" (HasArg (upd . addOptl)) Supported - , Flag "optdep" (HasArg (upd . addOptdep)) Supported , Flag "optwindres" (HasArg (upd . addOptwindres)) Supported , Flag "split-objs" (NoArg (if can_split then setDynFlag Opt_SplitObjs else return ())) Supported + -------- ghc -M ----------------------------------------------------- + , Flag "dep-suffix" (HasArg (upd . addDepSuffix)) Supported + , Flag "optdep-s" (HasArg (upd . addDepSuffix)) + (Deprecated "Use -dep-suffix instead") + , Flag "dep-makefile" (HasArg (upd . setDepMakefile)) Supported + , Flag "optdep-f" (HasArg (upd . setDepMakefile)) + (Deprecated "Use -dep-makefile instead") + , 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))) + (Deprecated "Use -include-pkg-deps instead") + , Flag "optdep--include-pkg-deps" (NoArg (upd (setDepIncludePkgDeps True))) + (Deprecated "Use -include-pkg-deps instead") + , Flag "exclude-module" (HasArg (upd . addDepExcludeMod)) Supported + , Flag "optdep--exclude-module" (HasArg (upd . addDepExcludeMod)) + (Deprecated "Use -exclude-module instead") + , Flag "optdep-x" (HasArg (upd . addDepExcludeMod)) + (Deprecated "Use -exclude-module instead") + -------- Linking ---------------------------------------------------- , Flag "c" (NoArg (upd $ \d -> d{ ghcLink=NoLink } )) Supported @@ -1081,6 +1257,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 @@ -1096,6 +1273,7 @@ dynamic_flags = [ , Flag "keep-tmp-files" (NoArg (setDynFlag Opt_KeepTmpFiles)) Supported ------- Miscellaneous ---------------------------------------------- + , Flag "no-auto-link-packages" (NoArg (unSetDynFlag Opt_AutoLinkPackages)) Supported , Flag "no-hs-main" (NoArg (setDynFlag Opt_NoHsMain)) Supported , Flag "main-is" (SepArg setMainIs ) Supported , Flag "haddock" (NoArg (setDynFlag Opt_Haddock)) Supported @@ -1104,23 +1282,9 @@ dynamic_flags = [ ------- recompilation checker -------------------------------------- , Flag "recomp" (NoArg (unSetDynFlag Opt_ForceRecomp)) - (Deprecated "Use -fforce-recomp instead") - , Flag "no-recomp" (NoArg (setDynFlag Opt_ForceRecomp)) (Deprecated "Use -fno-force-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") + , Flag "no-recomp" (NoArg (setDynFlag Opt_ForceRecomp)) + (Deprecated "Use -fforce-recomp instead") ------ HsCpp opts --------------------------------------------------- , Flag "D" (AnySuffix (upd . addOptP)) Supported @@ -1242,6 +1406,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 @@ -1252,7 +1418,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)) @@ -1323,6 +1489,50 @@ 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 (setDPHBackend DPHSeq)) + Supported + , Flag "fdph-par" + (NoArg (setDPHBackend DPHPar)) + Supported + , Flag "fdph-this" + (NoArg (setDPHBackend DPHThis)) + Supported + ------ Compiler flags ----------------------------------------------- , Flag "fasm" (NoArg (setObjTarget HscAsm)) Supported @@ -1337,190 +1547,232 @@ dynamic_flags = [ Supported , Flag "fno-glasgow-exts" (NoArg (mapM_ unSetDynFlag glasgowExtsFlags)) Supported + ] + ++ map (mkFlag True "f" setDynFlag ) fFlags + ++ map (mkFlag False "fno-" unSetDynFlag) fFlags + ++ map (mkFlag True "X" setDynFlag ) xFlags + ++ map (mkFlag False "XNo" unSetDynFlag) xFlags - -- XXX We need to flatten these: - - -- the rest of the -f* and -fno-* flags - , Flag "f" - (PrefixPred (isFlag fFlags) - (\f -> setDynFlag (getFlag fFlags f))) - Supported - , Flag "f" - (PrefixPred (isPrefFlag "no-" fFlags) - (\f -> unSetDynFlag (getPrefFlag "no-" fFlags f))) +package_flags :: [Flag DynP] +package_flags = [ + ------- Packages ---------------------------------------------------- + Flag "package-conf" (HasArg extraPkgConf_) Supported + , Flag "no-user-package-conf" (NoArg (unSetDynFlag Opt_ReadUserPackageConf)) Supported - - -- the -X* and -XNo* flags - , Flag "X" - (PrefixPred (isFlag xFlags) - (\f -> setDynFlag (getFlag xFlags f))) + , 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 "X" - (PrefixPred (isPrefFlag "No" xFlags) - (\f -> unSetDynFlag (getPrefFlag "No" xFlags f))) + , Flag "ignore-package" (HasArg ignorePackage) Supported - ] + , Flag "syslib" (HasArg exposePackage) + (Deprecated "Use -package instead") + ] --- these -f flags can all be reversed with -fno- +mkFlag :: Bool -- ^ True <=> it should be turned on + -> String -- ^ The flag prefix + -> (DynFlag -> DynP ()) + -> (String, DynFlag, Bool -> Deprecated) + -> Flag DynP +mkFlag turnOn flagPrefix f (name, dynflag, deprecated) + = Flag (flagPrefix ++ name) (NoArg (f dynflag)) (deprecated turnOn) + +deprecatedForLanguage :: String -> Bool -> Deprecated +deprecatedForLanguage lang turn_on + = Deprecated ("use -X" ++ flag ++ " or pragma {-# LANGUAGE " ++ flag ++ "#-} instead") + where + flag | turn_on = lang + | otherwise = "No"++lang + +useInstead :: String -> Bool -> Deprecated +useInstead flag turn_on + = Deprecated ("Use -f" ++ no ++ flag ++ " instead") + where + no = if turn_on then "" else "no-" -fFlags :: [(String, DynFlag)] +-- | These @-f\@ flags can all be reversed with @-fno-\@ +fFlags :: [(String, DynFlag, Bool -> Deprecated)] fFlags = [ - ( "warn-dodgy-imports", Opt_WarnDodgyImports ), - ( "warn-duplicate-exports", Opt_WarnDuplicateExports ), - ( "warn-hi-shadowing", Opt_WarnHiShadows ), - ( "warn-implicit-prelude", Opt_WarnImplicitPrelude ), - ( "warn-incomplete-patterns", Opt_WarnIncompletePatterns ), - ( "warn-incomplete-record-updates", Opt_WarnIncompletePatternsRecUpd ), - ( "warn-missing-fields", Opt_WarnMissingFields ), - ( "warn-missing-methods", Opt_WarnMissingMethods ), - ( "warn-missing-signatures", Opt_WarnMissingSigs ), - ( "warn-name-shadowing", Opt_WarnNameShadowing ), - ( "warn-overlapping-patterns", Opt_WarnOverlappingPatterns ), - ( "warn-simple-patterns", Opt_WarnSimplePatterns ), - ( "warn-type-defaults", Opt_WarnTypeDefaults ), - ( "warn-monomorphism-restriction", Opt_WarnMonomorphism ), - ( "warn-unused-binds", Opt_WarnUnusedBinds ), - ( "warn-unused-imports", Opt_WarnUnusedImports ), - ( "warn-unused-matches", Opt_WarnUnusedMatches ), - ( "warn-deprecations", Opt_WarnDeprecations ), - ( "warn-orphans", Opt_WarnOrphans ), - ( "warn-tabs", Opt_WarnTabs ), - ( "print-explicit-foralls", Opt_PrintExplicitForalls ), - ( "strictness", Opt_Strictness ), - ( "static-argument-transformation", Opt_StaticArgumentTransformation ), - ( "full-laziness", Opt_FullLaziness ), - ( "liberate-case", Opt_LiberateCase ), - ( "spec-constr", Opt_SpecConstr ), - ( "cse", Opt_CSE ), - ( "ignore-interface-pragmas", Opt_IgnoreInterfacePragmas ), - ( "omit-interface-pragmas", Opt_OmitInterfacePragmas ), - ( "do-lambda-eta-expansion", Opt_DoLambdaEtaExpansion ), - ( "ignore-asserts", Opt_IgnoreAsserts ), - ( "do-eta-reduction", Opt_DoEtaReduction ), - ( "case-merge", Opt_CaseMerge ), - ( "unbox-strict-fields", Opt_UnboxStrictFields ), - ( "method-sharing", Opt_MethodSharing ), - ( "dicts-cheap", Opt_DictsCheap ), - ( "excess-precision", Opt_ExcessPrecision ), - ( "asm-mangling", Opt_DoAsmMangling ), - ( "print-bind-result", Opt_PrintBindResult ), - ( "force-recomp", Opt_ForceRecomp ), - ( "hpc-no-auto", Opt_Hpc_No_Auto ), - ( "rewrite-rules", Opt_RewriteRules ), - ( "break-on-exception", Opt_BreakOnException ), - ( "break-on-error", Opt_BreakOnError ), - ( "print-evld-with-show", Opt_PrintEvldWithShow ), - ( "print-bind-contents", Opt_PrintBindContents ), - ( "run-cps", Opt_RunCPSZ ), - ( "convert-to-zipper-and-back", Opt_ConvertToZipCfgAndBack), - ( "vectorise", Opt_Vectorise ), - ( "regs-graph", Opt_RegsGraph), - ( "regs-iterative", Opt_RegsIterative), - -- Deprecated in favour of -XTemplateHaskell: - ( "th", Opt_TemplateHaskell ), - -- Deprecated in favour of -XForeignFunctionInterface: - ( "fi", Opt_ForeignFunctionInterface ), - -- Deprecated in favour of -XForeignFunctionInterface: - ( "ffi", Opt_ForeignFunctionInterface ), - -- Deprecated in favour of -XArrows: - ( "arrows", Opt_Arrows ), - -- Deprecated in favour of -XGenerics: - ( "generics", Opt_Generics ), - -- Deprecated in favour of -XImplicitPrelude: - ( "implicit-prelude", Opt_ImplicitPrelude ), - -- Deprecated in favour of -XBangPatterns: - ( "bang-patterns", Opt_BangPatterns ), - -- Deprecated in favour of -XMonomorphismRestriction: - ( "monomorphism-restriction", Opt_MonomorphismRestriction ), - -- Deprecated in favour of -XMonoPatBinds: - ( "mono-pat-binds", Opt_MonoPatBinds ), - -- Deprecated in favour of -XExtendedDefaultRules: - ( "extended-default-rules", Opt_ExtendedDefaultRules ), - -- Deprecated in favour of -XImplicitParams: - ( "implicit-params", Opt_ImplicitParams ), - -- Deprecated in favour of -XScopedTypeVariables: - ( "scoped-type-variables", Opt_ScopedTypeVariables ), - -- Deprecated in favour of -XPArr: - ( "parr", Opt_PArr ), - -- Deprecated in favour of -XOverlappingInstances: - ( "allow-overlapping-instances", Opt_OverlappingInstances ), - -- Deprecated in favour of -XUndecidableInstances: - ( "allow-undecidable-instances", Opt_UndecidableInstances ), - -- Deprecated in favour of -XIncoherentInstances: - ( "allow-incoherent-instances", Opt_IncoherentInstances ), - ( "gen-manifest", Opt_GenManifest ), - ( "embed-manifest", Opt_EmbedManifest ) + ( "warn-dodgy-foreign-imports", Opt_WarnDodgyForeignImports, const Supported ), + ( "warn-dodgy-imports", Opt_WarnDodgyImports, const Supported ), + ( "warn-duplicate-exports", Opt_WarnDuplicateExports, const Supported ), + ( "warn-hi-shadowing", Opt_WarnHiShadows, const Supported ), + ( "warn-implicit-prelude", Opt_WarnImplicitPrelude, const Supported ), + ( "warn-incomplete-patterns", Opt_WarnIncompletePatterns, const Supported ), + ( "warn-incomplete-record-updates", Opt_WarnIncompletePatternsRecUpd, const Supported ), + ( "warn-missing-fields", Opt_WarnMissingFields, const Supported ), + ( "warn-missing-methods", Opt_WarnMissingMethods, const Supported ), + ( "warn-missing-signatures", Opt_WarnMissingSigs, const Supported ), + ( "warn-name-shadowing", Opt_WarnNameShadowing, const Supported ), + ( "warn-overlapping-patterns", Opt_WarnOverlappingPatterns, const Supported ), + ( "warn-simple-patterns", Opt_WarnSimplePatterns, const Supported ), + ( "warn-type-defaults", Opt_WarnTypeDefaults, const Supported ), + ( "warn-monomorphism-restriction", Opt_WarnMonomorphism, const Supported ), + ( "warn-unused-binds", Opt_WarnUnusedBinds, const Supported ), + ( "warn-unused-imports", Opt_WarnUnusedImports, const Supported ), + ( "warn-unused-matches", Opt_WarnUnusedMatches, const Supported ), + ( "warn-warnings-deprecations", Opt_WarnWarningsDeprecations, const Supported ), + ( "warn-deprecations", Opt_WarnWarningsDeprecations, const Supported ), + ( "warn-deprecated-flags", Opt_WarnDeprecatedFlags, const Supported ), + ( "warn-orphans", Opt_WarnOrphans, const Supported ), + ( "warn-tabs", Opt_WarnTabs, const Supported ), + ( "warn-unrecognised-pragmas", Opt_WarnUnrecognisedPragmas, const Supported ), + ( "print-explicit-foralls", Opt_PrintExplicitForalls, const Supported ), + ( "strictness", Opt_Strictness, const Supported ), + ( "static-argument-transformation", Opt_StaticArgumentTransformation, const Supported ), + ( "full-laziness", Opt_FullLaziness, const Supported ), + ( "liberate-case", Opt_LiberateCase, const Supported ), + ( "spec-constr", Opt_SpecConstr, const Supported ), + ( "cse", Opt_CSE, const Supported ), + ( "ignore-interface-pragmas", Opt_IgnoreInterfacePragmas, const Supported ), + ( "omit-interface-pragmas", Opt_OmitInterfacePragmas, const Supported ), + ( "do-lambda-eta-expansion", Opt_DoLambdaEtaExpansion, const Supported ), + ( "ignore-asserts", Opt_IgnoreAsserts, const Supported ), + ( "do-eta-reduction", Opt_DoEtaReduction, const Supported ), + ( "case-merge", Opt_CaseMerge, const Supported ), + ( "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 ), + ( "hpc-no-auto", Opt_Hpc_No_Auto, const Supported ), + ( "rewrite-rules", Opt_EnableRewriteRules, useInstead "enable-rewrite-rules" ), + ( "enable-rewrite-rules", Opt_EnableRewriteRules, const Supported ), + ( "break-on-exception", Opt_BreakOnException, const Supported ), + ( "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_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 ), + ( "regs-iterative", Opt_RegsIterative, const Supported ), + ( "th", Opt_TemplateHaskell, + deprecatedForLanguage "TemplateHaskell" ), + ( "fi", Opt_ForeignFunctionInterface, + deprecatedForLanguage "ForeignFunctionInterface" ), + ( "ffi", Opt_ForeignFunctionInterface, + deprecatedForLanguage "ForeignFunctionInterface" ), + ( "arrows", Opt_Arrows, + deprecatedForLanguage "Arrows" ), + ( "generics", Opt_Generics, + deprecatedForLanguage "Generics" ), + ( "implicit-prelude", Opt_ImplicitPrelude, + deprecatedForLanguage "ImplicitPrelude" ), + ( "bang-patterns", Opt_BangPatterns, + deprecatedForLanguage "BangPatterns" ), + ( "monomorphism-restriction", Opt_MonomorphismRestriction, + deprecatedForLanguage "MonomorphismRestriction" ), + ( "mono-pat-binds", Opt_MonoPatBinds, + deprecatedForLanguage "MonoPatBinds" ), + ( "extended-default-rules", Opt_ExtendedDefaultRules, + deprecatedForLanguage "ExtendedDefaultRules" ), + ( "implicit-params", Opt_ImplicitParams, + deprecatedForLanguage "ImplicitParams" ), + ( "scoped-type-variables", Opt_ScopedTypeVariables, + deprecatedForLanguage "ScopedTypeVariables" ), + ( "parr", Opt_PArr, + deprecatedForLanguage "PArr" ), + ( "allow-overlapping-instances", Opt_OverlappingInstances, + deprecatedForLanguage "OverlappingInstances" ), + ( "allow-undecidable-instances", Opt_UndecidableInstances, + deprecatedForLanguage "UndecidableInstances" ), + ( "allow-incoherent-instances", Opt_IncoherentInstances, + deprecatedForLanguage "IncoherentInstances" ), + ( "gen-manifest", Opt_GenManifest, const Supported ), + ( "embed-manifest", Opt_EmbedManifest, const Supported ), + ( "implicit-import-qualified", Opt_ImplicitImportQualified, const Supported ) ] supportedLanguages :: [String] -supportedLanguages = map fst xFlags +supportedLanguages = [ name | (name, _, _) <- xFlags ] --- These -X flags can all be reversed with -XNo -xFlags :: [(String, DynFlag)] +-- This may contain duplicates +languageOptions :: [DynFlag] +languageOptions = [ dynFlag | (_, dynFlag, _) <- xFlags ] + +-- | These -X flags can all be reversed with -XNo +xFlags :: [(String, DynFlag, Bool -> Deprecated)] xFlags = [ - ( "CPP", Opt_Cpp ), - ( "PatternGuards", Opt_PatternGuards ), - ( "UnicodeSyntax", Opt_UnicodeSyntax ), - ( "MagicHash", Opt_MagicHash ), - ( "PolymorphicComponents", Opt_PolymorphicComponents ), - ( "ExistentialQuantification", Opt_ExistentialQuantification ), - ( "KindSignatures", Opt_KindSignatures ), - ( "PatternSignatures", Opt_PatternSignatures ), - ( "EmptyDataDecls", Opt_EmptyDataDecls ), - ( "ParallelListComp", Opt_ParallelListComp ), - ( "TransformListComp", Opt_TransformListComp ), - ( "ForeignFunctionInterface", Opt_ForeignFunctionInterface ), - ( "UnliftedFFITypes", Opt_UnliftedFFITypes ), - ( "LiberalTypeSynonyms", Opt_LiberalTypeSynonyms ), - ( "Rank2Types", Opt_Rank2Types ), - ( "RankNTypes", Opt_RankNTypes ), - ( "ImpredicativeTypes", Opt_ImpredicativeTypes ), - ( "TypeOperators", Opt_TypeOperators ), - ( "RecursiveDo", Opt_RecursiveDo ), - ( "Arrows", Opt_Arrows ), - ( "PArr", Opt_PArr ), - ( "TemplateHaskell", Opt_TemplateHaskell ), - ( "QuasiQuotes", Opt_QuasiQuotes ), - ( "Generics", Opt_Generics ), + ( "CPP", Opt_Cpp, const Supported ), + ( "PostfixOperators", Opt_PostfixOperators, const Supported ), + ( "PatternGuards", Opt_PatternGuards, const Supported ), + ( "UnicodeSyntax", Opt_UnicodeSyntax, const Supported ), + ( "MagicHash", Opt_MagicHash, const Supported ), + ( "PolymorphicComponents", Opt_PolymorphicComponents, const Supported ), + ( "ExistentialQuantification", Opt_ExistentialQuantification, const Supported ), + ( "KindSignatures", Opt_KindSignatures, const Supported ), + ( "EmptyDataDecls", Opt_EmptyDataDecls, const Supported ), + ( "ParallelListComp", Opt_ParallelListComp, const Supported ), + ( "TransformListComp", Opt_TransformListComp, const Supported ), + ( "ForeignFunctionInterface", Opt_ForeignFunctionInterface, const Supported ), + ( "UnliftedFFITypes", Opt_UnliftedFFITypes, const Supported ), + ( "LiberalTypeSynonyms", Opt_LiberalTypeSynonyms, const Supported ), + ( "Rank2Types", Opt_Rank2Types, const Supported ), + ( "RankNTypes", Opt_RankNTypes, const Supported ), + ( "ImpredicativeTypes", Opt_ImpredicativeTypes, const Supported ), + ( "TypeOperators", Opt_TypeOperators, const Supported ), + ( "RecursiveDo", Opt_RecursiveDo, const Supported ), + ( "Arrows", Opt_Arrows, const Supported ), + ( "PArr", Opt_PArr, const Supported ), + ( "TemplateHaskell", Opt_TemplateHaskell, const Supported ), + ( "QuasiQuotes", Opt_QuasiQuotes, const Supported ), + ( "Generics", Opt_Generics, const Supported ), -- On by default: - ( "ImplicitPrelude", Opt_ImplicitPrelude ), - ( "RecordWildCards", Opt_RecordWildCards ), - ( "RecordPuns", Opt_RecordPuns ), - ( "DisambiguateRecordFields", Opt_DisambiguateRecordFields ), - ( "OverloadedStrings", Opt_OverloadedStrings ), - ( "GADTs", Opt_GADTs ), - ( "ViewPatterns", Opt_ViewPatterns), - ( "TypeFamilies", Opt_TypeFamilies ), - ( "BangPatterns", Opt_BangPatterns ), + ( "ImplicitPrelude", Opt_ImplicitPrelude, const Supported ), + ( "RecordWildCards", Opt_RecordWildCards, const Supported ), + ( "NamedFieldPuns", Opt_RecordPuns, const Supported ), + ( "RecordPuns", Opt_RecordPuns, + deprecatedForLanguage "NamedFieldPuns" ), + ( "DisambiguateRecordFields", Opt_DisambiguateRecordFields, const Supported ), + ( "OverloadedStrings", Opt_OverloadedStrings, const Supported ), + ( "GADTs", Opt_GADTs, const Supported ), + ( "ViewPatterns", Opt_ViewPatterns, const Supported ), + ( "TypeFamilies", Opt_TypeFamilies, const Supported ), + ( "BangPatterns", Opt_BangPatterns, const Supported ), -- On by default: - ( "MonomorphismRestriction", Opt_MonomorphismRestriction ), + ( "MonomorphismRestriction", Opt_MonomorphismRestriction, const Supported ), -- On by default (which is not strictly H98): - ( "MonoPatBinds", Opt_MonoPatBinds ), - ( "RelaxedPolyRec", Opt_RelaxedPolyRec), - ( "ExtendedDefaultRules", Opt_ExtendedDefaultRules ), - ( "ImplicitParams", Opt_ImplicitParams ), - ( "ScopedTypeVariables", Opt_ScopedTypeVariables ), - ( "UnboxedTuples", Opt_UnboxedTuples ), - ( "StandaloneDeriving", Opt_StandaloneDeriving ), - ( "DeriveDataTypeable", Opt_DeriveDataTypeable ), - ( "TypeSynonymInstances", Opt_TypeSynonymInstances ), - ( "FlexibleContexts", Opt_FlexibleContexts ), - ( "FlexibleInstances", Opt_FlexibleInstances ), - ( "ConstrainedClassMethods", Opt_ConstrainedClassMethods ), - ( "MultiParamTypeClasses", Opt_MultiParamTypeClasses ), - ( "FunctionalDependencies", Opt_FunctionalDependencies ), - ( "GeneralizedNewtypeDeriving", Opt_GeneralizedNewtypeDeriving ), - ( "OverlappingInstances", Opt_OverlappingInstances ), - ( "UndecidableInstances", Opt_UndecidableInstances ), - ( "IncoherentInstances", Opt_IncoherentInstances ) + ( "MonoPatBinds", Opt_MonoPatBinds, const Supported ), + ( "RelaxedPolyRec", Opt_RelaxedPolyRec, const Supported ), + ( "ExtendedDefaultRules", Opt_ExtendedDefaultRules, const Supported ), + ( "ImplicitParams", Opt_ImplicitParams, const Supported ), + ( "ScopedTypeVariables", Opt_ScopedTypeVariables, const Supported ), + + ( "PatternSignatures", Opt_ScopedTypeVariables, + deprecatedForLanguage "ScopedTypeVariables" ), + + ( "UnboxedTuples", Opt_UnboxedTuples, const Supported ), + ( "StandaloneDeriving", Opt_StandaloneDeriving, const Supported ), + ( "DeriveDataTypeable", Opt_DeriveDataTypeable, const Supported ), + ( "TypeSynonymInstances", Opt_TypeSynonymInstances, const Supported ), + ( "FlexibleContexts", Opt_FlexibleContexts, const Supported ), + ( "FlexibleInstances", Opt_FlexibleInstances, const Supported ), + ( "ConstrainedClassMethods", Opt_ConstrainedClassMethods, const Supported ), + ( "MultiParamTypeClasses", Opt_MultiParamTypeClasses, const Supported ), + ( "FunctionalDependencies", Opt_FunctionalDependencies, const Supported ), + ( "GeneralizedNewtypeDeriving", Opt_GeneralizedNewtypeDeriving, const Supported ), + ( "OverlappingInstances", Opt_OverlappingInstances, const Supported ), + ( "UndecidableInstances", Opt_UndecidableInstances, const Supported ), + ( "IncoherentInstances", Opt_IncoherentInstances, const Supported ), + ( "PackageImports", Opt_PackageImports, const Supported ), + ( "NewQualifiedOperators", Opt_NewQualifiedOperators, const Supported ) ] -impliedFlags :: [(DynFlag, [DynFlag])] -impliedFlags = [ - ( 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 +impliedFlags :: [(DynFlag, DynFlag)] +impliedFlags + = [ (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 :: [DynFlag] @@ -1544,6 +1796,7 @@ glasgowExtsFlags = [ , Opt_PolymorphicComponents , Opt_ExistentialQuantification , Opt_UnicodeSyntax + , Opt_PostfixOperators , Opt_PatternGuards , Opt_LiberalTypeSynonyms , Opt_RankNTypes @@ -1553,38 +1806,55 @@ glasgowExtsFlags = [ , Opt_ParallelListComp , Opt_EmptyDataDecls , Opt_KindSignatures - , Opt_PatternSignatures , Opt_GeneralizedNewtypeDeriving , Opt_TypeFamilies ] ------------------- -isFlag :: [(String,a)] -> String -> Bool -isFlag flags f = any (\(ff,_) -> ff == f) flags - -isPrefFlag :: String -> [(String,a)] -> String -> Bool -isPrefFlag pref flags no_f - | Just f <- maybePrefixMatch pref no_f = isFlag flags f - | otherwise = False - ------------------- -getFlag :: [(String,a)] -> String -> a -getFlag flags f = case [ opt | (ff, opt) <- flags, ff == f] of - (o:_) -> o - [] -> panic ("get_flag " ++ f) - -getPrefFlag :: String -> [(String,a)] -> String -> a -getPrefFlag pref flags f = getFlag flags (fromJust (maybePrefixMatch pref f)) --- We should only be passed flags which match the prefix - -- ----------------------------------------------------------------------------- -- Parsing the dynamic flags. -parseDynamicFlags :: DynFlags -> [String] -> IO (DynFlags, [String], [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 + -- optdep-f -optdep depend + -- optdep -f -optdepdepend + -- optdep -f -optdep depend + -- but the spaces trip up proper argument handling. So get rid of them. + let f (L p "-optdep" : L _ x : xs) = (L p ("-optdep" ++ x)) : f xs + 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 - when (not (null errs)) $ do - throwDyn (UsageError (unlines errs)) + = runCmdLine (processArgs flag_spec args') dflags + when (not (null errs)) $ ghcError $ errorsToGhcException errs return (dflags', leftover, warns) type DynP = CmdLineP DynFlags @@ -1596,10 +1866,13 @@ upd f = do -------------------------- setDynFlag, unSetDynFlag :: DynFlag -> DynP () -setDynFlag f = upd (\dfs -> foldl dopt_set (dopt_set dfs f) deps) +setDynFlag f = do { upd (\dfs -> dopt_set dfs f) + ; mapM_ setDynFlag deps } where - deps = [ d | (f', ds) <- impliedFlags, f' == f, d <- ds ] + deps = [ d | (f', d) <- impliedFlags, f' == f ] -- When you set f, set the ones it implies + -- NB: use setDynFlag recursively, in case the implied flags + -- implies further flags -- When you un-set f, however, we don't un-set the things it implies -- (except for -fno-glasgow-exts, which is treated specially) @@ -1608,24 +1881,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 @@ -1676,7 +1956,7 @@ ignorePackage p = setPackageName :: String -> DynFlags -> DynFlags setPackageName p | Nothing <- unpackPackageId pid - = throwDyn (CmdLineError ("cannot parse \'" ++ p ++ "\' as a package identifier")) + = ghcError (CmdLineError ("cannot parse \'" ++ p ++ "\' as a package identifier")) | otherwise = \s -> s{ thisPackage = pid } where @@ -1720,15 +2000,38 @@ setOptLevel n dflags -- -fdicts-cheap always inline dictionaries -- -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 , 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"] - +dphPackage :: DynFlags -> PackageId +dphPackage dflags = case dphBackend dflags of + DPHPar -> dphParPackageId + DPHSeq -> dphSeqPackageId + DPHThis -> thisPackage dflags setMainIs :: String -> DynP () setMainIs arg @@ -1745,6 +2048,13 @@ 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 @@ -1889,7 +2199,6 @@ machdepCCOpts _dflags sta = opt_Static in ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else "" --- , if "mingw32" `isSuffixOf` cTARGETPLATFORM then "-mno-cygwin" else "" ], [ "-fno-defer-pop", "-fomit-frame-pointer", @@ -1944,18 +2253,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