{-# OPTIONS -fno-cse #-}
-- -fno-cse is needed for GLOBAL_VAR's to behave properly
-{-# OPTIONS -#include "Linker.h" #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-----------------------------------------------------------------------------
--
-- The GHC interface
import qualified GHC hiding (resume, runStmt)
import GHC ( LoadHowMuch(..), Target(..), TargetId(..),
- Module, ModuleName, TyThing(..), Phase,
- BreakIndex, SrcSpan, Resume, SingleStep,
+ TyThing(..), Phase,
+ BreakIndex, Resume, SingleStep,
Ghc, handleSourceError )
import PprTyThing
import DynFlags
import Packages
-import PackageConfig
+-- import PackageConfig
import UniqFM
-import HscTypes ( implicitTyThings, handleFlagWarnings )
+import HscTypes ( handleFlagWarnings )
+import HsImpExp
import qualified RdrName ( getGRE_NameQualifier_maybes ) -- should this come via GHC?
+import RdrName (RdrName)
import Outputable hiding (printForUser, printForUserPartWay)
import Module -- for ModuleEnv
import Name
import SrcLoc
-import ObjLink
-- Other random utilities
import CmdLineParser
import Maybes ( orElse, expectJust )
import FastString
import Encoding
+import Foreign.C
#ifndef mingw32_HOST_OS
import System.Posix hiding (getEnv)
--import SystemExts
import Exception hiding (catch, block, unblock)
-import qualified Exception
-- import Control.Concurrent
import Text.Printf
import Foreign
import GHC.Exts ( unsafeCoerce# )
+
+#if __GLASGOW_HASKELL__ >= 611
+import GHC.IO.Exception ( IOErrorType(InvalidArgument) )
+import GHC.IO.Handle ( hFlushAll )
+#else
import GHC.IOBase ( IOErrorType(InvalidArgument) )
+#endif
+
import GHC.TopHandler
import Data.IORef ( IORef, readIORef, writeIORef )
("check", keepGoing' checkModule, completeHomeModule),
("continue", keepGoing continueCmd, noCompletion),
("cmd", keepGoing cmdCmd, completeExpression),
- ("ctags", keepGoing createCTagsFileCmd, completeFilename),
+ ("ctags", keepGoing createCTagsWithLineNumbersCmd, completeFilename),
+ ("ctags!", keepGoing createCTagsWithRegExesCmd, completeFilename),
("def", keepGoing (defineMacro False), completeExpression),
("def!", keepGoing (defineMacro True), completeExpression),
("delete", keepGoing deleteCmd, noCompletion),
- ("e", keepGoing editFile, completeFilename),
("edit", keepGoing editFile, completeFilename),
("etags", keepGoing createETagsFileCmd, completeFilename),
("force", keepGoing forceCmd, completeExpression),
" (!: 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" ++
+ " :ctags[!] [<file>] create tags file for Vi (default: \"tags\")\n" ++
+ " (!: use regex instead of line number)\n" ++
" :def <cmd> <expr> define a command :<cmd>\n" ++
" :edit <file> edit file\n" ++
" :edit edit last module\n" ++
return ""
#endif
+foreign import ccall unsafe "rts_isProfiled" isProfiled :: IO CInt
+
interactiveUI :: [(FilePath, Maybe Phase)] -> Maybe [String]
-> Ghc ()
interactiveUI srcs maybe_exprs = do
-- although GHCi compiles with -prof, it is not usable: the byte-code
-- compiler and interpreter don't work with profiling. So we check for
-- this up front and emit a helpful error message (#2197)
- m <- liftIO $ lookupSymbol "PushCostCentre"
- when (isJust m) $
+ i <- liftIO $ isProfiled
+ when (i /= 0) $
ghcError (InstallationError "GHCi cannot be used when compiled with -prof")
-- HACK! If we happen to get into an infinite loop (eg the user
-- it refers to might be finalized, including the standard Handles.
-- This sounds like a bug, but we don't have a good solution right
-- now.
- liftIO $ newStablePtr stdin
- liftIO $ newStablePtr stdout
- liftIO $ newStablePtr stderr
+ _ <- liftIO $ newStablePtr stdin
+ _ <- liftIO $ newStablePtr stdout
+ _ <- liftIO $ newStablePtr stderr
-- Initialise buffering for the *interpreted* I/O system
initInterpBuffering
-- We don't want the cmd line to buffer any input that might be
-- intended for the program, so unbuffer stdin.
hSetBuffering stdin NoBuffering
+#if defined(mingw32_HOST_OS) && __GLASGOW_HASKELL__ >= 611
+ -- On Unix, stdin will use the locale encoding. The IO library
+ -- doesn't do this on Windows (yet), so for now we use UTF-8,
+ -- for consistency with GHC 6.10 and to make the tests work.
+ hSetEncoding stdin utf8
+#endif
-- initial context is just the Prelude
prel_mod <- GHC.lookupModule (GHC.mkModuleName "Prelude") Nothing
- GHC.setContext [] [prel_mod]
+ GHC.setContext [] [(prel_mod, Nothing)]
default_editor <- liftIO $ findEditor
Right home -> return (Just (home </> ".ghci"))
_ -> return Nothing
+ canonicalizePath' :: FilePath -> IO (Maybe FilePath)
+ canonicalizePath' fp = liftM Just (canonicalizePath fp)
+ `catchIO` \_ -> return Nothing
+
sourceConfigFile :: FilePath -> GHCi ()
sourceConfigFile file = do
exists <- io $ doesFileExist file
-- can we assume this will always be the case?
-- This would be a good place for runFileInputT.
Right hdl -> runInputTWithPrefs defaultPrefs defaultSettings $ do
- setLogAction
runCommands $ fileLoop hdl
where
getDirectory f = case takeDirectory f of "" -> "."; d -> d
when (read_dot_files) $ do
- cfgs0 <- sequence [ current_dir, app_user_dir, home_dir ]
- cfgs <- io $ mapM canonicalizePath (catMaybes cfgs0)
- mapM_ sourceConfigFile (nub cfgs)
+ mcfgs0 <- sequence [ current_dir, app_user_dir, home_dir ]
+ mcfgs <- io $ mapM canonicalizePath' (catMaybes mcfgs0)
+ mapM_ sourceConfigFile $ nub $ catMaybes mcfgs
-- nub, because we don't want to read .ghci twice if the
-- CWD is $HOME.
-- just evaluate the expression we were given
enqueueCommands exprs
let handle e = do st <- getGHCiState
+ -- flush the interpreter's stdout/stderr on exit (#3890)
+ flushInterpBuffers
-- Jump through some hoops to get the
-- current progname in the exception text:
-- <progname>: <exception>
-- this used to be topHandlerFastExit, see #2228
$ topHandler e
runInputTWithPrefs defaultPrefs defaultSettings $ do
- setLogAction
runCommands' handle (return Nothing)
-- and finally, exit
(return Nothing)
let settings = setComplete ghciCompleteWord
$ defaultSettings {historyFile = histFile}
- runInputT settings $ do
- setLogAction
- f
+ runInputT settings f
nextInputLine :: Bool -> Bool -> InputT GHCi (Maybe String)
nextInputLine show_prompt is_tty
-- this can happen if the user closed stdin, or
-- perhaps did getContents which closes stdin at
-- EOF.
- Right l -> fmap Just (Encoding.decode (BS.pack l))
+ Right l -> return (Just l)
mkPrompt :: GHCi String
mkPrompt = do
dots | _:rs <- resumes, not (null rs) = text "... "
| otherwise = empty
-
-
modules_bit =
-- 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)
+ hsep (map (ppr . GHC.moduleName) (nub (map fst exports)))
deflt_prompt = dots <> context_bit <> modules_bit
runCommands' :: (SomeException -> GHCi Bool) -- Exception handler
-> InputT GHCi (Maybe String) -> InputT GHCi ()
runCommands' eh getCmd = do
- b <- handleGhcException (\e -> case e of
- Interrupted -> return False
- _other -> liftIO (print e) >> return True)
+ b <- ghandle (\e -> case fromException e of
+ Just UserInterrupt -> return False
+ _ -> case fromException e of
+ Just ghc_e ->
+ do liftIO (print (ghc_e :: GhcException))
+ return True
+ _other ->
+ liftIO (Exception.throwIO e))
(runOneCommand eh getCmd)
if b then return () else runCommands' eh getCmd
maybe (liftIO (ioError collectError))
(\l->if removeSpaces l == ":}"
then return (Just $ removeSpaces c)
- else collectCommand q (c++map normSpace l))
+ else collectCommand q (c ++ "\n" ++ map normSpace l))
where normSpace '\r' = ' '
normSpace c = c
-- QUESTION: is userError the one to use here?
collectError = userError "unterminated multiline command :{ .. :}"
doCommand (':' : cmd) = specialCommand cmd
- doCommand stmt = do timeIt $ lift $ runStmt stmt GHC.RunToCompletion
+ doCommand stmt = do _ <- timeIt $ lift $ runStmt stmt GHC.RunToCompletion
return False
enqueueCommands :: [String] -> GHCi ()
runStmt :: String -> SingleStep -> GHCi Bool
runStmt stmt step
- | null (filter (not.isSpace) stmt) = return False
- | ["import", mod] <- words stmt = keepGoing' setContext ('+':mod)
+ | null (filter (not.isSpace) stmt)
+ = return False
+ | "import " `isPrefixOf` stmt
+ = do newContextCmd (Import stmt); return False
| otherwise
- = do result <- GhciMonad.runStmt stmt step
+ = do
+#if __GLASGOW_HASKELL__ >= 611
+ -- In the new IO library, read handles buffer data even if the Handle
+ -- is set to NoBuffering. This causes problems for GHCi where there
+ -- are really two stdin Handles. So we flush any bufferred data in
+ -- GHCi's stdin Handle here (only relevant if stdin is attached to
+ -- a file, otherwise the read buffer can't be flushed).
+ _ <- liftIO $ IO.try $ hFlushAll stdin
+#endif
+ result <- GhciMonad.runStmt stmt step
afterRunStmt (const True) result
--afterRunStmt :: GHC.RunResult -> GHCi Bool
Nothing -> BadCommand
lookupCommand' :: String -> IO (Maybe Command)
-lookupCommand' str = do
+lookupCommand' ":" = return Nothing
+lookupCommand' str' = do
macros <- readIORef macros_ref
- let cmds = builtin_commands ++ macros
+ let{ (str, cmds) = case str' of
+ ':' : rest -> (rest, builtin_commands)
+ _ -> (str', macros ++ builtin_commands) }
-- look for exact match first, then the first prefix match
return $ case [ c | c <- cmds, str == cmdName c ] of
c:_ -> Just c
-- constructor in the same type
filterOutChildren :: (a -> TyThing) -> [a] -> [a]
filterOutChildren get_thing xs
- = [x | x <- xs, not (getName (get_thing x) `elemNameSet` implicits)]
+ = filterOut has_parent xs
where
- implicits = mkNameSet [getName t | x <- xs, t <- implicitTyThings (get_thing x)]
+ all_names = mkNameSet (map (getName . get_thing) xs)
+ has_parent x = case pprTyThingParent_maybe (get_thing x) of
+ Just p -> getName p `elemNameSet` all_names
+ Nothing -> False
pprInfo :: PrintExplicitForalls -> (TyThing, Fixity, [GHC.Instance]) -> SDoc
pprInfo pefas (thing, fixity, insts)
outputStr "Warning: changing directory causes all loaded modules to be unloaded,\nbecause the search path has changed.\n"
prev_context <- GHC.getContext
GHC.setTargets []
- GHC.load LoadAllTargets
+ _ <- GHC.load LoadAllTargets
lift $ setContextAfterLoad prev_context False []
GHC.workingDirectoryChanged
dir <- expandPath dir
let cmd = editor st
when (null cmd)
$ ghcError (CmdLineError "editor not set, use :set editor")
- io $ system (cmd ++ ' ':file)
+ _ <- io $ system (cmd ++ ' ':file)
return ()
-- The user didn't specify a file so we pick one for them.
fromTarget _ = Nothing -- when would we get a module target?
defineMacro :: Bool{-overwrite-} -> String -> GHCi ()
+defineMacro _ (':':_) =
+ io $ putStrLn "macro name cannot start with a colon"
defineMacro overwrite s = do
let (macro_name, definition) = break isSpace s
macros <- io (readIORef macros_ref)
enqueueCommands (lines cmds)
return ()
+loadModuleName :: GHC.GhcMonad m => ImportDecl RdrName -> m Module
+loadModuleName = flip GHC.findModule Nothing . unLoc . ideclName
+
loadModule :: [(FilePath, Maybe Phase)] -> InputT GHCi SuccessFlag
loadModule fs = timeIt (loadModule' fs)
loadModule_ :: [FilePath] -> InputT GHCi ()
-loadModule_ fs = do loadModule (zip fs (repeat Nothing)); return ()
+loadModule_ fs = loadModule (zip fs (repeat Nothing)) >> return ()
loadModule' :: [(FilePath, Maybe Phase)] -> InputT GHCi SuccessFlag
loadModule' files = do
prev_context <- GHC.getContext
-- unload first
- GHC.abandonAll
+ _ <- GHC.abandonAll
lift discardActiveBreakPoints
GHC.setTargets []
- GHC.load LoadAllTargets
+ _ <- GHC.load LoadAllTargets
let (filenames, phases) = unzip files
exp_filenames <- mapM expandPath filenames
reloadModule :: String -> InputT GHCi ()
reloadModule m = do
prev_context <- GHC.getContext
- doLoad True prev_context $
+ _ <- doLoad True prev_context $
if null m then LoadAllTargets
else LoadUpTo (GHC.mkModuleName m)
return ()
-doLoad :: Bool -> ([Module],[Module]) -> LoadHowMuch -> InputT GHCi SuccessFlag
+doLoad :: Bool -> ([Module],[(Module, Maybe (ImportDecl RdrName))]) -> LoadHowMuch -> InputT GHCi SuccessFlag
doLoad 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.
afterLoad ok retain_context prev_context
return ok
-afterLoad :: SuccessFlag -> Bool -> ([Module],[Module]) -> InputT GHCi ()
+afterLoad :: SuccessFlag -> Bool -> ([Module],[(Module, Maybe (ImportDecl RdrName))]) -> InputT GHCi ()
afterLoad ok retain_context prev_context = do
lift revertCAFs -- always revert CAFs on load.
lift discardTickArrays
lift $ setContextAfterLoad prev_context retain_context loaded_mod_summaries
-setContextAfterLoad :: ([Module],[Module]) -> Bool -> [GHC.ModSummary] -> GHCi ()
+setContextAfterLoad :: ([Module],[(Module, Maybe (ImportDecl RdrName))]) -> Bool -> [GHC.ModSummary] -> GHCi ()
setContextAfterLoad prev keep_ctxt [] = do
prel_mod <- getPrelude
- setContextKeepingPackageModules prev keep_ctxt ([], [prel_mod])
+ setContextKeepingPackageModules prev keep_ctxt ([], [(prel_mod, Nothing)])
setContextAfterLoad prev keep_ctxt ms = do
-- load a target if one is available, otherwise load the topmost module.
targets <- GHC.getTargets
if b then setContextKeepingPackageModules prev keep_ctxt ([m], [])
else do
prel_mod <- getPrelude
- setContextKeepingPackageModules prev keep_ctxt ([],[prel_mod,m])
+ setContextKeepingPackageModules prev keep_ctxt ([],[(prel_mod,Nothing),(m,Nothing)])
-- | Keep any package modules (except Prelude) when changing the context.
setContextKeepingPackageModules
- :: ([Module],[Module]) -- previous context
+ :: ([Module],[(Module, Maybe (ImportDecl RdrName))]) -- previous context
-> Bool -- re-execute :module commands
- -> ([Module],[Module]) -- new context
+ -> ([Module],[(Module, Maybe (ImportDecl RdrName))]) -- new context
-> GHCi ()
setContextKeepingPackageModules prev_context keep_ctxt (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
- GHC.setContext as (nub (bs1 ++ pkg_modules))
+ -- filter everything, not just lefts
+ let pkg_modules = filter ((\p -> not (isHomeModule p) && p /= prel_mod) . fst) bs0
+ let bs1 = if null as then nubBy sameFst ((prel_mod,Nothing) : bs) else bs
+ GHC.setContext as (nubBy sameFst (bs1 ++ pkg_modules))
if keep_ctxt
then do
st <- getGHCiState
isHomeModule :: Module -> Bool
isHomeModule mod = GHC.modulePackageId mod == mainPackageId
+sameFst :: (Module, Maybe (ImportDecl RdrName)) -> (Module, Maybe (ImportDecl RdrName)) -> Bool
+sameFst x y = fst x == fst y
+
modulesLoadedMsg :: SuccessFlag -> [ModuleName] -> InputT GHCi ()
modulesLoadedMsg ok mods = do
dflags <- getDynFlags
ty <- GHC.exprType str
dflags <- getDynFlags
let pefas = dopt Opt_PrintExplicitForalls dflags
- printForUser' $ sep [text str, nest 2 (dcolon <+> pprTypeForUser pefas ty)]
+ printForUser $ sep [text str, nest 2 (dcolon <+> pprTypeForUser pefas ty)]
kindOfType :: String -> InputT GHCi ()
kindOfType str
= handleSourceError (\e -> GHC.printExceptionAndWarnings e) $ do
ty <- GHC.typeKind str
- printForUser' $ text str <+> dcolon <+> ppr ty
+ printForUser $ text str <+> dcolon <+> ppr ty
quit :: String -> InputT GHCi Bool
quit _ = return True
-- recently-added module occurs last, it seems.
case (as,bs) of
(as@(_:_), _) -> browseModule bang (last as) True
- ([], bs@(_:_)) -> browseModule bang (last bs) True
- ([], []) -> ghcError (CmdLineError ":browse: no current module")
+ ([], bs@(_:_)) -> browseModule bang (fst (last bs)) True
+ ([], []) -> ghcError (CmdLineError ":browse: no current module")
_ -> ghcError (CmdLineError "syntax: :browse <module>")
-- without bang, show items in context of their parents and omit children
-- just so we can get an appropriate PrintUnqualified
(as,bs) <- GHC.getContext
prel_mod <- lift getPrelude
- if exports_only then GHC.setContext [] [prel_mod,modl]
+ if exports_only then GHC.setContext [] [(prel_mod,Nothing), (modl,Nothing)]
else GHC.setContext [modl] []
target_unqual <- GHC.getPrintUnqual
GHC.setContext as bs
-----------------------------------------------------------------------------
-- Setting the module context
+newContextCmd :: CtxtCmd -> GHCi ()
+newContextCmd cmd = do
+ playCtxtCmd True cmd
+ st <- getGHCiState
+ let cmds = remembered_ctx st
+ setGHCiState st{ remembered_ctx = cmds ++ [cmd] }
+
setContext :: String -> GHCi ()
setContext str
- | all sensible strs = do
- playCtxtCmd True (cmd, as, bs)
- st <- getGHCiState
- setGHCiState st{ remembered_ctx = remembered_ctx st ++ [(cmd,as,bs)] }
+ | all sensible strs = newContextCmd cmd
| otherwise = ghcError (CmdLineError "syntax: :module [+/-] [*]M1 ... [*]Mn")
where
- (cmd, strs, as, bs) =
+ (cmd, strs) =
case str of
'+':stuff -> rest AddModules stuff
'-':stuff -> rest RemModules stuff
stuff -> rest SetContext stuff
- rest cmd stuff = (cmd, strs, as, bs)
+ rest cmd stuff = (cmd as bs, strs)
where strs = words stuff
(as,bs) = partitionWith starred strs
starred ('*':m) = Left m
starred m = Right m
-playCtxtCmd :: Bool -> (CtxtCmd, [String], [String]) -> GHCi ()
-playCtxtCmd fail (cmd, as, bs)
- = do
- (as',bs') <- do_checks fail
+playCtxtCmd:: Bool -> CtxtCmd -> GHCi ()
+playCtxtCmd fail cmd = do
(prev_as,prev_bs) <- GHC.getContext
- (new_as, new_bs) <-
- case cmd of
- SetContext -> do
+ case cmd of
+ SetContext as bs -> do
+ (as',bs') <- do_checks as bs
prel_mod <- getPrelude
- let bs'' = if null as && prel_mod `notElem` bs' then prel_mod:bs'
- else bs'
- return (as',bs'')
- AddModules -> do
- let as_to_add = as' \\ (prev_as ++ prev_bs)
- bs_to_add = bs' \\ (prev_as ++ prev_bs)
- return (prev_as ++ as_to_add, prev_bs ++ bs_to_add)
- RemModules -> do
- let new_as = prev_as \\ (as' ++ bs')
- new_bs = prev_bs \\ (as' ++ bs')
- return (new_as, new_bs)
- GHC.setContext new_as new_bs
+ let bs'' = if null as && prel_mod `notElem` (map fst bs')
+ then (prel_mod,Nothing):bs'
+ else bs'
+ GHC.setContext as' bs''
+
+ AddModules as bs -> do
+ (as',bs') <- do_checks as bs
+ -- it should replace the old stuff, not the other way around
+ -- need deleteAllBy, not deleteFirstsBy for sameFst
+ let remaining_as = prev_as \\ (as' ++ map fst bs')
+ remaining_bs = deleteAllBy sameFst prev_bs (bs' ++ map contextualize as')
+ GHC.setContext (remaining_as ++ as') (remaining_bs ++ bs')
+
+ RemModules as bs -> do
+ (as',bs') <- do_checks as bs
+ let new_as = prev_as \\ (as' ++ map fst bs')
+ new_bs = deleteAllBy sameFst prev_bs (map contextualize as' ++ bs')
+ GHC.setContext new_as new_bs
+
+ Import str -> do
+ m_idecl <- maybe_fail $ GHC.parseImportDecl str
+ case m_idecl of
+ Nothing -> return ()
+ Just idecl -> do
+ m_mdl <- maybe_fail $ loadModuleName idecl
+ case m_mdl of
+ Nothing -> return ()
+ Just m -> GHC.setContext prev_as (prev_bs ++ [(m, Just idecl)])
+
where
- do_checks True = do
- as' <- mapM wantInterpretedModule as
- bs' <- mapM lookupModule bs
- return (as',bs')
- do_checks False = do
- as' <- mapM (trymaybe . wantInterpretedModule) as
- bs' <- mapM (trymaybe . lookupModule) bs
- return (catMaybes as', catMaybes bs')
-
- trymaybe m = do
- r <- ghciTry m
- case r of
- Left _ -> return Nothing
- Right a -> return (Just a)
+ maybe_fail | fail = liftM Just
+ | otherwise = trymaybe
+
+ do_checks as bs = do
+ as' <- mapM (maybe_fail . wantInterpretedModule) as
+ bs' <- mapM (maybe_fail . lookupModule) bs
+ return (catMaybes as', map contextualize (catMaybes bs'))
+
+ contextualize x = (x,Nothing)
+ deleteAllBy f a b = filter (\x->(not (any (f x) b))) a
+
+trymaybe ::GHCi a -> GHCi (Maybe a)
+trymaybe m = do
+ r <- ghciTry m
+ case r of
+ Left _ -> return Nothing
+ Right a -> return (Just a)
----------------------------------------------------------------------------
-- Code for `:set'
when (packageFlags dflags /= pkg_flags) $ do
io $ hPutStrLn stderr "package flags have changed, resetting and loading new packages..."
GHC.setTargets []
- GHC.load LoadAllTargets
+ _ <- GHC.load LoadAllTargets
io (linkPackages dflags new_pkgs)
-- package flags changed, we can't re-use any of the old context
setContextAfterLoad ([],[]) False []
where showFlag (ExposePackage p) = text $ " -package " ++ p
showFlag (HidePackage p) = text $ " -hide-package " ++ p
showFlag (IgnorePackage p) = text $ " -ignore-package " ++ p
+ showFlag (ExposePackageId p) = text $ " -package-id " ++ p
showLanguages :: GHCi ()
showLanguages = do
Nothing -> return completeFilename
completeCmd = wrapCompleter " " $ \w -> do
- cmds <- liftIO $ readIORef macros_ref
- return (filter (w `isPrefixOf`) (map (':':)
- (map cmdName (builtin_commands ++ cmds))))
+ macros <- liftIO $ readIORef macros_ref
+ let macro_names = map (':':) . map cmdName $ macros
+ let command_names = map (':':) . map cmdName $ builtin_commands
+ let{ candidates = case w of
+ ':' : ':' : _ -> map (':':) command_names
+ _ -> nub $ macro_names ++ command_names }
+ return $ filter (w `isPrefixOf`) candidates
completeMacro = wrapIdentCompleter $ \w -> do
cmds <- liftIO $ readIORef macros_ref
showException :: SomeException -> GHCi ()
showException se =
io $ case fromException se of
- Just Interrupted -> putStrLn "Interrupted."
-- omit the location for CmdLineError:
Just (CmdLineError s) -> putStrLn s
-- ditto:
Just ph@(PhaseFailed {}) -> putStrLn (showGhcException ph "")
Just other_ghc_ex -> print other_ghc_ex
- Nothing -> putStrLn ("*** Exception: " ++ show se)
+ Nothing ->
+ case fromException se of
+ Just UserInterrupt -> putStrLn "Interrupted."
+ _other -> putStrLn ("*** Exception: " ++ show se)
-----------------------------------------------------------------------------
-- recursive exception handlers
stepCmd :: String -> GHCi ()
stepCmd [] = doContinue (const True) GHC.SingleStep
-stepCmd expression = do runStmt expression GHC.SingleStep; return ()
+stepCmd expression = runStmt expression GHC.SingleStep >> return ()
stepLocalCmd :: String -> GHCi ()
stepLocalCmd [] = do
traceCmd :: String -> GHCi ()
traceCmd [] = doContinue (const True) GHC.RunAndLogSteps
-traceCmd expression = do runStmt expression GHC.RunAndLogSteps; return ()
+traceCmd expression = runStmt expression GHC.RunAndLogSteps >> return ()
continueCmd :: String -> GHCi ()
continueCmd = noArgs $ doContinue (const True) GHC.RunToCompletion
doContinue :: (SrcSpan -> Bool) -> SingleStep -> GHCi ()
doContinue pred step = do
runResult <- resume pred step
- afterRunStmt pred runResult
+ _ <- afterRunStmt pred runResult
return ()
abandonCmd :: String -> GHCi ()
mb_span <- lift getCurrentBreakSpan
case mb_span of
Nothing ->
- printForUser' $ text "Not stopped at a breakpoint; nothing to list"
+ printForUser $ text "Not stopped at a breakpoint; nothing to list"
Just span
| GHC.isGoodSrcSpan span -> listAround span True
| otherwise ->
[] -> text "rerunning with :trace,"
_ -> empty
doWhat = traceIt <+> text ":back then :list"
- printForUser' (text "Unable to list source for" <+>
+ printForUser (text "Unable to list source for" <+>
ppr span
$$ text "Try" <+> doWhat)
listCmd str = list2 (words str)
noCanDo name $ text "can't find its location: " <>
ppr loc
where
- noCanDo n why = printForUser' $
+ noCanDo n why = printForUser $
text "cannot list source code for " <> ppr n <> text ": " <> why
list2 _other =
outputStrLn "syntax: :list [<line> | <module> <line> | <identifier>]"
where
file = GHC.srcSpanFile span
line1 = GHC.srcSpanStartLine span
- col1 = GHC.srcSpanStartCol span
+ col1 = GHC.srcSpanStartCol span - 1
line2 = GHC.srcSpanEndLine span
- col2 = GHC.srcSpanEndCol span
+ col2 = GHC.srcSpanEndCol span - 1
pad_before | line1 == 1 = 0
| otherwise = 1
discardActiveBreakPoints :: GHCi ()
discardActiveBreakPoints = do
st <- getGHCiState
- mapM (turnOffBreak.snd) (breaks st)
+ mapM_ (turnOffBreak.snd) (breaks st)
setGHCiState $ st { breaks = [] }
deleteBreak :: Int -> GHCi ()
then printForUser (text "Breakpoint" <+> ppr identity <+>
text "does not exist")
else do
- mapM (turnOffBreak.snd) this
+ mapM_ (turnOffBreak.snd) this
setGHCiState $ st { breaks = rest }
turnOffBreak :: BreakLocation -> GHCi Bool