-- 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,
defaultDynFlags, -- DynFlags
initDynFlags, -- DynFlags -> IO DynFlags
- dopt, -- DynFlag -> DynFlags -> Bool
- dopt_set, dopt_unset, -- DynFlags -> DynFlag -> DynFlags
getOpts, -- DynFlags -> (DynFlags -> [a]) -> [a]
getVerbFlag,
updOptLevel,
parseDynamicNoPackageFlags,
allFlags,
- supportedLanguages, languageOptions,
+ supportedLanguagesAndExtensions,
-- ** DynFlag C compiler options
machdepCCOpts, picCCOpts,
| 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
| Opt_AutoSccsOnIndividualCafs
-- misc opts
- | Opt_Cpp
| Opt_Pp
| Opt_ForceRecomp
| Opt_DryRun
| Opt_EagerBlackHoling
| Opt_ReadUserPackageConf
| Opt_NoHsMain
- | Opt_RtsOptsEnabled
| Opt_SplitObjs
| Opt_StgStats
| Opt_HideAllPackages
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_DoAndIfThenElse
+
+ | 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
-- information relating to the compilation of a single file or GHC session
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
opt_a :: [String],
opt_l :: [String],
opt_windres :: [String],
- opt_la :: [String], -- LLVM: llvm-as assembler
opt_lo :: [String], -- LLVM: llvm optimiser
opt_lc :: [String], -- LLVM: llc static compiler
pgm_T :: String,
pgm_sysman :: String,
pgm_windres :: String,
- pgm_la :: (String,[Option]), -- LLVM: llvm-as assembler
pgm_lo :: (String,[Option]), -- LLVM: opt llvm optimiser
pgm_lc :: (String,[Option]), -- LLVM: llc static compiler
-- 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 (),
| 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
cmdlineFrameworks = [],
tmpDir = cDEFAULT_TMPDIR,
rtsOpts = Nothing,
+ rtsOptsEnabled = RtsOptsSafeOnly,
hpcDir = ".hpc",
opt_m = [],
opt_l = [],
opt_windres = [],
- opt_la = [],
opt_lo = [],
opt_lc = [],
pgm_T = panic "defaultDynFlags: No pgm_T",
pgm_sysman = panic "defaultDynFlags: No pgm_sysman",
pgm_windres = panic "defaultDynFlags: No pgm_windres",
- pgm_la = panic "defaultDynFlags: No pgm_la",
pgm_lo = panic "defaultDynFlags: No pgm_lo",
pgm_lc = panic "defaultDynFlags: No pgm_lc",
-- end of initSysTools values
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,
-- The default -O0 options
++ standardWarnings,
+ language = Nothing,
+ extensionFlags = Left [],
+
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
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_DoAndIfThenElse,
+ 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
setObjectDir, setHiDir, setStubDir, setOutputDir, setDylibInstallName,
setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode,
setPgmP, setPgmL, setPgmF, setPgmc, setPgmm, setPgms, setPgma, setPgml, setPgmdll, setPgmwindres,
- setPgmla, setPgmlo, setPgmlc,
- addOptL, addOptP, addOptF, addOptc, addOptm, addOpta, addOptl, addOptwindres, addOptla, addOptlo,
- addOptlc, addCmdlineFramework, addHaddockOpts
+ setPgmlo, setPgmlc,
+ addOptL, addOptP, addOptF, addOptc, addOptm, addOpta, addOptl, addOptwindres, addOptlo, addOptlc,
+ addCmdlineFramework, addHaddockOpts
:: String -> DynFlags -> DynFlags
setOutputFile, setOutputHi, setDumpPrefixForce
:: Maybe String -> DynFlags -> DynFlags
setPgml f d = d{ pgm_l = (f,[])}
setPgmdll f d = d{ pgm_dll = (f,[])}
setPgmwindres f d = d{ pgm_windres = f}
-setPgmla f d = d{ pgm_la = (f,[])}
setPgmlo f d = d{ pgm_lo = (f,[])}
setPgmlc f d = d{ pgm_lc = (f,[])}
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}
-addOptla f d = d{ opt_la = f : opt_la d}
addOptlo f d = d{ opt_lo = f : opt_lo d}
addOptlc f d = d{ opt_lc = f : opt_lc d}
[ flagName flag | flag <- dynamic_flags, ok (flagOptKind flag) ] ++
map ("fno-"++) flags ++
map ("f"++) flags ++
- map ("X"++) 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))
(DeprecatedFullText "-#include and INCLUDE pragmas are deprecated: They no longer have any effect")
------- Specific phases --------------------------------------------
-- need to appear before -pgmL to be parsed as LLVM flags.
- , Flag "pgmla" (HasArg (upd . setPgmla)) Supported
, Flag "pgmlo" (HasArg (upd . setPgmlo)) Supported
, Flag "pgmlc" (HasArg (upd . setPgmlc)) Supported
, Flag "pgmwindres" (HasArg (upd . setPgmwindres)) Supported
-- need to appear before -optl/-opta to be parsed as LLVM flags.
- , Flag "optla" (HasArg (upd . addOptla)) Supported
, Flag "optlo" (HasArg (upd . addOptlo)) Supported
, Flag "optlc" (HasArg (upd . addOptlc)) Supported
, 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
, 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 = [
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
( "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\<blah\>@ flags can all be reversed with @-fno-\<blah\>@
+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, name' <- [name, "No" ++ name] ]
+supportedLanguages = [ name | (name, _, _) <- languageFlags ]
--- This may contain duplicates
-languageOptions :: [DynFlag]
-languageOptions = [ dynFlag | (_, dynFlag, _) <- xFlags ]
+supportedExtensions :: [String]
+supportedExtensions = [ name' | (name, _, _) <- xFlags, name' <- [name, "No" ++ name] ]
+
+supportedLanguagesAndExtensions :: [String]
+supportedLanguagesAndExtensions = supportedLanguages ++ supportedExtensions
+
+-- | These -X<blah> flags cannot be reversed with -XNo<blah>
+languageFlags :: [(String, Language, Bool -> Deprecated)]
+languageFlags = [
+ ( "Haskell98", Haskell98, const Supported ),
+ ( "Haskell2010", Haskell2010, const Supported )
+ ]
-- | These -X<blah> flags can all be reversed with -XNo<blah>
-xFlags :: [(String, DynFlag, Bool -> Deprecated)]
+xFlags :: [(String, ExtensionFlag, Bool -> Deprecated)]
xFlags = [
( "CPP", Opt_Cpp, const Supported ),
( "PostfixOperators", Opt_PostfixOperators, const Supported ),
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):
+ ( "DoAndIfThenElse", Opt_DoAndIfThenElse, const Supported ),
( "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 ),
( "ScopedTypeVariables", Opt_ScopedTypeVariables, const Supported ),
( "PatternSignatures", Opt_ScopedTypeVariables,
- deprecatedForLanguage "ScopedTypeVariables" ),
+ deprecatedForExtension "ScopedTypeVariables" ),
( "UnboxedTuples", Opt_UnboxedTuples, const Supported ),
( "StandaloneDeriving", Opt_StandaloneDeriving, const Supported ),
( "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)
, (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
--------------------------
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
setRtsOpts :: String -> DynP ()
setRtsOpts arg = upd $ \ d -> d {rtsOpts = Just arg}
+setRtsOptsEnabled :: RtsOptsEnabled -> DynP ()
+setRtsOptsEnabled arg = upd $ \ d -> d {rtsOptsEnabled = arg}
+
-----------------------------------------------------------------------------
-- Hpc stuff
("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),