diff options
| -rw-r--r-- | compiler/main/DynFlags.hs | 17 | ||||
| -rw-r--r-- | compiler/main/GHC.hs | 63 | ||||
| -rw-r--r-- | compiler/main/GhcMake.hs | 15 | ||||
| -rw-r--r-- | compiler/main/HscMain.hs | 52 | ||||
| -rw-r--r-- | compiler/main/HscTypes.lhs | 11 | ||||
| -rw-r--r-- | compiler/main/InteractiveEval.hs | 17 | ||||
| -rw-r--r-- | compiler/typecheck/TcEnv.lhs | 8 | ||||
| -rw-r--r-- | compiler/typecheck/TcSMonad.lhs | 4 | ||||
| -rw-r--r-- | docs/users_guide/ghci.xml | 98 | ||||
| -rw-r--r-- | ghc/GhciMonad.hs | 6 | ||||
| -rw-r--r-- | ghc/InteractiveUI.hs | 218 | ||||
| -rw-r--r-- | ghc/Main.hs | 2 |
12 files changed, 378 insertions, 133 deletions
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 93fab1f66e..eeb1dfc280 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -16,6 +16,7 @@ module DynFlags ( DynFlag(..), WarningFlag(..), ExtensionFlag(..), + Language(..), LogAction, FlushOut(..), FlushErr(..), ProfAuto(..), glasgowExtsFlags, @@ -28,6 +29,7 @@ module DynFlags ( xopt, xopt_set, xopt_unset, + lang_set, DynFlags(..), HasDynFlags(..), ContainsDynFlags(..), RtsOptsEnabled(..), @@ -1078,15 +1080,16 @@ xopt_unset dfs f in dfs { extensions = onoffs, extensionFlags = flattenExtensionFlags (language dfs) onoffs } +lang_set :: DynFlags -> Maybe Language -> DynFlags +lang_set dflags lang = + dflags { + language = lang, + extensionFlags = flattenExtensionFlags lang (extensions dflags) + } + -- | Set the Haskell language standard to use setLanguage :: Language -> DynP () -setLanguage l = upd f - where f dfs = let mLang = Just l - oneoffs = extensions dfs - in dfs { - language = mLang, - extensionFlags = flattenExtensionFlags mLang oneoffs - } +setLanguage l = upd (`lang_set` Just l) -- | Some modules have dependencies on others through the DynFlags rather than textual imports dynFlagDependencies :: DynFlags -> [ModuleName] diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index c3206aab11..9e33aae2bb 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -24,8 +24,9 @@ module GHC ( DynFlags(..), DynFlag(..), Severity(..), HscTarget(..), dopt, GhcMode(..), GhcLink(..), defaultObjectTarget, parseDynamicFlags, - getSessionDynFlags, - setSessionDynFlags, + getSessionDynFlags, setSessionDynFlags, + getProgramDynFlags, setProgramDynFlags, + getInteractiveDynFlags, setInteractiveDynFlags, parseStaticFlags, -- * Targets @@ -449,11 +450,33 @@ initGhcMonad mb_top_dir = do -- %* * -- %************************************************************************ --- | Updates the DynFlags in a Session. This also reads --- the package database (unless it has already been read), --- and prepares the compilers knowledge about packages. It --- can be called again to load new packages: just add new --- package flags to (packageFlags dflags). +-- $DynFlags +-- +-- The GHC session maintains two sets of 'DynFlags': +-- +-- * The "interactive" @DynFlags@, which are used for everything +-- related to interactive evaluation, including 'runStmt', +-- 'runDecls', 'exprType', 'lookupName' and so on (everything +-- under \"Interactive evaluation\" in this module). +-- +-- * The "program" @DynFlags@, which are used when loading +-- whole modules with 'load' +-- +-- 'setInteractiveDynFlags', 'getInteractiveDynFlags' work with the +-- interactive @DynFlags@. +-- +-- 'setProgramDynFlags', 'getProgramDynFlags' work with the +-- program @DynFlags@. +-- +-- 'setSessionDynFlags' sets both @DynFlags@, and 'getSessionDynFlags' +-- retrieves the program @DynFlags@ (for backwards compatibility). + + +-- | Updates both the interactive and program DynFlags in a Session. +-- This also reads the package database (unless it has already been +-- read), and prepares the compilers knowledge about packages. It can +-- be called again to load new packages: just add new package flags to +-- (packageFlags dflags). -- -- Returns a list of new packages that may need to be linked in using -- the dynamic linker (see 'linkPackages') as a result of new package @@ -463,9 +486,33 @@ initGhcMonad mb_top_dir = do setSessionDynFlags :: GhcMonad m => DynFlags -> m [PackageId] setSessionDynFlags dflags = do (dflags', preload) <- liftIO $ initPackages dflags - modifySession (\h -> h{ hsc_dflags = dflags' }) + modifySession $ \h -> h{ hsc_dflags = dflags' + , hsc_IC = (hsc_IC h){ ic_dflags = dflags' } } + return preload + +-- | Sets the program 'DynFlags'. +setProgramDynFlags :: GhcMonad m => DynFlags -> m [PackageId] +setProgramDynFlags dflags = do + (dflags', preload) <- liftIO $ initPackages dflags + modifySession $ \h -> h{ hsc_dflags = dflags' } return preload +-- | Returns the program 'DynFlags'. +getProgramDynFlags :: GhcMonad m => m DynFlags +getProgramDynFlags = getSessionDynFlags + +-- | Set the 'DynFlags' used to evaluate interactive expressions. +-- Note: this cannot be used for changes to packages. Use +-- 'setSessionDynFlags', or 'setProgramDynFlags' and then copy the +-- 'pkgState' into the interactive @DynFlags@. +setInteractiveDynFlags :: GhcMonad m => DynFlags -> m () +setInteractiveDynFlags dflags = do + modifySession $ \h -> h{ hsc_IC = (hsc_IC h) { ic_dflags = dflags }} + +-- | Get the 'DynFlags' used to evaluate interactive expressions. +getInteractiveDynFlags :: GhcMonad m => m DynFlags +getInteractiveDynFlags = withSession $ \h -> return (ic_dflags (hsc_IC h)) + parseDynamicFlags :: Monad m => DynFlags -> [Located String] diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index a2fb9edf16..545993d62d 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -198,8 +198,7 @@ load2 how_much mod_graph = do -- before we unload anything, make sure we don't leave an old -- interactive context around pointing to dead bindings. Also, -- write the pruned HPT to allow the old HPT to be GC'd. - modifySession $ \_ -> hsc_env{ hsc_IC = emptyInteractiveContext, - hsc_HPT = pruned_hpt } + modifySession $ \_ -> discardIC $ hsc_env { hsc_HPT = pruned_hpt } liftIO $ debugTraceMsg dflags 2 (text "Stable obj:" <+> ppr stable_obj $$ text "Stable BCO:" <+> ppr stable_bco) @@ -362,16 +361,20 @@ loadFinish _all_ok Failed -- Empty the interactive context and set the module context to the topmost -- newly loaded module, or the Prelude if none were loaded. loadFinish all_ok Succeeded - = do modifySession $ \hsc_env -> hsc_env{ hsc_IC = emptyInteractiveContext } + = do modifySession discardIC return all_ok -- Forget the current program, but retain the persistent info in HscEnv discardProg :: HscEnv -> HscEnv discardProg hsc_env - = hsc_env { hsc_mod_graph = emptyMG, - hsc_IC = emptyInteractiveContext, - hsc_HPT = emptyHomePackageTable } + = discardIC $ hsc_env { hsc_mod_graph = emptyMG + , hsc_HPT = emptyHomePackageTable } + +-- discard the contents of the InteractiveContext, but keep the DynFlags +discardIC :: HscEnv -> HscEnv +discardIC hsc_env + = hsc_env { hsc_IC = emptyInteractiveContext (ic_dflags (hsc_IC hsc_env)) } intermediateCleanTempFiles :: DynFlags -> [ModSummary] -> HscEnv -> IO () intermediateCleanTempFiles dflags summaries hsc_env diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index 1fe9077046..89d4d212c2 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -175,7 +175,7 @@ newHscEnv dflags = do return HscEnv { hsc_dflags = dflags, hsc_targets = [], hsc_mod_graph = [], - hsc_IC = emptyInteractiveContext, + hsc_IC = emptyInteractiveContext dflags, hsc_HPT = emptyHomePackageTable, hsc_EPS = eps_var, hsc_NC = nc_var, @@ -217,6 +217,13 @@ runHsc hsc_env (Hsc hsc) = do printOrThrowWarnings (hsc_dflags hsc_env) w return a +-- A variant of runHsc that switches in the DynFlags from the +-- InteractiveContext before running the Hsc computation. +-- +runInteractiveHsc :: HscEnv -> Hsc a -> IO a +runInteractiveHsc hsc_env = + runHsc (hsc_env { hsc_dflags = ic_dflags (hsc_IC hsc_env) }) + getWarnings :: Hsc WarningMessages getWarnings = Hsc $ \_ w -> return (w, w) @@ -287,31 +294,36 @@ ioMsgMaybe' ioA = do #ifdef GHCI hscTcRnLookupRdrName :: HscEnv -> RdrName -> IO [Name] -hscTcRnLookupRdrName hsc_env rdr_name = - runHsc hsc_env $ ioMsgMaybe $ tcRnLookupRdrName hsc_env rdr_name +hscTcRnLookupRdrName hsc_env0 rdr_name = runInteractiveHsc hsc_env0 $ do + hsc_env <- getHscEnv + ioMsgMaybe $ tcRnLookupRdrName hsc_env rdr_name #endif hscTcRcLookupName :: HscEnv -> Name -> IO (Maybe TyThing) -hscTcRcLookupName hsc_env name = - runHsc hsc_env $ ioMsgMaybe' $ tcRnLookupName hsc_env name +hscTcRcLookupName hsc_env0 name = runInteractiveHsc hsc_env0 $ do + hsc_env <- getHscEnv + ioMsgMaybe' $ tcRnLookupName hsc_env name -- ignore errors: the only error we're likely to get is -- "name not found", and the Maybe in the return type -- is used to indicate that. hscTcRnGetInfo :: HscEnv -> Name -> IO (Maybe (TyThing, Fixity, [ClsInst])) -hscTcRnGetInfo hsc_env name = - runHsc hsc_env $ ioMsgMaybe' $ tcRnGetInfo hsc_env name +hscTcRnGetInfo hsc_env0 name = runInteractiveHsc hsc_env0 $ do + hsc_env <- getHscEnv + ioMsgMaybe' $ tcRnGetInfo hsc_env name #ifdef GHCI hscGetModuleInterface :: HscEnv -> Module -> IO ModIface -hscGetModuleInterface hsc_env mod = - runHsc hsc_env $ ioMsgMaybe $ getModuleInterface hsc_env mod +hscGetModuleInterface hsc_env0 mod = runInteractiveHsc hsc_env0 $ do + hsc_env <- getHscEnv + ioMsgMaybe $ getModuleInterface hsc_env mod -- ----------------------------------------------------------------------------- -- | Rename some import declarations hscRnImportDecls :: HscEnv -> [LImportDecl RdrName] -> IO GlobalRdrEnv -hscRnImportDecls hsc_env import_decls = - runHsc hsc_env $ ioMsgMaybe $ tcRnImportDecls hsc_env import_decls +hscRnImportDecls hsc_env0 import_decls = runInteractiveHsc hsc_env0 $ do + hsc_env <- getHscEnv + ioMsgMaybe $ tcRnImportDecls hsc_env import_decls #endif -- ----------------------------------------------------------------------------- @@ -1378,7 +1390,9 @@ hscStmtWithLocation :: HscEnv -> String -- ^ The source -> Int -- ^ Starting line -> IO (Maybe ([Id], IO [HValue])) -hscStmtWithLocation hsc_env stmt source linenumber = runHsc hsc_env $ do +hscStmtWithLocation hsc_env0 stmt source linenumber = + runInteractiveHsc hsc_env0 $ do + hsc_env <- getHscEnv maybe_stmt <- hscParseStmtWithLocation source linenumber stmt case maybe_stmt of Nothing -> return Nothing @@ -1418,7 +1432,9 @@ hscDeclsWithLocation :: HscEnv -> String -- ^ The source -> Int -- ^ Starting line -> IO ([TyThing], InteractiveContext) -hscDeclsWithLocation hsc_env str source linenumber = runHsc hsc_env $ do +hscDeclsWithLocation hsc_env0 str source linenumber = + runInteractiveHsc hsc_env0 $ do + hsc_env <- getHscEnv L _ (HsModule{ hsmodDecls = decls }) <- hscParseThingWithLocation source linenumber parseModule str @@ -1489,7 +1505,7 @@ hscDeclsWithLocation hsc_env str source linenumber = runHsc hsc_env $ do return (tythings, ictxt) hscImport :: HscEnv -> String -> IO (ImportDecl RdrName) -hscImport hsc_env str = runHsc hsc_env $ do +hscImport hsc_env str = runInteractiveHsc hsc_env $ do (L _ (HsModule{hsmodImports=is})) <- hscParseThing parseModule str case is of @@ -1502,7 +1518,8 @@ hscImport hsc_env str = runHsc hsc_env $ do hscTcExpr :: HscEnv -> String -- ^ The expression -> IO Type -hscTcExpr hsc_env expr = runHsc hsc_env $ do +hscTcExpr hsc_env0 expr = runInteractiveHsc hsc_env0 $ do + hsc_env <- getHscEnv maybe_stmt <- hscParseStmt expr case maybe_stmt of Just (L _ (ExprStmt expr _ _ _)) -> @@ -1517,7 +1534,8 @@ hscKcType -> Bool -- ^ Normalise the type -> String -- ^ The type as a string -> IO (Type, Kind) -- ^ Resulting type (possibly normalised) and kind -hscKcType hsc_env normalise str = runHsc hsc_env $ do +hscKcType hsc_env0 normalise str = runInteractiveHsc hsc_env0 $ do + hsc_env <- getHscEnv ty <- hscParseType str ioMsgMaybe $ tcRnType hsc_env (hsc_IC hsc_env) normalise ty @@ -1535,7 +1553,7 @@ hscParseType = hscParseThing parseType hscParseIdentifier :: HscEnv -> String -> IO (Located RdrName) hscParseIdentifier hsc_env str = - runHsc hsc_env $ hscParseThing parseIdentifier str + runInteractiveHsc hsc_env $ hscParseThing parseIdentifier str hscParseThing :: (Outputable thing) => Lexer.P thing -> String -> Hsc thing hscParseThing = hscParseThingWithLocation "<interactive>" 1 diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index e0eea7dc4b..adc98765cf 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -917,6 +917,10 @@ appendStubC (ForeignStubs h c) c_code = ForeignStubs h (c $$ c_code) -- context in which statements are executed in a GHC session. data InteractiveContext = InteractiveContext { + ic_dflags :: DynFlags, + -- ^ The 'DynFlags' used to evaluate interative expressions + -- and statements. + ic_imports :: [InteractiveImport], -- ^ The GHCi context is extended with these imports -- @@ -977,9 +981,10 @@ hscDeclsWithLocation) and save them in ic_sys_vars. -} -- | Constructs an empty InteractiveContext. -emptyInteractiveContext :: InteractiveContext -emptyInteractiveContext - = InteractiveContext { ic_imports = [], +emptyInteractiveContext :: DynFlags -> InteractiveContext +emptyInteractiveContext dflags + = InteractiveContext { ic_dflags = dflags, + ic_imports = [], ic_rn_gbl_env = emptyGlobalRdrEnv, ic_tythings = [], ic_sys_vars = [], diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs index b62ec40ec0..8cc94a3ce8 100644 --- a/compiler/main/InteractiveEval.hs +++ b/compiler/main/InteractiveEval.hs @@ -195,8 +195,9 @@ runStmtWithLocation source linenumber expr step = -- Turn off -fwarn-unused-bindings when running a statement, to hide -- warnings about the implicit bindings we introduce. - let dflags' = wopt_unset (hsc_dflags hsc_env) Opt_WarnUnusedBinds - hsc_env' = hsc_env{ hsc_dflags = dflags' } + let ic = hsc_IC hsc_env -- use the interactive dflags + idflags' = ic_dflags ic `wopt_unset` Opt_WarnUnusedBinds + hsc_env' = hsc_env{ hsc_IC = ic{ ic_dflags = idflags' } } -- compile to value (IO [HValue]), don't run r <- liftIO $ hscStmtWithLocation hsc_env' expr source linenumber @@ -208,8 +209,8 @@ runStmtWithLocation source linenumber expr step = Just (tyThings, hval) -> do status <- withVirtualCWD $ - withBreakAction (isStep step) dflags' breakMVar statusMVar $ do - liftIO $ sandboxIO dflags' statusMVar hval + withBreakAction (isStep step) idflags' breakMVar statusMVar $ do + liftIO $ sandboxIO idflags' statusMVar hval let ic = hsc_IC hsc_env bindings = (ic_tythings ic, ic_rn_gbl_env ic) @@ -229,13 +230,7 @@ runDeclsWithLocation :: GhcMonad m => String -> Int -> String -> m [Name] runDeclsWithLocation source linenumber expr = do hsc_env <- getSession - - -- Turn off -fwarn-unused-bindings when running a statement, to hide - -- warnings about the implicit bindings we introduce. - let dflags' = wopt_unset (hsc_dflags hsc_env) Opt_WarnUnusedBinds - hsc_env' = hsc_env{ hsc_dflags = dflags' } - - (tyThings, ic) <- liftIO $ hscDeclsWithLocation hsc_env' expr source linenumber + (tyThings, ic) <- liftIO $ hscDeclsWithLocation hsc_env expr source linenumber setSession $ hsc_env { hsc_IC = ic } hsc_env <- getSession diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs index 3411d23360..a94663e67b 100644 --- a/compiler/typecheck/TcEnv.lhs +++ b/compiler/typecheck/TcEnv.lhs @@ -572,15 +572,13 @@ thTopLevelId id = isGlobalId id || isExternalName (idName id) %************************************************************************ \begin{code} -tcGetDefaultTys :: Bool -- True <=> interactive context - -> TcM ([Type], -- Default types +tcGetDefaultTys :: TcM ([Type], -- Default types (Bool, -- True <=> Use overloaded strings Bool)) -- True <=> Use extended defaulting rules -tcGetDefaultTys interactive +tcGetDefaultTys = do { dflags <- getDynFlags ; let ovl_strings = xopt Opt_OverloadedStrings dflags - extended_defaults = interactive - || xopt Opt_ExtendedDefaultRules dflags + extended_defaults = xopt Opt_ExtendedDefaultRules dflags -- See also Trac #1974 flags = (ovl_strings, extended_defaults) diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs index 77c81e7993..964a3d375e 100644 --- a/compiler/typecheck/TcSMonad.lhs +++ b/compiler/typecheck/TcSMonad.lhs @@ -1081,7 +1081,7 @@ warnTcS loc warn_if doc getDefaultInfo :: TcS (SimplContext, [Type], (Bool, Bool)) getDefaultInfo = do { ctxt <- getTcSContext - ; (tys, flags) <- wrapTcS (TcM.tcGetDefaultTys (isInteractive ctxt)) + ; (tys, flags) <- wrapTcS TcM.tcGetDefaultTys ; return (ctxt, tys, flags) } -- Just get some environments needed for instance looking up and matching @@ -1423,4 +1423,4 @@ getCtCoercion ct -- solved, so it is not safe to simply do a mkTcCoVarCo (cc_id ct) -- Instead we use the most accurate type, given by ctPred c where maybe_given = isGiven_maybe (cc_flavor ct) -\end{code}
\ No newline at end of file +\end{code} diff --git a/docs/users_guide/ghci.xml b/docs/users_guide/ghci.xml index d09a794b11..b3fa469a99 100644 --- a/docs/users_guide/ghci.xml +++ b/docs/users_guide/ghci.xml @@ -2649,6 +2649,28 @@ bar <varlistentry> <term> + <literal>:seti</literal> <optional><replaceable>option</replaceable>...</optional> + <indexterm><primary><literal>:seti</literal></primary></indexterm> + </term> + <listitem> + <para> + Like <literal>:set</literal>, but options set with + <literal>:seti</literal> affect only expressions and + commands typed at the prompt, and not modules loaded with + <literal>:load</literal> (in contrast, options set with + <literal>:set</literal> apply everywhere). See <xref + linkend="ghci-interactive-options" />. + </para> + <para> + Without any arguments, displays the current set of options + that are applied to expressions and commands typed at the + prompt. + </para> + </listitem> + </varlistentry> + + <varlistentry> + <term> <literal>:show bindings</literal> <indexterm><primary><literal>:show bindings</literal></primary></indexterm> </term> @@ -2824,8 +2846,9 @@ bar </sect1> <sect1 id="ghci-set"> - <title>The <literal>:set</literal> command</title> + <title>The <literal>:set</literal> and <literal>:seti</literal> commands</title> <indexterm><primary><literal>:set</literal></primary></indexterm> + <indexterm><primary><literal>:seti</literal></primary></indexterm> <para>The <literal>:set</literal> command sets two types of options: GHCi options, which begin with @@ -2945,7 +2968,71 @@ Prelude> :set -fno-warn-incomplete-patterns -XNoMultiParamTypeClasses not take effect until the next reload.</para> <indexterm><primary>static</primary><secondary>options</secondary></indexterm> </sect2> + + <sect2 id="ghci-interactive-options"> + <title>Setting options for interactive evaluation only</title> + + <para> + GHCi actually maintains two sets of options: one set that + applies when loading modules, and another set that applies for + expressions and commands typed at the prompt. The + <literal>:set</literal> command modifies both, but there is + also a <literal>:seti</literal> command (for "set + interactive") that affects only the second set. + </para> + + <para> + The two sets of options can be inspected using the + <literal>:set</literal> and <literal>:seti</literal> commands + respectively, with no arguments. For example, in a clean GHCi + session we might see something like this: + </para> + +<screen> +Prelude> :seti +base language is: Haskell2010 +with the following modifiers: + -XNoDatatypeContexts + -XNondecreasingIndentation + -XExtendedDefaultRules +GHCi-specific dynamic flag settings: +other dynamic, non-language, flag settings: + -fimplicit-import-qualified +warning settings: +</screen> + + <para> + Note that the option <option>-XExtendedDefaultRules</option> + is on, because we apply special defaulting rules to + expressions typed at the prompt (see <xref + linkend="extended-default-rules" />). + </para> + + <para> + It is often useful to change the language options for + expressions typed at the prompt only, without having that + option apply to loaded modules too. A good example is +<screen> +:seti -XNoMonomorphismRestriction +</screen> + It would be undesirable if + <option>-XNoMonomorphismRestriction</option> were to apply to + loaded modules too: that might cause a compilation error, but + more commonly it will cause extra recompilation, because GHC + will think that it needs to recompile the module because the + flags have changed. + </para> + + <para> + It is therefore good practice if you are setting language + options in your <literal>.ghci</literal> file, to use + <literal>:seti</literal> rather than <literal>:set</literal> + unless you really do want them to apply to all modules you + load in GHCi. + </para> + </sect2> </sect1> + <sect1 id="ghci-dot-files"> <title>The <filename>.ghci</filename> file</title> <indexterm><primary><filename>.ghci</filename></primary><secondary>file</secondary> @@ -2976,7 +3063,14 @@ Prelude> :set -fno-warn-incomplete-patterns -XNoMultiParamTypeClasses <para>The <filename>ghci.conf</filename> file is most useful for turning on favourite options (eg. <literal>:set +s</literal>), and - defining useful macros. Placing a <filename>.ghci</filename> file + defining useful macros. Note: when setting language options in + this file it is usually desirable to use <literal>:seti</literal> + rather than <literal>:set</literal> (see <xref + linkend="ghci-interactive-options" />). + </para> + + <para> + Placing a <filename>.ghci</filename> file in a directory with a Haskell project is a useful way to set certain project-wide options so you don't have to type them every time you start GHCi: eg. if your project uses multi-parameter diff --git a/ghc/GhciMonad.hs b/ghc/GhciMonad.hs index 71d1e763d3..11d23a6876 100644 --- a/ghc/GhciMonad.hs +++ b/ghc/GhciMonad.hs @@ -16,7 +16,7 @@ module GhciMonad ( Command, BreakLocation(..), TickArray, - setDynFlags, + getDynFlags, runStmt, runDecls, resume, timeIt, recordBreak, revertCAFs, @@ -229,10 +229,6 @@ instance ExceptionMonad (InputT GHCi) where gblock = Haskeline.block gunblock = Haskeline.unblock -setDynFlags :: DynFlags -> GHCi [PackageId] -setDynFlags dflags = do - GHC.setSessionDynFlags dflags - isOptionSet :: GHCiOption -> GHCi Bool isOptionSet opt = do st <- getGHCiState diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index c92392d6fc..2846bb637e 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -146,7 +146,9 @@ builtin_commands = [ ("run", keepGoing runRun, completeFilename), ("script", keepGoing' scriptCmd, completeFilename), ("set", keepGoing setCmd, completeSetOptions), + ("seti", keepGoing setiCmd, completeSeti), ("show", keepGoing showCmd, completeShowOptions), + ("showi", keepGoing showiCmd, completeShowiOptions), ("sprint", keepGoing sprintCmd, completeExpression), ("step", keepGoing stepCmd, completeIdentifier), ("steplocal", keepGoing stepLocalCmd, completeIdentifier), @@ -253,6 +255,7 @@ helpText = " -- Commands for changing settings:\n" ++ "\n" ++ " :set <option> ... set options\n" ++ + " :seti <option> ... set options for interactive evaluation only\n" ++ " :set args <arg> ... set the arguments returned by System.getArgs\n" ++ " :set prog <progname> set the value returned by System.getProgName\n" ++ " :set prompt <prompt> set the prompt used in GHCi\n" ++ @@ -279,9 +282,10 @@ helpText = " :show imports show the current imports\n" ++ " :show modules show the currently loaded modules\n" ++ " :show packages show the currently active package flags\n" ++ - " :show languages show the currently active language flags\n" ++ + " :show language show the currently active language flags\n" ++ " :show <setting> show value of <setting>, which is one of\n" ++ " [args, prog, prompt, editor, stop]\n" ++ + " :showi language show language flags for interactive evaluation\n" ++ "\n" findEditor :: IO String @@ -330,6 +334,11 @@ interactiveUI srcs maybe_exprs = do -- Initialise buffering for the *interpreted* I/O system initInterpBuffering + -- The initial set of DynFlags used for interactive evaluation is the same + -- as the global DynFlags, plus -XExtendedDefaultRules + dflags <- getDynFlags + GHC.setInteractiveDynFlags (xopt_set dflags Opt_ExtendedDefaultRules) + liftIO $ when (isNothing maybe_exprs) $ do -- Only for GHCi (not runghc and ghc -e): @@ -1778,7 +1787,35 @@ iiSubsumes _ _ = False -- figure out which ones & disallow them. setCmd :: String -> GHCi () -setCmd "" +setCmd "" = showOptions False +setCmd "-a" = showOptions True +setCmd str + = case getCmd str of + Right ("args", rest) -> + case toArgs rest of + Left err -> liftIO (hPutStrLn stderr err) + Right args -> setArgs args + Right ("prog", rest) -> + case toArgs rest of + Right [prog] -> setProg prog + _ -> liftIO (hPutStrLn stderr "syntax: :set prog <progname>") + Right ("prompt", rest) -> setPrompt $ dropWhile isSpace rest + Right ("editor", rest) -> setEditor $ dropWhile isSpace rest + Right ("stop", rest) -> setStop $ dropWhile isSpace rest + _ -> case toArgs str of + Left err -> liftIO (hPutStrLn stderr err) + Right wds -> setOptions wds + +setiCmd :: String -> GHCi () +setiCmd "" = GHC.getInteractiveDynFlags >>= liftIO . showDynFlags False +setiCmd "-a" = GHC.getInteractiveDynFlags >>= liftIO . showDynFlags True +setiCmd str = + case toArgs str of + Left err -> liftIO (hPutStrLn stderr err) + Right wds -> newDynFlags True wds + +showOptions :: Bool -> GHCi () +showOptions show_all = do st <- getGHCiState let opts = options st liftIO $ putStrLn (showSDoc ( @@ -1787,26 +1824,30 @@ setCmd "" then text "none." else hsep (map (\o -> char '+' <> text (optToStr o)) opts) )) - dflags <- getDynFlags - liftIO $ putStrLn (showSDoc ( - text "GHCi-specific dynamic flag settings:" $$ - nest 2 (vcat (map (flagSetting dflags) ghciFlags)) - )) - liftIO $ putStrLn (showSDoc ( - text "other dynamic, non-language, flag settings:" $$ - nest 2 (vcat (map (flagSetting dflags) others)) - )) - liftIO $ putStrLn (showSDoc ( - text "warning settings:" $$ - nest 2 (vcat (map (warnSetting dflags) DynFlags.fWarningFlags)) - )) + getDynFlags >>= liftIO . showDynFlags show_all + + +showDynFlags :: Bool -> DynFlags -> IO () +showDynFlags show_all dflags = do + showLanguages' show_all dflags + putStrLn $ showSDoc $ + text "GHCi-specific dynamic flag settings:" $$ + nest 2 (vcat (map (setting dopt) ghciFlags)) + putStrLn $ showSDoc $ + text "other dynamic, non-language, flag settings:" $$ + nest 2 (vcat (map (setting dopt) others)) + putStrLn $ showSDoc $ + text "warning settings:" $$ + nest 2 (vcat (map (setting wopt) DynFlags.fWarningFlags)) + where + setting test (str, f, _) + | quiet = empty + | is_on = fstr str + | otherwise = fnostr str + where is_on = test f dflags + quiet = not show_all && test f default_dflags == is_on - where flagSetting dflags (str, f, _) - | dopt f dflags = fstr str - | otherwise = fnostr str - warnSetting dflags (str, f, _) - | wopt f dflags = fstr str - | otherwise = fnostr str + default_dflags = defaultDynFlags (settings dflags) fstr str = text "-f" <> text str fnostr str = text "-fno-" <> text str @@ -1819,22 +1860,6 @@ setCmd "" ,Opt_BreakOnError ,Opt_PrintEvldWithShow ] -setCmd str - = case getCmd str of - Right ("args", rest) -> - case toArgs rest of - Left err -> liftIO (hPutStrLn stderr err) - Right args -> setArgs args - Right ("prog", rest) -> - case toArgs rest of - Right [prog] -> setProg prog - _ -> liftIO (hPutStrLn stderr "syntax: :set prog <progname>") - Right ("prompt", rest) -> setPrompt $ dropWhile isSpace rest - Right ("editor", rest) -> setEditor $ dropWhile isSpace rest - Right ("stop", rest) -> setStop $ dropWhile isSpace rest - _ -> case toArgs str of - Left err -> liftIO (hPutStrLn stderr err) - Right wds -> setOptions wds setArgs, setOptions :: [String] -> GHCi () setProg, setEditor, setStop, setPrompt :: String -> GHCi () @@ -1885,32 +1910,48 @@ setOptions wds = let (plus_opts, minus_opts) = partitionWith isPlus wds mapM_ setOpt plus_opts -- then, dynamic flags - newDynFlags minus_opts + newDynFlags False minus_opts -newDynFlags :: [String] -> GHCi () -newDynFlags minus_opts = do - dflags0 <- getDynFlags - let pkg_flags = packageFlags dflags0 - (dflags1, leftovers, warns) <- liftIO $ GHC.parseDynamicFlags dflags0 $ map noLoc minus_opts - liftIO $ handleFlagWarnings dflags1 warns +newDynFlags :: Bool -> [String] -> GHCi () +newDynFlags interactive_only minus_opts = do + let lopts = map noLoc minus_opts + idflags0 <- GHC.getInteractiveDynFlags + (idflags1, leftovers, warns) <- GHC.parseDynamicFlags idflags0 lopts + + liftIO $ handleFlagWarnings idflags1 warns when (not $ null leftovers) (ghcError . CmdLineError $ "Some flags have not been recognized: " ++ (concat . intersperse ", " $ map unLoc leftovers)) - new_pkgs <- setDynFlags dflags1 - - -- if the package flags changed, we should reset the context - -- and link the new packages. - dflags2 <- getDynFlags - when (packageFlags dflags2 /= pkg_flags) $ do - liftIO $ hPutStrLn stderr "package flags have changed, resetting and loading new packages..." - GHC.setTargets [] - _ <- GHC.load LoadAllTargets - liftIO (linkPackages dflags2 new_pkgs) - -- package flags changed, we can't re-use any of the old context - setContextAfterLoad False [] + when (interactive_only && + packageFlags idflags1 /= packageFlags idflags0) $ do + liftIO $ hPutStrLn stderr "cannot set package flags with :seti; use :set" + GHC.setInteractiveDynFlags idflags1 + + dflags0 <- getDynFlags + when (not interactive_only) $ do + (dflags1, _, _) <- liftIO $ GHC.parseDynamicFlags dflags0 lopts + new_pkgs <- GHC.setProgramDynFlags dflags1 + + -- if the package flags changed, reset the context and link + -- the new packages. + dflags2 <- getDynFlags + when (packageFlags dflags2 /= packageFlags dflags0) $ do + liftIO $ hPutStrLn stderr "package flags have changed, resetting and loading new packages..." + GHC.setTargets [] + _ <- GHC.load LoadAllTargets + liftIO $ linkPackages dflags2 new_pkgs + -- package flags changed, we can't re-use any of the old context + setContextAfterLoad False [] + -- and copy the package state to the interactive DynFlags + idflags <- GHC.getInteractiveDynFlags + GHC.setInteractiveDynFlags + idflags{ pkgState = pkgState dflags2 + , pkgDatabase = pkgDatabase dflags2 + , packageFlags = packageFlags dflags2 } + return () @@ -1941,7 +1982,7 @@ unsetOptions str mapM_ unsetOpt plus_opts no_flags <- mapM no_flag minus_opts - newDynFlags no_flags + newDynFlags False no_flags isMinus :: String -> Bool isMinus ('-':_) = True @@ -1981,6 +2022,8 @@ optToStr RevertCAFs = "r" -- :show showCmd :: String -> GHCi () +showCmd "" = showOptions False +showCmd "-a" = showOptions True showCmd str = do st <- getGHCiState case words str of @@ -1996,9 +2039,19 @@ showCmd str = do ["breaks"] -> showBkptTable ["context"] -> showContext ["packages"] -> showPackages - ["languages"] -> showLanguages + ["languages"] -> showLanguages -- backwards compat + ["language"] -> showLanguages + ["lang"] -> showLanguages -- useful abbreviation _ -> ghcError (CmdLineError ("syntax: :show [ args | prog | prompt | editor | stop | modules | bindings\n"++ - " | breaks | context | packages | languages ]")) + " | breaks | context | packages | language ]")) + +showiCmd :: String -> GHCi () +showiCmd str = do + case words str of + ["languages"] -> showiLanguages -- backwards compat + ["language"] -> showiLanguages + ["lang"] -> showiLanguages -- useful abbreviation + _ -> ghcError (CmdLineError ("syntax: :showi language")) showImports :: GHCi () showImports = do @@ -2090,18 +2143,42 @@ showPackages = do showFlag (DistrustPackage p) = text $ " -distrust " ++ p showLanguages :: GHCi () -showLanguages = do - dflags <- getDynFlags - liftIO $ putStrLn $ showSDoc $ vcat $ - text "active language flags:" : - [text (" -X" ++ str) | (str, f, _) <- DynFlags.xFlags, xopt f dflags] - +showLanguages = getDynFlags >>= liftIO . showLanguages' False + +showiLanguages :: GHCi () +showiLanguages = GHC.getInteractiveDynFlags >>= liftIO . showLanguages' False + +showLanguages' :: Bool -> DynFlags -> IO () +showLanguages' show_all dflags = + putStrLn $ showSDoc $ vcat + [ text "base language is: " <> + case language dflags of + Nothing -> text "Haskell2010" + Just Haskell98 -> text "Haskell98" + Just Haskell2010 -> text "Haskell2010" + , (if show_all then text "all active language options:" + else text "with the following modifiers:") $$ + nest 2 (vcat (map (setting xopt) DynFlags.xFlags)) + ] + where + setting test (str, f, _) + | quiet = empty + | is_on = text "-X" <> text str + | otherwise = text "-XNo" <> text str + where is_on = test f dflags + quiet = not show_all && test f default_dflags == is_on + + default_dflags = + defaultDynFlags (settings dflags) `lang_set` + case language dflags of + Nothing -> Just Haskell2010 + other -> other -- ----------------------------------------------------------------------------- -- Completion completeCmd, completeMacro, completeIdentifier, completeModule, - completeSetModule, + completeSetModule, completeSeti, completeShowiOptions, completeHomeModule, completeSetOptions, completeShowOptions, completeHomeModuleOrFile, completeExpression :: CompletionFunc GHCi @@ -2173,11 +2250,18 @@ completeSetOptions = wrapCompleter flagWordBreakChars $ \w -> do where opts = "args":"prog":"prompt":"editor":"stop":flagList flagList = map head $ group $ sort allFlags +completeSeti = wrapCompleter flagWordBreakChars $ \w -> do + return (filter (w `isPrefixOf`) flagList) + where flagList = map head $ group $ sort allFlags + completeShowOptions = wrapCompleter flagWordBreakChars $ \w -> do return (filter (w `isPrefixOf`) opts) where opts = ["args", "prog", "prompt", "editor", "stop", "modules", "bindings", "linker", "breaks", - "context", "packages", "languages"] + "context", "packages", "language"] + +completeShowiOptions = wrapCompleter flagWordBreakChars $ \w -> do + return (filter (w `isPrefixOf`) ["language"]) completeHomeModuleOrFile = completeWord Nothing filenameWordBreakChars $ unionComplete (fmap (map simpleCompletion) . listHomeModules) diff --git a/ghc/Main.hs b/ghc/Main.hs index 38066dbd68..204c54fa70 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -155,6 +155,8 @@ main' postLoadMode dflags0 args flagWarnings = do -- turn on -fimplicit-import-qualified for GHCi now, so that it -- can be overriden from the command-line + -- XXX: this should really be in the interactive DynFlags, but + -- we don't set that until later in interactiveUI dflags1a | DoInteractive <- postLoadMode = imp_qual_enabled | DoEval _ <- postLoadMode = imp_qual_enabled | otherwise = dflags1 |