import UniqFM
#endif
-import HscTypes ( implicitTyThings, reflectGhc, reifyGhc )
+import HscTypes ( implicitTyThings, reflectGhc, reifyGhc
+ , handleFlagWarnings )
import qualified RdrName ( getGRE_NameQualifier_maybes ) -- should this come via GHC?
import Outputable hiding (printForUser, printForUserPartWay)
import Module -- for ModuleEnv
import SrcLoc
-- Other random utilities
-import ErrUtils
import CmdLineParser
import Digraph
import BasicTypes hiding (isTopLevel)
("reload", keepGoing reloadModule, Nothing, completeNone),
("run", keepGoing runRun, Nothing, completeIdentifier),
("set", keepGoing setCmd, Just flagWordBreakChars, completeSetOptions),
- ("show", keepGoing showCmd, Nothing, completeNone),
+ ("show", keepGoing showCmd, Nothing, completeShowOptions),
("sprint", keepGoing sprintCmd, Nothing, completeIdentifier),
("step", keepGoing stepCmd, Nothing, completeIdentifier),
("steplocal", keepGoing stepLocalCmd, Nothing, completeIdentifier),
default_editor <- liftIO $ findEditor
- cwd <- liftIO $ getCurrentDirectory
-
startGHCi (runGHCi srcs maybe_exprs)
GHCiState{ progname = "<interactive>",
args = [],
last_command = Nothing,
cmdqueue = [],
remembered_ctx = [],
- virtual_path = cwd,
ghc_e = isJust maybe_exprs
}
GHC.RunOk names -> do
show_types <- isOptionSet ShowType
when show_types $ printTypeOfNames names
- GHC.RunBreak _ names mb_info
- | isNothing mb_info ||
+ GHC.RunBreak _ names mb_info
+ | isNothing mb_info ||
step_here (GHC.resumeSpan $ head resumes) -> do
- printForUser $ ptext (sLit "Stopped at") <+>
- ppr (GHC.resumeSpan $ head resumes)
--- printTypeOfNames session names
- let namesSorted = sortBy compareNames names
- tythings <- catMaybes `liftM`
- mapM GHC.lookupName namesSorted
- docs <- pprTypeAndContents [id | AnId id <- tythings]
- printForUserPartWay docs
- maybe (return ()) runBreakCmd mb_info
+ mb_id_loc <- toBreakIdAndLocation mb_info
+ let breakCmd = maybe "" ( \(_,l) -> onBreakCmd l ) mb_id_loc
+ if (null breakCmd)
+ then printStoppedAtBreakInfo (head resumes) names
+ else enqueueCommands [breakCmd]
-- run the command set with ":set stop <cmd>"
st <- getGHCiState
enqueueCommands [stop st]
return ()
- | otherwise -> resume GHC.SingleStep >>=
+ | otherwise -> resume step_here GHC.SingleStep >>=
afterRunStmt step_here >> return ()
_ -> return ()
return (case run_result of GHC.RunOk _ -> True; _ -> False)
-runBreakCmd :: GHC.BreakInfo -> GHCi ()
-runBreakCmd info = do
+toBreakIdAndLocation ::
+ Maybe GHC.BreakInfo -> GHCi (Maybe (Int, BreakLocation))
+toBreakIdAndLocation Nothing = return Nothing
+toBreakIdAndLocation (Just info) = do
let mod = GHC.breakInfo_module info
nm = GHC.breakInfo_number info
st <- getGHCiState
- case [ loc | (_,loc) <- breaks st,
- breakModule loc == mod, breakTick loc == nm ] of
- [] -> return ()
- loc:_ | null cmd -> return ()
- | otherwise -> do enqueueCommands [cmd]; return ()
- where cmd = onBreakCmd loc
+ return $ listToMaybe [ id_loc | id_loc@(_,loc) <- breaks st,
+ breakModule loc == mod,
+ breakTick loc == nm ]
+
+printStoppedAtBreakInfo :: Resume -> [Name] -> GHCi ()
+printStoppedAtBreakInfo resume names = do
+ printForUser $ ptext (sLit "Stopped at") <+>
+ ppr (GHC.resumeSpan resume)
+ -- printTypeOfNames session names
+ let namesSorted = sortBy compareNames names
+ tythings <- catMaybes `liftM` mapM GHC.lookupName namesSorted
+ docs <- pprTypeAndContents [id | AnId id <- tythings]
+ printForUserPartWay docs
printTypeOfNames :: [Name] -> GHCi ()
printTypeOfNames names
runMacro :: GHC.HValue{-String -> IO String-} -> String -> GHCi Bool
runMacro fun s = do
str <- io ((unsafeCoerce# fun :: String -> IO String) s)
+ -- make sure we force any exceptions in the result, while we are still
+ -- inside the exception handler for commands:
+ seqList str (return ())
enqueueCommands (lines str)
return False
ty <- GHC.exprType str
dflags <- getDynFlags
let pefas = dopt Opt_PrintExplicitForalls dflags
- printForUser $ text str <+> dcolon
- <+> pprTypeForUser pefas ty
+ printForUser $ sep [utext str, nest 2 (dcolon <+> pprTypeForUser pefas ty)]
kindOfType :: String -> GHCi ()
kindOfType str
= handleSourceError (\e -> GHC.printExceptionAndWarnings e) $ do
ty <- GHC.typeKind str
- printForUser $ text str <+> dcolon <+> ppr ty
+ printForUser $ utext str <+> dcolon <+> ppr ty
+-- HACK for printing unicode text. We assume the output device
+-- understands UTF-8, and go via FastString which converts to UTF-8.
+-- ToDo: fix properly when we have encoding support in Handles.
+utext :: String -> SDoc
+utext str = ftext (mkFastString str)
+
quit :: String -> GHCi Bool
quit _ = return True
dflags <- getDynFlags
let pkg_flags = packageFlags dflags
(dflags', leftovers, warns) <- io $ GHC.parseDynamicFlags dflags $ map noLoc minus_opts
- io $ handleFlagWarnings dflags' warns
+ handleFlagWarnings dflags' warns
if (not (null leftovers))
then ghcError $ errorsToGhcException leftovers
completeNone _w = return []
completeMacro, completeIdentifier, completeModule,
- completeHomeModule, completeSetOptions, completeFilename,
- completeHomeModuleOrFile
+ completeHomeModule, completeSetOptions, completeShowOptions,
+ completeFilename, completeHomeModuleOrFile
:: String -> IO [String]
#ifdef USE_EDITLINE
completeSetOptions w = do
return (filter (w `isPrefixOf`) options)
- where options = "args":"prog":flagList
+ where options = "args":"prog":"prompt":"editor":"stop":flagList
flagList = map head $ group $ sort allFlags
+completeShowOptions w = do
+ return (filter (w `isPrefixOf`) options)
+ where options = ["args", "prog", "prompt", "editor", "stop",
+ "modules", "bindings", "linker", "breaks",
+ "context", "packages", "languages"]
+
completeFilename w = do
ws <- Readline.filenameCompletionFunction w
case ws of
where
pkg_db = pkgIdMap (pkgState dflags)
#else
-completeMacro = completeNone
-completeIdentifier = completeNone
-completeModule = completeNone
-completeHomeModule = completeNone
-completeSetOptions = completeNone
-completeFilename = completeNone
+completeMacro = completeNone
+completeIdentifier = completeNone
+completeModule = completeNone
+completeHomeModule = completeNone
+completeSetOptions = completeNone
+completeShowOptions = completeNone
+completeFilename = completeNone
completeHomeModuleOrFile=completeNone
#endif
-- doContinue :: SingleStep -> GHCi ()
doContinue :: (SrcSpan -> Bool) -> SingleStep -> GHCi ()
doContinue pred step = do
- runResult <- resume step
+ runResult <- resume pred step
afterRunStmt pred runResult
return ()