X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=2971aa11cacc231e3fee5544b0b0e9d833c9d550;hb=320738062c7a81f062c5adab98a1a1c4fdbd4bc7;hp=8ea1293fb7c9641ac55ab10d2be0b31d50b94783;hpb=6b17e71f0a23d06bb7a5454ca9c6935d0529d272;p=ghc-hetmet.git diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 8ea1293..2971aa1 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -11,15 +11,22 @@ -- 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, DynFlags(..), + RtsOptsEnabled(..), HscTarget(..), isObjectTarget, defaultObjectTarget, GhcMode(..), isOneShot, GhcLink(..), isNoLink, PackageFlag(..), Option(..), showOpt, DynLibLoader(..), - fFlags, xFlags, + fFlags, fLangFlags, xFlags, dphPackage, wayNames, @@ -27,8 +34,6 @@ module DynFlags ( defaultDynFlags, -- DynFlags initDynFlags, -- DynFlags -> IO DynFlags - dopt, -- DynFlag -> DynFlags -> Bool - dopt_set, dopt_unset, -- DynFlags -> DynFlag -> DynFlags getOpts, -- DynFlags -> (DynFlags -> [a]) -> [a] getVerbFlag, updOptLevel, @@ -41,7 +46,7 @@ module DynFlags ( parseDynamicNoPackageFlags, allFlags, - supportedLanguages, languageOptions, + supportedLanguagesAndExtensions, -- ** DynFlag C compiler options machdepCCOpts, picCCOpts, @@ -107,6 +112,7 @@ data DynFlag | Opt_D_dump_asm_conflicts | Opt_D_dump_asm_stats | Opt_D_dump_asm_expanded + | Opt_D_dump_llvm | Opt_D_dump_cpranal | Opt_D_dump_deriv | Opt_D_dump_ds @@ -163,6 +169,7 @@ data DynFlag | Opt_WarnIncompletePatterns | Opt_WarnIncompletePatternsRecUpd | Opt_WarnMissingFields + | Opt_WarnMissingImportList | Opt_WarnMissingMethods | Opt_WarnMissingSigs | Opt_WarnNameShadowing @@ -186,75 +193,6 @@ data DynFlag | Opt_WarnWrongDoBind | Opt_WarnAlternativeLayoutRuleTransitional - - -- language opts - | Opt_OverlappingInstances - | Opt_UndecidableInstances - | Opt_IncoherentInstances - | Opt_MonomorphismRestriction - | Opt_MonoPatBinds - | Opt_MonoLocalBinds - | Opt_ExtendedDefaultRules -- Use GHC's extended rules for defaulting - | Opt_ForeignFunctionInterface - | Opt_UnliftedFFITypes - | Opt_GHCForeignImportPrim - | Opt_PArr -- Syntactic support for parallel arrays - | Opt_Arrows -- Arrow-notation syntax - | Opt_TemplateHaskell - | Opt_QuasiQuotes - | Opt_ImplicitParams - | Opt_Generics -- "Derivable type classes" - | Opt_ImplicitPrelude - | Opt_ScopedTypeVariables - | Opt_UnboxedTuples - | Opt_BangPatterns - | Opt_TypeFamilies - | Opt_OverloadedStrings - | Opt_DisambiguateRecordFields - | Opt_RecordWildCards - | Opt_RecordPuns - | Opt_ViewPatterns - | Opt_GADTs - | Opt_RelaxedPolyRec - | Opt_NPlusKPatterns - - | Opt_StandaloneDeriving - | Opt_DeriveDataTypeable - | Opt_DeriveFunctor - | Opt_DeriveTraversable - | Opt_DeriveFoldable - - | Opt_TypeSynonymInstances - | Opt_FlexibleContexts - | Opt_FlexibleInstances - | Opt_ConstrainedClassMethods - | Opt_MultiParamTypeClasses - | Opt_FunctionalDependencies - | Opt_UnicodeSyntax - | Opt_PolymorphicComponents - | Opt_ExistentialQuantification - | Opt_MagicHash - | Opt_EmptyDataDecls - | Opt_KindSignatures - | Opt_ParallelListComp - | Opt_TransformListComp - | Opt_GeneralizedNewtypeDeriving - | Opt_RecursiveDo - | Opt_DoRec - | Opt_PostfixOperators - | Opt_TupleSections - | Opt_PatternGuards - | Opt_LiberalTypeSynonyms - | Opt_Rank2Types - | Opt_RankNTypes - | Opt_ImpredicativeTypes - | Opt_TypeOperators - | Opt_PackageImports - | Opt_NewQualifiedOperators - | Opt_ExplicitForAll - | Opt_AlternativeLayoutRule - | Opt_AlternativeLayoutRuleTransitional - | Opt_PrintExplicitForalls -- optimisation opts @@ -289,7 +227,6 @@ data DynFlag | Opt_AutoSccsOnIndividualCafs -- misc opts - | Opt_Cpp | Opt_Pp | Opt_ForceRecomp | Opt_DryRun @@ -298,7 +235,6 @@ data DynFlag | Opt_EagerBlackHoling | Opt_ReadUserPackageConf | Opt_NoHsMain - | Opt_RtsOptsEnabled | Opt_SplitObjs | Opt_StgStats | Opt_HideAllPackages @@ -332,7 +268,81 @@ data DynFlag | Opt_KeepRawSFiles | Opt_KeepTmpFiles | Opt_KeepRawTokenStream + | Opt_KeepLlvmFiles + + deriving (Eq, Show) + +data Language = Haskell98 | Haskell2010 + +data ExtensionFlag + = Opt_Cpp + | Opt_OverlappingInstances + | Opt_UndecidableInstances + | Opt_IncoherentInstances + | Opt_MonomorphismRestriction + | Opt_MonoPatBinds + | Opt_MonoLocalBinds + | Opt_ExtendedDefaultRules -- Use GHC's extended rules for defaulting + | Opt_ForeignFunctionInterface + | Opt_UnliftedFFITypes + | Opt_GHCForeignImportPrim + | Opt_PArr -- Syntactic support for parallel arrays + | Opt_Arrows -- Arrow-notation syntax + | Opt_TemplateHaskell + | Opt_QuasiQuotes + | Opt_ImplicitParams + | Opt_Generics -- "Derivable type classes" + | Opt_ImplicitPrelude + | Opt_ScopedTypeVariables + | Opt_UnboxedTuples + | Opt_BangPatterns + | Opt_TypeFamilies + | Opt_OverloadedStrings + | Opt_DisambiguateRecordFields + | Opt_RecordWildCards + | Opt_RecordPuns + | Opt_ViewPatterns + | Opt_GADTs + | Opt_RelaxedPolyRec + | Opt_NPlusKPatterns + | Opt_StandaloneDeriving + | Opt_DeriveDataTypeable + | Opt_DeriveFunctor + | Opt_DeriveTraversable + | Opt_DeriveFoldable + + | Opt_TypeSynonymInstances + | Opt_FlexibleContexts + | Opt_FlexibleInstances + | Opt_ConstrainedClassMethods + | Opt_MultiParamTypeClasses + | Opt_FunctionalDependencies + | Opt_UnicodeSyntax + | Opt_PolymorphicComponents + | Opt_ExistentialQuantification + | Opt_MagicHash + | Opt_EmptyDataDecls + | Opt_KindSignatures + | Opt_ParallelListComp + | Opt_TransformListComp + | Opt_GeneralizedNewtypeDeriving + | Opt_RecursiveDo + | Opt_DoRec + | Opt_PostfixOperators + | Opt_TupleSections + | Opt_PatternGuards + | Opt_LiberalTypeSynonyms + | Opt_Rank2Types + | Opt_RankNTypes + | Opt_ImpredicativeTypes + | Opt_TypeOperators + | Opt_PackageImports + | Opt_NewQualifiedOperators + | Opt_ExplicitForAll + | Opt_AlternativeLayoutRule + | Opt_AlternativeLayoutRuleTransitional + | Opt_DatatypeContexts deriving (Eq, Show) -- | Contains not only a collection of 'DynFlag's but also a plethora of @@ -408,6 +418,7 @@ data DynFlags = DynFlags { ghcUsagePath :: FilePath, -- Filled in by SysTools ghciUsagePath :: FilePath, -- ditto rtsOpts :: Maybe String, + rtsOptsEnabled :: RtsOptsEnabled, hpcDir :: String, -- ^ Path to store the .mix files @@ -420,6 +431,8 @@ data DynFlags = DynFlags { 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, @@ -434,6 +447,8 @@ data DynFlags = DynFlags { 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 -- For ghc -M depMakefile :: FilePath, @@ -465,6 +480,9 @@ data DynFlags = DynFlags { -- hsc dynamic flags flags :: [DynFlag], + language :: Maybe Language, + extensionFlags :: Either [OnOff ExtensionFlag] + [ExtensionFlag], -- | Message output action: use "ErrUtils" instead of this if you can log_action :: Severity -> SrcSpan -> PprStyle -> Message -> IO (), @@ -498,6 +516,7 @@ wayNames = map wayName . ways data HscTarget = HscC -- ^ Generate C code. | HscAsm -- ^ Generate assembly using the native code generator. + | HscLlvm -- ^ Generate assembly using the llvm code generator. | HscJava -- ^ Generate Java bytecode. | HscInterpreted -- ^ Generate bytecode. (Requires 'LinkInMemory') | HscNothing -- ^ Don't generate any code. See notes above. @@ -507,6 +526,7 @@ data HscTarget isObjectTarget :: HscTarget -> Bool isObjectTarget HscC = True isObjectTarget HscAsm = True +isObjectTarget HscLlvm = True isObjectTarget _ = False -- | The 'GhcMode' tells us whether we're doing multi-module @@ -573,6 +593,8 @@ data DynLibLoader | SystemDependent deriving Eq +data RtsOptsEnabled = RtsOptsNone | RtsOptsSafeOnly | RtsOptsAll + -- | Used by 'GHC.newSession' to partially initialize a new 'DynFlags' value initDynFlags :: DynFlags -> IO DynFlags initDynFlags dflags = do @@ -643,6 +665,7 @@ defaultDynFlags = cmdlineFrameworks = [], tmpDir = cDEFAULT_TMPDIR, rtsOpts = Nothing, + rtsOptsEnabled = RtsOptsSafeOnly, hpcDir = ".hpc", @@ -656,6 +679,8 @@ defaultDynFlags = opt_m = [], opt_l = [], opt_windres = [], + opt_lo = [], + opt_lc = [], extraPkgConfs = [], packageFlags = [], @@ -682,6 +707,8 @@ defaultDynFlags = 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 -- ghc -M values depMakefile = "Makefile", @@ -693,18 +720,9 @@ defaultDynFlags = dirsToClean = panic "defaultDynFlags: No dirsToClean", haddockOptions = Nothing, flags = [ - Opt_RtsOptsEnabled, Opt_AutoLinkPackages, Opt_ReadUserPackageConf, - 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_MethodSharing, Opt_DoAsmMangling, @@ -719,6 +737,9 @@ defaultDynFlags = -- The default -O0 options ++ standardWarnings, + language = Nothing, + extensionFlags = Left [], + log_action = \severity srcSpan style msg -> case severity of SevInfo -> printErrs (msg style) @@ -742,17 +763,120 @@ Note [Verbosity levels] 5 | "ghc -v -ddump-all" -} +data OnOff a = On a + | Off a + +flattenExtensionFlags :: DynFlags -> DynFlags +flattenExtensionFlags dflags + = case extensionFlags dflags of + Left onoffs -> + dflags { + extensionFlags = Right $ flattenExtensionFlags' (language dflags) onoffs + } + Right _ -> + panic "Flattening already-flattened extension flags" + +ensureFlattenedExtensionFlags :: DynFlags -> DynFlags +ensureFlattenedExtensionFlags dflags + = case extensionFlags dflags of + Left onoffs -> + dflags { + extensionFlags = Right $ flattenExtensionFlags' (language dflags) onoffs + } + Right _ -> + dflags + +-- OnOffs accumulate in reverse order, so we use foldr in order to +-- process them in the right order +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 = languageExtensions ml + +languageExtensions :: Maybe Language -> [ExtensionFlag] +languageExtensions Nothing + = Opt_MonoPatBinds -- Experimentally, I'm making this non-standard + -- behaviour the default, to see if anyone notices + -- SLPJ July 06 + : languageExtensions (Just Haskell2010) +languageExtensions (Just Haskell98) + = [Opt_ImplicitPrelude, + Opt_MonomorphismRestriction, + Opt_NPlusKPatterns, + Opt_DatatypeContexts] +languageExtensions (Just Haskell2010) + = [Opt_ImplicitPrelude, + Opt_MonomorphismRestriction, + Opt_DatatypeContexts, + Opt_EmptyDataDecls, + Opt_ForeignFunctionInterface, + Opt_PatternGuards, + Opt_RelaxedPolyRec] + +-- 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 + -- | 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") + +-- | 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) } + +-- | 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) } -- | Retrieve the options corresponding to a particular @opt_*@ field in the correct order getOpts :: DynFlags -- ^ 'DynFlags' to retrieve the options from @@ -771,7 +895,8 @@ getVerbFlag dflags setObjectDir, setHiDir, setStubDir, setOutputDir, setDylibInstallName, setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode, setPgmP, setPgmL, setPgmF, setPgmc, setPgmm, setPgms, setPgma, setPgml, setPgmdll, setPgmwindres, - addOptL, addOptP, addOptF, addOptc, addOptm, addOpta, addOptl, addOptwindres, + setPgmlo, setPgmlc, + addOptL, addOptP, addOptF, addOptc, addOptm, addOpta, addOptl, addOptwindres, addOptlo, addOptlc, addCmdlineFramework, addHaddockOpts :: String -> DynFlags -> DynFlags setOutputFile, setOutputHi, setDumpPrefixForce @@ -816,6 +941,8 @@ 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} @@ -825,6 +952,8 @@ 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} setDepMakefile :: FilePath -> DynFlags -> DynFlags setDepMakefile f d = d { depMakefile = deOptDep f } @@ -1004,22 +1133,27 @@ allFlags = map ('-':) $ [ flagName flag | flag <- dynamic_flags, ok (flagOptKind flag) ] ++ map ("fno-"++) flags ++ map ("f"++) flags ++ - map ("X"++) supportedLanguages ++ - map ("XNo"++) supportedLanguages + map ("f"++) flags' ++ + map ("X"++) supportedExtensions where ok (PrefixPred _ _) = False ok _ = True flags = [ name | (name, _, _) <- fFlags ] + flags' = [ name | (name, _, _) <- fLangFlags ] dynamic_flags :: [Flag DynP] dynamic_flags = [ Flag "n" (NoArg (setDynFlag Opt_DryRun)) Supported - , Flag "cpp" (NoArg (setDynFlag Opt_Cpp)) Supported + , Flag "cpp" (NoArg (setExtensionFlag Opt_Cpp)) Supported , Flag "F" (NoArg (setDynFlag Opt_Pp)) Supported , Flag "#include" (HasArg (addCmdlineHCInclude)) - (Deprecated "No longer has any effect") + (DeprecatedFullText "-#include and INCLUDE pragmas are deprecated: They no longer have any effect") , Flag "v" (OptIntSuffix setVerbosity) Supported ------- 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 @@ -1031,6 +1165,10 @@ dynamic_flags = [ , Flag "pgmdll" (HasArg (upd . setPgmdll)) Supported , Flag "pgmwindres" (HasArg (upd . setPgmwindres)) Supported + -- 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 @@ -1065,10 +1203,8 @@ dynamic_flags = [ (Deprecated "Use -exclude-module instead") -------- Linking ---------------------------------------------------- - , Flag "c" (NoArg (upd $ \d -> d{ ghcLink=NoLink } )) - Supported , Flag "no-link" (NoArg (upd $ \d -> d{ ghcLink=NoLink } )) - (Deprecated "Use -c instead") + Supported , Flag "shared" (NoArg (upd $ \d -> d{ ghcLink=LinkDynLib } )) Supported , Flag "dynload" (HasArg (upd . parseDynLibLoaderMode)) @@ -1106,6 +1242,8 @@ dynamic_flags = [ , 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 -- This only makes sense as plural , Flag "keep-tmp-files" (NoArg (setDynFlag Opt_KeepTmpFiles)) Supported @@ -1113,8 +1251,11 @@ dynamic_flags = [ , 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 "rtsopts" (NoArg (setRtsOptsEnabled RtsOptsAll)) Supported + , Flag "rtsopts=all" (NoArg (setRtsOptsEnabled RtsOptsAll)) Supported + , Flag "rtsopts=some" (NoArg (setRtsOptsEnabled RtsOptsSafeOnly)) Supported + , Flag "rtsopts=none" (NoArg (setRtsOptsEnabled RtsOptsNone)) Supported + , Flag "no-rtsopts" (NoArg (setRtsOptsEnabled RtsOptsNone)) Supported , Flag "main-is" (SepArg setMainIs ) Supported , Flag "haddock" (NoArg (setDynFlag Opt_Haddock)) Supported , Flag "haddock-opts" (HasArg (upd . addHaddockOpts)) Supported @@ -1166,6 +1307,9 @@ dynamic_flags = [ 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) @@ -1386,22 +1530,30 @@ dynamic_flags = [ ------ Compiler flags ----------------------------------------------- , Flag "fasm" (NoArg (setObjTarget HscAsm)) Supported - , Flag "fvia-c" (NoArg (setObjTarget HscC)) Supported - , Flag "fvia-C" (NoArg (setObjTarget HscC)) Supported - - , Flag "fno-code" (NoArg (setTarget HscNothing)) 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 "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 (mapM_ setDynFlag glasgowExtsFlags)) + , Flag "fglasgow-exts" (NoArg enableGlasgowExts) Supported - , Flag "fno-glasgow-exts" (NoArg (mapM_ unSetDynFlag glasgowExtsFlags)) + , Flag "fno-glasgow-exts" (NoArg disableGlasgowExts) Supported ] ++ map (mkFlag True "f" setDynFlag ) fFlags ++ map (mkFlag False "fno-" unSetDynFlag) fFlags - ++ map (mkFlag True "X" setDynFlag ) xFlags - ++ map (mkFlag False "XNo" unSetDynFlag) xFlags + ++ map (mkFlag True "f" setExtensionFlag ) fLangFlags + ++ map (mkFlag False "fno-" unSetExtensionFlag) fLangFlags + ++ map (mkFlag True "X" setExtensionFlag ) xFlags + ++ map (mkFlag False "XNo" unSetExtensionFlag) xFlags + ++ map (mkFlag True "X" setLanguage ) languageFlags package_flags :: [Flag DynP] package_flags = [ @@ -1423,14 +1575,14 @@ package_flags = [ mkFlag :: Bool -- ^ True <=> it should be turned on -> String -- ^ The flag prefix - -> (DynFlag -> DynP ()) - -> (String, DynFlag, Bool -> Deprecated) + -> (flag -> DynP ()) + -> (String, flag, Bool -> Deprecated) -> Flag DynP -mkFlag turnOn flagPrefix f (name, dynflag, deprecated) - = Flag (flagPrefix ++ name) (NoArg (f dynflag)) (deprecated turnOn) +mkFlag turnOn flagPrefix f (name, flag, deprecated) + = Flag (flagPrefix ++ name) (NoArg (f flag)) (deprecated turnOn) -deprecatedForLanguage :: String -> Bool -> Deprecated -deprecatedForLanguage lang turn_on +deprecatedForExtension :: String -> Bool -> Deprecated +deprecatedForExtension lang turn_on = Deprecated ("use -X" ++ flag ++ " or pragma {-# LANGUAGE " ++ flag ++ " #-} instead") where flag | turn_on = lang @@ -1454,6 +1606,7 @@ fFlags = [ ( "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 ), @@ -1513,55 +1666,69 @@ fFlags = [ ( "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 ) + ] + +-- | These @-f\@ flags can all be reversed with @-fno-\@ +fLangFlags :: [(String, ExtensionFlag, Bool -> Deprecated)] +fLangFlags = [ ( "th", Opt_TemplateHaskell, - deprecatedForLanguage "TemplateHaskell" ), + deprecatedForExtension "TemplateHaskell" ), ( "fi", Opt_ForeignFunctionInterface, - deprecatedForLanguage "ForeignFunctionInterface" ), + deprecatedForExtension "ForeignFunctionInterface" ), ( "ffi", Opt_ForeignFunctionInterface, - deprecatedForLanguage "ForeignFunctionInterface" ), + deprecatedForExtension "ForeignFunctionInterface" ), ( "arrows", Opt_Arrows, - deprecatedForLanguage "Arrows" ), + deprecatedForExtension "Arrows" ), ( "generics", Opt_Generics, - deprecatedForLanguage "Generics" ), + deprecatedForExtension "Generics" ), ( "implicit-prelude", Opt_ImplicitPrelude, - deprecatedForLanguage "ImplicitPrelude" ), + deprecatedForExtension "ImplicitPrelude" ), ( "bang-patterns", Opt_BangPatterns, - deprecatedForLanguage "BangPatterns" ), + deprecatedForExtension "BangPatterns" ), ( "monomorphism-restriction", Opt_MonomorphismRestriction, - deprecatedForLanguage "MonomorphismRestriction" ), + deprecatedForExtension "MonomorphismRestriction" ), ( "mono-pat-binds", Opt_MonoPatBinds, - deprecatedForLanguage "MonoPatBinds" ), + deprecatedForExtension "MonoPatBinds" ), ( "extended-default-rules", Opt_ExtendedDefaultRules, - deprecatedForLanguage "ExtendedDefaultRules" ), + deprecatedForExtension "ExtendedDefaultRules" ), ( "implicit-params", Opt_ImplicitParams, - deprecatedForLanguage "ImplicitParams" ), + deprecatedForExtension "ImplicitParams" ), ( "scoped-type-variables", Opt_ScopedTypeVariables, - deprecatedForLanguage "ScopedTypeVariables" ), + deprecatedForExtension "ScopedTypeVariables" ), ( "parr", Opt_PArr, - deprecatedForLanguage "PArr" ), + deprecatedForExtension "PArr" ), ( "allow-overlapping-instances", Opt_OverlappingInstances, - deprecatedForLanguage "OverlappingInstances" ), + deprecatedForExtension "OverlappingInstances" ), ( "allow-undecidable-instances", Opt_UndecidableInstances, - deprecatedForLanguage "UndecidableInstances" ), + deprecatedForExtension "UndecidableInstances" ), ( "allow-incoherent-instances", Opt_IncoherentInstances, - deprecatedForLanguage "IncoherentInstances" ), - ( "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 ) + deprecatedForExtension "IncoherentInstances" ) ] supportedLanguages :: [String] -supportedLanguages = [ name | (name, _, _) <- xFlags ] +supportedLanguages = [ name | (name, _, _) <- languageFlags ] + +supportedExtensions :: [String] +supportedExtensions = [ name' | (name, _, _) <- xFlags, name' <- [name, "No" ++ name] ] + +supportedLanguagesAndExtensions :: [String] +supportedLanguagesAndExtensions = supportedLanguages ++ supportedExtensions --- This may contain duplicates -languageOptions :: [DynFlag] -languageOptions = [ dynFlag | (_, dynFlag, _) <- xFlags ] +-- | These -X flags cannot be reversed with -XNo +languageFlags :: [(String, Language, Bool -> Deprecated)] +languageFlags = [ + ( "Haskell98", Haskell98, const Supported ), + ( "Haskell2010", Haskell2010, const Supported ) + ] -- | These -X flags can all be reversed with -XNo -xFlags :: [(String, DynFlag, Bool -> Deprecated)] +xFlags :: [(String, ExtensionFlag, Bool -> Deprecated)] xFlags = [ ( "CPP", Opt_Cpp, const Supported ), ( "PostfixOperators", Opt_PostfixOperators, const Supported ), @@ -1585,34 +1752,31 @@ xFlags = [ const $ Deprecated "impredicative polymorphism will be simplified or removed in GHC 6.14" ), ( "TypeOperators", Opt_TypeOperators, const Supported ), ( "RecursiveDo", Opt_RecursiveDo, - deprecatedForLanguage "DoRec"), + 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 ), ( "RecordPuns", Opt_RecordPuns, - deprecatedForLanguage "NamedFieldPuns" ), + 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 ), + ( "DatatypeContexts", Opt_DatatypeContexts, const Supported ), ( "MonoLocalBinds", Opt_MonoLocalBinds, const Supported ), ( "RelaxedPolyRec", Opt_RelaxedPolyRec, const Supported ), ( "ExtendedDefaultRules", Opt_ExtendedDefaultRules, const Supported ), @@ -1620,7 +1784,7 @@ xFlags = [ ( "ScopedTypeVariables", Opt_ScopedTypeVariables, const Supported ), ( "PatternSignatures", Opt_ScopedTypeVariables, - deprecatedForLanguage "ScopedTypeVariables" ), + deprecatedForExtension "ScopedTypeVariables" ), ( "UnboxedTuples", Opt_UnboxedTuples, const Supported ), ( "StandaloneDeriving", Opt_StandaloneDeriving, const Supported ), @@ -1639,10 +1803,11 @@ xFlags = [ ( "UndecidableInstances", Opt_UndecidableInstances, const Supported ), ( "IncoherentInstances", Opt_IncoherentInstances, const Supported ), ( "PackageImports", Opt_PackageImports, const Supported ), - ( "NewQualifiedOperators", Opt_NewQualifiedOperators, const Supported ) + ( "NewQualifiedOperators", Opt_NewQualifiedOperators, + const $ Deprecated "The new qualified operator syntax was rejected by Haskell'" ) ] -impliedFlags :: [(DynFlag, DynFlag)] +impliedFlags :: [(ExtensionFlag, ExtensionFlag)] impliedFlags = [ (Opt_RankNTypes, Opt_ExplicitForAll) , (Opt_Rank2Types, Opt_ExplicitForAll) @@ -1669,10 +1834,17 @@ impliedFlags , (Opt_RecordWildCards, Opt_DisambiguateRecordFields) ] -glasgowExtsFlags :: [DynFlag] +enableGlasgowExts :: DynP () +enableGlasgowExts = do setDynFlag Opt_PrintExplicitForalls + mapM_ setExtensionFlag glasgowExtsFlags + +disableGlasgowExts :: DynP () +disableGlasgowExts = do unSetDynFlag Opt_PrintExplicitForalls + mapM_ unSetExtensionFlag glasgowExtsFlags + +glasgowExtsFlags :: [ExtensionFlag] glasgowExtsFlags = [ - Opt_PrintExplicitForalls - , Opt_ForeignFunctionInterface + Opt_ForeignFunctionInterface , Opt_UnliftedFFITypes , Opt_GADTs , Opt_ImplicitParams @@ -1775,23 +1947,35 @@ upd f = do -------------------------- setDynFlag, unSetDynFlag :: DynFlag -> DynP () -setDynFlag f = do { upd (\dfs -> dopt_set dfs f) - ; mapM_ setDynFlag deps } +setDynFlag f = upd (\dfs -> dopt_set dfs f) +unSetDynFlag f = upd (\dfs -> dopt_unset dfs f) + +-------------------------- +setLanguage :: Language -> DynP () +setLanguage l = upd (\dfs -> dfs { language = Just l }) + +-------------------------- +setExtensionFlag, unSetExtensionFlag :: ExtensionFlag -> DynP () +setExtensionFlag f = do { upd (\dfs -> lopt_set dfs f) + ; mapM_ setExtensionFlag deps } where deps = [ d | (f', d) <- impliedFlags, f' == f ] -- When you set f, set the ones it implies - -- NB: use setDynFlag recursively, in case the implied flags - -- implies further flags + -- 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) -unSetDynFlag f = upd (\dfs -> dopt_unset dfs f) +unSetExtensionFlag f = upd (\dfs -> lopt_unset dfs f) -------------------------- setDumpFlag :: DynFlag -> OptKind DynP -setDumpFlag dump_flag - = NoArg (do { setDynFlag dump_flag - ; when want_recomp forceRecompile }) +setDumpFlag dump_flag = NoArg (setDumpFlag' dump_flag) + +setDumpFlag' :: DynFlag -> DynP () +setDumpFlag' dump_flag + = do { setDynFlag dump_flag + ; when want_recomp forceRecompile } where -- Certain dumpy-things are really interested in what's going -- on during recompilation checking, so in those cases we @@ -2021,6 +2205,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 @@ -2161,6 +2348,11 @@ picCCOpts _dflags | otherwise = [] #else + -- we need -fPIC for C files when we are compiling with -dynamic, + -- otherwise things like stub.c files don't get compiled + -- correctly. They need to reference data in the Haskell + -- objects, but can't without -fPIC. See + -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/PositionIndependentCode | opt_PIC || not opt_Static = ["-fPIC", "-U __PIC__", "-D__PIC__"] | otherwise @@ -2184,16 +2376,20 @@ 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), - ("Win32 DLLs", String cEnableWin32DLLs), ("RTS ways", String cGhcRTSWays), ("Leading underscore", String cLeadingUnderscore), ("Debug on", String (show debugIsOn)), - ("LibDir", FromDynFlags topDir) + ("LibDir", FromDynFlags topDir), + ("Global Package DB", FromDynFlags systemPackageConfig) ]