X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=9feae0e9778679a0a0182b0a017a540a18714331;hb=8ffd91b6102f4ad3111cabdf6bdb1998f257887f;hp=4fdf949233121c580a34e1cf1f8f1bc57af5ce50;hpb=426b9e61dfa26ff086bc0195a8c5c0d2700c315e;p=ghc-hetmet.git diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs index 4fdf949..9feae0e 100644 --- a/compiler/ghci/InteractiveUI.hs +++ b/compiler/ghci/InteractiveUI.hs @@ -34,7 +34,8 @@ import PackageConfig 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 @@ -42,7 +43,6 @@ import Name import SrcLoc -- Other random utilities -import ErrUtils import CmdLineParser import Digraph import BasicTypes hiding (isTopLevel) @@ -52,7 +52,7 @@ import StaticFlags import Linker import Util import NameSet -import Maybes ( orElse ) +import Maybes ( orElse, expectJust ) import FastString import Encoding import MonadUtils ( liftIO ) @@ -96,10 +96,6 @@ import GHC.TopHandler import Data.IORef ( IORef, readIORef, writeIORef ) -#ifdef USE_EDITLINE -import System.Posix.Internals ( setNonBlockingFD ) -#endif - ----------------------------------------------------------------------------- ghciWelcomeMsg :: String @@ -147,7 +143,7 @@ builtin_commands = [ ("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), @@ -344,8 +340,6 @@ interactiveUI srcs maybe_exprs = withTerminalReset $ do default_editor <- liftIO $ findEditor - cwd <- liftIO $ getCurrentDirectory - startGHCi (runGHCi srcs maybe_exprs) GHCiState{ progname = "", args = [], @@ -361,7 +355,6 @@ interactiveUI srcs maybe_exprs = withTerminalReset $ do last_command = Nothing, cmdqueue = [], remembered_ctx = [], - virtual_path = cwd, ghc_e = isJust maybe_exprs } @@ -641,11 +634,8 @@ readlineLoop = do return (Just str) withReadline :: IO a -> IO a -withReadline = bracket_ stopTimer (do startTimer; setNonBlockingFD 0) - -- Two problems are being worked around here: - -- 1. readline sometimes puts stdin into blocking mode, - -- so we need to put it back for the IO library - -- 2. editline doesn't handle some of its system calls returning +withReadline = bracket_ stopTimer startTimer + -- editline doesn't handle some of its system calls returning -- EINTR, so our timer signal confuses it, hence we turn off -- the timer signal when making calls to editline. (#2277) -- If editline is ever fixed, we can remove this. @@ -740,23 +730,19 @@ afterRunStmt step_here run_result = do 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 " st <- getGHCiState enqueueCommands [stop st] return () - | otherwise -> resume GHC.SingleStep >>= + | otherwise -> resume step_here GHC.SingleStep >>= afterRunStmt step_here >> return () _ -> return () @@ -767,17 +753,26 @@ afterRunStmt step_here run_result = do 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 @@ -1040,6 +1035,9 @@ defineMacro overwrite s = do 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 @@ -1217,8 +1215,7 @@ typeOfExpr str ty <- GHC.exprType str dflags <- getDynFlags let pefas = dopt Opt_PrintExplicitForalls dflags - printForUser $ text str <+> dcolon - <+> pprTypeForUser pefas ty + printForUser $ sep [text str, nest 2 (dcolon <+> pprTypeForUser pefas ty)] kindOfType :: String -> GHCi () kindOfType str @@ -1519,7 +1516,7 @@ newDynFlags minus_opts = do 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 @@ -1682,8 +1679,8 @@ completeNone :: String -> IO [String] completeNone _w = return [] completeMacro, completeIdentifier, completeModule, - completeHomeModule, completeSetOptions, completeFilename, - completeHomeModuleOrFile + completeHomeModule, completeSetOptions, completeShowOptions, + completeFilename, completeHomeModuleOrFile :: String -> IO [String] #ifdef USE_EDITLINE @@ -1757,9 +1754,15 @@ completeHomeModule w = do 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 @@ -1808,12 +1811,13 @@ allExposedModules dflags 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 @@ -1974,7 +1978,7 @@ continueCmd = noArgs $ doContinue (const True) GHC.RunToCompletion -- doContinue :: SingleStep -> GHCi () doContinue :: (SrcSpan -> Bool) -> SingleStep -> GHCi () doContinue pred step = do - runResult <- resume step + runResult <- resume pred step afterRunStmt pred runResult return () @@ -2247,7 +2251,7 @@ listModuleLine modl line = do case this of [] -> panic "listModuleLine" summ:_ -> do - let filename = fromJust (ml_hs_file (GHC.ms_location summ)) + let filename = expectJust "listModuleLine" (ml_hs_file (GHC.ms_location summ)) loc = GHC.mkSrcLoc (mkFastString (filename)) line 0 io $ listAround (GHC.srcLocSpan loc) False