Commit 1f4bc1f3 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Separate language option handling into 2 phases

We now first collect the option instructions (from the commandline,
from pragmas in source files, etc), and then later flatten them into
the list of enabled options. This will enable us to use different
standards (H98, H2010, etc) as a base upon which to apply the
instructions, when we don't know what the base will be when we start
collecting instructions.
parent 27286cf2
...@@ -698,27 +698,30 @@ runPhase (Unlit sf) _stop hsc_env _basename _suff input_fn get_output_fn maybe_l ...@@ -698,27 +698,30 @@ 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 runPhase (Cpp sf) _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc
= do let dflags0 = hsc_dflags hsc_env = do let dflags0 = hsc_dflags hsc_env
src_opts <- liftIO $ getOptionsFromFile dflags0 input_fn let dflags0' = flattenLanguageFlags dflags0
src_opts <- liftIO $ getOptionsFromFile dflags0' input_fn
(dflags1, unhandled_flags, warns) (dflags1, unhandled_flags, warns)
<- liftIO $ parseDynamicNoPackageFlags dflags0 src_opts <- liftIO $ parseDynamicNoPackageFlags dflags0 src_opts
checkProcessArgsResult unhandled_flags checkProcessArgsResult unhandled_flags
let dflags1' = flattenLanguageFlags dflags1
if not (dopt Opt_Cpp dflags1) then do if not (dopt Opt_Cpp dflags1') then do
-- we have to be careful to emit warnings only once. -- we have to be careful to emit warnings only once.
unless (dopt Opt_Pp dflags1) $ handleFlagWarnings dflags1 warns unless (dopt Opt_Pp dflags1') $ handleFlagWarnings dflags1' warns
-- no need to preprocess CPP, just pass input file along -- no need to preprocess CPP, just pass input file along
-- to the next phase of the pipeline. -- to the next phase of the pipeline.
return (HsPp sf, dflags1, maybe_loc, input_fn) return (HsPp sf, dflags1, maybe_loc, input_fn)
else do else do
output_fn <- liftIO $ get_output_fn dflags1 (HsPp sf) maybe_loc output_fn <- liftIO $ get_output_fn dflags1' (HsPp sf) maybe_loc
liftIO $ doCpp dflags1 True{-raw-} False{-no CC opts-} input_fn output_fn liftIO $ doCpp dflags1' True{-raw-} False{-no CC opts-} input_fn output_fn
-- re-read the pragmas now that we've preprocessed the file -- re-read the pragmas now that we've preprocessed the file
-- See #2464,#3457 -- See #2464,#3457
src_opts <- liftIO $ getOptionsFromFile dflags0 output_fn src_opts <- liftIO $ getOptionsFromFile dflags0' output_fn
(dflags2, unhandled_flags, warns) (dflags2, unhandled_flags, warns)
<- liftIO $ parseDynamicNoPackageFlags dflags0 src_opts <- liftIO $ parseDynamicNoPackageFlags dflags0 src_opts
unless (dopt Opt_Pp dflags2) $ handleFlagWarnings dflags2 warns let dflags2' = flattenLanguageFlags dflags2
unless (dopt Opt_Pp dflags2') $ handleFlagWarnings dflags2' warns
-- the HsPp pass below will emit warnings -- the HsPp pass below will emit warnings
checkProcessArgsResult unhandled_flags checkProcessArgsResult unhandled_flags
...@@ -729,10 +732,11 @@ runPhase (Cpp sf) _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc ...@@ -729,10 +732,11 @@ 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 runPhase (HsPp sf) _stop hsc_env basename suff input_fn get_output_fn maybe_loc
= do let dflags = hsc_dflags hsc_env = do let dflags = hsc_dflags hsc_env
dflags' = flattenLanguageFlags dflags
if not (dopt Opt_Pp dflags) then if not (dopt Opt_Pp dflags) then
-- no need to preprocess, just pass input file along -- no need to preprocess, just pass input file along
-- to the next phase of the pipeline. -- to the next phase of the pipeline.
return (Hsc sf, dflags, maybe_loc, input_fn) return (Hsc sf, dflags', maybe_loc, input_fn)
else do else do
let hspp_opts = getOpts dflags opt_F let hspp_opts = getOpts dflags opt_F
let orig_fn = basename <.> suff let orig_fn = basename <.> suff
...@@ -746,13 +750,14 @@ runPhase (HsPp sf) _stop hsc_env basename suff input_fn get_output_fn maybe_loc ...@@ -746,13 +750,14 @@ runPhase (HsPp sf) _stop hsc_env basename suff input_fn get_output_fn maybe_loc
) )
-- re-read pragmas now that we've parsed the file (see #3674) -- re-read pragmas now that we've parsed the file (see #3674)
src_opts <- liftIO $ getOptionsFromFile dflags output_fn src_opts <- liftIO $ getOptionsFromFile dflags' output_fn
(dflags1, unhandled_flags, warns) (dflags1, unhandled_flags, warns)
<- liftIO $ parseDynamicNoPackageFlags dflags src_opts <- liftIO $ parseDynamicNoPackageFlags dflags src_opts
handleFlagWarnings dflags1 warns let dflags1' = flattenLanguageFlags dflags1
handleFlagWarnings dflags1' warns
checkProcessArgsResult unhandled_flags checkProcessArgsResult unhandled_flags
return (Hsc sf, dflags1, maybe_loc, output_fn) return (Hsc sf, dflags1', maybe_loc, output_fn)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- Hsc phase -- Hsc phase
...@@ -900,9 +905,10 @@ runPhase (Hsc src_flavour) stop hsc_env basename suff input_fn get_output_fn _ma ...@@ -900,9 +905,10 @@ 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 runPhase CmmCpp _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc
= do = do
let dflags = hsc_dflags hsc_env let dflags = hsc_dflags hsc_env
output_fn <- liftIO $ get_output_fn dflags Cmm maybe_loc dflags' = flattenLanguageFlags dflags
liftIO $ doCpp dflags False{-not raw-} True{-include CC opts-} input_fn output_fn output_fn <- liftIO $ get_output_fn dflags' Cmm maybe_loc
return (Cmm, dflags, maybe_loc, output_fn) liftIO $ doCpp dflags' False{-not raw-} True{-include CC opts-} input_fn output_fn
return (Cmm, dflags', maybe_loc, output_fn)
runPhase Cmm stop hsc_env basename _ input_fn get_output_fn maybe_loc runPhase Cmm stop hsc_env basename _ input_fn get_output_fn maybe_loc
= do = do
......
...@@ -14,6 +14,10 @@ module DynFlags ( ...@@ -14,6 +14,10 @@ module DynFlags (
DOpt(..), DOpt(..),
DynFlag(..), DynFlag(..),
LanguageFlag(..), LanguageFlag(..),
flattenLanguageFlags,
ensureFlattenedLanguageFlags,
lopt_set_flattened,
lopt_unset_flattened,
DynFlags(..), DynFlags(..),
HscTarget(..), isObjectTarget, defaultObjectTarget, HscTarget(..), isObjectTarget, defaultObjectTarget,
GhcMode(..), isOneShot, GhcMode(..), isOneShot,
...@@ -473,7 +477,8 @@ data DynFlags = DynFlags { ...@@ -473,7 +477,8 @@ data DynFlags = DynFlags {
-- hsc dynamic flags -- hsc dynamic flags
flags :: [DynFlag], flags :: [DynFlag],
languageFlags :: [LanguageFlag], languageFlags :: Either [OnOff LanguageFlag]
[LanguageFlag],
-- | Message output action: use "ErrUtils" instead of this if you can -- | Message output action: use "ErrUtils" instead of this if you can
log_action :: Severity -> SrcSpan -> PprStyle -> Message -> IO (), log_action :: Severity -> SrcSpan -> PprStyle -> Message -> IO (),
...@@ -725,16 +730,7 @@ defaultDynFlags = ...@@ -725,16 +730,7 @@ defaultDynFlags =
-- The default -O0 options -- The default -O0 options
++ standardWarnings, ++ standardWarnings,
languageFlags = [ languageFlags = Left [],
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
],
log_action = \severity srcSpan style msg -> log_action = \severity srcSpan style msg ->
case severity of case severity of
...@@ -759,6 +755,46 @@ Note [Verbosity levels] ...@@ -759,6 +755,46 @@ Note [Verbosity levels]
5 | "ghc -v -ddump-all" 5 | "ghc -v -ddump-all"
-} -}
data OnOff a = On a
| Off a
flattenLanguageFlags :: DynFlags -> DynFlags
flattenLanguageFlags dflags
= case languageFlags dflags of
Left onoffs ->
dflags {
languageFlags = Right $ flattenLanguageFlags' onoffs
}
Right _ ->
panic "Flattening already-flattened language flags"
ensureFlattenedLanguageFlags :: DynFlags -> DynFlags
ensureFlattenedLanguageFlags dflags
= case languageFlags dflags of
Left onoffs ->
dflags {
languageFlags = Right $ flattenLanguageFlags' 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
where f (On f) flags = f : delete f flags
f (Off f) flags = delete f flags
defaultLanguageFlags = [
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
]
-- The DOpt class is a temporary workaround, to avoid having to do -- The DOpt class is a temporary workaround, to avoid having to do
-- a mass-renaming dopt->lopt at the moment -- a mass-renaming dopt->lopt at the moment
class DOpt a where class DOpt a where
...@@ -790,15 +826,37 @@ dopt_unset' dfs f = dfs{ flags = filter (/= f) (flags dfs) } ...@@ -790,15 +826,37 @@ dopt_unset' dfs f = dfs{ flags = filter (/= f) (flags dfs) }
-- | Test whether a 'LanguageFlag' is set -- | Test whether a 'LanguageFlag' is set
lopt :: LanguageFlag -> DynFlags -> Bool lopt :: LanguageFlag -> DynFlags -> Bool
lopt f dflags = f `elem` languageFlags dflags lopt f dflags = case languageFlags dflags of
Left _ -> panic ("Testing for language flag " ++ show f ++ " before flattening")
Right flags -> f `elem` flags
-- | Set a 'LanguageFlag' -- | Set a 'LanguageFlag'
lopt_set :: DynFlags -> LanguageFlag -> DynFlags lopt_set :: DynFlags -> LanguageFlag -> DynFlags
lopt_set dfs f = dfs{ languageFlags = f : languageFlags dfs } 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 'LanguageFlag'
lopt_set_flattened :: DynFlags -> LanguageFlag -> DynFlags
lopt_set_flattened dfs f = case languageFlags dfs of
Left _ ->
panic ("Setting language flag " ++ show f ++ " before flattening, but expected flattened")
Right flags ->
dfs { languageFlags = Right (f : delete f flags) }
-- | Unset a 'LanguageFlag' -- | Unset a 'LanguageFlag'
lopt_unset :: DynFlags -> LanguageFlag -> DynFlags lopt_unset :: DynFlags -> LanguageFlag -> DynFlags
lopt_unset dfs f = dfs{ languageFlags = filter (/= f) (languageFlags dfs) } 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 'LanguageFlag'
lopt_unset_flattened :: DynFlags -> LanguageFlag -> DynFlags
lopt_unset_flattened dfs f = case languageFlags dfs of
Left _ ->
panic ("Unsetting language flag " ++ show f ++ " before flattening, but expected flattened")
Right flags ->
dfs { languageFlags = Right (delete f flags) }
-- | Retrieve the options corresponding to a particular @opt_*@ field in the correct order -- | Retrieve the options corresponding to a particular @opt_*@ field in the correct order
getOpts :: DynFlags -- ^ 'DynFlags' to retrieve the options from getOpts :: DynFlags -- ^ 'DynFlags' to retrieve the options from
......
...@@ -233,11 +233,13 @@ getDOpts = do { env <- getTopEnv; return (hsc_dflags env) } ...@@ -233,11 +233,13 @@ getDOpts = do { env <- getTopEnv; return (hsc_dflags env) }
doptM :: DOpt d => d -> TcRnIf gbl lcl Bool doptM :: DOpt d => d -> TcRnIf gbl lcl Bool
doptM flag = do { dflags <- getDOpts; return (dopt flag dflags) } doptM flag = do { dflags <- getDOpts; return (dopt flag dflags) }
setOptM :: DOpt d => d -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a -- XXX setOptM and unsetOptM operate on different types. One should be renamed.
setOptM :: LanguageFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
setOptM flag = updEnv (\ env@(Env { env_top = top }) -> setOptM flag = updEnv (\ env@(Env { env_top = top }) ->
env { env_top = top { hsc_dflags = dopt_set (hsc_dflags top) flag}} ) env { env_top = top { hsc_dflags = lopt_set_flattened (hsc_dflags top) flag}} )
unsetOptM :: DOpt d => d -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a unsetOptM :: DynFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
unsetOptM flag = updEnv (\ env@(Env { env_top = top }) -> unsetOptM flag = updEnv (\ env@(Env { env_top = top }) ->
env { env_top = top { hsc_dflags = dopt_unset (hsc_dflags top) flag}} ) env { env_top = top { hsc_dflags = dopt_unset (hsc_dflags top) flag}} )
......
...@@ -657,7 +657,7 @@ runStmt stmt step ...@@ -657,7 +657,7 @@ runStmt stmt step
-- a file, otherwise the read buffer can't be flushed). -- a file, otherwise the read buffer can't be flushed).
_ <- liftIO $ IO.try $ hFlushAll stdin _ <- liftIO $ IO.try $ hFlushAll stdin
#endif #endif
result <- GhciMonad.runStmt stmt step result <- withFlattenedDynflags $ GhciMonad.runStmt stmt step
afterRunStmt (const True) result afterRunStmt (const True) result
--afterRunStmt :: GHC.RunResult -> GHCi Bool --afterRunStmt :: GHC.RunResult -> GHCi Bool
...@@ -815,7 +815,8 @@ help _ = io (putStr helpText) ...@@ -815,7 +815,8 @@ help _ = io (putStr helpText)
info :: String -> InputT GHCi () info :: String -> InputT GHCi ()
info "" = ghcError (CmdLineError "syntax: ':i <thing-you-want-info-about>'") info "" = ghcError (CmdLineError "syntax: ':i <thing-you-want-info-about>'")
info s = handleSourceError GHC.printExceptionAndWarnings $ do info s = handleSourceError GHC.printExceptionAndWarnings $
withFlattenedDynflags $ do
{ let names = words s { let names = words s
; dflags <- getDynFlags ; dflags <- getDynFlags
; let pefas = dopt Opt_PrintExplicitForalls dflags ; let pefas = dopt Opt_PrintExplicitForalls dflags
...@@ -856,7 +857,8 @@ runMain :: String -> GHCi () ...@@ -856,7 +857,8 @@ runMain :: String -> GHCi ()
runMain s = case toArgs s of runMain s = case toArgs s of
Left err -> io (hPutStrLn stderr err) Left err -> io (hPutStrLn stderr err)
Right args -> Right args ->
do dflags <- getDynFlags withFlattenedDynflags $ do
dflags <- getDynFlags
case mainFunIs dflags of case mainFunIs dflags of
Nothing -> doWithArgs args "main" Nothing -> doWithArgs args "main"
Just f -> doWithArgs args f Just f -> doWithArgs args f
...@@ -974,7 +976,8 @@ defineMacro overwrite s = do ...@@ -974,7 +976,8 @@ defineMacro overwrite s = do
let new_expr = '(' : definition ++ ") :: String -> IO String" let new_expr = '(' : definition ++ ") :: String -> IO String"
-- compile the expression -- compile the expression
handleSourceError (\e -> GHC.printExceptionAndWarnings e) $ do handleSourceError (\e -> GHC.printExceptionAndWarnings e) $
withFlattenedDynflags $ do
hv <- GHC.compileExpr new_expr hv <- GHC.compileExpr new_expr
io (writeIORef macros_ref -- io (writeIORef macros_ref --
(filtered ++ [(macro_name, lift . runMacro hv, noCompletion)])) (filtered ++ [(macro_name, lift . runMacro hv, noCompletion)]))
...@@ -1001,7 +1004,8 @@ undefineMacro str = mapM_ undef (words str) ...@@ -1001,7 +1004,8 @@ undefineMacro str = mapM_ undef (words str)
cmdCmd :: String -> GHCi () cmdCmd :: String -> GHCi ()
cmdCmd str = do cmdCmd str = do
let expr = '(' : str ++ ") :: IO String" let expr = '(' : str ++ ") :: IO String"
handleSourceError (\e -> GHC.printExceptionAndWarnings e) $ do handleSourceError (\e -> GHC.printExceptionAndWarnings e) $
withFlattenedDynflags $ do
hv <- GHC.compileExpr expr hv <- GHC.compileExpr expr
cmds <- io $ (unsafeCoerce# hv :: IO String) cmds <- io $ (unsafeCoerce# hv :: IO String)
enqueueCommands (lines cmds) enqueueCommands (lines cmds)
...@@ -1084,7 +1088,7 @@ afterLoad ok retain_context prev_context = do ...@@ -1084,7 +1088,7 @@ afterLoad ok retain_context prev_context = do
loaded_mod_names = map GHC.moduleName loaded_mods loaded_mod_names = map GHC.moduleName loaded_mods
modulesLoadedMsg ok loaded_mod_names modulesLoadedMsg ok loaded_mod_names
lift $ setContextAfterLoad prev_context retain_context loaded_mod_summaries withFlattenedDynflags $ lift $ setContextAfterLoad prev_context retain_context loaded_mod_summaries
setContextAfterLoad :: ([Module],[(Module, Maybe (ImportDecl RdrName))]) -> Bool -> [GHC.ModSummary] -> GHCi () setContextAfterLoad :: ([Module],[(Module, Maybe (ImportDecl RdrName))]) -> Bool -> [GHC.ModSummary] -> GHCi ()
...@@ -1164,7 +1168,9 @@ modulesLoadedMsg ok mods = do ...@@ -1164,7 +1168,9 @@ modulesLoadedMsg ok mods = do
typeOfExpr :: String -> InputT GHCi () typeOfExpr :: String -> InputT GHCi ()
typeOfExpr str typeOfExpr str
= handleSourceError (\e -> GHC.printExceptionAndWarnings e) $ do = handleSourceError (\e -> GHC.printExceptionAndWarnings e)
$ withFlattenedDynflags
$ do
ty <- GHC.exprType str ty <- GHC.exprType str
dflags <- getDynFlags dflags <- getDynFlags
let pefas = dopt Opt_PrintExplicitForalls dflags let pefas = dopt Opt_PrintExplicitForalls dflags
...@@ -1172,7 +1178,9 @@ typeOfExpr str ...@@ -1172,7 +1178,9 @@ typeOfExpr str
kindOfType :: String -> InputT GHCi () kindOfType :: String -> InputT GHCi ()
kindOfType str kindOfType str
= handleSourceError (\e -> GHC.printExceptionAndWarnings e) $ do = handleSourceError (\e -> GHC.printExceptionAndWarnings e)
$ withFlattenedDynflags
$ do
ty <- GHC.typeKind str ty <- GHC.typeKind str
printForUser $ text str <+> dcolon <+> ppr ty printForUser $ text str <+> dcolon <+> ppr ty
...@@ -1182,6 +1190,13 @@ quit _ = return True ...@@ -1182,6 +1190,13 @@ quit _ = return True
shellEscape :: String -> GHCi Bool shellEscape :: String -> GHCi Bool
shellEscape str = io (system str >> return False) 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))
(\_ -> GHC.setSessionDynFlags dflags)
(\_ -> m)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- Browsing a module's contents -- Browsing a module's contents
...@@ -1210,7 +1225,7 @@ browseCmd bang m = ...@@ -1210,7 +1225,7 @@ browseCmd bang m =
-- indicate import modules, to aid qualifying unqualified names -- indicate import modules, to aid qualifying unqualified names
-- with sorted, sort items alphabetically -- with sorted, sort items alphabetically
browseModule :: Bool -> Module -> Bool -> InputT GHCi () browseModule :: Bool -> Module -> Bool -> InputT GHCi ()
browseModule bang modl exports_only = do browseModule bang modl exports_only = withFlattenedDynflags $ do
-- :browse! reports qualifiers wrt current context -- :browse! reports qualifiers wrt current context
current_unqual <- GHC.getPrintUnqual current_unqual <- GHC.getPrintUnqual
-- Temporarily set the context to the module we're interested in, -- Temporarily set the context to the module we're interested in,
...@@ -1323,6 +1338,7 @@ setContext str ...@@ -1323,6 +1338,7 @@ setContext str
playCtxtCmd:: Bool -> CtxtCmd -> GHCi () playCtxtCmd:: Bool -> CtxtCmd -> GHCi ()
playCtxtCmd fail cmd = do playCtxtCmd fail cmd = do
withFlattenedDynflags $ do
(prev_as,prev_bs) <- GHC.getContext (prev_as,prev_bs) <- GHC.getContext
case cmd of case cmd of
SetContext as bs -> do SetContext as bs -> do
...@@ -1850,7 +1866,7 @@ forceCmd = pprintCommand False True ...@@ -1850,7 +1866,7 @@ forceCmd = pprintCommand False True
pprintCommand :: Bool -> Bool -> String -> GHCi () pprintCommand :: Bool -> Bool -> String -> GHCi ()
pprintCommand bind force str = do pprintCommand bind force str = do
pprintClosureCommand bind force str withFlattenedDynflags $ pprintClosureCommand bind force str
stepCmd :: String -> GHCi () stepCmd :: String -> GHCi ()
stepCmd [] = doContinue (const True) GHC.SingleStep stepCmd [] = doContinue (const True) GHC.SingleStep
...@@ -1981,7 +1997,7 @@ forwardCmd = noArgs $ do ...@@ -1981,7 +1997,7 @@ forwardCmd = noArgs $ do
-- handle the "break" command -- handle the "break" command
breakCmd :: String -> GHCi () breakCmd :: String -> GHCi ()
breakCmd argLine = do breakCmd argLine = do
breakSwitch $ words argLine withFlattenedDynflags $ breakSwitch $ words argLine
breakSwitch :: [String] -> GHCi () breakSwitch :: [String] -> GHCi ()
breakSwitch [] = do breakSwitch [] = do
...@@ -2114,7 +2130,10 @@ end_bold :: String ...@@ -2114,7 +2130,10 @@ end_bold :: String
end_bold = "\ESC[0m" end_bold = "\ESC[0m"
listCmd :: String -> InputT GHCi () listCmd :: String -> InputT GHCi ()
listCmd "" = do listCmd c = withFlattenedDynflags $ listCmd' c
listCmd' :: String -> InputT GHCi ()
listCmd' "" = do
mb_span <- lift getCurrentBreakSpan mb_span <- lift getCurrentBreakSpan
case mb_span of case mb_span of
Nothing -> Nothing ->
...@@ -2133,7 +2152,7 @@ listCmd "" = do ...@@ -2133,7 +2152,7 @@ listCmd "" = do
printForUser (text "Unable to list source for" <+> printForUser (text "Unable to list source for" <+>
ppr span ppr span
$$ text "Try" <+> doWhat) $$ text "Try" <+> doWhat)
listCmd str = list2 (words str) listCmd' str = list2 (words str)
list2 :: [String] -> InputT GHCi () list2 :: [String] -> InputT GHCi ()
list2 [arg] | all isDigit arg = do list2 [arg] | all isDigit arg = do
......
...@@ -76,8 +76,9 @@ import Data.Maybe ...@@ -76,8 +76,9 @@ import Data.Maybe
-- GHC's command-line interface -- GHC's command-line interface
main :: IO () main :: IO ()
main = main = do
GHC.defaultErrorHandler defaultDynFlags $ do hSetBuffering stdout NoBuffering
GHC.defaultErrorHandler defaultDynFlags $ do
-- 1. extract the -B flag from the args -- 1. extract the -B flag from the args
argv0 <- getArgs argv0 <- getArgs
......
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