X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=e0c49ceed6928e3489e84d667370306085d995cb;hb=831a35dd00faff195cf938659c2dd736192b865f;hp=4741a618b164e84ab4b181343f21f7a8daf1e35e;hpb=1246293616fc45787ecaed13aa31a2555510f7e3;p=ghc-hetmet.git diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs index 4741a61..e0c49ce 100644 --- a/compiler/ghci/InteractiveUI.hs +++ b/compiler/ghci/InteractiveUI.hs @@ -143,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), @@ -335,13 +335,11 @@ interactiveUI srcs maybe_exprs = withTerminalReset $ do #endif -- initial context is just the Prelude - prel_mod <- GHC.findModule (GHC.mkModuleName "Prelude") Nothing + prel_mod <- GHC.lookupModule (GHC.mkModuleName "Prelude") Nothing GHC.setContext [] [prel_mod] default_editor <- liftIO $ findEditor - cwd <- liftIO $ getCurrentDirectory - startGHCi (runGHCi srcs maybe_exprs) GHCiState{ progname = "", args = [], @@ -357,7 +355,6 @@ interactiveUI srcs maybe_exprs = withTerminalReset $ do last_command = Nothing, cmdqueue = [], remembered_ctx = [], - virtual_path = cwd, ghc_e = isJust maybe_exprs } @@ -733,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 () @@ -760,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 @@ -1033,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 @@ -1210,15 +1215,20 @@ typeOfExpr str 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 @@ -1675,8 +1685,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 @@ -1750,9 +1760,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 @@ -1801,12 +1817,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 @@ -1967,7 +1984,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 () @@ -2339,7 +2356,7 @@ mkTickArray ticks lookupModule :: String -> GHCi Module lookupModule modName - = GHC.findModule (GHC.mkModuleName modName) Nothing + = GHC.lookupModule (GHC.mkModuleName modName) Nothing -- don't reset the counter back to zero? discardActiveBreakPoints :: GHCi ()