X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=6ff79243a53b1403243769322a3cc8bc8bf6a759;hp=afe665260b7d22478f761850a201294cafc85b0c;hb=4564ccb752ff2dd28176ff1b567b8475fdb8b403;hpb=1971591f865ac0806802c476f23792ae2c89411a diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index afe6652..6ff7924 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -11,14 +11,17 @@ -- flags. Dynamic flags can also be set at the prompt in GHCi. module DynFlags ( -- * Dynamic flags and associated configuration types - DOpt(..), DynFlag(..), ExtensionFlag(..), - flattenExtensionFlags, - ensureFlattenedExtensionFlags, - lopt_set_flattened, - lopt_unset_flattened, + glasgowExtsFlags, + dopt, + dopt_set, + dopt_unset, + xopt, + xopt_set, + xopt_unset, DynFlags(..), + RtsOptsEnabled(..), HscTarget(..), isObjectTarget, defaultObjectTarget, GhcMode(..), isOneShot, GhcLink(..), isNoLink, @@ -26,15 +29,24 @@ module DynFlags ( Option(..), showOpt, DynLibLoader(..), fFlags, fLangFlags, xFlags, - dphPackage, + DPHBackend(..), dphPackageMaybe, wayNames, + Settings(..), + ghcUsagePath, ghciUsagePath, topDir, tmpDir, rawSettings, + extraGccViaCFlags, systemPackageConfig, + pgm_L, pgm_P, pgm_F, pgm_c, pgm_s, pgm_a, pgm_l, pgm_dll, pgm_T, + pgm_sysman, pgm_windres, pgm_lo, pgm_lc, + opt_L, opt_P, opt_F, opt_c, opt_m, opt_a, opt_l, + opt_windres, opt_lo, opt_lc, + + -- ** Manipulating DynFlags - defaultDynFlags, -- DynFlags + defaultDynFlags, -- Settings -> DynFlags initDynFlags, -- DynFlags -> IO DynFlags getOpts, -- DynFlags -> (DynFlags -> [a]) -> [a] - getVerbFlag, + getVerbFlags, updOptLevel, setTmpDir, setPackageName, @@ -45,7 +57,7 @@ module DynFlags ( parseDynamicNoPackageFlags, allFlags, - supportedExtensions, extensionOptions, + supportedLanguagesAndExtensions, -- ** DynFlag C compiler options machdepCCOpts, picCCOpts, @@ -55,8 +67,12 @@ module DynFlags ( getStgToDo, -- * Compiler configuration suitable for display to the user - Printable(..), compilerInfo +#ifdef GHCI +-- Only in stage 2 can we be sure that the RTS +-- exposes the appropriate runtime boolean + , rtsIsProfiled +#endif ) where #include "HsVersions.h" @@ -78,15 +94,23 @@ import Util import Maybes ( orElse ) import SrcLoc import FastString -import FiniteMap import Outputable +#ifdef GHCI +import Foreign.C ( CInt ) +#endif import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage ) +#ifdef GHCI +import System.IO.Unsafe ( unsafePerformIO ) +#endif import Data.IORef import Control.Monad ( when ) import Data.Char import Data.List +import Data.Map (Map) +import qualified Data.Map as Map +-- import Data.Maybe import System.FilePath import System.IO ( stderr, hPutChar ) @@ -98,6 +122,7 @@ data DynFlag -- debugging flags = Opt_D_dump_cmm + | Opt_D_dump_raw_cmm | Opt_D_dump_cmmz | Opt_D_dump_cmmz_pretty | Opt_D_dump_cps_cmm @@ -112,6 +137,7 @@ data DynFlag | Opt_D_dump_asm_stats | Opt_D_dump_asm_expanded | Opt_D_dump_llvm + | Opt_D_dump_core_stats | Opt_D_dump_cpranal | Opt_D_dump_deriv | Opt_D_dump_ds @@ -119,6 +145,7 @@ data DynFlag | Opt_D_dump_foreign | Opt_D_dump_inlinings | Opt_D_dump_rule_firings + | Opt_D_dump_rule_rewrites | Opt_D_dump_occur_anal | Opt_D_dump_parsed | Opt_D_dump_rn @@ -138,8 +165,10 @@ data DynFlag | Opt_D_dump_rn_stats | Opt_D_dump_opt_cmm | Opt_D_dump_simpl_stats + | Opt_D_dump_cs_trace -- Constraint solver in type checker | Opt_D_dump_tc_trace | Opt_D_dump_if_trace + | Opt_D_dump_vt_trace | Opt_D_dump_splices | Opt_D_dump_BCOs | Opt_D_dump_vect @@ -161,19 +190,26 @@ data DynFlag | Opt_DoCmmLinting | Opt_DoAsmLinting + | Opt_F_coqpass -- run the core-to-core coqPass, but don't change anything (just "parse/unparse") + | Opt_F_skolemize -- run the core-to-core coqPass, skolemizing the proof + | Opt_F_flatten -- run the core-to-core coqPass, flattening the proof + | Opt_D_dump_proofs -- dump natural deduction typing proof of the coqpass input + | Opt_D_coqpass -- run the core-to-string coqPass and dumps the result + | Opt_WarnIsError -- -Werror; makes warnings fatal | Opt_WarnDuplicateExports | Opt_WarnHiShadows | Opt_WarnImplicitPrelude | Opt_WarnIncompletePatterns + | Opt_WarnIncompleteUniPatterns | Opt_WarnIncompletePatternsRecUpd | Opt_WarnMissingFields | Opt_WarnMissingImportList | Opt_WarnMissingMethods | Opt_WarnMissingSigs + | Opt_WarnMissingLocalSigs | Opt_WarnNameShadowing | Opt_WarnOverlappingPatterns - | Opt_WarnSimplePatterns | Opt_WarnTypeDefaults | Opt_WarnMonomorphism | Opt_WarnUnusedBinds @@ -184,6 +220,8 @@ data DynFlag | Opt_WarnDodgyExports | Opt_WarnDodgyImports | Opt_WarnOrphans + | Opt_WarnAutoOrphans + | Opt_WarnIdentities | Opt_WarnTabs | Opt_WarnUnrecognisedPragmas | Opt_WarnDodgyForeignImports @@ -208,7 +246,7 @@ data DynFlag | Opt_DoEtaReduction | Opt_CaseMerge | Opt_UnboxStrictFields - | Opt_MethodSharing + | Opt_MethodSharing -- Now a no-op; remove in GHC 7.2 | Opt_DictsCheap | Opt_EnableRewriteRules -- Apply rewrite rules during simplification | Opt_Vectorise @@ -229,12 +267,10 @@ data DynFlag | Opt_Pp | Opt_ForceRecomp | Opt_DryRun - | Opt_DoAsmMangling | Opt_ExcessPrecision | Opt_EagerBlackHoling | Opt_ReadUserPackageConf | Opt_NoHsMain - | Opt_RtsOptsEnabled | Opt_SplitObjs | Opt_StgStats | Opt_HideAllPackages @@ -252,6 +288,8 @@ data DynFlag | Opt_SharedImplib | Opt_BuildingCabalPackage | Opt_SSE2 + | Opt_GhciSandbox + | Opt_HelpfulErrors -- temporary flags | Opt_RunCPS @@ -265,13 +303,14 @@ data DynFlag | Opt_KeepHiDiffs | Opt_KeepHcFiles | Opt_KeepSFiles - | Opt_KeepRawSFiles | Opt_KeepTmpFiles | Opt_KeepRawTokenStream | Opt_KeepLlvmFiles deriving (Eq, Show) +data Language = Haskell98 | Haskell2010 + data ExtensionFlag = Opt_Cpp | Opt_OverlappingInstances @@ -280,12 +319,14 @@ data ExtensionFlag | Opt_MonomorphismRestriction | Opt_MonoPatBinds | Opt_MonoLocalBinds + | Opt_RelaxedPolyRec -- Deprecated | Opt_ExtendedDefaultRules -- Use GHC's extended rules for defaulting | Opt_ForeignFunctionInterface | Opt_UnliftedFFITypes | Opt_GHCForeignImportPrim - | Opt_PArr -- Syntactic support for parallel arrays + | Opt_ParallelArrays -- Syntactic support for parallel arrays | Opt_Arrows -- Arrow-notation syntax + | Opt_ModalTypes -- Heterogeneous Metaprogramming (modal types, brackets, escape, CSP) | Opt_TemplateHaskell | Opt_QuasiQuotes | Opt_ImplicitParams @@ -301,8 +342,10 @@ data ExtensionFlag | Opt_RecordPuns | Opt_ViewPatterns | Opt_GADTs - | Opt_RelaxedPolyRec + | Opt_GADTSyntax | Opt_NPlusKPatterns + | Opt_DoAndIfThenElse + | Opt_RebindableSyntax | Opt_StandaloneDeriving | Opt_DeriveDataTypeable @@ -336,11 +379,12 @@ data ExtensionFlag | Opt_ImpredicativeTypes | Opt_TypeOperators | Opt_PackageImports - | Opt_NewQualifiedOperators | Opt_ExplicitForAll | Opt_AlternativeLayoutRule | Opt_AlternativeLayoutRuleTransitional | Opt_DatatypeContexts + | Opt_NondecreasingIndentation + | Opt_RelaxedLayout deriving (Eq, Show) -- | Contains not only a collection of 'DynFlag's but also a plethora of @@ -362,11 +406,12 @@ data DynFlags = DynFlags { specConstrThreshold :: Maybe Int, -- ^ Threshold for SpecConstr specConstrCount :: Maybe Int, -- ^ Max number of specialisations for any one function liberateCaseThreshold :: Maybe Int, -- ^ Threshold for LiberateCase + floatLamArgs :: Maybe Int, -- ^ Arg count for lambda floating + -- See CoreMonad.FloatOutSwitches #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], mainModIs :: Module, @@ -411,41 +456,13 @@ data DynFlags = DynFlags { libraryPaths :: [String], frameworkPaths :: [String], -- used on darwin only cmdlineFrameworks :: [String], -- ditto - tmpDir :: String, -- no trailing '/' - ghcUsagePath :: FilePath, -- Filled in by SysTools - ghciUsagePath :: FilePath, -- ditto rtsOpts :: Maybe String, + rtsOptsEnabled :: RtsOptsEnabled, hpcDir :: String, -- ^ Path to store the .mix files - -- options for particular phases - opt_L :: [String], - opt_P :: [String], - opt_F :: [String], - opt_c :: [String], - opt_m :: [String], - opt_a :: [String], - opt_l :: [String], - opt_windres :: [String], - opt_lo :: [String], -- LLVM: llvm optimiser - opt_lc :: [String], -- LLVM: llc static compiler - - -- commands for particular phases - pgm_L :: String, - pgm_P :: (String,[Option]), - pgm_F :: String, - pgm_c :: (String,[Option]), - pgm_m :: (String,[Option]), - pgm_s :: (String,[Option]), - pgm_a :: (String,[Option]), - pgm_l :: (String,[Option]), - pgm_dll :: (String,[Option]), - pgm_T :: String, - pgm_sysman :: String, - pgm_windres :: String, - pgm_lo :: (String,[Option]), -- LLVM: opt llvm optimiser - pgm_lc :: (String,[Option]), -- LLVM: llc static compiler + settings :: Settings, -- For ghc -M depMakefile :: FilePath, @@ -455,8 +472,6 @@ data DynFlags = DynFlags { -- 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 -- they appeared. @@ -473,12 +488,17 @@ data DynFlags = DynFlags { -- 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), + dirsToClean :: IORef (Map FilePath FilePath), -- hsc dynamic flags flags :: [DynFlag], - extensionFlags :: Either [OnOff ExtensionFlag] - [ExtensionFlag], + -- Don't change this without updating extensionFlags: + language :: Maybe Language, + -- Don't change this without updating extensionFlags: + extensions :: [OnOff ExtensionFlag], + -- extensionFlags should always be equal to + -- flattenExtensionFlags language extensions + extensionFlags :: [ExtensionFlag], -- | Message output action: use "ErrUtils" instead of this if you can log_action :: Severity -> SrcSpan -> PprStyle -> Message -> IO (), @@ -486,6 +506,105 @@ data DynFlags = DynFlags { haddockOptions :: Maybe String } +data Settings = Settings { + sGhcUsagePath :: FilePath, -- Filled in by SysTools + sGhciUsagePath :: FilePath, -- ditto + sTopDir :: FilePath, + sTmpDir :: String, -- no trailing '/' + -- You shouldn't need to look things up in rawSettings directly. + -- They should have their own fields instead. + sRawSettings :: [(String, String)], + sExtraGccViaCFlags :: [String], + sSystemPackageConfig :: FilePath, + -- commands for particular phases + sPgm_L :: String, + sPgm_P :: (String,[Option]), + sPgm_F :: String, + sPgm_c :: (String,[Option]), + sPgm_s :: (String,[Option]), + sPgm_a :: (String,[Option]), + sPgm_l :: (String,[Option]), + sPgm_dll :: (String,[Option]), + sPgm_T :: String, + sPgm_sysman :: String, + sPgm_windres :: String, + sPgm_lo :: (String,[Option]), -- LLVM: opt llvm optimiser + sPgm_lc :: (String,[Option]), -- LLVM: llc static compiler + -- options for particular phases + sOpt_L :: [String], + sOpt_P :: [String], + sOpt_F :: [String], + sOpt_c :: [String], + sOpt_m :: [String], + sOpt_a :: [String], + sOpt_l :: [String], + sOpt_windres :: [String], + sOpt_lo :: [String], -- LLVM: llvm optimiser + sOpt_lc :: [String] -- LLVM: llc static compiler + + } + +ghcUsagePath :: DynFlags -> FilePath +ghcUsagePath dflags = sGhcUsagePath (settings dflags) +ghciUsagePath :: DynFlags -> FilePath +ghciUsagePath dflags = sGhciUsagePath (settings dflags) +topDir :: DynFlags -> FilePath +topDir dflags = sTopDir (settings dflags) +tmpDir :: DynFlags -> String +tmpDir dflags = sTmpDir (settings dflags) +rawSettings :: DynFlags -> [(String, String)] +rawSettings dflags = sRawSettings (settings dflags) +extraGccViaCFlags :: DynFlags -> [String] +extraGccViaCFlags dflags = sExtraGccViaCFlags (settings dflags) +systemPackageConfig :: DynFlags -> FilePath +systemPackageConfig dflags = sSystemPackageConfig (settings dflags) +pgm_L :: DynFlags -> String +pgm_L dflags = sPgm_L (settings dflags) +pgm_P :: DynFlags -> (String,[Option]) +pgm_P dflags = sPgm_P (settings dflags) +pgm_F :: DynFlags -> String +pgm_F dflags = sPgm_F (settings dflags) +pgm_c :: DynFlags -> (String,[Option]) +pgm_c dflags = sPgm_c (settings dflags) +pgm_s :: DynFlags -> (String,[Option]) +pgm_s dflags = sPgm_s (settings dflags) +pgm_a :: DynFlags -> (String,[Option]) +pgm_a dflags = sPgm_a (settings dflags) +pgm_l :: DynFlags -> (String,[Option]) +pgm_l dflags = sPgm_l (settings dflags) +pgm_dll :: DynFlags -> (String,[Option]) +pgm_dll dflags = sPgm_dll (settings dflags) +pgm_T :: DynFlags -> String +pgm_T dflags = sPgm_T (settings dflags) +pgm_sysman :: DynFlags -> String +pgm_sysman dflags = sPgm_sysman (settings dflags) +pgm_windres :: DynFlags -> String +pgm_windres dflags = sPgm_windres (settings dflags) +pgm_lo :: DynFlags -> (String,[Option]) +pgm_lo dflags = sPgm_lo (settings dflags) +pgm_lc :: DynFlags -> (String,[Option]) +pgm_lc dflags = sPgm_lc (settings dflags) +opt_L :: DynFlags -> [String] +opt_L dflags = sOpt_L (settings dflags) +opt_P :: DynFlags -> [String] +opt_P dflags = sOpt_P (settings dflags) +opt_F :: DynFlags -> [String] +opt_F dflags = sOpt_F (settings dflags) +opt_c :: DynFlags -> [String] +opt_c dflags = sOpt_c (settings dflags) +opt_m :: DynFlags -> [String] +opt_m dflags = sOpt_m (settings dflags) +opt_a :: DynFlags -> [String] +opt_a dflags = sOpt_a (settings dflags) +opt_l :: DynFlags -> [String] +opt_l dflags = sOpt_l (settings dflags) +opt_windres :: DynFlags -> [String] +opt_windres dflags = sOpt_windres (settings dflags) +opt_lo :: DynFlags -> [String] +opt_lo dflags = sOpt_lo (settings dflags) +opt_lc :: DynFlags -> [String] +opt_lc dflags = sOpt_lc (settings dflags) + wayNames :: DynFlags -> [WayName] wayNames = map wayName . ways @@ -585,17 +704,19 @@ defaultObjectTarget data DynLibLoader = Deployable - | Wrapped (Maybe String) | SystemDependent deriving Eq +data RtsOptsEnabled = RtsOptsNone | RtsOptsSafeOnly | RtsOptsAll + deriving (Show) + -- | Used by 'GHC.newSession' to partially initialize a new 'DynFlags' value initDynFlags :: DynFlags -> IO DynFlags initDynFlags dflags = do -- someday these will be dynamic flags ways <- readIORef v_Ways refFilesToClean <- newIORef [] - refDirsToClean <- newIORef emptyFM + refDirsToClean <- newIORef Map.empty return dflags{ ways = ways, buildTag = mkBuildTag (filter (not . wayRTSOnly) ways), @@ -606,8 +727,8 @@ initDynFlags dflags = do -- | 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 = +defaultDynFlags :: Settings -> DynFlags +defaultDynFlags mySettings = DynFlags { ghcMode = CompManager, ghcLink = LinkBinary, @@ -623,19 +744,19 @@ defaultDynFlags = specConstrThreshold = Just 200, specConstrCount = Just 3, liberateCaseThreshold = Just 200, + floatLamArgs = Just 0, -- Default: float only if no fvs strictnessBefore = [], #ifndef OMIT_NATIVE_CODEGEN targetPlatform = defaultTargetPlatform, #endif - stolen_x86_regs = 4, cmdlineHcIncludes = [], importPaths = ["."], mainModIs = mAIN, mainFunIs = Nothing, ctxtStkDepth = mAX_CONTEXT_REDUCTION_DEPTH, - dphBackend = DPHPar, + dphBackend = DPHNone, thisPackage = mainPackageId, @@ -657,24 +778,11 @@ defaultDynFlags = libraryPaths = [], frameworkPaths = [], cmdlineFrameworks = [], - tmpDir = cDEFAULT_TMPDIR, rtsOpts = Nothing, + rtsOptsEnabled = RtsOptsSafeOnly, hpcDir = ".hpc", - opt_L = [], - opt_P = (if opt_PIC - then ["-D__PIC__", "-U __PIC__"] -- this list is reversed - else []), - opt_F = [], - opt_c = [], - opt_a = [], - opt_m = [], - opt_l = [], - opt_windres = [], - opt_lo = [], - opt_lc = [], - extraPkgConfs = [], packageFlags = [], pkgDatabase = Nothing, @@ -683,26 +791,7 @@ defaultDynFlags = 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 "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", - pgm_c = panic "defaultDynFlags: No pgm_c", - pgm_m = panic "defaultDynFlags: No pgm_m", - pgm_s = panic "defaultDynFlags: No pgm_s", - pgm_a = panic "defaultDynFlags: No pgm_a", - pgm_l = panic "defaultDynFlags: No pgm_l", - pgm_dll = panic "defaultDynFlags: No pgm_dll", - pgm_T = panic "defaultDynFlags: No pgm_T", - pgm_sysman = panic "defaultDynFlags: No pgm_sysman", - pgm_windres = panic "defaultDynFlags: No pgm_windres", - pgm_lo = panic "defaultDynFlags: No pgm_lo", - pgm_lc = panic "defaultDynFlags: No pgm_lc", - -- end of initSysTools values + settings = mySettings, -- ghc -M values depMakefile = "Makefile", depIncludePkgDeps = False, @@ -712,31 +801,17 @@ defaultDynFlags = filesToClean = panic "defaultDynFlags: No filesToClean", dirsToClean = panic "defaultDynFlags: No dirsToClean", haddockOptions = Nothing, - flags = [ - Opt_AutoLinkPackages, - Opt_ReadUserPackageConf, - - Opt_MethodSharing, - - Opt_DoAsmMangling, - - Opt_SharedImplib, - - Opt_GenManifest, - Opt_EmbedManifest, - Opt_PrintBindContents - ] - ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] - -- The default -O0 options - ++ standardWarnings, - - extensionFlags = Left [], + flags = defaultFlags, + language = Nothing, + extensions = [], + extensionFlags = flattenExtensionFlags Nothing [], log_action = \severity srcSpan style msg -> case severity of - SevInfo -> printErrs (msg style) - SevFatal -> printErrs (msg style) - _ -> do + SevOutput -> printOutput (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 @@ -758,105 +833,89 @@ Note [Verbosity levels] data OnOff a = On a | Off a -flattenExtensionFlags :: DynFlags -> DynFlags -flattenExtensionFlags dflags - = case extensionFlags dflags of - Left onoffs -> - dflags { - extensionFlags = Right $ flattenExtensionFlags' onoffs - } - Right _ -> - panic "Flattening already-flattened extension flags" - -ensureFlattenedExtensionFlags :: DynFlags -> DynFlags -ensureFlattenedExtensionFlags dflags - = case extensionFlags dflags of - Left onoffs -> - dflags { - extensionFlags = Right $ flattenExtensionFlags' onoffs - } - Right _ -> - dflags - -- OnOffs accumulate in reverse order, so we use foldr in order to -- process them in the right order -flattenExtensionFlags' :: [OnOff ExtensionFlag] -> [ExtensionFlag] -flattenExtensionFlags' = foldr f defaultExtensionFlags +flattenExtensionFlags :: Maybe Language -> [OnOff ExtensionFlag] + -> [ExtensionFlag] +flattenExtensionFlags ml = foldr f defaultExtensionFlags where f (On f) flags = f : delete f flags f (Off f) flags = delete f flags - defaultExtensionFlags = [ - Opt_MonoPatBinds, -- Experimentally, I'm making this non-standard - -- behaviour the default, to see if anyone notices - -- SLPJ July 06 - - Opt_ImplicitPrelude, - Opt_MonomorphismRestriction, - Opt_NPlusKPatterns, - Opt_DatatypeContexts - ] - --- The DOpt class is a temporary workaround, to avoid having to do --- a mass-renaming dopt->lopt at the moment -class DOpt a where - dopt :: a -> DynFlags -> Bool - dopt_set :: DynFlags -> a -> DynFlags - dopt_unset :: DynFlags -> a -> DynFlags - -instance DOpt DynFlag where - dopt = dopt' - dopt_set = dopt_set' - dopt_unset = dopt_unset' - -instance DOpt ExtensionFlag where - dopt = lopt - dopt_set = lopt_set - dopt_unset = lopt_unset + defaultExtensionFlags = languageExtensions ml + +languageExtensions :: Maybe Language -> [ExtensionFlag] + +languageExtensions Nothing + -- Nothing => the default case + = Opt_MonoPatBinds -- Experimentally, I'm making this non-standard + -- behaviour the default, to see if anyone notices + -- SLPJ July 06 + -- In due course I'd like Opt_MonoLocalBinds to be on by default + -- But NB it's implied by GADTs etc + -- SLPJ September 2010 + : Opt_NondecreasingIndentation -- This has been on by default for some time + : languageExtensions (Just Haskell2010) + +languageExtensions (Just Haskell98) + = [Opt_ImplicitPrelude, + Opt_MonomorphismRestriction, + Opt_NPlusKPatterns, + Opt_DatatypeContexts, + Opt_NondecreasingIndentation + -- strictly speaking non-standard, but we always had this + -- on implicitly before the option was added in 7.1, and + -- turning it off breaks code, so we're keeping it on for + -- backwards compatibility. Cabal uses -XHaskell98 by + -- default unless you specify another language. + ] + +languageExtensions (Just Haskell2010) + = [Opt_ImplicitPrelude, + Opt_MonomorphismRestriction, + Opt_DatatypeContexts, + Opt_EmptyDataDecls, + Opt_ForeignFunctionInterface, + Opt_PatternGuards, + Opt_DoAndIfThenElse, + Opt_RelaxedPolyRec] -- | Test whether a 'DynFlag' is set -dopt' :: DynFlag -> DynFlags -> Bool -dopt' f dflags = f `elem` (flags dflags) +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 } +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) } +dopt_unset :: DynFlags -> DynFlag -> DynFlags +dopt_unset dfs f = dfs{ flags = filter (/= f) (flags dfs) } -- | Test whether a 'ExtensionFlag' is set -lopt :: ExtensionFlag -> DynFlags -> Bool -lopt f dflags = case extensionFlags dflags of - Left _ -> panic ("Testing for extension flag " ++ show f ++ " before flattening") - Right flags -> f `elem` flags - --- | Set a 'ExtensionFlag' -lopt_set :: DynFlags -> ExtensionFlag -> DynFlags -lopt_set dfs f = case extensionFlags dfs of - Left onoffs -> dfs { extensionFlags = Left (On f : onoffs) } - Right _ -> panic ("Setting extension flag " ++ show f ++ " after flattening") +xopt :: ExtensionFlag -> DynFlags -> Bool +xopt f dflags = f `elem` extensionFlags dflags -- | Set a 'ExtensionFlag' -lopt_set_flattened :: DynFlags -> ExtensionFlag -> DynFlags -lopt_set_flattened dfs f = case extensionFlags dfs of - Left _ -> - panic ("Setting extension flag " ++ show f ++ " before flattening, but expected flattened") - Right flags -> - dfs { extensionFlags = Right (f : delete f flags) } +xopt_set :: DynFlags -> ExtensionFlag -> DynFlags +xopt_set dfs f + = let onoffs = On f : extensions dfs + in dfs { extensions = onoffs, + extensionFlags = flattenExtensionFlags (language dfs) onoffs } -- | Unset a 'ExtensionFlag' -lopt_unset :: DynFlags -> ExtensionFlag -> DynFlags -lopt_unset dfs f = case extensionFlags dfs of - Left onoffs -> dfs { extensionFlags = Left (Off f : onoffs) } - Right _ -> panic ("Unsetting extension flag " ++ show f ++ " after flattening") - --- | Unset a 'ExtensionFlag' -lopt_unset_flattened :: DynFlags -> ExtensionFlag -> DynFlags -lopt_unset_flattened dfs f = case extensionFlags dfs of - Left _ -> - panic ("Unsetting extension flag " ++ show f ++ " before flattening, but expected flattened") - Right flags -> - dfs { extensionFlags = Right (delete f flags) } +xopt_unset :: DynFlags -> ExtensionFlag -> DynFlags +xopt_unset dfs f + = let onoffs = Off f : extensions dfs + in dfs { extensions = onoffs, + extensionFlags = flattenExtensionFlags (language dfs) onoffs } + +setLanguage :: Language -> DynP () +setLanguage l = upd f + where f dfs = let mLang = Just l + oneoffs = extensions dfs + in dfs { + language = mLang, + extensionFlags = flattenExtensionFlags mLang oneoffs + } -- | Retrieve the options corresponding to a particular @opt_*@ field in the correct order getOpts :: DynFlags -- ^ 'DynFlags' to retrieve the options from @@ -867,16 +926,14 @@ getOpts dflags opts = reverse (opts dflags) -- | 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 = "" +getVerbFlags :: DynFlags -> [String] +getVerbFlags dflags + | verbosity dflags >= 4 = ["-v"] + | otherwise = [] setObjectDir, setHiDir, setStubDir, setOutputDir, setDylibInstallName, setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode, - setPgmP, setPgmL, setPgmF, setPgmc, setPgmm, setPgms, setPgma, setPgml, setPgmdll, setPgmwindres, - setPgmlo, setPgmlc, - addOptL, addOptP, addOptF, addOptc, addOptm, addOpta, addOptl, addOptwindres, addOptlo, addOptlc, + setPgmP, addOptl, addOptP, addCmdlineFramework, addHaddockOpts :: String -> DynFlags -> DynFlags setOutputFile, setOutputHi, setDumpPrefixForce @@ -886,7 +943,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 via C (i.e. unregisterised + -- builds). setOutputDir f = setObjectDir f . setHiDir f . setStubDir f setDylibInstallName f d = d{ dylibInstallName = Just f} @@ -901,39 +959,16 @@ parseDynLibLoaderMode f d = case splitAt 8 f of ("deploy", "") -> d{ dynLibLoader = Deployable } ("sysdep", "") -> d{ dynLibLoader = SystemDependent } - ("wrapped", "") -> d{ dynLibLoader = Wrapped Nothing } - ("wrapped:", "hard") -> d{ dynLibLoader = Wrapped Nothing } - ("wrapped:", flex) -> d{ dynLibLoader = Wrapped (Just flex) } _ -> ghcError (CmdLineError ("Unknown dynlib loader: " ++ f)) setDumpPrefixForce f d = d { dumpPrefixForce = f} -- XXX HACK: Prelude> words "'does not' work" ===> ["'does","not'","work"] -- Config.hs should really use Option. -setPgmP f d = let (pgm:args) = words f in d{ pgm_P = (pgm, map Option args)} - -setPgmL f d = d{ pgm_L = f} -setPgmF f d = d{ pgm_F = f} -setPgmc f d = d{ pgm_c = (f,[])} -setPgmm f d = d{ pgm_m = (f,[])} -setPgms f d = d{ pgm_s = (f,[])} -setPgma f d = d{ pgm_a = (f,[])} -setPgml f d = d{ pgm_l = (f,[])} -setPgmdll f d = d{ pgm_dll = (f,[])} -setPgmwindres f d = d{ pgm_windres = f} -setPgmlo f d = d{ pgm_lo = (f,[])} -setPgmlc f d = d{ pgm_lc = (f,[])} - -addOptL f d = d{ opt_L = f : opt_L d} -addOptP f d = d{ opt_P = f : opt_P d} -addOptF f d = d{ opt_F = f : opt_F d} -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} -addOptwindres f d = d{ opt_windres = f : opt_windres d} -addOptlo f d = d{ opt_lo = f : opt_lo d} -addOptlc f d = d{ opt_lc = f : opt_lc d} +setPgmP f = let (pgm:args) = words f in alterSettings (\s -> s { sPgm_P = (pgm, map Option args)}) +addOptl f = alterSettings (\s -> s { sOpt_l = f : sOpt_l s}) +addOptP f = alterSettings (\s -> s { sOpt_P = f : sOpt_P s}) + setDepMakefile :: FilePath -> DynFlags -> DynFlags setDepMakefile f d = d { depMakefile = deOptDep f } @@ -995,94 +1030,6 @@ updOptLevel n dfs extra_dopts = [ f | (ns,f) <- optLevelFlags, final_n `elem` ns ] remove_dopts = [ f | (ns,f) <- optLevelFlags, final_n `notElem` ns ] -optLevelFlags :: [([Int], DynFlag)] -optLevelFlags - = [ ([0], Opt_IgnoreInterfacePragmas) - , ([0], Opt_OmitInterfacePragmas) - - , ([1,2], Opt_IgnoreAsserts) - , ([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) - , ([1,2], Opt_CSE) - , ([1,2], Opt_FullLaziness) - , ([1,2], Opt_Specialise) - , ([1,2], Opt_FloatIn) - - , ([2], Opt_LiberateCase) - , ([2], Opt_SpecConstr) - --- , ([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: - -- we want to make sure that the bindings for data - -- constructors are eta-expanded. This is probably - -- a good thing anyway, but it seems fragile. - ] - --- ----------------------------------------------------------------------------- --- Standard sets of warning options - -standardWarnings :: [DynFlag] -standardWarnings - = [ Opt_WarnWarningsDeprecations, - Opt_WarnDeprecatedFlags, - Opt_WarnUnrecognisedPragmas, - Opt_WarnOverlappingPatterns, - Opt_WarnMissingFields, - Opt_WarnMissingMethods, - Opt_WarnDuplicateExports, - Opt_WarnLazyUnliftedBindings, - Opt_WarnDodgyForeignImports, - Opt_WarnWrongDoBind, - Opt_WarnAlternativeLayoutRuleTransitional - ] - -minusWOpts :: [DynFlag] -minusWOpts - = standardWarnings ++ - [ Opt_WarnUnusedBinds, - Opt_WarnUnusedMatches, - Opt_WarnUnusedImports, - Opt_WarnIncompletePatterns, - Opt_WarnDodgyExports, - Opt_WarnDodgyImports - ] - -minusWallOpts :: [DynFlag] -minusWallOpts - = minusWOpts ++ - [ Opt_WarnTypeDefaults, - Opt_WarnNameShadowing, - Opt_WarnMissingSigs, - Opt_WarnHiShadows, - Opt_WarnOrphans, - Opt_WarnUnusedDoBind - ] - --- minuswRemovesOpts should be every warning option -minuswRemovesOpts :: [DynFlag] -minuswRemovesOpts - = minusWallOpts ++ - [Opt_WarnImplicitPrelude, - Opt_WarnIncompletePatternsRecUpd, - Opt_WarnSimplePatterns, - Opt_WarnMonomorphism, - Opt_WarnUnrecognisedPragmas, - Opt_WarnTabs - ] - -- ----------------------------------------------------------------------------- -- StgToDo: abstraction of stg-to-stg passes to run. @@ -1105,8 +1052,76 @@ getStgToDo dflags | otherwise = todo1 +{- ********************************************************************** +%* * + DynFlags parser +%* * +%********************************************************************* -} + -- ----------------------------------------------------------------------------- --- DynFlags parser +-- Parsing the dynamic flags. + +-- | 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_ dflags0 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), dflags1) + = runCmdLine (processArgs flag_spec args') dflags0 + when (not (null errs)) $ ghcError $ errorsToGhcException errs + + let (pic_warns, dflags2) +#if !(x86_64_TARGET_ARCH && linux_TARGET_OS) + | (not opt_Static || opt_PIC) && hscTarget dflags1 == HscLlvm + = ([L noSrcSpan $ "Warning: -fllvm is incompatible with -fPIC and -" + ++ "dynamic on this platform;\n ignoring -fllvm"], + dflags1{ hscTarget = HscAsm }) +#endif + | otherwise = ([], dflags1) + + return (dflags2, leftover, pic_warns ++ warns) + + +{- ********************************************************************** +%* * + DynFlags specifications +%* * +%********************************************************************* -} allFlags :: [String] allFlags = map ('-':) $ @@ -1120,541 +1135,435 @@ allFlags = map ('-':) $ flags = [ name | (name, _, _) <- fFlags ] flags' = [ name | (name, _, _) <- fLangFlags ] -dynamic_flags :: [Flag DynP] +--------------- The main flags themselves ------------------ +dynamic_flags :: [Flag (CmdLineP DynFlags)] dynamic_flags = [ - Flag "n" (NoArg (setDynFlag Opt_DryRun)) Supported - , Flag "cpp" (NoArg (setExtensionFlag Opt_Cpp)) Supported - , Flag "F" (NoArg (setDynFlag Opt_Pp)) Supported - , Flag "#include" (HasArg (addCmdlineHCInclude)) - (DeprecatedFullText "-#include and INCLUDE pragmas are deprecated: They no longer have any effect") - , Flag "v" (OptIntSuffix setVerbosity) Supported + Flag "n" (NoArg (setDynFlag Opt_DryRun)) + , Flag "cpp" (NoArg (setExtensionFlag Opt_Cpp)) + , Flag "F" (NoArg (setDynFlag Opt_Pp)) + , Flag "#include" + (HasArg (\s -> do { addCmdlineHCInclude s + ; addWarn "-#include and INCLUDE pragmas are deprecated: They no longer have any effect" })) + , Flag "v" (OptIntSuffix setVerbosity) ------- Specific phases -------------------------------------------- -- need to appear before -pgmL to be parsed as LLVM flags. - , Flag "pgmlo" (HasArg (upd . setPgmlo)) Supported - , Flag "pgmlc" (HasArg (upd . setPgmlc)) Supported - - , Flag "pgmL" (HasArg (upd . setPgmL)) Supported - , Flag "pgmP" (HasArg (upd . setPgmP)) Supported - , Flag "pgmF" (HasArg (upd . setPgmF)) Supported - , Flag "pgmc" (HasArg (upd . setPgmc)) Supported - , Flag "pgmm" (HasArg (upd . setPgmm)) Supported - , Flag "pgms" (HasArg (upd . setPgms)) Supported - , Flag "pgma" (HasArg (upd . setPgma)) Supported - , Flag "pgml" (HasArg (upd . setPgml)) Supported - , Flag "pgmdll" (HasArg (upd . setPgmdll)) Supported - , Flag "pgmwindres" (HasArg (upd . setPgmwindres)) Supported + , Flag "pgmlo" (hasArg (\f -> alterSettings (\s -> s { sPgm_lo = (f,[])}))) + , Flag "pgmlc" (hasArg (\f -> alterSettings (\s -> s { sPgm_lc = (f,[])}))) + , Flag "pgmL" (hasArg (\f -> alterSettings (\s -> s { sPgm_L = f}))) + , Flag "pgmP" (hasArg setPgmP) + , Flag "pgmF" (hasArg (\f -> alterSettings (\s -> s { sPgm_F = f}))) + , Flag "pgmc" (hasArg (\f -> alterSettings (\s -> s { sPgm_c = (f,[])}))) + , Flag "pgmm" (HasArg (\_ -> addWarn "The -keep-raw-s-files flag does nothing; it will be removed in a future GHC release")) + , Flag "pgms" (hasArg (\f -> alterSettings (\s -> s { sPgm_s = (f,[])}))) + , Flag "pgma" (hasArg (\f -> alterSettings (\s -> s { sPgm_a = (f,[])}))) + , Flag "pgml" (hasArg (\f -> alterSettings (\s -> s { sPgm_l = (f,[])}))) + , Flag "pgmdll" (hasArg (\f -> alterSettings (\s -> s { sPgm_dll = (f,[])}))) + , Flag "pgmwindres" (hasArg (\f -> alterSettings (\s -> s { sPgm_windres = f}))) -- need to appear before -optl/-opta to be parsed as LLVM flags. - , Flag "optlo" (HasArg (upd . addOptlo)) Supported - , Flag "optlc" (HasArg (upd . addOptlc)) Supported - - , Flag "optL" (HasArg (upd . addOptL)) Supported - , Flag "optP" (HasArg (upd . addOptP)) Supported - , Flag "optF" (HasArg (upd . addOptF)) Supported - , Flag "optc" (HasArg (upd . addOptc)) Supported - , Flag "optm" (HasArg (upd . addOptm)) Supported - , Flag "opta" (HasArg (upd . addOpta)) Supported - , Flag "optl" (HasArg (upd . addOptl)) Supported - , Flag "optwindres" (HasArg (upd . addOptwindres)) Supported + , Flag "optlo" (hasArg (\f -> alterSettings (\s -> s { sOpt_lo = f : sOpt_lo s}))) + , Flag "optlc" (hasArg (\f -> alterSettings (\s -> s { sOpt_lc = f : sOpt_lc s}))) + , Flag "optL" (hasArg (\f -> alterSettings (\s -> s { sOpt_L = f : sOpt_L s}))) + , Flag "optP" (hasArg addOptP) + , Flag "optF" (hasArg (\f -> alterSettings (\s -> s { sOpt_F = f : sOpt_F s}))) + , Flag "optc" (hasArg (\f -> alterSettings (\s -> s { sOpt_c = f : sOpt_c s}))) + , Flag "optm" (hasArg (\f -> alterSettings (\s -> s { sOpt_m = f : sOpt_m s}))) + , Flag "opta" (hasArg (\f -> alterSettings (\s -> s { sOpt_a = f : sOpt_a s}))) + , Flag "optl" (hasArg addOptl) + , Flag "optwindres" (hasArg (\f -> alterSettings (\s -> s { sOpt_windres = f : sOpt_windres s}))) , Flag "split-objs" - (NoArg (if can_split then setDynFlag Opt_SplitObjs else return ())) - Supported + (NoArg (if can_split + then setDynFlag Opt_SplitObjs + else addWarn "ignoring -fsplit-objs")) -------- 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") + , Flag "dep-suffix" (hasArg addDepSuffix) + , Flag "optdep-s" (hasArgDF addDepSuffix "Use -dep-suffix instead") + , Flag "dep-makefile" (hasArg setDepMakefile) + , Flag "optdep-f" (hasArgDF setDepMakefile "Use -dep-makefile instead") + , Flag "optdep-w" (NoArg (deprecate "doesn't do anything")) + , Flag "include-pkg-deps" (noArg (setDepIncludePkgDeps True)) + , Flag "optdep--include-prelude" (noArgDF (setDepIncludePkgDeps True) "Use -include-pkg-deps instead") + , Flag "optdep--include-pkg-deps" (noArgDF (setDepIncludePkgDeps True) "Use -include-pkg-deps instead") + , Flag "exclude-module" (hasArg addDepExcludeMod) + , Flag "optdep--exclude-module" (hasArgDF addDepExcludeMod "Use -exclude-module instead") + , Flag "optdep-x" (hasArgDF addDepExcludeMod "Use -exclude-module instead") -------- Linking ---------------------------------------------------- - , Flag "no-link" (NoArg (upd $ \d -> d{ ghcLink=NoLink } )) - Supported - , Flag "shared" (NoArg (upd $ \d -> d{ ghcLink=LinkDynLib } )) - Supported - , Flag "dynload" (HasArg (upd . parseDynLibLoaderMode)) - Supported - , Flag "dylib-install-name" (HasArg (upd . setDylibInstallName)) Supported + , Flag "no-link" (noArg (\d -> d{ ghcLink=NoLink })) + , Flag "shared" (noArg (\d -> d{ ghcLink=LinkDynLib })) + , Flag "dynload" (hasArg parseDynLibLoaderMode) + , Flag "dylib-install-name" (hasArg setDylibInstallName) ------- Libraries --------------------------------------------------- - , Flag "L" (Prefix addLibraryPath ) Supported - , Flag "l" (AnySuffix (\s -> do upd (addOptl s))) Supported + , Flag "L" (Prefix addLibraryPath) + , Flag "l" (AnySuffix (upd . addOptl)) ------- Frameworks -------------------------------------------------- -- -framework-path should really be -F ... - , Flag "framework-path" (HasArg addFrameworkPath ) Supported - , Flag "framework" (HasArg (upd . addCmdlineFramework)) Supported + , Flag "framework-path" (HasArg addFrameworkPath) + , Flag "framework" (hasArg addCmdlineFramework) ------- Output Redirection ------------------------------------------ - , Flag "odir" (HasArg (upd . setObjectDir)) Supported - , Flag "o" (SepArg (upd . setOutputFile . Just)) Supported - , Flag "ohi" (HasArg (upd . setOutputHi . Just )) Supported - , Flag "osuf" (HasArg (upd . setObjectSuf)) Supported - , Flag "hcsuf" (HasArg (upd . setHcSuf)) Supported - , Flag "hisuf" (HasArg (upd . setHiSuf)) Supported - , 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 + , Flag "odir" (hasArg setObjectDir) + , Flag "o" (SepArg (upd . setOutputFile . Just)) + , Flag "ohi" (hasArg (setOutputHi . Just )) + , Flag "osuf" (hasArg setObjectSuf) + , Flag "hcsuf" (hasArg setHcSuf) + , Flag "hisuf" (hasArg setHiSuf) + , Flag "hidir" (hasArg setHiDir) + , Flag "tmpdir" (hasArg setTmpDir) + , Flag "stubdir" (hasArg setStubDir) + , Flag "outputdir" (hasArg setOutputDir) + , Flag "ddump-file-prefix" (hasArg (setDumpPrefixForce . Just)) ------- Keeping temporary files ------------------------------------- -- These can be singular (think ghc -c) or plural (think ghc --make) - , Flag "keep-hc-file" (NoArg (setDynFlag Opt_KeepHcFiles)) Supported - , Flag "keep-hc-files" (NoArg (setDynFlag Opt_KeepHcFiles)) Supported - , Flag "keep-s-file" (NoArg (setDynFlag Opt_KeepSFiles)) Supported - , Flag "keep-s-files" (NoArg (setDynFlag Opt_KeepSFiles)) Supported - , Flag "keep-raw-s-file" (NoArg (setDynFlag Opt_KeepRawSFiles)) Supported - , Flag "keep-raw-s-files" (NoArg (setDynFlag Opt_KeepRawSFiles)) Supported - , Flag "keep-llvm-file" (NoArg (setDynFlag Opt_KeepLlvmFiles)) Supported - , Flag "keep-llvm-files" (NoArg (setDynFlag Opt_KeepLlvmFiles)) Supported + , Flag "keep-hc-file" (NoArg (setDynFlag Opt_KeepHcFiles)) + , Flag "keep-hc-files" (NoArg (setDynFlag Opt_KeepHcFiles)) + , Flag "keep-s-file" (NoArg (setDynFlag Opt_KeepSFiles)) + , Flag "keep-s-files" (NoArg (setDynFlag Opt_KeepSFiles)) + , Flag "keep-raw-s-file" (NoArg (addWarn "The -keep-raw-s-file flag does nothing; it will be removed in a future GHC release")) + , Flag "keep-raw-s-files" (NoArg (addWarn "The -keep-raw-s-files flag does nothing; it will be removed in a future GHC release")) + , Flag "keep-llvm-file" (NoArg (setDynFlag Opt_KeepLlvmFiles)) + , Flag "keep-llvm-files" (NoArg (setDynFlag Opt_KeepLlvmFiles)) -- This only makes sense as plural - , Flag "keep-tmp-files" (NoArg (setDynFlag Opt_KeepTmpFiles)) Supported + , Flag "keep-tmp-files" (NoArg (setDynFlag Opt_KeepTmpFiles)) ------- Miscellaneous ---------------------------------------------- - , Flag "no-auto-link-packages" (NoArg (unSetDynFlag Opt_AutoLinkPackages)) Supported - , Flag "no-hs-main" (NoArg (setDynFlag Opt_NoHsMain)) Supported - , Flag "with-rtsopts" (HasArg setRtsOpts) Supported - , Flag "rtsopts" (NoArg (setDynFlag Opt_RtsOptsEnabled)) Supported - , Flag "no-rtsopts" (NoArg (unSetDynFlag Opt_RtsOptsEnabled)) Supported - , Flag "main-is" (SepArg setMainIs ) Supported - , Flag "haddock" (NoArg (setDynFlag Opt_Haddock)) Supported - , Flag "haddock-opts" (HasArg (upd . addHaddockOpts)) Supported - , Flag "hpcdir" (SepArg setOptHpcDir) Supported + , Flag "no-auto-link-packages" (NoArg (unSetDynFlag Opt_AutoLinkPackages)) + , Flag "no-hs-main" (NoArg (setDynFlag Opt_NoHsMain)) + , Flag "with-rtsopts" (HasArg setRtsOpts) + , Flag "rtsopts" (NoArg (setRtsOptsEnabled RtsOptsAll)) + , Flag "rtsopts=all" (NoArg (setRtsOptsEnabled RtsOptsAll)) + , Flag "rtsopts=some" (NoArg (setRtsOptsEnabled RtsOptsSafeOnly)) + , Flag "rtsopts=none" (NoArg (setRtsOptsEnabled RtsOptsNone)) + , Flag "no-rtsopts" (NoArg (setRtsOptsEnabled RtsOptsNone)) + , Flag "main-is" (SepArg setMainIs) + , Flag "haddock" (NoArg (setDynFlag Opt_Haddock)) + , Flag "haddock-opts" (hasArg addHaddockOpts) + , Flag "hpcdir" (SepArg setOptHpcDir) ------- recompilation checker -------------------------------------- - , Flag "recomp" (NoArg (unSetDynFlag Opt_ForceRecomp)) - (Deprecated "Use -fno-force-recomp instead") - , Flag "no-recomp" (NoArg (setDynFlag Opt_ForceRecomp)) - (Deprecated "Use -fforce-recomp instead") + , Flag "recomp" (NoArg (do { unSetDynFlag Opt_ForceRecomp + ; deprecate "Use -fno-force-recomp instead" })) + , Flag "no-recomp" (NoArg (do { setDynFlag Opt_ForceRecomp + ; deprecate "Use -fforce-recomp instead" })) ------ HsCpp opts --------------------------------------------------- - , Flag "D" (AnySuffix (upd . addOptP)) Supported - , Flag "U" (AnySuffix (upd . addOptP)) Supported + , Flag "D" (AnySuffix (upd . addOptP)) + , Flag "U" (AnySuffix (upd . addOptP)) ------- Include/Import Paths ---------------------------------------- - , Flag "I" (Prefix addIncludePath) Supported - , Flag "i" (OptPrefix addImportPath ) Supported + , Flag "I" (Prefix addIncludePath) + , Flag "i" (OptPrefix addImportPath) ------ Debugging ---------------------------------------------------- - , Flag "dstg-stats" (NoArg (setDynFlag Opt_StgStats)) Supported + , Flag "dstg-stats" (NoArg (setDynFlag Opt_StgStats)) , Flag "ddump-cmm" (setDumpFlag Opt_D_dump_cmm) - Supported + , Flag "ddump-raw-cmm" (setDumpFlag Opt_D_dump_raw_cmm) , Flag "ddump-cmmz" (setDumpFlag Opt_D_dump_cmmz) - Supported , Flag "ddump-cmmz-pretty" (setDumpFlag Opt_D_dump_cmmz_pretty) - Supported + , Flag "ddump-core-stats" (setDumpFlag Opt_D_dump_core_stats) , Flag "ddump-cps-cmm" (setDumpFlag Opt_D_dump_cps_cmm) - Supported , Flag "ddump-cvt-cmm" (setDumpFlag Opt_D_dump_cvt_cmm) - Supported , Flag "ddump-asm" (setDumpFlag Opt_D_dump_asm) - Supported , Flag "ddump-asm-native" (setDumpFlag Opt_D_dump_asm_native) - Supported , Flag "ddump-asm-liveness" (setDumpFlag Opt_D_dump_asm_liveness) - Supported , Flag "ddump-asm-coalesce" (setDumpFlag Opt_D_dump_asm_coalesce) - Supported , Flag "ddump-asm-regalloc" (setDumpFlag Opt_D_dump_asm_regalloc) - Supported , Flag "ddump-asm-conflicts" (setDumpFlag Opt_D_dump_asm_conflicts) - Supported - , Flag "ddump-asm-regalloc-stages" - (setDumpFlag Opt_D_dump_asm_regalloc_stages) - Supported + , Flag "ddump-asm-regalloc-stages" (setDumpFlag Opt_D_dump_asm_regalloc_stages) , Flag "ddump-asm-stats" (setDumpFlag Opt_D_dump_asm_stats) - Supported , Flag "ddump-asm-expanded" (setDumpFlag Opt_D_dump_asm_expanded) - Supported , Flag "ddump-llvm" (NoArg (do { setObjTarget HscLlvm ; setDumpFlag' Opt_D_dump_llvm})) - Supported , Flag "ddump-cpranal" (setDumpFlag Opt_D_dump_cpranal) - Supported , Flag "ddump-deriv" (setDumpFlag Opt_D_dump_deriv) - Supported , Flag "ddump-ds" (setDumpFlag Opt_D_dump_ds) - Supported , Flag "ddump-flatC" (setDumpFlag Opt_D_dump_flatC) - Supported , Flag "ddump-foreign" (setDumpFlag Opt_D_dump_foreign) - Supported , Flag "ddump-inlinings" (setDumpFlag Opt_D_dump_inlinings) - Supported , Flag "ddump-rule-firings" (setDumpFlag Opt_D_dump_rule_firings) - Supported + , Flag "ddump-rule-rewrites" (setDumpFlag Opt_D_dump_rule_rewrites) , Flag "ddump-occur-anal" (setDumpFlag Opt_D_dump_occur_anal) - Supported , Flag "ddump-parsed" (setDumpFlag Opt_D_dump_parsed) - Supported , Flag "ddump-rn" (setDumpFlag Opt_D_dump_rn) - Supported , Flag "ddump-simpl" (setDumpFlag Opt_D_dump_simpl) - Supported , Flag "ddump-simpl-iterations" (setDumpFlag Opt_D_dump_simpl_iterations) - Supported , Flag "ddump-simpl-phases" (OptPrefix setDumpSimplPhases) - Supported , Flag "ddump-spec" (setDumpFlag Opt_D_dump_spec) - Supported , Flag "ddump-prep" (setDumpFlag Opt_D_dump_prep) - Supported , Flag "ddump-stg" (setDumpFlag Opt_D_dump_stg) - Supported , Flag "ddump-stranal" (setDumpFlag Opt_D_dump_stranal) - Supported , Flag "ddump-tc" (setDumpFlag Opt_D_dump_tc) - Supported , Flag "ddump-types" (setDumpFlag Opt_D_dump_types) - Supported , Flag "ddump-rules" (setDumpFlag Opt_D_dump_rules) - Supported , Flag "ddump-cse" (setDumpFlag Opt_D_dump_cse) - Supported , Flag "ddump-worker-wrapper" (setDumpFlag Opt_D_dump_worker_wrapper) - Supported , Flag "ddump-rn-trace" (setDumpFlag Opt_D_dump_rn_trace) - Supported , Flag "ddump-if-trace" (setDumpFlag Opt_D_dump_if_trace) - Supported + , Flag "ddump-cs-trace" (setDumpFlag Opt_D_dump_cs_trace) , Flag "ddump-tc-trace" (setDumpFlag Opt_D_dump_tc_trace) - Supported + , Flag "ddump-vt-trace" (setDumpFlag Opt_D_dump_vt_trace) , Flag "ddump-splices" (setDumpFlag Opt_D_dump_splices) - Supported , Flag "ddump-rn-stats" (setDumpFlag Opt_D_dump_rn_stats) - Supported , Flag "ddump-opt-cmm" (setDumpFlag Opt_D_dump_opt_cmm) - Supported , Flag "ddump-simpl-stats" (setDumpFlag Opt_D_dump_simpl_stats) - Supported , Flag "ddump-bcos" (setDumpFlag Opt_D_dump_BCOs) - Supported , Flag "dsource-stats" (setDumpFlag Opt_D_source_stats) - Supported , Flag "dverbose-core2core" (NoArg (do { setVerbosity (Just 2) ; setVerboseCore2Core })) - Supported , Flag "dverbose-stg2stg" (setDumpFlag Opt_D_verbose_stg2stg) - Supported , Flag "ddump-hi" (setDumpFlag Opt_D_dump_hi) - Supported , Flag "ddump-minimal-imports" (setDumpFlag Opt_D_dump_minimal_imports) - Supported , Flag "ddump-vect" (setDumpFlag Opt_D_dump_vect) - Supported , Flag "ddump-hpc" (setDumpFlag Opt_D_dump_hpc) - Supported , Flag "ddump-mod-cycles" (setDumpFlag Opt_D_dump_mod_cycles) - Supported , Flag "ddump-view-pattern-commoning" (setDumpFlag Opt_D_dump_view_pattern_commoning) - Supported , Flag "ddump-to-file" (setDumpFlag Opt_DumpToFile) - 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 , Flag "dstg-lint" (NoArg (setDynFlag Opt_DoStgLinting)) - Supported , Flag "dcmm-lint" (NoArg (setDynFlag Opt_DoCmmLinting)) - Supported , Flag "dasm-lint" (NoArg (setDynFlag Opt_DoAsmLinting)) - Supported - , Flag "dshow-passes" - (NoArg (do forceRecompile - setVerbosity (Just 2))) - Supported + , Flag "dshow-passes" (NoArg (do forceRecompile + setVerbosity (Just 2))) , Flag "dfaststring-stats" (NoArg (setDynFlag Opt_D_faststring_stats)) - Supported - ------ Machine dependant (-m) stuff --------------------------- + ------ Coq-in-GHC --------------------------- + , Flag "ddump-proofs" (NoArg (setDynFlag Opt_D_dump_proofs)) + , Flag "ddump-coqpass" (NoArg (setDynFlag Opt_D_coqpass)) + , Flag "fcoqpass" (NoArg (setDynFlag Opt_F_coqpass)) + , Flag "fflatten" (NoArg (do { setDynFlag Opt_F_coqpass ; setDynFlag Opt_F_flatten })) + , Flag "funsafe-skolemize" (NoArg (do { setDynFlag Opt_F_coqpass ; setDynFlag Opt_F_flatten ; setDynFlag Opt_F_skolemize })) - , Flag "monly-2-regs" (NoArg (upd (\s -> s{stolen_x86_regs = 2}) )) - Supported - , Flag "monly-3-regs" (NoArg (upd (\s -> s{stolen_x86_regs = 3}) )) - Supported - , Flag "monly-4-regs" (NoArg (upd (\s -> s{stolen_x86_regs = 4}) )) - Supported + ------ Machine dependant (-m) stuff --------------------------- - , Flag "msse2" (NoArg (setDynFlag Opt_SSE2)) - Supported + , Flag "monly-2-regs" (NoArg (addWarn "The -monly-2-regs flag does nothing; it will be removed in a future GHC release")) + , Flag "monly-3-regs" (NoArg (addWarn "The -monly-3-regs flag does nothing; it will be removed in a future GHC release")) + , Flag "monly-4-regs" (NoArg (addWarn "The -monly-4-regs flag does nothing; it will be removed in a future GHC release")) + , Flag "msse2" (NoArg (setDynFlag Opt_SSE2)) ------ Warning opts ------------------------------------------------- , Flag "W" (NoArg (mapM_ setDynFlag minusWOpts)) - Supported , Flag "Werror" (NoArg (setDynFlag Opt_WarnIsError)) - Supported , Flag "Wwarn" (NoArg (unSetDynFlag Opt_WarnIsError)) - Supported , Flag "Wall" (NoArg (mapM_ setDynFlag minusWallOpts)) - Supported - , Flag "Wnot" (NoArg (mapM_ unSetDynFlag minusWallOpts)) - (Deprecated "Use -w instead") + , Flag "Wnot" (NoArg (do { mapM_ unSetDynFlag minusWallOpts + ; deprecate "Use -w instead" })) , Flag "w" (NoArg (mapM_ unSetDynFlag minuswRemovesOpts)) - Supported ------ Optimisation flags ------------------------------------------ - , Flag "O" (NoArg (upd (setOptLevel 1))) Supported - , Flag "Onot" (NoArg (upd (setOptLevel 0))) - (Deprecated "Use -O0 instead") - , Flag "Odph" (NoArg (upd setDPHOpt)) Supported + , Flag "O" (noArg (setOptLevel 1)) + , Flag "Onot" (noArgDF (setOptLevel 0) "Use -O0 instead") + , Flag "Odph" (noArg setDPHOpt) , Flag "O" (OptIntSuffix (\mb_n -> upd (setOptLevel (mb_n `orElse` 1)))) - Supported -- If the number is missing, use 1 - , Flag "fsimplifier-phases" - (IntSuffix (\n -> upd (\dfs -> dfs{ simplPhases = n }))) - Supported - , Flag "fmax-simplifier-iterations" - (IntSuffix (\n -> upd (\dfs -> dfs{ maxSimplIterations = n }))) - Supported - - , Flag "fspec-constr-threshold" - (IntSuffix (\n -> upd (\dfs -> dfs{ specConstrThreshold = Just n }))) - Supported - , Flag "fno-spec-constr-threshold" - (NoArg (upd (\dfs -> dfs{ specConstrThreshold = Nothing }))) - Supported - , Flag "fspec-constr-count" - (IntSuffix (\n -> upd (\dfs -> dfs{ specConstrCount = Just n }))) - Supported - , Flag "fno-spec-constr-count" - (NoArg (upd (\dfs -> dfs{ specConstrCount = Nothing }))) - Supported - , Flag "fliberate-case-threshold" - (IntSuffix (\n -> upd (\dfs -> dfs{ liberateCaseThreshold = Just n }))) - Supported - , Flag "fno-liberate-case-threshold" - (NoArg (upd (\dfs -> dfs{ liberateCaseThreshold = Nothing }))) - Supported - - , Flag "frule-check" - (SepArg (\s -> upd (\dfs -> dfs{ ruleCheck = Just s }))) - Supported - , Flag "fcontext-stack" - (IntSuffix $ \n -> upd $ \dfs -> dfs{ ctxtStkDepth = n }) - Supported - - , Flag "fstrictness-before" - (IntSuffix (\n -> upd (\dfs -> dfs{ strictnessBefore = n : strictnessBefore dfs }))) - Supported + , Flag "fsimplifier-phases" (intSuffix (\n d -> d{ simplPhases = n })) + , Flag "fmax-simplifier-iterations" (intSuffix (\n d -> d{ maxSimplIterations = n })) + , Flag "fspec-constr-threshold" (intSuffix (\n d -> d{ specConstrThreshold = Just n })) + , Flag "fno-spec-constr-threshold" (noArg (\d -> d{ specConstrThreshold = Nothing })) + , Flag "fspec-constr-count" (intSuffix (\n d -> d{ specConstrCount = Just n })) + , Flag "fno-spec-constr-count" (noArg (\d -> d{ specConstrCount = Nothing })) + , Flag "fliberate-case-threshold" (intSuffix (\n d -> d{ liberateCaseThreshold = Just n })) + , Flag "fno-liberate-case-threshold" (noArg (\d -> d{ liberateCaseThreshold = Nothing })) + , Flag "frule-check" (SepArg (\s -> upd (\d -> d{ ruleCheck = Just s }))) + , Flag "fcontext-stack" (intSuffix (\n d -> d{ ctxtStkDepth = n })) + , Flag "fstrictness-before" (intSuffix (\n d -> d{ strictnessBefore = n : strictnessBefore d })) + , Flag "ffloat-lam-args" (intSuffix (\n d -> d{ floatLamArgs = Just n })) + , Flag "ffloat-all-lams" (noArg (\d -> d{ floatLamArgs = Nothing })) ------ 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 + , Flag "fauto-sccs-on-all-toplevs" (NoArg (setDynFlag Opt_AutoSccsOnAllToplevs)) + , Flag "auto-all" (NoArg (setDynFlag Opt_AutoSccsOnAllToplevs)) + , Flag "no-auto-all" (NoArg (unSetDynFlag Opt_AutoSccsOnAllToplevs)) + , Flag "fauto-sccs-on-exported-toplevs" (NoArg (setDynFlag Opt_AutoSccsOnExportedToplevs)) + , Flag "auto" (NoArg (setDynFlag Opt_AutoSccsOnExportedToplevs)) + , Flag "no-auto" (NoArg (unSetDynFlag Opt_AutoSccsOnExportedToplevs)) + , Flag "fauto-sccs-on-individual-cafs" (NoArg (setDynFlag Opt_AutoSccsOnIndividualCafs)) + , Flag "caf-all" (NoArg (setDynFlag Opt_AutoSccsOnIndividualCafs)) + , Flag "no-caf-all" (NoArg (unSetDynFlag Opt_AutoSccsOnIndividualCafs)) ------ DPH flags ---------------------------------------------------- - , Flag "fdph-seq" - (NoArg (setDPHBackend DPHSeq)) - Supported - , Flag "fdph-par" - (NoArg (setDPHBackend DPHPar)) - Supported - , Flag "fdph-this" - (NoArg (setDPHBackend DPHThis)) - Supported + , Flag "fdph-seq" (NoArg (setDPHBackend DPHSeq)) + , Flag "fdph-par" (NoArg (setDPHBackend DPHPar)) + , Flag "fdph-this" (NoArg (setDPHBackend DPHThis)) + , Flag "fdph-none" (NoArg (setDPHBackend DPHNone)) ------ Compiler flags ----------------------------------------------- - , Flag "fasm" (NoArg (setObjTarget HscAsm)) Supported - , Flag "fvia-c" (NoArg (setObjTarget HscC)) - (Deprecated "The -fvia-c flag will be removed in a future GHC release") - , Flag "fvia-C" (NoArg (setObjTarget HscC)) - (Deprecated "The -fvia-C flag will be removed in a future GHC release") - , Flag "fllvm" (NoArg (setObjTarget HscLlvm)) Supported + , Flag "fasm" (NoArg (setObjTarget HscAsm)) + , Flag "fvia-c" (NoArg + (addWarn "The -fvia-c flag does nothing; it will be removed in a future GHC release")) + , Flag "fvia-C" (NoArg + (addWarn "The -fvia-C flag does nothing; it will be removed in a future GHC release")) + , Flag "fllvm" (NoArg (setObjTarget HscLlvm)) , Flag "fno-code" (NoArg (do upd $ \d -> d{ ghcLink=NoLink } setTarget HscNothing)) - Supported - , Flag "fbyte-code" (NoArg (setTarget HscInterpreted)) Supported - , Flag "fobject-code" (NoArg (setTarget defaultHscTarget)) Supported - - , Flag "fglasgow-exts" (NoArg enableGlasgowExts) - Supported - , Flag "fno-glasgow-exts" (NoArg disableGlasgowExts) - Supported + , Flag "fbyte-code" (NoArg (setTarget HscInterpreted)) + , Flag "fobject-code" (NoArg (setTarget defaultHscTarget)) + , Flag "fglasgow-exts" (NoArg (enableGlasgowExts >> deprecate "Use individual extensions instead")) + , Flag "fno-glasgow-exts" (NoArg (disableGlasgowExts >> deprecate "Use individual extensions instead")) ] - ++ map (mkFlag True "f" setDynFlag ) fFlags - ++ map (mkFlag False "fno-" unSetDynFlag) fFlags - ++ map (mkFlag True "f" setExtensionFlag ) fLangFlags - ++ map (mkFlag False "fno-" unSetExtensionFlag) fLangFlags - ++ map (mkFlag True "X" setExtensionFlag ) xFlags - ++ map (mkFlag False "XNo" unSetExtensionFlag) xFlags - -package_flags :: [Flag DynP] + ++ map (mkFlag turnOn "f" setDynFlag ) fFlags + ++ map (mkFlag turnOff "fno-" unSetDynFlag) fFlags + ++ map (mkFlag turnOn "f" setExtensionFlag ) fLangFlags + ++ map (mkFlag turnOff "fno-" unSetExtensionFlag) fLangFlags + ++ map (mkFlag turnOn "X" setExtensionFlag ) xFlags + ++ map (mkFlag turnOff "XNo" unSetExtensionFlag) xFlags + ++ map (mkFlag turnOn "X" setLanguage) languageFlags + +package_flags :: [Flag (CmdLineP DynFlags)] package_flags = [ ------- Packages ---------------------------------------------------- - Flag "package-conf" (HasArg extraPkgConf_) Supported + Flag "package-conf" (HasArg extraPkgConf_) , Flag "no-user-package-conf" (NoArg (unSetDynFlag Opt_ReadUserPackageConf)) - Supported - , Flag "package-name" (HasArg (upd . setPackageName)) Supported - , Flag "package-id" (HasArg exposePackageId) 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 "package-name" (hasArg setPackageName) + , Flag "package-id" (HasArg exposePackageId) + , Flag "package" (HasArg exposePackage) + , Flag "hide-package" (HasArg hidePackage) + , Flag "hide-all-packages" (NoArg (setDynFlag Opt_HideAllPackages)) + , Flag "ignore-package" (HasArg ignorePackage) + , Flag "syslib" (HasArg (\s -> do { exposePackage s + ; deprecate "Use -package instead" })) ] -mkFlag :: Bool -- ^ True <=> it should be turned on +type TurnOnFlag = Bool -- True <=> we are turning the flag on + -- False <=> we are turning the flag off +turnOn :: TurnOnFlag; turnOn = True +turnOff :: TurnOnFlag; turnOff = False + +type FlagSpec flag + = ( String -- Flag in string form + , flag -- Flag in internal form + , TurnOnFlag -> DynP ()) -- Extra action to run when the flag is found + -- Typically, emit a warning or error + +mkFlag :: TurnOnFlag -- ^ True <=> it should be turned on -> String -- ^ The flag prefix - -> (flag -> DynP ()) - -> (String, flag, Bool -> Deprecated) - -> Flag DynP -mkFlag turnOn flagPrefix f (name, flag, deprecated) - = Flag (flagPrefix ++ name) (NoArg (f flag)) (deprecated turnOn) + -> (flag -> DynP ()) -- ^ What to do when the flag is found + -> FlagSpec flag -- ^ Specification of this particular flag + -> Flag (CmdLineP DynFlags) +mkFlag turn_on flagPrefix f (name, flag, extra_action) + = Flag (flagPrefix ++ name) (NoArg (f flag >> extra_action turn_on)) -deprecatedForExtension :: String -> Bool -> Deprecated +deprecatedForExtension :: String -> TurnOnFlag -> DynP () deprecatedForExtension lang turn_on - = Deprecated ("use -X" ++ flag ++ " or pragma {-# LANGUAGE " ++ flag ++ " #-} instead") + = deprecate ("use -X" ++ flag ++ " or pragma {-# LANGUAGE " ++ flag ++ " #-} instead") where flag | turn_on = lang | otherwise = "No"++lang -useInstead :: String -> Bool -> Deprecated +useInstead :: String -> TurnOnFlag -> DynP () useInstead flag turn_on - = Deprecated ("Use -f" ++ no ++ flag ++ " instead") + = deprecate ("Use -f" ++ no ++ flag ++ " instead") where no = if turn_on then "" else "no-" +nop :: TurnOnFlag -> DynP () +nop _ = return () + -- | These @-f\@ flags can all be reversed with @-fno-\@ -fFlags :: [(String, DynFlag, Bool -> Deprecated)] +fFlags :: [FlagSpec DynFlag] fFlags = [ - ( "warn-dodgy-foreign-imports", Opt_WarnDodgyForeignImports, const Supported ), - ( "warn-dodgy-exports", Opt_WarnDodgyExports, 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-import-lists", Opt_WarnMissingImportList, 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 ), - ( "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 ), - ( "warn-alternative-layout-rule-transitional", Opt_WarnAlternativeLayoutRuleTransitional, const Supported ), - ( "print-explicit-foralls", Opt_PrintExplicitForalls, const Supported ), - ( "strictness", Opt_Strictness, const Supported ), - ( "specialise", Opt_Specialise, const Supported ), - ( "float-in", Opt_FloatIn, 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 ), - ( "expose-all-unfoldings", Opt_ExposeAllUnfoldings, 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 ), - ( "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 ), + ( "warn-dodgy-foreign-imports", Opt_WarnDodgyForeignImports, nop ), + ( "warn-dodgy-exports", Opt_WarnDodgyExports, nop ), + ( "warn-dodgy-imports", Opt_WarnDodgyImports, nop ), + ( "warn-duplicate-exports", Opt_WarnDuplicateExports, nop ), + ( "warn-hi-shadowing", Opt_WarnHiShadows, nop ), + ( "warn-implicit-prelude", Opt_WarnImplicitPrelude, nop ), + ( "warn-incomplete-patterns", Opt_WarnIncompletePatterns, nop ), + ( "warn-incomplete-uni-patterns", Opt_WarnIncompleteUniPatterns, nop ), + ( "warn-incomplete-record-updates", Opt_WarnIncompletePatternsRecUpd, nop ), + ( "warn-missing-fields", Opt_WarnMissingFields, nop ), + ( "warn-missing-import-lists", Opt_WarnMissingImportList, nop ), + ( "warn-missing-methods", Opt_WarnMissingMethods, nop ), + ( "warn-missing-signatures", Opt_WarnMissingSigs, nop ), + ( "warn-missing-local-sigs", Opt_WarnMissingLocalSigs, nop ), + ( "warn-name-shadowing", Opt_WarnNameShadowing, nop ), + ( "warn-overlapping-patterns", Opt_WarnOverlappingPatterns, nop ), + ( "warn-type-defaults", Opt_WarnTypeDefaults, nop ), + ( "warn-monomorphism-restriction", Opt_WarnMonomorphism, nop ), + ( "warn-unused-binds", Opt_WarnUnusedBinds, nop ), + ( "warn-unused-imports", Opt_WarnUnusedImports, nop ), + ( "warn-unused-matches", Opt_WarnUnusedMatches, nop ), + ( "warn-warnings-deprecations", Opt_WarnWarningsDeprecations, nop ), + ( "warn-deprecations", Opt_WarnWarningsDeprecations, nop ), + ( "warn-deprecated-flags", Opt_WarnDeprecatedFlags, nop ), + ( "warn-orphans", Opt_WarnOrphans, nop ), + ( "warn-identities", Opt_WarnIdentities, nop ), + ( "warn-auto-orphans", Opt_WarnAutoOrphans, nop ), + ( "warn-tabs", Opt_WarnTabs, nop ), + ( "warn-unrecognised-pragmas", Opt_WarnUnrecognisedPragmas, nop ), + ( "warn-lazy-unlifted-bindings", Opt_WarnLazyUnliftedBindings, nop), + ( "warn-unused-do-bind", Opt_WarnUnusedDoBind, nop ), + ( "warn-wrong-do-bind", Opt_WarnWrongDoBind, nop ), + ( "warn-alternative-layout-rule-transitional", Opt_WarnAlternativeLayoutRuleTransitional, nop ), + ( "print-explicit-foralls", Opt_PrintExplicitForalls, nop ), + ( "strictness", Opt_Strictness, nop ), + ( "specialise", Opt_Specialise, nop ), + ( "float-in", Opt_FloatIn, nop ), + ( "static-argument-transformation", Opt_StaticArgumentTransformation, nop ), + ( "full-laziness", Opt_FullLaziness, nop ), + ( "liberate-case", Opt_LiberateCase, nop ), + ( "spec-constr", Opt_SpecConstr, nop ), + ( "cse", Opt_CSE, nop ), + ( "ignore-interface-pragmas", Opt_IgnoreInterfacePragmas, nop ), + ( "omit-interface-pragmas", Opt_OmitInterfacePragmas, nop ), + ( "expose-all-unfoldings", Opt_ExposeAllUnfoldings, nop ), + ( "do-lambda-eta-expansion", Opt_DoLambdaEtaExpansion, nop ), + ( "ignore-asserts", Opt_IgnoreAsserts, nop ), + ( "do-eta-reduction", Opt_DoEtaReduction, nop ), + ( "case-merge", Opt_CaseMerge, nop ), + ( "unbox-strict-fields", Opt_UnboxStrictFields, nop ), + ( "method-sharing", Opt_MethodSharing, + \_ -> deprecate "doesn't do anything any more"), + -- Remove altogether in GHC 7.2 + ( "dicts-cheap", Opt_DictsCheap, nop ), + ( "excess-precision", Opt_ExcessPrecision, nop ), + ( "eager-blackholing", Opt_EagerBlackHoling, nop ), + ( "print-bind-result", Opt_PrintBindResult, nop ), + ( "force-recomp", Opt_ForceRecomp, nop ), + ( "hpc-no-auto", Opt_Hpc_No_Auto, nop ), ( "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 ), - ( "gen-manifest", Opt_GenManifest, const Supported ), - ( "embed-manifest", Opt_EmbedManifest, const Supported ), - ( "ext-core", Opt_EmitExternalCore, const Supported ), - ( "shared-implib", Opt_SharedImplib, const Supported ), - ( "building-cabal-package", Opt_BuildingCabalPackage, const Supported ), - ( "implicit-import-qualified", Opt_ImplicitImportQualified, const Supported ) + ( "enable-rewrite-rules", Opt_EnableRewriteRules, nop ), + ( "break-on-exception", Opt_BreakOnException, nop ), + ( "break-on-error", Opt_BreakOnError, nop ), + ( "print-evld-with-show", Opt_PrintEvldWithShow, nop ), + ( "print-bind-contents", Opt_PrintBindContents, nop ), + ( "run-cps", Opt_RunCPS, nop ), + ( "run-cpsz", Opt_RunCPSZ, nop ), + ( "new-codegen", Opt_TryNewCodeGen, nop ), + ( "convert-to-zipper-and-back", Opt_ConvertToZipCfgAndBack, nop ), + ( "vectorise", Opt_Vectorise, nop ), + ( "regs-graph", Opt_RegsGraph, nop ), + ( "regs-iterative", Opt_RegsIterative, nop ), + ( "gen-manifest", Opt_GenManifest, nop ), + ( "embed-manifest", Opt_EmbedManifest, nop ), + ( "ext-core", Opt_EmitExternalCore, nop ), + ( "shared-implib", Opt_SharedImplib, nop ), + ( "ghci-sandbox", Opt_GhciSandbox, nop ), + ( "helpful-errors", Opt_HelpfulErrors, nop ), + ( "building-cabal-package", Opt_BuildingCabalPackage, nop ), + ( "implicit-import-qualified", Opt_ImplicitImportQualified, nop ) ] -- | These @-f\@ flags can all be reversed with @-fno-\@ -fLangFlags :: [(String, ExtensionFlag, Bool -> Deprecated)] +fLangFlags :: [FlagSpec ExtensionFlag] fLangFlags = [ ( "th", Opt_TemplateHaskell, - deprecatedForExtension "TemplateHaskell" ), + deprecatedForExtension "TemplateHaskell" >> checkTemplateHaskellOk ), ( "fi", Opt_ForeignFunctionInterface, deprecatedForExtension "ForeignFunctionInterface" ), ( "ffi", Opt_ForeignFunctionInterface, @@ -1677,8 +1586,10 @@ fLangFlags = [ deprecatedForExtension "ImplicitParams" ), ( "scoped-type-variables", Opt_ScopedTypeVariables, deprecatedForExtension "ScopedTypeVariables" ), - ( "parr", Opt_PArr, - deprecatedForExtension "PArr" ), + ( "parr", Opt_ParallelArrays, + deprecatedForExtension "ParallelArrays" ), + ( "PArr", Opt_ParallelArrays, + deprecatedForExtension "ParallelArrays" ), ( "allow-overlapping-instances", Opt_OverlappingInstances, deprecatedForExtension "OverlappingInstances" ), ( "allow-undecidable-instances", Opt_UndecidableInstances, @@ -1687,125 +1598,259 @@ fLangFlags = [ deprecatedForExtension "IncoherentInstances" ) ] +supportedLanguages :: [String] +supportedLanguages = [ name | (name, _, _) <- languageFlags ] + supportedExtensions :: [String] supportedExtensions = [ name' | (name, _, _) <- xFlags, name' <- [name, "No" ++ name] ] --- This may contain duplicates -extensionOptions :: [ExtensionFlag] -extensionOptions = [ langFlag | (_, langFlag, _) <- xFlags ] +supportedLanguagesAndExtensions :: [String] +supportedLanguagesAndExtensions = supportedLanguages ++ supportedExtensions + +-- | These -X flags cannot be reversed with -XNo +languageFlags :: [FlagSpec Language] +languageFlags = [ + ( "Haskell98", Haskell98, nop ), + ( "Haskell2010", Haskell2010, nop ) + ] -- | These -X flags can all be reversed with -XNo -xFlags :: [(String, ExtensionFlag, Bool -> Deprecated)] +xFlags :: [FlagSpec ExtensionFlag] xFlags = [ - ( "CPP", Opt_Cpp, const Supported ), - ( "PostfixOperators", Opt_PostfixOperators, const Supported ), - ( "TupleSections", Opt_TupleSections, 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 ), - ( "GHCForeignImportPrim", Opt_GHCForeignImportPrim, const Supported ), - ( "LiberalTypeSynonyms", Opt_LiberalTypeSynonyms, const Supported ), - ( "Rank2Types", Opt_Rank2Types, const Supported ), - ( "RankNTypes", Opt_RankNTypes, const Supported ), - ( "ImpredicativeTypes", Opt_ImpredicativeTypes, - const $ Deprecated "impredicative polymorphism will be simplified or removed in GHC 6.14" ), - ( "TypeOperators", Opt_TypeOperators, const Supported ), + ( "CPP", Opt_Cpp, nop ), + ( "PostfixOperators", Opt_PostfixOperators, nop ), + ( "TupleSections", Opt_TupleSections, nop ), + ( "PatternGuards", Opt_PatternGuards, nop ), + ( "UnicodeSyntax", Opt_UnicodeSyntax, nop ), + ( "MagicHash", Opt_MagicHash, nop ), + ( "PolymorphicComponents", Opt_PolymorphicComponents, nop ), + ( "ExistentialQuantification", Opt_ExistentialQuantification, nop ), + ( "KindSignatures", Opt_KindSignatures, nop ), + ( "EmptyDataDecls", Opt_EmptyDataDecls, nop ), + ( "ParallelListComp", Opt_ParallelListComp, nop ), + ( "TransformListComp", Opt_TransformListComp, nop ), + ( "ForeignFunctionInterface", Opt_ForeignFunctionInterface, nop ), + ( "UnliftedFFITypes", Opt_UnliftedFFITypes, nop ), + ( "GHCForeignImportPrim", Opt_GHCForeignImportPrim, nop ), + ( "LiberalTypeSynonyms", Opt_LiberalTypeSynonyms, nop ), + ( "Rank2Types", Opt_Rank2Types, nop ), + ( "RankNTypes", Opt_RankNTypes, nop ), + ( "ImpredicativeTypes", Opt_ImpredicativeTypes, nop), + ( "TypeOperators", Opt_TypeOperators, nop ), ( "RecursiveDo", Opt_RecursiveDo, deprecatedForExtension "DoRec"), - ( "DoRec", Opt_DoRec, 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, const Supported ), - ( "RecordWildCards", Opt_RecordWildCards, const Supported ), - ( "NamedFieldPuns", Opt_RecordPuns, const Supported ), + ( "DoRec", Opt_DoRec, nop ), + ( "Arrows", Opt_Arrows, nop ), + ( "ModalTypes", Opt_ModalTypes, nop ), + ( "ParallelArrays", Opt_ParallelArrays, nop ), + ( "TemplateHaskell", Opt_TemplateHaskell, checkTemplateHaskellOk ), + ( "QuasiQuotes", Opt_QuasiQuotes, nop ), + ( "Generics", Opt_Generics, nop ), + ( "ImplicitPrelude", Opt_ImplicitPrelude, nop ), + ( "RecordWildCards", Opt_RecordWildCards, nop ), + ( "NamedFieldPuns", Opt_RecordPuns, nop ), ( "RecordPuns", Opt_RecordPuns, deprecatedForExtension "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, const Supported ), - -- On by default: - ( "NPlusKPatterns", Opt_NPlusKPatterns, const Supported ), - -- On by default (which is not strictly H98): - ( "MonoPatBinds", Opt_MonoPatBinds, const Supported ), - ( "ExplicitForAll", Opt_ExplicitForAll, const Supported ), - ( "AlternativeLayoutRule", Opt_AlternativeLayoutRule, const Supported ), - ( "AlternativeLayoutRuleTransitional",Opt_AlternativeLayoutRuleTransitional, const Supported ), - -- On by default: - ( "DatatypeContexts", Opt_DatatypeContexts, const Supported ), - ( "MonoLocalBinds", Opt_MonoLocalBinds, const Supported ), - ( "RelaxedPolyRec", Opt_RelaxedPolyRec, const Supported ), - ( "ExtendedDefaultRules", Opt_ExtendedDefaultRules, const Supported ), - ( "ImplicitParams", Opt_ImplicitParams, const Supported ), - ( "ScopedTypeVariables", Opt_ScopedTypeVariables, const Supported ), + ( "DisambiguateRecordFields", Opt_DisambiguateRecordFields, nop ), + ( "OverloadedStrings", Opt_OverloadedStrings, nop ), + ( "GADTs", Opt_GADTs, nop ), + ( "GADTSyntax", Opt_GADTSyntax, nop ), + ( "ViewPatterns", Opt_ViewPatterns, nop ), + ( "TypeFamilies", Opt_TypeFamilies, nop ), + ( "BangPatterns", Opt_BangPatterns, nop ), + ( "MonomorphismRestriction", Opt_MonomorphismRestriction, nop ), + ( "NPlusKPatterns", Opt_NPlusKPatterns, nop ), + ( "DoAndIfThenElse", Opt_DoAndIfThenElse, nop ), + ( "RebindableSyntax", Opt_RebindableSyntax, nop ), + ( "MonoPatBinds", Opt_MonoPatBinds, nop ), + ( "ExplicitForAll", Opt_ExplicitForAll, nop ), + ( "AlternativeLayoutRule", Opt_AlternativeLayoutRule, nop ), + ( "AlternativeLayoutRuleTransitional",Opt_AlternativeLayoutRuleTransitional, nop ), + ( "DatatypeContexts", Opt_DatatypeContexts, nop ), + ( "NondecreasingIndentation", Opt_NondecreasingIndentation, nop ), + ( "RelaxedLayout", Opt_RelaxedLayout, nop ), + ( "MonoLocalBinds", Opt_MonoLocalBinds, nop ), + ( "RelaxedPolyRec", Opt_RelaxedPolyRec, + \ turn_on -> if not turn_on + then deprecate "You can't turn off RelaxedPolyRec any more" + else return () ), + ( "ExtendedDefaultRules", Opt_ExtendedDefaultRules, nop ), + ( "ImplicitParams", Opt_ImplicitParams, nop ), + ( "ScopedTypeVariables", Opt_ScopedTypeVariables, nop ), ( "PatternSignatures", Opt_ScopedTypeVariables, deprecatedForExtension "ScopedTypeVariables" ), - ( "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 ), - ( "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 $ Deprecated "The new qualified operator syntax was rejected by Haskell'" ) + ( "UnboxedTuples", Opt_UnboxedTuples, nop ), + ( "StandaloneDeriving", Opt_StandaloneDeriving, nop ), + ( "DeriveDataTypeable", Opt_DeriveDataTypeable, nop ), + ( "DeriveFunctor", Opt_DeriveFunctor, nop ), + ( "DeriveTraversable", Opt_DeriveTraversable, nop ), + ( "DeriveFoldable", Opt_DeriveFoldable, nop ), + ( "TypeSynonymInstances", Opt_TypeSynonymInstances, nop ), + ( "FlexibleContexts", Opt_FlexibleContexts, nop ), + ( "FlexibleInstances", Opt_FlexibleInstances, nop ), + ( "ConstrainedClassMethods", Opt_ConstrainedClassMethods, nop ), + ( "MultiParamTypeClasses", Opt_MultiParamTypeClasses, nop ), + ( "FunctionalDependencies", Opt_FunctionalDependencies, nop ), + ( "GeneralizedNewtypeDeriving", Opt_GeneralizedNewtypeDeriving, nop ), + ( "OverlappingInstances", Opt_OverlappingInstances, nop ), + ( "UndecidableInstances", Opt_UndecidableInstances, nop ), + ( "IncoherentInstances", Opt_IncoherentInstances, nop ), + ( "PackageImports", Opt_PackageImports, nop ) ] -impliedFlags :: [(ExtensionFlag, ExtensionFlag)] +defaultFlags :: [DynFlag] +defaultFlags + = [ Opt_AutoLinkPackages, + Opt_ReadUserPackageConf, + + Opt_SharedImplib, + +#if GHC_DEFAULT_NEW_CODEGEN + Opt_TryNewCodeGen, +#endif + + Opt_GenManifest, + Opt_EmbedManifest, + Opt_PrintBindContents, + Opt_GhciSandbox, + Opt_HelpfulErrors + ] + + ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] + -- The default -O0 options + + ++ standardWarnings + +impliedFlags :: [(ExtensionFlag, TurnOnFlag, ExtensionFlag)] impliedFlags - = [ (Opt_RankNTypes, Opt_ExplicitForAll) - , (Opt_Rank2Types, Opt_ExplicitForAll) - , (Opt_ScopedTypeVariables, Opt_ExplicitForAll) - , (Opt_LiberalTypeSynonyms, Opt_ExplicitForAll) - , (Opt_ExistentialQuantification, Opt_ExplicitForAll) - , (Opt_PolymorphicComponents, Opt_ExplicitForAll) - - , (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 + = [ (Opt_RankNTypes, turnOn, Opt_ExplicitForAll) + , (Opt_Rank2Types, turnOn, Opt_ExplicitForAll) + , (Opt_ScopedTypeVariables, turnOn, Opt_ExplicitForAll) + , (Opt_LiberalTypeSynonyms, turnOn, Opt_ExplicitForAll) + , (Opt_ExistentialQuantification, turnOn, Opt_ExplicitForAll) + , (Opt_PolymorphicComponents, turnOn, Opt_ExplicitForAll) + , (Opt_FlexibleInstances, turnOn, Opt_TypeSynonymInstances) + , (Opt_FunctionalDependencies, turnOn, Opt_MultiParamTypeClasses) + + , (Opt_ModalTypes, turnOn, Opt_RankNTypes) + , (Opt_ModalTypes, turnOn, Opt_ExplicitForAll) + --, (Opt_ModalTypes, turnOn, Opt_RebindableSyntax) + , (Opt_ModalTypes, turnOff, Opt_MonomorphismRestriction) + + , (Opt_RebindableSyntax, turnOff, Opt_ImplicitPrelude) -- NB: turn off! + + , (Opt_GADTs, turnOn, Opt_GADTSyntax) + , (Opt_GADTs, turnOn, Opt_MonoLocalBinds) + , (Opt_TypeFamilies, turnOn, Opt_MonoLocalBinds) + + , (Opt_TypeFamilies, turnOn, 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) + , (Opt_ImpredicativeTypes, turnOn, Opt_RankNTypes) -- Record wild-cards implies field disambiguation -- Otherwise if you write (C {..}) you may well get -- stuff like " 'a' not in scope ", which is a bit silly -- if the compiler has just filled in field 'a' of constructor 'C' - , (Opt_RecordWildCards, Opt_DisambiguateRecordFields) + , (Opt_RecordWildCards, turnOn, Opt_DisambiguateRecordFields) + + , (Opt_ParallelArrays, turnOn, Opt_ParallelListComp) ] +optLevelFlags :: [([Int], DynFlag)] +optLevelFlags + = [ ([0], Opt_IgnoreInterfacePragmas) + , ([0], Opt_OmitInterfacePragmas) + + , ([1,2], Opt_IgnoreAsserts) + , ([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) + , ([1,2], Opt_CSE) + , ([1,2], Opt_FullLaziness) + , ([1,2], Opt_Specialise) + , ([1,2], Opt_FloatIn) + + , ([2], Opt_LiberateCase) + , ([2], Opt_SpecConstr) + , ([2], Opt_RegsGraph) + +-- , ([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: + -- we want to make sure that the bindings for data + -- constructors are eta-expanded. This is probably + -- a good thing anyway, but it seems fragile. + ] + +-- ----------------------------------------------------------------------------- +-- Standard sets of warning options + +standardWarnings :: [DynFlag] +standardWarnings + = [ Opt_WarnWarningsDeprecations, + Opt_WarnDeprecatedFlags, + Opt_WarnUnrecognisedPragmas, + Opt_WarnOverlappingPatterns, + Opt_WarnMissingFields, + Opt_WarnMissingMethods, + Opt_WarnDuplicateExports, + Opt_WarnLazyUnliftedBindings, + Opt_WarnDodgyForeignImports, + Opt_WarnWrongDoBind, + Opt_WarnAlternativeLayoutRuleTransitional + ] + +minusWOpts :: [DynFlag] +-- Things you get with -W +minusWOpts + = standardWarnings ++ + [ Opt_WarnUnusedBinds, + Opt_WarnUnusedMatches, + Opt_WarnUnusedImports, + Opt_WarnIncompletePatterns, + Opt_WarnDodgyExports, + Opt_WarnDodgyImports + ] + +minusWallOpts :: [DynFlag] +-- Things you get with -Wall +minusWallOpts + = minusWOpts ++ + [ Opt_WarnTypeDefaults, + Opt_WarnNameShadowing, + Opt_WarnMissingSigs, + Opt_WarnHiShadows, + Opt_WarnOrphans, + Opt_WarnUnusedDoBind + ] + +minuswRemovesOpts :: [DynFlag] +-- minuswRemovesOpts should be every warning option +minuswRemovesOpts + = minusWallOpts ++ + [Opt_WarnTabs, + Opt_WarnIncompletePatternsRecUpd, + Opt_WarnIncompleteUniPatterns, + Opt_WarnMonomorphism, + Opt_WarnUnrecognisedPragmas, + Opt_WarnAutoOrphans, + Opt_WarnImplicitPrelude + ] + enableGlasgowExts :: DynP () enableGlasgowExts = do setDynFlag Opt_PrintExplicitForalls mapM_ setExtensionFlag glasgowExtsFlags @@ -1818,7 +1863,6 @@ glasgowExtsFlags :: [ExtensionFlag] glasgowExtsFlags = [ Opt_ForeignFunctionInterface , Opt_UnliftedFFITypes - , Opt_GADTs , Opt_ImplicitParams , Opt_ScopedTypeVariables , Opt_UnboxedTuples @@ -1846,104 +1890,93 @@ glasgowExtsFlags = [ , Opt_ParallelListComp , Opt_EmptyDataDecls , Opt_KindSignatures - , Opt_GeneralizedNewtypeDeriving - , Opt_TypeFamilies ] + , Opt_GeneralizedNewtypeDeriving ] --- ----------------------------------------------------------------------------- --- Parsing the dynamic flags. +#ifdef GHCI +-- Consult the RTS to find whether GHC itself has been built profiled +-- If so, you can't use Template Haskell +foreign import ccall unsafe "rts_isProfiled" rtsIsProfiledIO :: IO CInt --- | 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 +rtsIsProfiled :: Bool +rtsIsProfiled = unsafePerformIO rtsIsProfiledIO /= 0 +#endif --- | 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 +checkTemplateHaskellOk :: Bool -> DynP () +#ifdef GHCI +checkTemplateHaskellOk turn_on + | turn_on && rtsIsProfiled + = addErr "You can't use Template Haskell with a profiled compiler" + | otherwise + = return () +#else +-- In stage 1 we don't know that the RTS has rts_isProfiled, +-- so we simply say "ok". It doesn't matter because TH isn't +-- available in stage 1 anyway. +checkTemplateHaskellOk _ = return () +#endif -parseDynamicFlags_ :: Monad m => - DynFlags -> [Located String] -> Bool - -> m (DynFlags, [Located String], [Located String]) -parseDynamicFlags_ dflags0 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 +{- ********************************************************************** +%* * + DynFlags constructors +%* * +%********************************************************************* -} - -- Note: -ignore-package (package_flags) must precede -i* (dynamic_flags) - flag_spec | pkg_flags = package_flags ++ dynamic_flags - | otherwise = dynamic_flags +type DynP = EwM (CmdLineP DynFlags) - let ((leftover, errs, warns), dflags1) - = runCmdLine (processArgs flag_spec args') dflags0 - when (not (null errs)) $ ghcError $ errorsToGhcException errs +upd :: (DynFlags -> DynFlags) -> DynP () +upd f = liftEwM (do { dfs <- getCmdLineState + ; putCmdLineState $! (f dfs) }) - -- Cannot use -fPIC with registerised -fvia-C, because the mangler - -- isn't up to the job. We know that if hscTarget == HscC, then the - -- user has explicitly used -fvia-C, because -fasm is the default, - -- unless there is no NCG on this platform. The latter case is - -- checked when the -fPIC flag is parsed. - -- - let (pic_warns, dflags2) = - if opt_PIC && hscTarget dflags1 == HscC && cGhcUnregisterised == "NO" - then ([L noSrcSpan $ "Warning: -fvia-C is incompatible with -fPIC; ignoring -fvia-C"], - dflags1{ hscTarget = HscAsm }) - else ([], dflags1) +--------------- Constructor functions for OptKind ----------------- +noArg :: (DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags) +noArg fn = NoArg (upd fn) - return (dflags2, leftover, pic_warns ++ warns) +noArgDF :: (DynFlags -> DynFlags) -> String -> OptKind (CmdLineP DynFlags) +noArgDF fn deprec = NoArg (upd fn >> deprecate deprec) -type DynP = CmdLineP DynFlags +hasArg :: (String -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags) +hasArg fn = HasArg (upd . fn) -upd :: (DynFlags -> DynFlags) -> DynP () -upd f = do - dfs <- getCmdLineState - putCmdLineState $! (f dfs) +hasArgDF :: (String -> DynFlags -> DynFlags) -> String -> OptKind (CmdLineP DynFlags) +hasArgDF fn deprec = HasArg (\s -> do { upd (fn s) + ; deprecate deprec }) + +intSuffix :: (Int -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags) +intSuffix fn = IntSuffix (\n -> upd (fn n)) + +setDumpFlag :: DynFlag -> OptKind (CmdLineP DynFlags) +setDumpFlag dump_flag = NoArg (setDumpFlag' dump_flag) -------------------------- setDynFlag, unSetDynFlag :: DynFlag -> DynP () -setDynFlag f = upd (\dfs -> dopt_set dfs f) +setDynFlag f = upd (\dfs -> dopt_set dfs f) unSetDynFlag f = upd (\dfs -> dopt_unset dfs f) -------------------------- setExtensionFlag, unSetExtensionFlag :: ExtensionFlag -> DynP () -setExtensionFlag f = do { upd (\dfs -> lopt_set dfs f) - ; mapM_ setExtensionFlag deps } +setExtensionFlag f = do { upd (\dfs -> xopt_set dfs f) + ; sequence_ deps } where - deps = [ d | (f', d) <- impliedFlags, f' == f ] + deps = [ if turn_on then setExtensionFlag d + else unSetExtensionFlag d + | (f', turn_on, d) <- impliedFlags, f' == f ] -- When you set f, set the ones it implies -- NB: use setExtensionFlag 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) -unSetExtensionFlag f = upd (\dfs -> lopt_unset dfs f) +unSetExtensionFlag f = upd (\dfs -> xopt_unset dfs f) + -- When you un-set f, however, we don't un-set the things it implies + -- (except for -fno-glasgow-exts, which is treated specially) -------------------------- -setDumpFlag :: DynFlag -> OptKind DynP -setDumpFlag dump_flag = NoArg (setDumpFlag' dump_flag) +alterSettings :: (Settings -> Settings) -> DynFlags -> DynFlags +alterSettings f dflags = dflags { settings = f (settings dflags) } +-------------------------- setDumpFlag' :: DynFlag -> DynP () setDumpFlag' dump_flag = do { setDynFlag dump_flag - ; when want_recomp forceRecompile } + ; when want_recomp forceRecompile } where -- Certain dumpy-things are really interested in what's going -- on during recompilation checking, so in those cases we @@ -1956,7 +1989,7 @@ forceRecompile :: DynP () -- 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 +forceRecompile = do { dfs <- liftEwM getCmdLineState ; when (force_recomp dfs) (setDynFlag Opt_ForceRecomp) } where force_recomp dfs = isOneShot (ghcMode dfs) @@ -2005,8 +2038,8 @@ setTarget l = upd set | otherwise = dfs -- Changes the target only if we're compiling object code. This is --- used by -fasm and -fvia-C, which switch from one to the other, but --- not from bytecode to object-code. The idea is that -fasm/-fvia-C +-- used by -fasm and -fllvm, which switch from one to the other, but +-- not from bytecode to object-code. The idea is that -fasm/-fllvm -- can be safely used in an OPTIONS_GHC pragma. setObjTarget :: HscTarget -> DynP () setObjTarget l = upd set @@ -2028,45 +2061,36 @@ setOptLevel n dflags -- -Odph is equivalent to -- -- -O2 optimise as much as possible --- -fno-method-sharing sharing specialisation defeats fusion --- 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 +-- -fsimplifier-phases=3 we use an additional simplifier phase for fusion -- setDPHOpt :: DynFlags -> DynFlags setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations = 20 , simplPhases = 3 - , specConstrThreshold = Nothing - , specConstrCount = Nothing }) - `dopt_set` Opt_DictsCheap - `dopt_unset` Opt_MethodSharing -data DPHBackend = DPHPar - | DPHSeq - | DPHThis +-- Determines the package used by the vectoriser for the symbols of the vectorised code. +-- 'DPHNone' indicates that no data-parallel backend library is available; hence, the +-- vectoriser cannot be used. +-- +data DPHBackend = DPHPar -- "dph-par" + | DPHSeq -- "dph-seq" + | DPHThis -- the currently compiled package + | DPHNone -- no DPH library available 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 backend = upd $ \dflags -> dflags { dphBackend = backend } -dphPackage :: DynFlags -> PackageId -dphPackage dflags = case dphBackend dflags of - DPHPar -> dphParPackageId - DPHSeq -> dphSeqPackageId - DPHThis -> thisPackage dflags +-- Query the DPH backend package to be used by the vectoriser and desugaring of DPH syntax. +-- +dphPackageMaybe :: DynFlags -> Maybe PackageId +dphPackageMaybe dflags + = case dphBackend dflags of + DPHPar -> Just dphParPackageId + DPHSeq -> Just dphSeqPackageId + DPHThis -> Just (thisPackage dflags) + DPHNone -> Nothing setMainIs :: String -> DynP () setMainIs arg @@ -2163,7 +2187,7 @@ splitPathList s = filter notNull (splitUp s) -- tmpDir, where we store temporary files. setTmpDir :: FilePath -> DynFlags -> DynFlags -setTmpDir dir dflags = dflags{ tmpDir = normalise dir } +setTmpDir dir = alterSettings (\s -> s { sTmpDir = normalise dir }) -- we used to fix /cygdrive/c/.. on Windows, but this doesn't -- seem necessary now --SDM 7/2/2008 @@ -2173,6 +2197,9 @@ setTmpDir dir dflags = dflags{ tmpDir = normalise dir } setRtsOpts :: String -> DynP () setRtsOpts arg = upd $ \ d -> d {rtsOpts = Just arg} +setRtsOptsEnabled :: RtsOptsEnabled -> DynP () +setRtsOptsEnabled arg = upd $ \ d -> d {rtsOptsEnabled = arg} + ----------------------------------------------------------------------------- -- Hpc stuff @@ -2185,24 +2212,25 @@ setOptHpcDir arg = upd $ \ d -> d{hpcDir = arg} -- There are some options that we need to pass to gcc when compiling -- Haskell code via C, but are only supported by recent versions of -- gcc. The configure script decides which of these options we need, --- and puts them in the file "extra-gcc-opts" in $topdir, which is --- read before each via-C compilation. The advantage of having these --- in a separate file is that the file can be created at install-time --- depending on the available gcc version, and even re-generated later --- if gcc is upgraded. +-- and puts them in the "settings" file in $topdir. The advantage of +-- having these in a separate file is that the file can be created at +-- install-time depending on the available gcc version, and even +-- re-generated later if gcc is upgraded. -- -- The options below are not dependent on the version of gcc, only the -- platform. -machdepCCOpts :: DynFlags -> ([String], -- flags for all C compilations - [String]) -- for registerised HC compilations -machdepCCOpts _dflags +machdepCCOpts :: DynFlags -> [String] -- flags for all C compilations +machdepCCOpts _ = cCcOpts ++ machdepCCOpts' + +machdepCCOpts' :: [String] -- flags for all C compilations +machdepCCOpts' #if alpha_TARGET_ARCH - = ( ["-w", "-mieee" + = ["-w", "-mieee" #ifdef HAVE_THREADED_RTS_SUPPORT , "-D_REENTRANT" #endif - ], [] ) + ] -- For now, to suppress the gcc warning "call-clobbered -- register used for global register variable", we simply -- disable all warnings altogether using the -w flag. Oh well. @@ -2210,85 +2238,17 @@ machdepCCOpts _dflags #elif hppa_TARGET_ARCH -- ___HPUX_SOURCE, not _HPUX_SOURCE, is #defined if -ansi! -- (very nice, but too bad the HP /usr/include files don't agree.) - = ( ["-D_HPUX_SOURCE"], [] ) - -#elif m68k_TARGET_ARCH - -- -fno-defer-pop : for the .hc files, we want all the pushing/ - -- popping of args to routines to be explicit; if we let things - -- be deferred 'til after an STGJUMP, imminent death is certain! - -- - -- -fomit-frame-pointer : *don't* - -- It's better to have a6 completely tied up being a frame pointer - -- rather than let GCC pick random things to do with it. - -- (If we want to steal a6, then we would try to do things - -- as on iX86, where we *do* steal the frame pointer [%ebp].) - = ( [], ["-fno-defer-pop", "-fno-omit-frame-pointer"] ) + = ["-D_HPUX_SOURCE"] #elif i386_TARGET_ARCH -- -fno-defer-pop : basically the same game as for m68k -- -- -fomit-frame-pointer : *must* in .hc files; because we're stealing -- the fp (%ebp) for our register maps. - = let n_regs = stolen_x86_regs _dflags - in - ( -#if darwin_TARGET_OS - -- By default, gcc on OS X will generate SSE - -- instructions, which need things 16-byte aligned, - -- but we don't 16-byte align things. Thus drop - -- back to generic i686 compatibility. Trac #2983. - -- - -- Since Snow Leopard (10.6), gcc defaults to x86_64. - ["-march=i686", "-m32"], -#else - [ if opt_Static then "-DDONT_WANT_WIN32_DLL_SUPPORT" else "" - ], -#endif - [ "-fno-defer-pop", - "-fomit-frame-pointer", - -- we want -fno-builtin, because when gcc inlines - -- built-in functions like memcpy() it tends to - -- run out of registers, requiring -monly-n-regs - "-fno-builtin", - "-DSTOLEN_X86_REGS="++show n_regs ] - ) - -#elif ia64_TARGET_ARCH - = ( [], ["-fomit-frame-pointer", "-G0"] ) - -#elif x86_64_TARGET_ARCH - = ( -#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 - -- would be to throw them away in the mangler, but this - -- is easier. - "-fno-builtin" - -- calling builtins like strlen() using the FFI can - -- cause gcc to run out of regs, so use the external - -- version. - ] ) - -#elif sparc_TARGET_ARCH - = ( [], ["-w"] ) - -- For now, to suppress the gcc warning "call-clobbered - -- register used for global register variable", we simply - -- disable all warnings altogether using the -w flag. Oh well. + = if opt_Static then ["-DDONT_WANT_WIN32_DLL_SUPPORT"] else [] -#elif powerpc_apple_darwin_TARGET - -- -no-cpp-precomp: - -- Disable Apple's precompiling preprocessor. It's a great thing - -- for "normal" programs, but it doesn't support register variable - -- declarations. - = ( [], ["-no-cpp-precomp"] ) #else - = ( [], [] ) + = [] #endif picCCOpts :: DynFlags -> [String] @@ -2328,33 +2288,40 @@ picCCOpts _dflags -- Splitting can_split :: Bool -can_split = cSplitObjs == "YES" +can_split = cSupportsSplitObjs == "YES" -- ----------------------------------------------------------------------------- -- Compiler Info -data Printable = String String - | FromDynFlags (DynFlags -> String) - -compilerInfo :: [(String, Printable)] -compilerInfo = [("Project name", String cProjectName), - ("Project version", String cProjectVersion), - ("Booter version", String cBooterVersion), - ("Stage", String cStage), - ("Build platform", String cBuildPlatform), - ("Host platform", String cHostPlatform), - ("Target platform", String cTargetPlatform), - ("Have interpreter", String cGhcWithInterpreter), - ("Object splitting", String cSplitObjs), - ("Have native code generator", String cGhcWithNativeCodeGen), - ("Have llvm code generator", String cGhcWithLlvmCodeGen), - ("Support SMP", String cGhcWithSMP), - ("Unregisterised", String cGhcUnregisterised), - ("Tables next to code", String cGhcEnableTablesNextToCode), - ("RTS ways", String cGhcRTSWays), - ("Leading underscore", String cLeadingUnderscore), - ("Debug on", String (show debugIsOn)), - ("LibDir", FromDynFlags topDir), - ("Global Package DB", FromDynFlags systemPackageConfig) - ] +compilerInfo :: DynFlags -> [(String, String)] +compilerInfo dflags + = -- We always make "Project name" be first to keep parsing in + -- other languages simple, i.e. when looking for other fields, + -- you don't have to worry whether there is a leading '[' or not + ("Project name", cProjectName) + -- Next come the settings, so anything else can be overridden + -- in the settings file (as "lookup" uses the first match for the + -- key) + : rawSettings dflags + ++ [("Project version", cProjectVersion), + ("Booter version", cBooterVersion), + ("Stage", cStage), + ("Build platform", cBuildPlatformString), + ("Host platform", cHostPlatformString), + ("Target platform", cTargetPlatformString), + ("Have interpreter", cGhcWithInterpreter), + ("Object splitting supported", cSupportsSplitObjs), + ("Have native code generator", cGhcWithNativeCodeGen), + ("Support SMP", cGhcWithSMP), + ("Unregisterised", cGhcUnregisterised), + ("Tables next to code", cGhcEnableTablesNextToCode), + ("RTS ways", cGhcRTSWays), + ("Leading underscore", cLeadingUnderscore), + ("Debug on", show debugIsOn), + ("LibDir", topDir dflags), + ("Global Package DB", systemPackageConfig dflags), + ("C compiler flags", show cCcOpts), + ("Gcc Linker flags", show cGccLinkerOpts), + ("Ld Linker flags", show cLdLinkerOpts) + ]