From: Ian Lynagh Date: Sat, 24 Jul 2010 22:36:24 +0000 (+0000) Subject: Rename "language" varibles etc to "extension", and add --supported-extensions X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=1971591f865ac0806802c476f23792ae2c89411a Rename "language" varibles etc to "extension", and add --supported-extensions --- diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index a77aa7a..2019836 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -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) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 74ca83f..afe6652 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -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\@ flags can all be reversed with @-fno-\@ -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 flags can all be reversed with -XNo -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 diff --git a/compiler/main/HeaderInfo.hs b/compiler/main/HeaderInfo.hs index cf61b8c..4c664bd 100644 --- a/compiler/main/HeaderInfo.hs +++ b/compiler/main/HeaderInfo.hs @@ -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 diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs index 5fcb45c..446bbdb 100644 --- a/compiler/typecheck/TcDeriv.lhs +++ b/compiler/typecheck/TcDeriv.lhs @@ -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 diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs index d9c41c0..6d5d6d1 100644 --- a/compiler/typecheck/TcRnMonad.lhs +++ b/compiler/typecheck/TcRnMonad.lhs @@ -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}} ) diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index 1998e86..4b48c98 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -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) diff --git a/ghc/Main.hs b/ghc/Main.hs index b7da083..a62663d 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -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)