lopt_set_flattened,
lopt_unset_flattened,
DynFlags(..),
+ RtsOptsEnabled(..),
HscTarget(..), isObjectTarget, defaultObjectTarget,
GhcMode(..), isOneShot,
GhcLink(..), isNoLink,
parseDynamicNoPackageFlags,
allFlags,
- supportedExtensions, extensionOptions,
+ supportedLanguagesAndExtensions,
-- ** DynFlag C compiler options
machdepCCOpts, picCCOpts,
| 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_GADTs
| Opt_RelaxedPolyRec
| Opt_NPlusKPatterns
+ | Opt_DoAndIfThenElse
| Opt_StandaloneDeriving
| Opt_DeriveDataTypeable
ghcUsagePath :: FilePath, -- Filled in by SysTools
ghciUsagePath :: FilePath, -- ditto
rtsOpts :: Maybe String,
+ rtsOptsEnabled :: RtsOptsEnabled,
hpcDir :: String, -- ^ Path to store the .mix files
-- hsc dynamic flags
flags :: [DynFlag],
+ language :: Maybe Language,
extensionFlags :: Either [OnOff ExtensionFlag]
[ExtensionFlag],
| 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",
-- 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
= case extensionFlags dflags of
Left onoffs ->
dflags {
- extensionFlags = Right $ flattenExtensionFlags' onoffs
+ extensionFlags = Right $ flattenExtensionFlags' (language dflags) onoffs
}
Right _ ->
panic "Flattening already-flattened extension flags"
= case extensionFlags dflags of
Left onoffs ->
dflags {
- extensionFlags = Right $ flattenExtensionFlags' onoffs
+ 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' :: [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
- ]
+ 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
, 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
++ 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 = [
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<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, ExtensionFlag, Bool -> Deprecated)]
( "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 ),
( "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 ),
- -- On by default:
( "DatatypeContexts", Opt_DatatypeContexts, const Supported ),
( "MonoLocalBinds", Opt_MonoLocalBinds, const Supported ),
( "RelaxedPolyRec", Opt_RelaxedPolyRec, const Supported ),
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 }
setRtsOpts :: String -> DynP ()
setRtsOpts arg = upd $ \ d -> d {rtsOpts = Just arg}
+setRtsOptsEnabled :: RtsOptsEnabled -> DynP ()
+setRtsOptsEnabled arg = upd $ \ d -> d {rtsOptsEnabled = arg}
+
-----------------------------------------------------------------------------
-- Hpc stuff
projects / ghc-hetmet.git / blobdiff