Skip to content

GitLab

Commit 1971591f authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Rename "language" varibles etc to "extension", and add --supported-extensions

parent 1f4bc1f3
Hide whitespace changes
Inline Side-by-side
compiler/main/DriverPipeline.hs
View file @ 1971591f
......@@ -698,12 +698,12 @@ runPhase (Unlit sf) _stop hsc_env _basename _suff input_fn get_output_fn maybe_l
runPhase (Cpp sf) _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc
= do let dflags0 = hsc_dflags hsc_env
let dflags0' = flattenLanguageFlags dflags0
let dflags0' = flattenExtensionFlags dflags0
src_opts <- liftIO $ getOptionsFromFile dflags0' input_fn
(dflags1, unhandled_flags, warns)
<- liftIO $ parseDynamicNoPackageFlags dflags0 src_opts
checkProcessArgsResult unhandled_flags
let dflags1' = flattenLanguageFlags dflags1
let dflags1' = flattenExtensionFlags dflags1
if not (dopt Opt_Cpp dflags1') then do
-- we have to be careful to emit warnings only once.
......@@ -720,7 +720,7 @@ runPhase (Cpp sf) _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc
src_opts <- liftIO $ getOptionsFromFile dflags0' output_fn
(dflags2, unhandled_flags, warns)
<- liftIO $ parseDynamicNoPackageFlags dflags0 src_opts
let dflags2' = flattenLanguageFlags dflags2
let dflags2' = flattenExtensionFlags dflags2
unless (dopt Opt_Pp dflags2') $ handleFlagWarnings dflags2' warns
-- the HsPp pass below will emit warnings
checkProcessArgsResult unhandled_flags
......@@ -732,7 +732,7 @@ runPhase (Cpp sf) _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc
runPhase (HsPp sf) _stop hsc_env basename suff input_fn get_output_fn maybe_loc
= do let dflags = hsc_dflags hsc_env
dflags' = flattenLanguageFlags dflags
dflags' = flattenExtensionFlags dflags
if not (dopt Opt_Pp dflags) then
-- no need to preprocess, just pass input file along
-- to the next phase of the pipeline.
......@@ -753,7 +753,7 @@ runPhase (HsPp sf) _stop hsc_env basename suff input_fn get_output_fn maybe_loc
src_opts <- liftIO $ getOptionsFromFile dflags' output_fn
(dflags1, unhandled_flags, warns)
<- liftIO $ parseDynamicNoPackageFlags dflags src_opts
let dflags1' = flattenLanguageFlags dflags1
let dflags1' = flattenExtensionFlags dflags1
handleFlagWarnings dflags1' warns
checkProcessArgsResult unhandled_flags
......@@ -905,7 +905,7 @@ runPhase (Hsc src_flavour) stop hsc_env basename suff input_fn get_output_fn _ma
runPhase CmmCpp _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc
= do
let dflags = hsc_dflags hsc_env
dflags' = flattenLanguageFlags dflags
dflags' = flattenExtensionFlags dflags
output_fn <- liftIO $ get_output_fn dflags' Cmm maybe_loc
liftIO $ doCpp dflags' False{-not raw-} True{-include CC opts-} input_fn output_fn
return (Cmm, dflags', maybe_loc, output_fn)
......
compiler/main/DynFlags.hs
View file @ 1971591f
......@@ -13,9 +13,9 @@ module DynFlags (
-- * Dynamic flags and associated configuration types
DOpt(..),
DynFlag(..),
LanguageFlag(..),
flattenLanguageFlags,
ensureFlattenedLanguageFlags,
ExtensionFlag(..),
flattenExtensionFlags,
ensureFlattenedExtensionFlags,
lopt_set_flattened,
lopt_unset_flattened,
DynFlags(..),
......@@ -45,7 +45,7 @@ module DynFlags (
parseDynamicNoPackageFlags,
allFlags,
supportedLanguages, languageOptions,
supportedExtensions, extensionOptions,
-- ** DynFlag C compiler options
machdepCCOpts, picCCOpts,
......@@ -272,7 +272,7 @@ data DynFlag
deriving (Eq, Show)
data LanguageFlag
data ExtensionFlag
= Opt_Cpp
| Opt_OverlappingInstances
| Opt_UndecidableInstances
......@@ -477,8 +477,8 @@ data DynFlags = DynFlags {
-- hsc dynamic flags
flags :: [DynFlag],
languageFlags :: Either [OnOff LanguageFlag]
[LanguageFlag],
extensionFlags :: Either [OnOff ExtensionFlag]
[ExtensionFlag],
-- | Message output action: use "ErrUtils" instead of this if you can
log_action :: Severity -> SrcSpan -> PprStyle -> Message -> IO (),
......@@ -730,7 +730,7 @@ defaultDynFlags =
-- The default -O0 options
++ standardWarnings,
languageFlags = Left [],
extensionFlags = Left [],
log_action = \severity srcSpan style msg ->
case severity of
......@@ -758,33 +758,33 @@ Note [Verbosity levels]
data OnOff a = On a
| Off a
flattenLanguageFlags :: DynFlags -> DynFlags
flattenLanguageFlags dflags
= case languageFlags dflags of
flattenExtensionFlags :: DynFlags -> DynFlags
flattenExtensionFlags dflags
= case extensionFlags dflags of
Left onoffs ->
dflags {
languageFlags = Right $ flattenLanguageFlags' onoffs
extensionFlags = Right $ flattenExtensionFlags' onoffs
}
Right _ ->
panic "Flattening already-flattened language flags"
panic "Flattening already-flattened extension flags"
ensureFlattenedLanguageFlags :: DynFlags -> DynFlags
ensureFlattenedLanguageFlags dflags
= case languageFlags dflags of
ensureFlattenedExtensionFlags :: DynFlags -> DynFlags
ensureFlattenedExtensionFlags dflags
= case extensionFlags dflags of
Left onoffs ->
dflags {
languageFlags = Right $ flattenLanguageFlags' onoffs
extensionFlags = Right $ flattenExtensionFlags' onoffs
}
Right _ ->
dflags
-- OnOffs accumulate in reverse order, so we use foldr in order to
-- process them in the right order
flattenLanguageFlags' :: [OnOff LanguageFlag] -> [LanguageFlag]
flattenLanguageFlags' = foldr f defaultLanguageFlags
flattenExtensionFlags' :: [OnOff ExtensionFlag] -> [ExtensionFlag]
flattenExtensionFlags' = foldr f defaultExtensionFlags
where f (On f) flags = f : delete f flags
f (Off f) flags = delete f flags
defaultLanguageFlags = [
defaultExtensionFlags = [
Opt_MonoPatBinds, -- Experimentally, I'm making this non-standard
-- behaviour the default, to see if anyone notices
-- SLPJ July 06
......@@ -807,7 +807,7 @@ instance DOpt DynFlag where
dopt_set = dopt_set'
dopt_unset = dopt_unset'
instance DOpt LanguageFlag where
instance DOpt ExtensionFlag where
dopt = lopt
dopt_set = lopt_set
dopt_unset = lopt_unset
......@@ -824,39 +824,39 @@ dopt_set' dfs f = dfs{ flags = f : flags dfs }
dopt_unset' :: DynFlags -> DynFlag -> DynFlags
dopt_unset' dfs f = dfs{ flags = filter (/= f) (flags dfs) }
-- | Test whether a 'LanguageFlag' is set
lopt :: LanguageFlag -> DynFlags -> Bool
lopt f dflags = case languageFlags dflags of
Left _ -> panic ("Testing for language flag " ++ show f ++ " before flattening")
-- | 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 'LanguageFlag'
lopt_set :: DynFlags -> LanguageFlag -> DynFlags
lopt_set dfs f = case languageFlags dfs of
Left onoffs -> dfs { languageFlags = Left (On f : onoffs) }
Right _ -> panic ("Setting language flag " ++ show f ++ " after flattening")
-- | 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 'LanguageFlag'
lopt_set_flattened :: DynFlags -> LanguageFlag -> DynFlags
lopt_set_flattened dfs f = case languageFlags dfs of
-- | Set a 'ExtensionFlag'
lopt_set_flattened :: DynFlags -> ExtensionFlag -> DynFlags
lopt_set_flattened dfs f = case extensionFlags dfs of
Left _ ->
panic ("Setting language flag " ++ show f ++ " before flattening, but expected flattened")
panic ("Setting extension flag " ++ show f ++ " before flattening, but expected flattened")
Right flags ->
dfs { languageFlags = Right (f : delete f flags) }
dfs { extensionFlags = Right (f : delete f flags) }
-- | Unset a 'LanguageFlag'
lopt_unset :: DynFlags -> LanguageFlag -> DynFlags
lopt_unset dfs f = case languageFlags dfs of
Left onoffs -> dfs { languageFlags = Left (Off f : onoffs) }
Right _ -> panic ("Unsetting language flag " ++ show f ++ " after flattening")
-- | 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 'LanguageFlag'
lopt_unset_flattened :: DynFlags -> LanguageFlag -> DynFlags
lopt_unset_flattened dfs f = case languageFlags dfs of
-- | Unset a 'ExtensionFlag'
lopt_unset_flattened :: DynFlags -> ExtensionFlag -> DynFlags
lopt_unset_flattened dfs f = case extensionFlags dfs of
Left _ ->
panic ("Unsetting language flag " ++ show f ++ " before flattening, but expected flattened")
panic ("Unsetting extension flag " ++ show f ++ " before flattening, but expected flattened")
Right flags ->
dfs { languageFlags = Right (delete f 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
......@@ -1114,7 +1114,7 @@ allFlags = map ('-':) $
map ("fno-"++) flags ++
map ("f"++) flags ++
map ("f"++) flags' ++
map ("X"++) supportedLanguages
map ("X"++) supportedExtensions
where ok (PrefixPred _ _) = False
ok _ = True
flags = [ name | (name, _, _) <- fFlags ]
......@@ -1123,7 +1123,7 @@ allFlags = map ('-':) $
dynamic_flags :: [Flag DynP]
dynamic_flags = [
Flag "n" (NoArg (setDynFlag Opt_DryRun)) Supported
, Flag "cpp" (NoArg (setLanguageFlag 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")
......@@ -1526,10 +1526,10 @@ dynamic_flags = [
]
++ map (mkFlag True "f" setDynFlag ) fFlags
++ map (mkFlag False "fno-" unSetDynFlag) fFlags
++ map (mkFlag True "f" setLanguageFlag ) fLangFlags
++ map (mkFlag False "fno-" unSetLanguageFlag) fLangFlags
++ map (mkFlag True "X" setLanguageFlag ) xFlags
++ map (mkFlag False "XNo" unSetLanguageFlag) 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
package_flags :: [Flag DynP]
package_flags = [
......@@ -1557,8 +1557,8 @@ mkFlag :: Bool -- ^ True <=> it should be turned on
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
......@@ -1651,51 +1651,51 @@ fFlags = [
]
-- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@
fLangFlags :: [(String, LanguageFlag, Bool -> Deprecated)]
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" )
deprecatedForExtension "IncoherentInstances" )
]
supportedLanguages :: [String]
supportedLanguages = [ name' | (name, _, _) <- xFlags, name' <- [name, "No" ++ name] ]
supportedExtensions :: [String]
supportedExtensions = [ name' | (name, _, _) <- xFlags, name' <- [name, "No" ++ name] ]
-- This may contain duplicates
languageOptions :: [LanguageFlag]
languageOptions = [ langFlag | (_, langFlag, _) <- xFlags ]
extensionOptions :: [ExtensionFlag]
extensionOptions = [ langFlag | (_, langFlag, _) <- xFlags ]
-- | These -X<blah> flags can all be reversed with -XNo<blah>
xFlags :: [(String, LanguageFlag, Bool -> Deprecated)]
xFlags :: [(String, ExtensionFlag, Bool -> Deprecated)]
xFlags = [
( "CPP", Opt_Cpp, const Supported ),
( "PostfixOperators", Opt_PostfixOperators, const Supported ),
......@@ -1719,7 +1719,7 @@ 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 ),
......@@ -1731,7 +1731,7 @@ xFlags = [
( "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 ),
......@@ -1756,7 +1756,7 @@ xFlags = [
( "ScopedTypeVariables", Opt_ScopedTypeVariables, const Supported ),
( "PatternSignatures", Opt_ScopedTypeVariables,
deprecatedForLanguage "ScopedTypeVariables" ),
deprecatedForExtension "ScopedTypeVariables" ),
( "UnboxedTuples", Opt_UnboxedTuples, const Supported ),
( "StandaloneDeriving", Opt_StandaloneDeriving, const Supported ),
......@@ -1779,7 +1779,7 @@ xFlags = [
const $ Deprecated "The new qualified operator syntax was rejected by Haskell'" )
]
impliedFlags :: [(LanguageFlag, LanguageFlag)]
impliedFlags :: [(ExtensionFlag, ExtensionFlag)]
impliedFlags
= [ (Opt_RankNTypes, Opt_ExplicitForAll)
, (Opt_Rank2Types, Opt_ExplicitForAll)
......@@ -1808,13 +1808,13 @@ impliedFlags
enableGlasgowExts :: DynP ()
enableGlasgowExts = do setDynFlag Opt_PrintExplicitForalls
mapM_ setLanguageFlag glasgowExtsFlags
mapM_ setExtensionFlag glasgowExtsFlags
disableGlasgowExts :: DynP ()
disableGlasgowExts = do unSetDynFlag Opt_PrintExplicitForalls
mapM_ unSetLanguageFlag glasgowExtsFlags
mapM_ unSetExtensionFlag glasgowExtsFlags
glasgowExtsFlags :: [LanguageFlag]
glasgowExtsFlags :: [ExtensionFlag]
glasgowExtsFlags = [
Opt_ForeignFunctionInterface
, Opt_UnliftedFFITypes
......@@ -1923,18 +1923,18 @@ setDynFlag f = upd (\dfs -> dopt_set dfs f)
unSetDynFlag f = upd (\dfs -> dopt_unset dfs f)
--------------------------
setLanguageFlag, unSetLanguageFlag :: LanguageFlag -> DynP ()
setLanguageFlag f = do { upd (\dfs -> lopt_set dfs f)
; mapM_ setLanguageFlag deps }
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 setLanguageFlag recursively, in case the implied 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)
unSetLanguageFlag f = upd (\dfs -> lopt_unset dfs f)
unSetExtensionFlag f = upd (\dfs -> lopt_unset dfs f)
--------------------------
setDumpFlag :: DynFlag -> OptKind DynP
......
compiler/main/HeaderInfo.hs
View file @ 1971591f
......@@ -266,7 +266,7 @@ checkExtension (L l ext)
-- Checks if a given extension is valid, and if so returns
-- its corresponding flag. Otherwise it throws an exception.
= let ext' = unpackFS ext in
if ext' `elem` supportedLanguages
if ext' `elem` supportedExtensions
then L l ("-X"++ext')
else unsupportedExtnError l ext'
......@@ -285,7 +285,7 @@ unsupportedExtnError loc unsup =
mkPlainErrMsg loc $
text "Unsupported extension: " <> text unsup $$
if null suggestions then empty else text "Perhaps you meant" <+> quotedListWithOr (map text suggestions)
where suggestions = fuzzyMatch unsup supportedLanguages
where suggestions = fuzzyMatch unsup supportedExtensions
optionsErrorMsgs :: [String] -> [Located String] -> FilePath -> Messages
......
compiler/typecheck/TcDeriv.lhs
View file @ 1971591f
......@@ -977,7 +977,7 @@ cond_functorOK allowFunctions (dflags, rep_tc)
functions = ptext (sLit "contains function types")
wrong_arg = ptext (sLit "uses the type variable in an argument other than the last")
checkFlag :: LanguageFlag -> Condition
checkFlag :: ExtensionFlag -> Condition
checkFlag flag (dflags, _)
| dopt flag dflags = Nothing
| otherwise = Just why
......
compiler/typecheck/TcRnMonad.lhs
View file @ 1971591f
......@@ -235,7 +235,7 @@ doptM flag = do { dflags <- getDOpts; return (dopt flag dflags) }
-- XXX setOptM and unsetOptM operate on different types. One should be renamed.
setOptM :: LanguageFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
setOptM :: ExtensionFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
setOptM flag = updEnv (\ env@(Env { env_top = top }) ->
env { env_top = top { hsc_dflags = lopt_set_flattened (hsc_dflags top) flag}} )
......
ghc/InteractiveUI.hs
View file @ 1971591f
......@@ -1193,7 +1193,7 @@ shellEscape str = io (system str >> return False)
withFlattenedDynflags :: GHC.GhcMonad m => m a -> m a
withFlattenedDynflags m
= do dflags <- GHC.getSessionDynFlags
gbracket (GHC.setSessionDynFlags (ensureFlattenedLanguageFlags dflags))
gbracket (GHC.setSessionDynFlags (ensureFlattenedExtensionFlags dflags))
(\_ -> GHC.setSessionDynFlags dflags)
(\_ -> m)
......
ghc/Main.hs
View file @ 1971591f
......@@ -105,7 +105,7 @@ main = do
case mode of
Left preStartupMode ->
do case preStartupMode of
ShowSupportedLanguages -> showSupportedLanguages
ShowSupportedExtensions -> showSupportedExtensions
ShowVersion -> showVersion
ShowNumVersion -> putStrLn cProjectVersion
Print str -> putStrLn str
......@@ -351,13 +351,13 @@ type PostStartupMode = Either PreLoadMode PostLoadMode
data PreStartupMode
= ShowVersion -- ghc -V/--version
| ShowNumVersion -- ghc --numeric-version
| ShowSupportedLanguages -- ghc --supported-languages
| ShowSupportedExtensions -- ghc --supported-extensions
| Print String -- ghc --print-foo
showVersionMode, showNumVersionMode, showSupportedLanguagesMode :: Mode
showVersionMode = mkPreStartupMode ShowVersion
showNumVersionMode = mkPreStartupMode ShowNumVersion
showSupportedLanguagesMode = mkPreStartupMode ShowSupportedLanguages
showVersionMode, showNumVersionMode, showSupportedExtensionsMode :: Mode
showVersionMode = mkPreStartupMode ShowVersion
showNumVersionMode = mkPreStartupMode ShowNumVersion
showSupportedExtensionsMode = mkPreStartupMode ShowSupportedExtensions
printMode :: String -> Mode
printMode str = mkPreStartupMode (Print str)
......@@ -496,19 +496,21 @@ type ModeM = CmdLineP (Maybe (Mode, String), [String], [Located String])
mode_flags :: [Flag ModeM]
mode_flags =
[ ------- help / version ----------------------------------------------
Flag "?" (PassFlag (setMode showGhcUsageMode))
Flag "?" (PassFlag (setMode showGhcUsageMode))
Supported
, Flag "-help" (PassFlag (setMode showGhcUsageMode))
, Flag "-help" (PassFlag (setMode showGhcUsageMode))
Supported
, Flag "V" (PassFlag (setMode showVersionMode))
, Flag "V" (PassFlag (setMode showVersionMode))
Supported
, Flag "-version" (PassFlag (setMode showVersionMode))
, Flag "-version" (PassFlag (setMode showVersionMode))
Supported
, Flag "-numeric-version" (PassFlag (setMode showNumVersionMode))
, Flag "-numeric-version" (PassFlag (setMode showNumVersionMode))
Supported
, Flag "-info" (PassFlag (setMode showInfoMode))
, Flag "-info" (PassFlag (setMode showInfoMode))
Supported
, Flag "-supported-languages" (PassFlag (setMode showSupportedLanguagesMode))
, Flag "-supported-languages" (PassFlag (setMode showSupportedExtensionsMode))
Supported
, Flag "-supported-extensions" (PassFlag (setMode showSupportedExtensionsMode))
Supported
] ++
[ Flag k' (PassFlag (setMode mode))
......@@ -674,8 +676,8 @@ showInfo dflags = do
where flatten (k, String v) = (k, v)
flatten (k, FromDynFlags f) = (k, f dflags)
showSupportedLanguages :: IO ()
showSupportedLanguages = mapM_ putStrLn supportedLanguages
showSupportedExtensions :: IO ()
showSupportedExtensions = mapM_ putStrLn supportedExtensions
showVersion :: IO ()
showVersion = putStrLn (cProjectName ++ ", version " ++ cProjectVersion)
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment