X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=48033ae709fad0902acacbe745962e999bdb55bf;hb=fc9bbbab3fe56cf0ff5723abbdb0f496d257f34e;hp=8ff83f92b4d884e3059234b42c446b0a7c32cdf9;hpb=fe16e5d64edfa6f7200ab3ebf6c8d14571574302;p=ghc-hetmet.git diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs index 8ff83f9..48033ae 100644 --- a/compiler/ghci/InteractiveUI.hs +++ b/compiler/ghci/InteractiveUI.hs @@ -1,3 +1,6 @@ +{-# OPTIONS -fno-cse #-} +-- -fno-cse is needed for GLOBAL_VAR's to behave properly + {-# OPTIONS -#include "Linker.h" #-} ----------------------------------------------------------------------------- -- @@ -11,12 +14,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 +28,7 @@ import PprTyThing import DynFlags import Packages -#ifdef USE_READLINE +#ifdef USE_EDITLINE import PackageConfig import UniqFM #endif @@ -37,6 +41,8 @@ import Name import SrcLoc -- Other random utilities +import ErrUtils +import CmdLineParser import Digraph import BasicTypes hiding (isTopLevel) import Panic hiding (showException) @@ -56,14 +62,14 @@ import GHC.ConsoleHandler ( flushConsole ) import qualified System.Win32 #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 -import Control.Exception as Exception +import Exception -- import Control.Concurrent import System.FilePath @@ -89,7 +95,7 @@ import GHC.TopHandler import Data.IORef ( IORef, readIORef, writeIORef ) -#ifdef USE_READLINE +#ifdef USE_EDITLINE import System.Posix.Internals ( setNonBlockingFD ) #endif @@ -102,7 +108,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 +166,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 +234,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 +320,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 + when is_tty $ withReadline $ do Readline.initialize + + withGhcAppData + (\dir -> Readline.readHistory (dir "ghci_history")) + (return True) + Readline.setAttemptedCompletionFunction (Just completeWord) --Readline.parseAndBind "set show-all-if-ambiguous 1" @@ -325,12 +338,13 @@ interactiveUI session srcs maybe_exprs = do #endif -- initial context is just the Prelude - prel_mod <- GHC.findModule session (GHC.mkModuleName "Prelude") - (Just basePackageId) + prel_mod <- GHC.findModule session (GHC.mkModuleName "Prelude") Nothing GHC.setContext session [] [prel_mod] default_editor <- findEditor + cwd <- getCurrentDirectory + startGHCi (runGHCi srcs maybe_exprs) GHCiState{ progname = "", args = [], @@ -345,15 +359,28 @@ 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 @@ -361,11 +388,9 @@ runGHCi paths maybe_exprs = do current_dir = return (Just ".ghci") - app_user_dir = do - either_dir <- io $ IO.try (getAppUserDataDirectory "ghc") - case either_dir of - Right dir -> return (Just (dir "ghci.conf")) - _ -> return Nothing + app_user_dir = io $ withGhcAppData + (\dir -> return (Just (dir "ghci.conf"))) + (return Nothing) home_dir = do either_dir <- io $ IO.try (getEnv "HOME") @@ -433,12 +458,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 @@ -447,7 +468,7 @@ runGHCi paths maybe_exprs = do interactiveLoop :: Bool -> Bool -> GHCi () interactiveLoop is_tty show_prompt = -- Ignore ^C exceptions caught here - ghciHandleDyn (\e -> case e of + ghciHandleGhcException (\e -> case e of Interrupted -> do #if defined(mingw32_HOST_OS) io (putStrLn "") @@ -459,7 +480,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) @@ -483,7 +504,7 @@ checkPerms _ = return True #else checkPerms name = - Util.handle (\_ -> return False) $ do + handleIO (\_ -> return False) $ do st <- getFileStatus name me <- getRealUserID if fileOwner st /= me then do @@ -587,15 +608,13 @@ mkPrompt = do return (showSDoc (f (prompt st))) -#ifdef USE_READLINE +#ifdef USE_EDITLINE readlineLoop :: GHCi (Maybe String) readlineLoop = do io yield saveSession -- for use by completion prompt <- mkPrompt - l <- io (readline prompt `finally` setNonBlockingFD 0) - -- readline sometimes puts stdin into blocking mode, - -- so we need to put it back for the IO library + l <- io $ withReadline (readline prompt) splatSavedSession case l of Nothing -> return Nothing @@ -604,6 +623,20 @@ readlineLoop = do io (addHistory l) str <- io $ consoleInputToUnicode True l 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 + -- 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. + +-- These come from the RTS +foreign import ccall unsafe startTimer :: IO () +foreign import ccall unsafe stopTimer :: IO () #endif queryQueue :: GHCi (Maybe String) @@ -617,7 +650,7 @@ queryQueue = do runCommands :: GHCi (Maybe String) -> GHCi () runCommands = runCommands' handler -runCommands' :: (Exception -> GHCi Bool) -- Exception handler +runCommands' :: (SomeException -> GHCi Bool) -- Exception handler -> GHCi (Maybe String) -> GHCi () runCommands' eh getCmd = do mb_cmd <- noSpace queryQueue @@ -672,13 +705,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 @@ -693,7 +722,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 @@ -706,14 +735,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) @@ -828,7 +857,7 @@ help :: String -> GHCi () help _ = io (putStr helpText) info :: String -> GHCi () -info "" = throwDyn (CmdLineError "syntax: ':i '") +info "" = ghcError (CmdLineError "syntax: ':i '") info s = do { let names = words s ; session <- getSession ; dflags <- getDynFlags @@ -883,7 +912,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 @@ -918,7 +947,7 @@ editFile str = st <- getGHCiState let cmd = editor st when (null cmd) - $ throwDyn (CmdLineError "editor not set, use :set editor") + $ ghcError (CmdLineError "editor not set, use :set editor") io $ system (cmd ++ ' ':file) return () @@ -950,7 +979,7 @@ chooseEditFile = do targets <- io (GHC.getTargets session) case msum (map fromTarget targets) of Just file -> return file - Nothing -> throwDyn (CmdLineError "No files to edit.") + Nothing -> ghcError (CmdLineError "No files to edit.") where fromTarget (GHC.Target (GHC.TargetFile f _) _) = Just f fromTarget _ = Nothing -- when would we get a module target? @@ -967,7 +996,7 @@ defineMacro overwrite s = do unlines defined) else do if (not overwrite && macro_name `elem` defined) - then throwDyn (CmdLineError + then ghcError (CmdLineError ("macro '" ++ macro_name ++ "' is already defined")) else do @@ -996,7 +1025,7 @@ undefineMacro str = mapM_ undef (words str) where undef macro_name = do cmds <- io (readIORef macros_ref) if (macro_name `notElem` map cmdName cmds) - then throwDyn (CmdLineError + then ghcError (CmdLineError ("macro '" ++ macro_name ++ "' is not defined")) else do io (writeIORef macros_ref (filter ((/= macro_name) . cmdName) cmds)) @@ -1025,6 +1054,7 @@ loadModule' files = do prev_context <- io $ GHC.getContext session -- unload first + io $ GHC.abandonAll session discardActiveBreakPoints io (GHC.setTargets session []) io (GHC.load session LoadAllTargets) @@ -1082,7 +1112,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 @@ -1210,8 +1240,8 @@ browseCmd bang m = case (as,bs) of (as@(_:_), _) -> browseModule bang (last as) True ([], bs@(_:_)) -> browseModule bang (last bs) True - ([], []) -> throwDyn (CmdLineError ":browse: no current module") - _ -> throwDyn (CmdLineError "syntax: :browse ") + ([], []) -> ghcError (CmdLineError ":browse: no current module") + _ -> ghcError (CmdLineError "syntax: :browse ") -- without bang, show items in context of their parents and omit children -- with bang, show class methods and data constructors separately, and @@ -1235,7 +1265,7 @@ browseModule bang modl exports_only = do mb_mod_info <- io $ GHC.getModuleInfo s modl case mb_mod_info of - Nothing -> throwDyn (CmdLineError ("unknown module: " ++ + Nothing -> ghcError (CmdLineError ("unknown module: " ++ GHC.moduleNameString (GHC.moduleName modl))) Just mod_info -> do dflags <- getDynFlags @@ -1307,7 +1337,7 @@ setContext str playCtxtCmd True (cmd, as, bs) st <- getGHCiState setGHCiState st{ remembered_ctx = remembered_ctx st ++ [(cmd,as,bs)] } - | otherwise = throwDyn (CmdLineError "syntax: :module [+/-] [*]M1 ... [*]Mn") + | otherwise = ghcError (CmdLineError "syntax: :module [+/-] [*]M1 ... [*]Mn") where (cmd, strs, as, bs) = case str of @@ -1392,13 +1422,13 @@ setCmd "" vcat (text "other dynamic, non-language, flag settings:" :map (flagSetting dflags) nonLanguageDynFlags) )) - where flagSetting dflags (str,f) + where flagSetting dflags (str, f, _) | dopt f dflags = text " " <> text "-f" <> text str | otherwise = text " " <> text "-fno-" <> text str - (ghciFlags,others) = partition (\(_,f)->f `elem` flags) + (ghciFlags,others) = partition (\(_, f, _) -> f `elem` flags) DynFlags.fFlags - nonLanguageDynFlags = filter (\(_,f)->not $ f `elem` map snd xFlags) - others + nonLanguageDynFlags = filterOut (\(_, f, _) -> f `elem` languageOptions) + others flags = [Opt_PrintExplicitForalls ,Opt_PrintBindResult ,Opt_BreakOnException @@ -1474,12 +1504,12 @@ newDynFlags :: [String] -> GHCi () newDynFlags minus_opts = do dflags <- getDynFlags let pkg_flags = packageFlags dflags - (dflags',leftovers) <- io $ GHC.parseDynamicFlags dflags minus_opts + (dflags', leftovers, warns) <- io $ GHC.parseDynamicFlags dflags $ map noLoc minus_opts + io $ handleFlagWarnings dflags' warns if (not (null leftovers)) - then throwDyn (CmdLineError ("unrecognised flags: " ++ - unwords leftovers)) - else return () + then ghcError $ errorsToGhcException leftovers + else return () new_pkgs <- setDynFlags dflags' @@ -1511,7 +1541,7 @@ unsetOptions str mapM_ unsetOpt plus_opts let no_flag ('-':'f':rest) = return ("-fno-" ++ rest) - no_flag f = throwDyn (ProgramError ("don't know how to reverse " ++ f)) + no_flag f = ghcError (ProgramError ("don't know how to reverse " ++ f)) no_flags <- mapM no_flag minus_opts newDynFlags no_flags @@ -1566,7 +1596,7 @@ showCmd str = do ["context"] -> showContext ["packages"] -> showPackages ["languages"] -> showLanguages - _ -> throwDyn (CmdLineError ("syntax: :show [ args | prog | prompt | editor | stop | modules | bindings\n"++ + _ -> ghcError (CmdLineError ("syntax: :show [ args | prog | prompt | editor | stop | modules | bindings\n"++ " | breaks | context | packages | languages ]")) showModules :: GHCi () @@ -1610,8 +1640,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 @@ -1622,7 +1652,8 @@ showPackages = do pkg_ids <- fmap (preloadPackages . pkgState) getDynFlags io $ putStrLn $ showSDoc $ vcat $ text "packages currently loaded:" - : map (nest 2 . text . packageIdString) pkg_ids + : map (nest 2 . text . packageIdString) + (sortBy (compare `on` packageIdFS) pkg_ids) where showFlag (ExposePackage p) = text $ " -package " ++ p showFlag (HidePackage p) = text $ " -hide-package " ++ p showFlag (IgnorePackage p) = text $ " -ignore-package " ++ p @@ -1632,7 +1663,7 @@ showLanguages = do dflags <- getDynFlags io $ putStrLn $ showSDoc $ vcat $ text "active language flags:" : - [text (" -X" ++ str) | (str,f) <- DynFlags.xFlags, dopt f dflags] + [text (" -X" ++ str) | (str, f, _) <- DynFlags.xFlags, dopt f dflags] -- ----------------------------------------------------------------------------- -- Completion @@ -1645,7 +1676,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 @@ -1673,7 +1704,7 @@ completeWord w start end = do (s,r') = span isBreak r in (n,w):words' isBreak (n+length w+length s) r' -- In a Haskell expression we want to parse 'a-b' as three words - -- where a compiler flag (ie. -fno-monomorphism-restriction) should + -- where a compiler flag (e.g. -ddump-simpl) should -- only be a single word. selectWord [] = (0,w) selectWord ((offset,x):xs) @@ -1791,14 +1822,15 @@ completeHomeModuleOrFile=completeNone -- raising another exception. We therefore don't put the recursive -- handler arond the flushing operation, so if stderr is closed -- GHCi will just die gracefully rather than going into an infinite loop. -handler :: Exception -> GHCi Bool +handler :: SomeException -> GHCi Bool handler exception = do flushInterpBuffers io installSignalHandlers ghciHandle handler (showException exception >> return False) -showException :: Exception -> GHCi () +showException :: SomeException -> GHCi () +#if __GLASGOW_HASKELL__ < 609 showException (DynException dyn) = case fromDynamic dyn of Nothing -> io (putStrLn ("*** Exception: (unknown)")) @@ -1809,6 +1841,17 @@ showException (DynException dyn) = showException other_exception = io (putStrLn ("*** Exception: " ++ show other_exception)) +#else +showException (SomeException e) = + io $ case cast e 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 e) +#endif ----------------------------------------------------------------------------- -- recursive exception handlers @@ -1817,7 +1860,7 @@ showException other_exception -- in an exception loop (eg. let a = error a in a) the ^C exception -- may never be delivered. Thanks to Marcin for pointing out the bug. -ghciHandle :: (Exception -> GHCi a) -> GHCi a -> GHCi a +ghciHandle :: (SomeException -> GHCi a) -> GHCi a -> GHCi a ghciHandle h (GHCi m) = GHCi $ \s -> Exception.catch (m s) (\e -> unGHCi (ghciUnblock (h e)) s) @@ -1825,7 +1868,7 @@ ghciHandle h (GHCi m) = GHCi $ \s -> ghciUnblock :: GHCi a -> GHCi a ghciUnblock (GHCi a) = GHCi $ \s -> Exception.unblock (a s) -ghciTry :: GHCi a -> GHCi (Either Exception a) +ghciTry :: GHCi a -> GHCi (Either SomeException a) ghciTry (GHCi m) = GHCi $ \s -> Exception.try (m s) -- ---------------------------------------------------------------------------- @@ -1849,7 +1892,7 @@ wantInterpretedModule str = do modl <- lookupModule str is_interpreted <- io (GHC.moduleIsInterpreted session modl) when (not is_interpreted) $ - throwDyn (CmdLineError ("module '" ++ str ++ "' is not interpreted")) + ghcError (CmdLineError ("module '" ++ str ++ "' is not interpreted")) return modl wantNameFromInterpretedModule :: (Name -> SDoc -> GHCi ()) -> String @@ -1908,7 +1951,7 @@ stepModuleCmd [] = do Nothing -> stepCmd [] Just _ -> do Just span <- getCurrentBreakSpan - let f some_span = optSrcSpanFileName span == optSrcSpanFileName some_span + let f some_span = srcSpanFileName_maybe span == srcSpanFileName_maybe some_span doContinue f GHC.SingleStep stepModuleCmd expression = stepCmd expression @@ -1933,8 +1976,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 () @@ -1998,7 +2040,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 @@ -2009,8 +2051,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 @@ -2026,7 +2068,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 @@ -2064,7 +2106,7 @@ breakByModuleLine mod line args | otherwise = breakSyntax breakSyntax :: a -breakSyntax = throwDyn (CmdLineError "Syntax: :break [] []") +breakSyntax = ghcError (CmdLineError "Syntax: :break [] []") findBreakAndSet :: Module -> (TickArray -> Maybe (Int, SrcSpan)) -> GHCi () findBreakAndSet mod lookupTickTree = do @@ -2144,7 +2186,7 @@ findBreakByCoord mb_file (line, col) arr do_bold :: Bool do_bold = (`isPrefixOf` unsafePerformIO mTerm) `any` ["xterm", "linux"] where mTerm = System.Environment.getEnv "TERM" - `Exception.catch` \_ -> return "TERM not set" + `catchIO` \_ -> return "TERM not set" start_bold :: String start_bold = "\ESC[1m" @@ -2219,7 +2261,7 @@ listModuleLine modl line = do -- | list a section of a source file around a particular SrcSpan. -- If the highlight flag is True, also highlight the span using --- start_bold/end_bold. +-- start_bold\/end_bold. listAround :: SrcSpan -> Bool -> IO () listAround span do_highlight = do contents <- BS.readFile (unpackFS file)