Commit 624a7c5a authored by Lennart Kolmodin's avatar Lennart Kolmodin Committed by Austin Seipp

ghc: allow --show-options and --interactive together

Summary:
Previously 'ghc --show-options' showed all options that GHC can possibly
accept. With this patch, it'll only show the options that have effect in
non-interactive modes.
This change also adds support for using 'ghc --interactive --show-options'
which previously was disallowed. This command will show all options that have
effect in the interactive mode.
The CmdLineParser is updated to know about the GHC modes, and then each flag
is annotated with which mode it has effect.
This fixes #9259.

Test Plan:
Try out --show-options with --interactive on the command line. With and without
--interactive should give different results.
Run the test suite, mode001 has been updated to verify this new flag
combination.

Reviewers: austin, jstolarek

Reviewed By: austin, jstolarek

Subscribers: jstolarek, thomie, carter, simonmar

Differential Revision: https://phabricator.haskell.org/D337

GHC Trac Issues: #9259
parent 02f8f6ad
......@@ -13,9 +13,9 @@
module CmdLineParser
(
processArgs, OptKind(..),
processArgs, OptKind(..), GhcFlagMode(..),
CmdLineP(..), getCmdLineState, putCmdLineState,
Flag(..),
Flag(..), defFlag, defGhcFlag, defGhciFlag, defHiddenFlag,
errorsToGhcException,
EwM, addErr, addWarn, getArg, getCurLoc, liftEwM, deprecate
......@@ -42,10 +42,30 @@ import Control.Applicative (Applicative(..))
--------------------------------------------------------
data Flag m = Flag
{ flagName :: String, -- Flag, without the leading "-"
flagOptKind :: OptKind m -- What to do if we see it
{ flagName :: String, -- Flag, without the leading "-"
flagOptKind :: OptKind m, -- What to do if we see it
flagGhcMode :: GhcFlagMode -- Which modes this flag affects
}
defFlag :: String -> OptKind m -> Flag m
defFlag name optKind = Flag name optKind AllModes
defGhcFlag :: String -> OptKind m -> Flag m
defGhcFlag name optKind = Flag name optKind OnlyGhc
defGhciFlag :: String -> OptKind m -> Flag m
defGhciFlag name optKind = Flag name optKind OnlyGhci
defHiddenFlag :: String -> OptKind m -> Flag m
defHiddenFlag name optKind = Flag name optKind HiddenFlag
-- | GHC flag modes describing when a flag has an effect.
data GhcFlagMode
= OnlyGhc -- ^ The flag only affects the non-interactive GHC
| OnlyGhci -- ^ The flag only affects the interactive GHC
| AllModes -- ^ The flag affects multiple ghc modes
| HiddenFlag -- ^ This flag should not be seen in cli completion
data OptKind m -- Suppose the flag is -f
= NoArg (EwM m ()) -- -f all by itself
| HasArg (String -> EwM m ()) -- -farg or -f arg
......
This diff is collapsed.
......@@ -119,17 +119,17 @@ staticFlags = unsafePerformIO $ do
flagsStatic :: [Flag IO]
flagsStatic = [
------ Debugging ----------------------------------------------------
Flag "dppr-debug" (PassFlag addOptEwM)
, Flag "dno-debug-output" (PassFlag addOptEwM)
defFlag "dppr-debug" (PassFlag addOptEwM)
, defFlag "dno-debug-output" (PassFlag addOptEwM)
-- rest of the debugging flags are dynamic
------ Compiler flags -----------------------------------------------
-- All other "-fno-<blah>" options cancel out "-f<blah>" on the hsc cmdline
, Flag "fno-"
, defFlag "fno-"
(PrefixPred (\s -> isStaticFlag ("f"++s)) (\s -> removeOptEwM ("-f"++s)))
-- Pass all remaining "-f<blah>" options to hsc
, Flag "f" (AnySuffixPred isStaticFlag addOptEwM)
, defFlag "f" (AnySuffixPred isStaticFlag addOptEwM)
]
......
......@@ -1442,7 +1442,7 @@ checkFlag flag (dflags, _, _)
where
why = ptext (sLit "You need ") <> text flag_str
<+> ptext (sLit "to derive an instance for this class")
flag_str = case [ s | (s, f, _) <- xFlags, f==flag ] of
flag_str = case [ flagSpecName f | f <- xFlags , flagSpecFlag f == flag ] of
[s] -> s
other -> pprPanic "checkFlag" (ppr other)
......
......@@ -1874,26 +1874,6 @@
<entry><option>-fno-liberate-case-threshold</option></entry>
</row>
<row>
<entry><option>-fllvm-pass-vectors-in-regs</option>
</entry>
<entry>Attempt to pass SIMD vectors in registers for LLVM backend on 32-bit architectures. This is dangerous.
See full description in <xref linkend="options-f"/> for details.
</entry>
<entry>dynamic</entry>
<entry><option>-fno-llvm-pass-vectors-in-regs</option></entry>
</row>
<row>
<entry><option>-fllvm-tbaa</option>
</entry>
<entry>Enable type-based alias analysis for LLVM backend.
Always enabled by default.
</entry>
<entry>dynamic</entry>
<entry><option>-fno-llvm-tbaa</option></entry>
</row>
<row>
<entry><option>-floopification</option></entry>
<entry>Turn saturated self-recursive tail-calls into local jumps in the generated assembly.
......
......@@ -2420,35 +2420,6 @@ _ = rhs3 -- No warning: lone wild-card pattern
</listitem>
</varlistentry>
<varlistentry>
<term>
<option>-fllvm-pass-vectors-in-regs</option>
<indexterm><primary><option>-fllvm-pass-vectors-in-regs</option></primary></indexterm>
</term>
<listitem>
<para>On 32-bit machines it changes calling convention used with LLVM backend
to pass 128-bit vectors in SIMD registers. At the moment this does not work
because this is not supported by LLVM. We strongly suggest you don't use this flag.
</para>
</listitem>
</varlistentry>
<varlistentry>
<term>
<option>-fllvm-tbaa</option>
<indexterm><primary><option>-fllvm-tbaa</option></primary></indexterm>
</term>
<listitem>
<para><emphasis>On by default for <option>-O0</option>, <option>-O</option>,
<option>-O2</option>.</emphasis>
</para>
<para>Enables type-based alias analysis for LLVM backend.
At the moment this has limited usefullness since we pass
very little information to LLVM.
</para>
</listitem>
</varlistentry>
<varlistentry>
<term>
<option>-floopification</option>
......
......@@ -2025,11 +2025,13 @@ showDynFlags show_all dflags = do
text "warning settings:" $$
nest 2 (vcat (map (setting wopt) DynFlags.fWarningFlags))
where
setting test (str, f, _)
setting test flag
| quiet = empty
| is_on = fstr str
| otherwise = fnostr str
where is_on = test f dflags
| is_on = fstr name
| otherwise = fnostr name
where name = flagSpecName flag
f = flagSpecFlag flag
is_on = test f dflags
quiet = not show_all && test f default_dflags == is_on
default_dflags = defaultDynFlags (settings dflags)
......@@ -2037,7 +2039,7 @@ showDynFlags show_all dflags = do
fstr str = text "-f" <> text str
fnostr str = text "-fno-" <> text str
(ghciFlags,others) = partition (\(_, f, _) -> f `elem` flgs)
(ghciFlags,others) = partition (\f -> flagSpecFlag f `elem` flgs)
DynFlags.fFlags
flgs = [ Opt_PrintExplicitForalls
, Opt_PrintExplicitKinds
......@@ -2387,11 +2389,13 @@ showLanguages' show_all dflags =
nest 2 (vcat (map (setting xopt) DynFlags.xFlags))
]
where
setting test (str, f, _)
setting test flag
| quiet = empty
| is_on = text "-X" <> text str
| otherwise = text "-XNo" <> text str
where is_on = test f dflags
| is_on = text "-X" <> text name
| otherwise = text "-XNo" <> text name
where name = flagSpecName flag
f = flagSpecFlag flag
is_on = test f dflags
quiet = not show_all && test f default_dflags == is_on
default_dflags =
......
......@@ -107,10 +107,10 @@ main = do
case mode of
Left preStartupMode ->
do case preStartupMode of
ShowSupportedExtensions -> showSupportedExtensions
ShowVersion -> showVersion
ShowNumVersion -> putStrLn cProjectVersion
ShowOptions -> showOptions
ShowSupportedExtensions -> showSupportedExtensions
ShowVersion -> showVersion
ShowNumVersion -> putStrLn cProjectVersion
ShowOptions isInteractive -> showOptions isInteractive
Right postStartupMode ->
-- start our GHC session
GHC.runGhc mbMinusB $ do
......@@ -378,16 +378,16 @@ type Mode = Either PreStartupMode PostStartupMode
type PostStartupMode = Either PreLoadMode PostLoadMode
data PreStartupMode
= ShowVersion -- ghc -V/--version
| ShowNumVersion -- ghc --numeric-version
| ShowSupportedExtensions -- ghc --supported-extensions
| ShowOptions -- ghc --show-options
= ShowVersion -- ghc -V/--version
| ShowNumVersion -- ghc --numeric-version
| ShowSupportedExtensions -- ghc --supported-extensions
| ShowOptions Bool {- isInteractive -} -- ghc --show-options
showVersionMode, showNumVersionMode, showSupportedExtensionsMode, showOptionsMode :: Mode
showVersionMode = mkPreStartupMode ShowVersion
showNumVersionMode = mkPreStartupMode ShowNumVersion
showSupportedExtensionsMode = mkPreStartupMode ShowSupportedExtensions
showOptionsMode = mkPreStartupMode ShowOptions
showOptionsMode = mkPreStartupMode (ShowOptions False)
mkPreStartupMode :: PreStartupMode -> Mode
mkPreStartupMode = Left
......@@ -528,18 +528,18 @@ type ModeM = CmdLineP (Maybe (Mode, String), [String], [Located String])
mode_flags :: [Flag ModeM]
mode_flags =
[ ------- help / version ----------------------------------------------
Flag "?" (PassFlag (setMode showGhcUsageMode))
, Flag "-help" (PassFlag (setMode showGhcUsageMode))
, Flag "V" (PassFlag (setMode showVersionMode))
, Flag "-version" (PassFlag (setMode showVersionMode))
, Flag "-numeric-version" (PassFlag (setMode showNumVersionMode))
, Flag "-info" (PassFlag (setMode showInfoMode))
, Flag "-show-options" (PassFlag (setMode showOptionsMode))
, Flag "-supported-languages" (PassFlag (setMode showSupportedExtensionsMode))
, Flag "-supported-extensions" (PassFlag (setMode showSupportedExtensionsMode))
, Flag "-show-packages" (PassFlag (setMode showPackagesMode))
defFlag "?" (PassFlag (setMode showGhcUsageMode))
, defFlag "-help" (PassFlag (setMode showGhcUsageMode))
, defFlag "V" (PassFlag (setMode showVersionMode))
, defFlag "-version" (PassFlag (setMode showVersionMode))
, defFlag "-numeric-version" (PassFlag (setMode showNumVersionMode))
, defFlag "-info" (PassFlag (setMode showInfoMode))
, defFlag "-show-options" (PassFlag (setMode showOptionsMode))
, defFlag "-supported-languages" (PassFlag (setMode showSupportedExtensionsMode))
, defFlag "-supported-extensions" (PassFlag (setMode showSupportedExtensionsMode))
, defFlag "-show-packages" (PassFlag (setMode showPackagesMode))
] ++
[ Flag k' (PassFlag (setMode (printSetting k)))
[ defFlag k' (PassFlag (setMode (printSetting k)))
| k <- ["Project version",
"Booter version",
"Stage",
......@@ -565,20 +565,20 @@ mode_flags =
replaceSpace c = c
] ++
------- interfaces ----------------------------------------------------
[ Flag "-show-iface" (HasArg (\f -> setMode (showInterfaceMode f)
[ defFlag "-show-iface" (HasArg (\f -> setMode (showInterfaceMode f)
"--show-iface"))
------- primary modes ------------------------------------------------
, Flag "c" (PassFlag (\f -> do setMode (stopBeforeMode StopLn) f
addFlag "-no-link" f))
, Flag "M" (PassFlag (setMode doMkDependHSMode))
, Flag "E" (PassFlag (setMode (stopBeforeMode anyHsc)))
, Flag "C" (PassFlag (setMode (stopBeforeMode HCc)))
, Flag "S" (PassFlag (setMode (stopBeforeMode (As False))))
, Flag "-make" (PassFlag (setMode doMakeMode))
, Flag "-interactive" (PassFlag (setMode doInteractiveMode))
, Flag "-abi-hash" (PassFlag (setMode doAbiHashMode))
, Flag "e" (SepArg (\s -> setMode (doEvalMode s) "-e"))
, defFlag "c" (PassFlag (\f -> do setMode (stopBeforeMode StopLn) f
addFlag "-no-link" f))
, defFlag "M" (PassFlag (setMode doMkDependHSMode))
, defFlag "E" (PassFlag (setMode (stopBeforeMode anyHsc)))
, defFlag "C" (PassFlag (setMode (stopBeforeMode HCc)))
, defFlag "S" (PassFlag (setMode (stopBeforeMode (As False))))
, defFlag "-make" (PassFlag (setMode doMakeMode))
, defFlag "-interactive" (PassFlag (setMode doInteractiveMode))
, defFlag "-abi-hash" (PassFlag (setMode doAbiHashMode))
, defFlag "e" (SepArg (\s -> setMode (doEvalMode s) "-e"))
]
setMode :: Mode -> String -> EwM ModeM ()
......@@ -612,6 +612,14 @@ setMode newMode newFlag = liftEwM $ do
errs)
-- Saying e.g. --interactive --interactive is OK
_ | oldFlag == newFlag -> ((oldMode, oldFlag), errs)
-- --interactive and --show-options are used together
(Right (Right DoInteractive), Left (ShowOptions _)) ->
((Left (ShowOptions True),
"--interactive --show-options"), errs)
(Left (ShowOptions _), (Right (Right DoInteractive))) ->
((Left (ShowOptions True),
"--show-options --interactive"), errs)
-- Otherwise, complain
_ -> let err = flagMismatchErr oldFlag newFlag
in ((oldMode, oldFlag), err : errs)
......@@ -711,20 +719,22 @@ showSupportedExtensions = mapM_ putStrLn supportedLanguagesAndExtensions
showVersion :: IO ()
showVersion = putStrLn (cProjectName ++ ", version " ++ cProjectVersion)
showOptions :: IO ()
showOptions = putStr (unlines availableOptions)
showOptions :: Bool -> IO ()
showOptions isInteractive = putStr (unlines availableOptions)
where
availableOptions = map ((:) '-') $
getFlagNames mode_flags ++
getFlagNames flagsDynamic ++
(filterUnwantedStatic . getFlagNames $ flagsStatic) ++
flagsStaticNames
getFlagNames opts = map getFlagName opts
getFlagName (Flag name _) = name
availableOptions = concat [
flagsForCompletion isInteractive,
map ('-':) (concat [
getFlagNames mode_flags
, (filterUnwantedStatic . getFlagNames $ flagsStatic)
, flagsStaticNames
])
]
getFlagNames opts = map flagName opts
-- this is a hack to get rid of two unwanted entries that get listed
-- as static flags. Hopefully this hack will disappear one day together
-- with static flags
filterUnwantedStatic = filter (\x -> not (x `elem` ["f", "fno-"]))
filterUnwantedStatic = filter (`notElem`["f", "fno-"])
showGhcUsage :: DynFlags -> IO ()
showGhcUsage = showUsage False
......
......@@ -440,6 +440,8 @@ mode001:
"$(TEST_HC)" $(TEST_HC_OPTS_NO_RECOMP) --help --version | sed '2,$$d'
"$(TEST_HC)" $(TEST_HC_OPTS_NO_RECOMP) --interactive --version | sed "s/, version.*//"
"$(TEST_HC)" $(TEST_HC_OPTS_NO_RECOMP) --version --interactive | sed "s/, version.*//"
"$(TEST_HC)" $(TEST_HC_OPTS_NO_RECOMP) --interactive --show-options | grep -- --interactive | sed '2,$$d'
"$(TEST_HC)" $(TEST_HC_OPTS_NO_RECOMP) --show-options --interactive | grep -- --interactive | sed '2,$$d'
# Test for building DLLs with ghc -shared, see #2745
shared001:
......
......@@ -8,7 +8,7 @@ import Language.Haskell.Extension
main :: IO ()
main = do
let ghcExtensions = [ ext | (ext, _, _) <- xFlags ]
let ghcExtensions = map flagSpecName xFlags
cabalExtensions = map show [ toEnum 0 :: KnownExtension .. ]
ghcOnlyExtensions = ghcExtensions \\ cabalExtensions
cabalOnlyExtensions = cabalExtensions \\ ghcExtensions
......
......@@ -6,3 +6,5 @@ The Glorious Glasgow Haskell Compilation System
Usage:
The Glorious Glasgow Haskell Compilation System
The Glorious Glasgow Haskell Compilation System
--interactive
--interactive
Markdown is supported
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