X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=26d548d0896561c87288d23bb5f256c5298f1189;hb=41ba0887070487f5cb0f60c55e8f612a6bcaccff;hp=d98b6bc1ac0b8c39650bc38e53489db85281f856;hpb=54a26ee6c4a70d8ab2a41a32507cf270ecbafb8a;p=ghc-hetmet.git diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs index d98b6bc..26d548d 100644 --- a/compiler/ghci/InteractiveUI.hs +++ b/compiler/ghci/InteractiveUI.hs @@ -11,12 +11,13 @@ module InteractiveUI ( interactiveUI, ghciWelcomeMsg ) where #include "HsVersions.h" -import GhciMonad +import qualified GhciMonad +import GhciMonad hiding (runStmt) import GhciTags import Debugger -- The GHC interface -import qualified GHC +import qualified GHC hiding (resume, runStmt) import GHC ( Session, LoadHowMuch(..), Target(..), TargetId(..), Module, ModuleName, TyThing(..), Phase, BreakIndex, SrcSpan, Resume, SingleStep ) @@ -24,7 +25,7 @@ import PprTyThing import DynFlags import Packages -#ifdef USE_READLINE +#ifdef USE_EDITLINE import PackageConfig import UniqFM #endif @@ -54,12 +55,11 @@ import System.Posix hiding (getEnv) #else import GHC.ConsoleHandler ( flushConsole ) import qualified System.Win32 -import System.FilePath #endif -#ifdef USE_READLINE +#ifdef USE_EDITLINE import Control.Concurrent ( yield ) -- Used in readline loop -import System.Console.Readline as Readline +import System.Console.Editline.Readline as Readline #endif --import SystemExts @@ -67,6 +67,7 @@ import System.Console.Readline as Readline import Control.Exception as Exception -- import Control.Concurrent +import System.FilePath import qualified Data.ByteString.Char8 as BS import Data.List import Data.Maybe @@ -89,7 +90,7 @@ import GHC.TopHandler import Data.IORef ( IORef, readIORef, writeIORef ) -#ifdef USE_READLINE +#ifdef USE_EDITLINE import System.Posix.Internals ( setNonBlockingFD ) #endif @@ -102,7 +103,6 @@ ghciWelcomeMsg = "GHCi, version " ++ cProjectVersion ++ cmdName :: Command -> String cmdName (n,_,_,_) = n -macros_ref :: IORef [Command] GLOBAL_VAR(macros_ref, [], [Command]) builtin_commands :: [Command] @@ -161,7 +161,7 @@ builtin_commands = [ -- -- NOTE: in order for us to override the default correctly, any custom entry -- must be a SUBSET of word_break_chars. -#ifdef USE_READLINE +#ifdef USE_EDITLINE word_break_chars :: String word_break_chars = let symbols = "!#$%&*+/<=>?@\\^|-~" specials = "(),;[]`{}" @@ -229,6 +229,9 @@ helpText = " :force print , forcing unevaluated parts\n" ++ " :forward go forward in the history (after :back)\n" ++ " :history [] after :trace, show the execution history\n" ++ + " :list show the source code around current breakpoint\n" ++ + " :list identifier show the source code for \n" ++ + " :list [] show the source code around line number \n" ++ " :print [ ...] prints a value without forcing its computation\n" ++ " :sprint [ ...] simplifed version of :print\n" ++ " :step single-step after stopping at a breakpoint\n"++ @@ -312,10 +315,15 @@ interactiveUI session srcs maybe_exprs = do -- intended for the program, so unbuffer stdin. hSetBuffering stdin NoBuffering -#ifdef USE_READLINE +#ifdef USE_EDITLINE is_tty <- hIsTerminalDevice stdin when is_tty $ do Readline.initialize + + withGhcAppData + (\dir -> Readline.readHistory (dir "ghci_history")) + (return True) + Readline.setAttemptedCompletionFunction (Just completeWord) --Readline.parseAndBind "set show-all-if-ambiguous 1" @@ -331,6 +339,8 @@ interactiveUI session srcs maybe_exprs = do default_editor <- findEditor + cwd <- getCurrentDirectory + startGHCi (runGHCi srcs maybe_exprs) GHCiState{ progname = "", args = [], @@ -345,47 +355,65 @@ interactiveUI session srcs maybe_exprs = do tickarrays = emptyModuleEnv, last_command = Nothing, cmdqueue = [], - remembered_ctx = [] + remembered_ctx = [], + virtual_path = cwd, + ghc_e = isJust maybe_exprs } -#ifdef USE_READLINE +#ifdef USE_EDITLINE + Readline.stifleHistory 100 + withGhcAppData (\dir -> Readline.writeHistory (dir "ghci_history")) + (return True) Readline.resetTerminal Nothing #endif return () +withGhcAppData :: (FilePath -> IO a) -> IO a -> IO a +withGhcAppData right left = do + either_dir <- IO.try (getAppUserDataDirectory "ghc") + case either_dir of + Right dir -> right dir + _ -> left + + runGHCi :: [(FilePath, Maybe Phase)] -> Maybe [String] -> GHCi () runGHCi paths maybe_exprs = do - let read_dot_files = not opt_IgnoreDotGhci + let + read_dot_files = not opt_IgnoreDotGhci - when (read_dot_files) $ do - -- Read in ./.ghci. - let file = "./.ghci" - exists <- io (doesFileExist file) - when exists $ do - dir_ok <- io (checkPerms ".") - file_ok <- io (checkPerms file) + current_dir = return (Just ".ghci") + + app_user_dir = io $ withGhcAppData + (\dir -> return (Just (dir "ghci.conf"))) + (return Nothing) + + home_dir = do + either_dir <- io $ IO.try (getEnv "HOME") + case either_dir of + Right home -> return (Just (home ".ghci")) + _ -> return Nothing + + sourceConfigFile :: FilePath -> GHCi () + sourceConfigFile file = do + exists <- io $ doesFileExist file + when exists $ do + dir_ok <- io $ checkPerms (getDirectory file) + file_ok <- io $ checkPerms file when (dir_ok && file_ok) $ do - either_hdl <- io (IO.try (openFile "./.ghci" ReadMode)) - case either_hdl of - Left _e -> return () - Right hdl -> runCommands (fileLoop hdl False False) + either_hdl <- io $ IO.try (openFile file ReadMode) + case either_hdl of + Left _e -> return () + Right hdl -> runCommands (fileLoop hdl False False) + where + getDirectory f = case takeDirectory f of "" -> "."; d -> d when (read_dot_files) $ do - -- Read in $HOME/.ghci - either_dir <- io (IO.try getHomeDirectory) - case either_dir of - Left _e -> return () - Right dir -> do - cwd <- io (getCurrentDirectory) - when (dir /= cwd) $ do - let file = dir ++ "/.ghci" - ok <- io (checkPerms file) - when ok $ do - either_hdl <- io (IO.try (openFile file ReadMode)) - case either_hdl of - Left _e -> return () - Right hdl -> runCommands (fileLoop hdl False False) + cfgs0 <- sequence [ current_dir, app_user_dir, home_dir ] + cfgs <- io $ mapM canonicalizePath (catMaybes cfgs0) + mapM_ sourceConfigFile (nub cfgs) + -- nub, because we don't want to read .ghci twice if the + -- CWD is $HOME. -- Perform a :load for files given on the GHCi command line -- When in -e mode, if the load fails then we want to stop @@ -426,12 +454,8 @@ runGHCi paths maybe_exprs = do -- current progname in the exception text: -- : io $ withProgName (progname st) - -- The "fast exit" part just calls exit() - -- directly instead of doing an orderly - -- runtime shutdown, otherwise the main - -- GHCi thread will complain about being - -- interrupted. - $ topHandlerFastExit e + -- this used to be topHandlerFastExit, see #2228 + $ topHandler e runCommands' handle (return Nothing) -- and finally, exit @@ -452,7 +476,7 @@ interactiveLoop is_tty show_prompt = -- exception handler above. -- read commands from stdin -#ifdef USE_READLINE +#ifdef USE_EDITLINE if (is_tty) then runCommands readlineLoop else runCommands (fileLoop stdin show_prompt is_tty) @@ -580,7 +604,7 @@ mkPrompt = do return (showSDoc (f (prompt st))) -#ifdef USE_READLINE +#ifdef USE_EDITLINE readlineLoop :: GHCi (Maybe String) readlineLoop = do io yield @@ -592,6 +616,7 @@ readlineLoop = do splatSavedSession case l of Nothing -> return Nothing + Just "" -> return (Just "") -- Don't put empty lines in the history Just l -> do io (addHistory l) str <- io $ consoleInputToUnicode True l @@ -664,13 +689,9 @@ runStmt stmt step | null (filter (not.isSpace) stmt) = return False | ["import", mod] <- words stmt = keepGoing setContext ('+':mod) | otherwise - = do st <- getGHCiState - session <- getSession - result <- io $ withProgName (progname st) $ withArgs (args st) $ - GHC.runStmt session stmt step + = do result <- GhciMonad.runStmt stmt step afterRunStmt (const True) result - --afterRunStmt :: GHC.RunResult -> GHCi Bool -- False <=> the statement failed to compile afterRunStmt :: (SrcSpan -> Bool) -> GHC.RunResult -> GHCi Bool @@ -685,7 +706,7 @@ afterRunStmt step_here run_result = do GHC.RunBreak _ names mb_info | isNothing mb_info || step_here (GHC.resumeSpan $ head resumes) -> do - printForUser $ ptext SLIT("Stopped at") <+> + printForUser $ ptext (sLit "Stopped at") <+> ppr (GHC.resumeSpan $ head resumes) -- printTypeOfNames session names let namesSorted = sortBy compareNames names @@ -698,14 +719,14 @@ afterRunStmt step_here run_result = do st <- getGHCiState enqueueCommands [stop st] return () - | otherwise -> io(GHC.resume session GHC.SingleStep) >>= + | otherwise -> resume GHC.SingleStep >>= afterRunStmt step_here >> return () _ -> return () flushInterpBuffers io installSignalHandlers b <- isOptionSet RevertCAFs - io (when b revertCAFs) + when b revertCAFs return (case run_result of GHC.RunOk _ -> True; _ -> False) @@ -875,7 +896,7 @@ doWithArgs args cmd = enqueueCommands ["System.Environment.withArgs " ++ addModule :: [FilePath] -> GHCi () addModule files = do - io (revertCAFs) -- always revert CAFs on load/add. + revertCAFs -- always revert CAFs on load/add. files <- mapM expandPath files targets <- mapM (\m -> io (GHC.guessTarget m Nothing)) files session <- getSession @@ -1074,7 +1095,7 @@ doLoad session retain_context prev_context howmuch = do afterLoad :: SuccessFlag -> Session -> Bool -> ([Module],[Module]) -> GHCi () afterLoad ok session retain_context prev_context = do - io (revertCAFs) -- always revert CAFs on load. + revertCAFs -- always revert CAFs on load. discardTickArrays loaded_mod_summaries <- getLoadedModules session let loaded_mods = map GHC.ms_mod loaded_mod_summaries @@ -1602,8 +1623,8 @@ showContext = do printForUser $ vcat (map pp_resume (reverse resumes)) where pp_resume resume = - ptext SLIT("--> ") <> text (GHC.resumeStmt resume) - $$ nest 2 (ptext SLIT("Stopped at") <+> ppr (GHC.resumeSpan resume)) + ptext (sLit "--> ") <> text (GHC.resumeStmt resume) + $$ nest 2 (ptext (sLit "Stopped at") <+> ppr (GHC.resumeSpan resume)) showPackages :: GHCi () showPackages = do @@ -1637,7 +1658,7 @@ completeMacro, completeIdentifier, completeModule, completeHomeModuleOrFile :: String -> IO [String] -#ifdef USE_READLINE +#ifdef USE_EDITLINE completeWord :: String -> Int -> Int -> IO (Maybe (String, [String])) completeWord w start end = do line <- Readline.getLineBuffer @@ -1925,8 +1946,7 @@ continueCmd = noArgs $ doContinue (const True) GHC.RunToCompletion -- doContinue :: SingleStep -> GHCi () doContinue :: (SrcSpan -> Bool) -> SingleStep -> GHCi () doContinue pred step = do - session <- getSession - runResult <- io $ GHC.resume session step + runResult <- resume step afterRunStmt pred runResult return () @@ -1990,7 +2010,7 @@ backCmd :: String -> GHCi () backCmd = noArgs $ do s <- getSession (names, _, span) <- io $ GHC.back s - printForUser $ ptext SLIT("Logged breakpoint at") <+> ppr span + printForUser $ ptext (sLit "Logged breakpoint at") <+> ppr span printTypeOfNames s names -- run the command set with ":set stop " st <- getGHCiState @@ -2001,8 +2021,8 @@ forwardCmd = noArgs $ do s <- getSession (names, ix, span) <- io $ GHC.forward s printForUser $ (if (ix == 0) - then ptext SLIT("Stopped at") - else ptext SLIT("Logged breakpoint at")) <+> ppr span + then ptext (sLit "Stopped at") + else ptext (sLit "Logged breakpoint at")) <+> ppr span printTypeOfNames s names -- run the command set with ":set stop " st <- getGHCiState @@ -2018,7 +2038,7 @@ breakSwitch :: Session -> [String] -> GHCi () breakSwitch _session [] = do io $ putStrLn "The break command requires at least one argument." breakSwitch session (arg1:rest) - | looksLikeModuleName arg1 = do + | looksLikeModuleName arg1 && not (null rest) = do mod <- wantInterpretedModule arg1 breakByModule mod rest | all isDigit arg1 = do