ghciWelcomeMsg = "GHCi, version " ++ cProjectVersion ++
": http://www.haskell.org/ghc/ :? for help"
-type Command = (String, String -> GHCi Bool, Bool, String -> IO [String])
-
cmdName :: Command -> String
cmdName (n,_,_,_) = n
" Commands available from the prompt:\n" ++
"\n" ++
" <statement> evaluate/run <statement>\n" ++
+ " : repeat last command\n" ++
" :{\\n ..lines.. \\n:}\\n multiline command\n" ++
" :add <filename> ... add module(s) to the current target set\n" ++
- " :browse[!] [-s] [[*]<mod>] display the names defined by module <mod>\n" ++
- " (!: more details; -s: sort; *: all top-level names)\n" ++
+ " :browse[!] [[*]<mod>] display the names defined by module <mod>\n" ++
+ " (!: more details; *: all top-level names)\n" ++
" :cd <dir> change directory to <dir>\n" ++
" :cmd <expr> run the commands returned by <expr>::IO String\n" ++
" :ctags [<file>] create tags file for Vi (default: \"tags\")\n" ++
break_ctr = 0,
breaks = [],
tickarrays = emptyModuleEnv,
- cmdqueue = []
+ last_command = Nothing,
+ cmdqueue = [],
+ remembered_ctx = Nothing
}
#ifdef USE_READLINE
session <- getSession
(toplevs,exports) <- io (GHC.getContext session)
resumes <- io $ GHC.getResumeContext session
+ -- st <- getGHCiState
context_bit <-
case resumes of
dots | _:rs <- resumes, not (null rs) = text "... "
| otherwise = empty
+
+
modules_bit =
- hsep (map (\m -> char '*' <> ppr (GHC.moduleName m)) toplevs) <+>
+ -- ToDo: maybe...
+ -- let (btoplevs, bexports) = fromMaybe ([],[]) (remembered_ctx st) in
+ -- hsep (map (\m -> text "!*" <> ppr (GHC.moduleName m)) btoplevs) <+>
+ -- hsep (map (\m -> char '!' <> ppr (GHC.moduleName m)) bexports) <+>
+ hsep (map (\m -> char '*' <> ppr (GHC.moduleName m)) toplevs) <+>
hsep (map (ppr . GHC.moduleName) exports)
deflt_prompt = dots <> context_bit <> modules_bit
Just thing -> printTyThing thing
-
+data MaybeCommand = GotCommand Command | BadCommand | NoLastCommand
specialCommand :: String -> GHCi Bool
specialCommand ('!':str) = shellEscape (dropWhile isSpace str)
specialCommand str = do
let (cmd,rest) = break isSpace str
- maybe_cmd <- io (lookupCommand cmd)
+ maybe_cmd <- lookupCommand cmd
case maybe_cmd of
- Nothing -> io (hPutStr stdout ("unknown command ':" ++ cmd ++ "'\n"
- ++ shortHelpText) >> return False)
- Just (_,f,_,_) -> f (dropWhile isSpace rest)
-
-lookupCommand :: String -> IO (Maybe Command)
+ GotCommand (_,f,_,_) -> f (dropWhile isSpace rest)
+ BadCommand ->
+ do io $ hPutStr stdout ("unknown command ':" ++ cmd ++ "'\n"
+ ++ shortHelpText)
+ return False
+ NoLastCommand ->
+ do io $ hPutStr stdout ("there is no last command to perform\n"
+ ++ shortHelpText)
+ return False
+
+lookupCommand :: String -> GHCi (MaybeCommand)
+lookupCommand "" = do
+ st <- getGHCiState
+ case last_command st of
+ Just c -> return $ GotCommand c
+ Nothing -> return NoLastCommand
lookupCommand str = do
+ mc <- io $ lookupCommand' str
+ st <- getGHCiState
+ setGHCiState st{ last_command = mc }
+ return $ case mc of
+ Just c -> GotCommand c
+ Nothing -> BadCommand
+
+lookupCommand' :: String -> IO (Maybe Command)
+lookupCommand' str = do
macros <- readIORef macros_ref
let cmds = builtin_commands ++ macros
-- look for exact match first, then the first prefix match
- case [ c | c <- cmds, str == cmdName c ] of
- c:_ -> return (Just c)
- [] -> case [ c | c@(s,_,_,_) <- cmds, str `isPrefixOf` s ] of
- [] -> return Nothing
- c:_ -> return (Just c)
-
+ return $ case [ c | c <- cmds, str == cmdName c ] of
+ c:_ -> Just c
+ [] -> case [ c | c@(s,_,_,_) <- cmds, str `isPrefixOf` s ] of
+ [] -> Nothing
+ c:_ -> Just c
getCurrentBreakSpan :: GHCi (Maybe SrcSpan)
getCurrentBreakSpan = do
targets <- mapM (\m -> io (GHC.guessTarget m Nothing)) files
session <- getSession
io (mapM_ (GHC.addTarget session) targets)
+ prev_context <- io $ GHC.getContext session
ok <- io (GHC.load session LoadAllTargets)
- afterLoad ok session Nothing
+ afterLoad ok session False prev_context
changeDirectory :: String -> GHCi ()
+changeDirectory "" = do
+ -- :cd on its own changes to the user's home directory
+ either_dir <- io (IO.try getHomeDirectory)
+ case either_dir of
+ Left _e -> return ()
+ Right dir -> changeDirectory dir
changeDirectory dir = do
session <- getSession
graph <- io (GHC.getModuleGraph session)
when (not (null graph)) $
io $ putStr "Warning: changing directory causes all loaded modules to be unloaded,\nbecause the search path has changed.\n"
+ prev_context <- io $ GHC.getContext session
io (GHC.setTargets session [])
io (GHC.load session LoadAllTargets)
- setContextAfterLoad session []
+ setContextAfterLoad session prev_context []
io (GHC.workingDirectoryChanged session)
dir <- expandPath dir
io (setCurrentDirectory dir)
loadModule' :: [(FilePath, Maybe Phase)] -> GHCi SuccessFlag
loadModule' files = do
session <- getSession
+ prev_context <- io $ GHC.getContext session
-- unload first
discardActiveBreakPoints
-- as a ToDo for now.
io (GHC.setTargets session targets)
- doLoad session False LoadAllTargets
+ doLoad session False prev_context LoadAllTargets
checkModule :: String -> GHCi ()
checkModule m = do
let modl = GHC.mkModuleName m
session <- getSession
+ prev_context <- io $ GHC.getContext session
result <- io (GHC.checkModule session modl False)
case result of
Nothing -> io $ putStrLn "Nothing"
(text "global names: " <+> ppr global) $$
(text "local names: " <+> ppr local)
_ -> empty))
- afterLoad (successIf (isJust result)) session Nothing
+ afterLoad (successIf (isJust result)) session False prev_context
reloadModule :: String -> GHCi ()
reloadModule m = do
session <- getSession
- doLoad session True $ if null m then LoadAllTargets
- else LoadUpTo (GHC.mkModuleName m)
+ prev_context <- io $ GHC.getContext session
+ doLoad session True prev_context $
+ if null m then LoadAllTargets
+ else LoadUpTo (GHC.mkModuleName m)
return ()
-doLoad :: Session -> Bool -> LoadHowMuch -> GHCi SuccessFlag
-doLoad session retain_context howmuch = do
+doLoad :: Session -> Bool -> ([Module],[Module]) -> LoadHowMuch -> GHCi SuccessFlag
+doLoad session retain_context prev_context howmuch = do
-- turn off breakpoints before we load: we can't turn them off later, because
-- the ModBreaks will have gone away.
discardActiveBreakPoints
- context <- io $ GHC.getContext session
ok <- io (GHC.load session howmuch)
- afterLoad ok session (if retain_context then Just context else Nothing)
+ afterLoad ok session retain_context prev_context
return ok
-afterLoad :: SuccessFlag -> Session -> Maybe ([Module],[Module]) -> GHCi ()
-afterLoad ok session maybe_context = do
+afterLoad :: SuccessFlag -> Session -> Bool -> ([Module],[Module]) -> GHCi ()
+afterLoad ok session retain_context prev_context = do
io (revertCAFs) -- always revert CAFs on load.
discardTickArrays
- loaded_mods <- getLoadedModules session
+ loaded_mod_summaries <- getLoadedModules session
+ let loaded_mods = map GHC.ms_mod loaded_mod_summaries
+ loaded_mod_names = map GHC.moduleName loaded_mods
+ modulesLoadedMsg ok loaded_mod_names
- -- try to retain the old module context for :reload. This might
- -- not be possible, for example if some modules have gone away, so
- -- we attempt to set the same context, backing off to the default
- -- context if that fails.
- case maybe_context of
- Nothing -> setContextAfterLoad session loaded_mods
- Just (as,bs) -> do
- r <- io $ Exception.try (GHC.setContext session as bs)
- case r of
- Left _err -> setContextAfterLoad session loaded_mods
- Right _ -> return ()
-
- modulesLoadedMsg ok (map GHC.ms_mod_name loaded_mods)
-
-setContextAfterLoad :: Session -> [GHC.ModSummary] -> GHCi ()
-setContextAfterLoad session [] = do
+ st <- getGHCiState
+ if not retain_context
+ then do
+ setGHCiState st{ remembered_ctx = Nothing }
+ setContextAfterLoad session prev_context loaded_mod_summaries
+ else do
+ -- figure out which modules we can keep in the context, which we
+ -- have to put back, and which we have to remember because they
+ -- are (temporarily) unavailable. See ghci.prog009, #1873, #1360
+ let (as,bs) = prev_context
+ as1 = filter isHomeModule as -- package modules are kept anyway
+ bs1 = filter isHomeModule bs
+ (as_ok, as_bad) = partition (`elem` loaded_mods) as1
+ (bs_ok, bs_bad) = partition (`elem` loaded_mods) bs1
+ (rem_as, rem_bs) = fromMaybe ([],[]) (remembered_ctx st)
+ (rem_as_ok, rem_as_bad) = partition (`elem` loaded_mods) rem_as
+ (rem_bs_ok, rem_bs_bad) = partition (`elem` loaded_mods) rem_bs
+ as' = nub (as_ok++rem_as_ok)
+ bs' = nub (bs_ok++rem_bs_ok)
+ rem_as' = nub (rem_as_bad ++ as_bad)
+ rem_bs' = nub (rem_bs_bad ++ bs_bad)
+
+ -- Put back into the context any modules that we previously had
+ -- to drop because they weren't available (rem_as_ok, rem_bs_ok).
+ setContextKeepingPackageModules session prev_context (as',bs')
+
+ -- If compilation failed, remember any modules that we are unable
+ -- to load, so that we can put them back in the context in the future.
+ case ok of
+ Succeeded -> setGHCiState st{ remembered_ctx = Nothing }
+ Failed -> setGHCiState st{ remembered_ctx = Just (rem_as',rem_bs') }
+
+
+
+setContextAfterLoad :: Session -> ([Module],[Module]) -> [GHC.ModSummary] -> GHCi ()
+setContextAfterLoad session prev [] = do
prel_mod <- getPrelude
- io (GHC.setContext session [] [prel_mod])
-setContextAfterLoad session ms = do
+ setContextKeepingPackageModules session prev ([], [prel_mod])
+setContextAfterLoad session prev ms = do
-- load a target if one is available, otherwise load the topmost module.
targets <- io (GHC.getTargets session)
case [ m | Just m <- map (findTarget ms) targets ] of
load_this summary | m <- GHC.ms_mod summary = do
b <- io (GHC.moduleIsInterpreted session m)
- if b then io (GHC.setContext session [m] [])
+ if b then setContextKeepingPackageModules session prev ([m], [])
else do
- prel_mod <- getPrelude
- io (GHC.setContext session [] [prel_mod,m])
+ prel_mod <- getPrelude
+ setContextKeepingPackageModules session prev ([],[prel_mod,m])
+
+-- | Keep any package modules (except Prelude) when changing the context.
+setContextKeepingPackageModules
+ :: Session
+ -> ([Module],[Module]) -- previous context
+ -> ([Module],[Module]) -- new context
+ -> GHCi ()
+setContextKeepingPackageModules session prev_context (as,bs) = do
+ let (_,bs0) = prev_context
+ prel_mod <- getPrelude
+ let pkg_modules = filter (\p -> not (isHomeModule p) && p /= prel_mod) bs0
+ let bs1 = if null as then nub (prel_mod : bs) else bs
+ io $ GHC.setContext session as (nub (bs1 ++ pkg_modules))
+isHomeModule :: Module -> Bool
+isHomeModule mod = GHC.modulePackageId mod == mainPackageId
modulesLoadedMsg :: SuccessFlag -> [ModuleName] -> GHCi ()
modulesLoadedMsg ok mods = do
browseModule :: Bool -> Module -> Bool -> GHCi ()
browseModule bang modl exports_only = do
s <- getSession
+ -- :browse! reports qualifiers wrt current context
+ current_unqual <- io (GHC.getPrintUnqual s)
-- Temporarily set the context to the module we're interested in,
-- just so we can get an appropriate PrintUnqualified
(as,bs) <- io (GHC.getContext s)
prel_mod <- getPrelude
io (if exports_only then GHC.setContext s [] [prel_mod,modl]
else GHC.setContext s [modl] [])
- unqual <- io (GHC.getPrintUnqual s)
+ target_unqual <- io (GHC.getPrintUnqual s)
io (GHC.setContext s as bs)
+ let unqual = if bang then current_unqual else target_unqual
+
mb_mod_info <- io $ GHC.getModuleInfo s modl
case mb_mod_info of
Nothing -> throwDyn (CmdLineError ("unknown module: " ++
labels [] = text "-- not currently imported"
labels l = text $ intercalate "\n" $ map qualifier l
qualifier = maybe "-- defined locally"
- (("-- imported from "++) . intercalate ", "
+ (("-- imported via "++) . intercalate ", "
. map GHC.moduleNameString)
importInfo = RdrName.getGRE_NameQualifier_maybes rdr_env
modNames = map (importInfo . GHC.getName) things
io (GHC.setTargets session [])
io (GHC.load session LoadAllTargets)
io (linkPackages dflags new_pkgs)
- setContextAfterLoad session []
+ -- package flags changed, we can't re-use any of the old context
+ setContextAfterLoad session ([],[]) []
return ()
':':_ | all isSpace (take (start-1) line) -> wrapCompleter completeCmd w
_other
| ((':':c) : _) <- line_words -> do
- maybe_cmd <- lookupCommand c
+ maybe_cmd <- lookupCommand' c
let (n,w') = selectWord (words' 0 line)
case maybe_cmd of
Nothing -> return Nothing
(r:_) -> do
let hist = GHC.resumeHistory r
(took,rest) = splitAt num hist
- spans <- mapM (io . GHC.getHistorySpan s) took
- let nums = map (printf "-%-3d:") [(1::Int)..]
- let names = map GHC.historyEnclosingDecl took
- printForUser (vcat(zipWith3
- (\x y z -> x <+> y <+> z)
- (map text nums)
- (map (bold . ppr) names)
- (map (parens . ppr) spans)))
- io $ putStrLn $ if null rest then "<end of history>" else "..."
+ case hist of
+ [] -> io $ putStrLn $
+ "Empty history. Perhaps you forgot to use :trace?"
+ _ -> do
+ spans <- mapM (io . GHC.getHistorySpan s) took
+ let nums = map (printf "-%-3d:") [(1::Int)..]
+ names = map GHC.historyEnclosingDecl took
+ printForUser (vcat(zipWith3
+ (\x y z -> x <+> y <+> z)
+ (map text nums)
+ (map (bold . ppr) names)
+ (map (parens . ppr) spans)))
+ io $ putStrLn $ if null rest then "<end of history>" else "..."
bold :: SDoc -> SDoc
bold c | do_bold = text start_bold <> c <> text end_bold