X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2FInteractiveUI.hs;h=6722722bebfbc923775e9619992f2f2d6d0f5492;hb=b8a331a4a5567251c9616d8f9ad609901bfef170;hp=323dc259c71339092b4ba7fdcf3757a4ffd25219;hpb=342b18fc5abca755d55a07449ea7183222782865;p=ghc-hetmet.git diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index 323dc25..6722722 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -1,7 +1,7 @@ {-# OPTIONS -fno-cse #-} -- -fno-cse is needed for GLOBAL_VAR's to behave properly -{-# OPTIONS -#include "Linker.h" #-} +{-# OPTIONS_GHC -fno-warn-name-shadowing #-} ----------------------------------------------------------------------------- -- -- GHC Interactive User Interface @@ -22,14 +22,14 @@ import Debugger -- The GHC interface import qualified GHC hiding (resume, runStmt) import GHC ( LoadHowMuch(..), Target(..), TargetId(..), - Module, ModuleName, TyThing(..), Phase, - BreakIndex, SrcSpan, Resume, SingleStep, + TyThing(..), Phase, + BreakIndex, Resume, SingleStep, Ghc, handleSourceError ) import PprTyThing import DynFlags import Packages -import PackageConfig +-- import PackageConfig import UniqFM import HscTypes ( implicitTyThings, handleFlagWarnings ) @@ -38,7 +38,6 @@ import Outputable hiding (printForUser, printForUserPartWay) import Module -- for ModuleEnv import Name import SrcLoc -import ObjLink -- Other random utilities import CmdLineParser @@ -53,6 +52,7 @@ import NameSet import Maybes ( orElse, expectJust ) import FastString import Encoding +import Foreign.C #ifndef mingw32_HOST_OS import System.Posix hiding (getEnv) @@ -67,7 +67,6 @@ import Control.Monad.Trans --import SystemExts import Exception hiding (catch, block, unblock) -import qualified Exception -- import Control.Concurrent @@ -87,7 +86,14 @@ import Control.Monad as Monad import Text.Printf import Foreign import GHC.Exts ( unsafeCoerce# ) + +#if __GLASGOW_HASKELL__ >= 611 +import GHC.IO.Exception ( IOErrorType(InvalidArgument) ) +import GHC.IO.Handle ( hFlushAll ) +#else import GHC.IOBase ( IOErrorType(InvalidArgument) ) +#endif + import GHC.TopHandler import Data.IORef ( IORef, readIORef, writeIORef ) @@ -121,7 +127,6 @@ builtin_commands = [ ("def", keepGoing (defineMacro False), completeExpression), ("def!", keepGoing (defineMacro True), completeExpression), ("delete", keepGoing deleteCmd, noCompletion), - ("e", keepGoing editFile, completeFilename), ("edit", keepGoing editFile, completeFilename), ("etags", keepGoing createETagsFileCmd, completeFilename), ("force", keepGoing forceCmd, completeExpression), @@ -283,14 +288,16 @@ findEditor = do return "" #endif +foreign import ccall unsafe "rts_isProfiled" isProfiled :: IO CInt + interactiveUI :: [(FilePath, Maybe Phase)] -> Maybe [String] -> Ghc () interactiveUI srcs maybe_exprs = do -- although GHCi compiles with -prof, it is not usable: the byte-code -- compiler and interpreter don't work with profiling. So we check for -- this up front and emit a helpful error message (#2197) - m <- liftIO $ lookupSymbol "PushCostCentre" - when (isJust m) $ + i <- liftIO $ isProfiled + when (i /= 0) $ ghcError (InstallationError "GHCi cannot be used when compiled with -prof") -- HACK! If we happen to get into an infinite loop (eg the user @@ -301,9 +308,9 @@ interactiveUI srcs maybe_exprs = do -- it refers to might be finalized, including the standard Handles. -- This sounds like a bug, but we don't have a good solution right -- now. - liftIO $ newStablePtr stdin - liftIO $ newStablePtr stdout - liftIO $ newStablePtr stderr + _ <- liftIO $ newStablePtr stdin + _ <- liftIO $ newStablePtr stdout + _ <- liftIO $ newStablePtr stderr -- Initialise buffering for the *interpreted* I/O system initInterpBuffering @@ -319,6 +326,12 @@ interactiveUI srcs maybe_exprs = do -- We don't want the cmd line to buffer any input that might be -- intended for the program, so unbuffer stdin. hSetBuffering stdin NoBuffering +#if defined(mingw32_HOST_OS) && __GLASGOW_HASKELL__ >= 611 + -- On Unix, stdin will use the locale encoding. The IO library + -- doesn't do this on Windows (yet), so for now we use UTF-8, + -- for consistency with GHC 6.10 and to make the tests work. + hSetEncoding stdin utf8 +#endif -- initial context is just the Prelude prel_mod <- GHC.lookupModule (GHC.mkModuleName "Prelude") Nothing @@ -419,7 +432,7 @@ runGHCi paths maybe_exprs = do Nothing -> do -- enter the interactive loop - runGHCiInput $ runCommands $ haskelineLoop show_prompt + runGHCiInput $ runCommands $ nextInputLine show_prompt is_tty Just exprs -> do -- just evaluate the expression we were given enqueueCommands exprs @@ -447,13 +460,14 @@ runGHCiInput f = do setLogAction f --- TODO really bad name -haskelineLoop :: Bool -> InputT GHCi (Maybe String) -haskelineLoop show_prompt = do +nextInputLine :: Bool -> Bool -> InputT GHCi (Maybe String) +nextInputLine show_prompt is_tty + | is_tty = do prompt <- if show_prompt then lift mkPrompt else return "" - l <- getInputLine prompt - return l - + getInputLine prompt + | otherwise = do + when show_prompt $ lift mkPrompt >>= liftIO . putStr + fileLoop stdin -- NOTE: We only read .ghci files if they are owned by the current user, -- and aren't world writable. Otherwise, we could be accidentally @@ -489,7 +503,7 @@ checkPerms name = fileLoop :: MonadIO m => Handle -> InputT m (Maybe String) fileLoop hdl = do - l <- liftIO $ IO.try (BS.hGetLine hdl) + l <- liftIO $ IO.try $ hGetLine hdl case l of Left e | isEOFError e -> return Nothing | InvalidArgument <- etype -> return Nothing @@ -499,7 +513,7 @@ fileLoop hdl = do -- this can happen if the user closed stdin, or -- perhaps did getContents which closes stdin at -- EOF. - Right l -> fmap Just (Encoding.decode l) + Right l -> return (Just l) mkPrompt :: GHCi String mkPrompt = do @@ -609,7 +623,7 @@ runOneCommand eh getCmd = do -- QUESTION: is userError the one to use here? collectError = userError "unterminated multiline command :{ .. :}" doCommand (':' : cmd) = specialCommand cmd - doCommand stmt = do timeIt $ lift $ runStmt stmt GHC.RunToCompletion + doCommand stmt = do _ <- timeIt $ lift $ runStmt stmt GHC.RunToCompletion return False enqueueCommands :: [String] -> GHCi () @@ -623,7 +637,16 @@ runStmt stmt step | null (filter (not.isSpace) stmt) = return False | ["import", mod] <- words stmt = keepGoing' setContext ('+':mod) | otherwise - = do result <- GhciMonad.runStmt stmt step + = do +#if __GLASGOW_HASKELL__ >= 611 + -- In the new IO library, read handles buffer data even if the Handle + -- is set to NoBuffering. This causes problems for GHCi where there + -- are really two stdin Handles. So we flush any bufferred data in + -- GHCi's stdin Handle here (only relevant if stdin is attached to + -- a file, otherwise the read buffer can't be flushed). + _ <- liftIO $ IO.try $ hFlushAll stdin +#endif + result <- GhciMonad.runStmt stmt step afterRunStmt (const True) result --afterRunStmt :: GHC.RunResult -> GHCi Bool @@ -729,9 +752,12 @@ lookupCommand str = do Nothing -> BadCommand lookupCommand' :: String -> IO (Maybe Command) -lookupCommand' str = do +lookupCommand' ":" = return Nothing +lookupCommand' str' = do macros <- readIORef macros_ref - let cmds = builtin_commands ++ macros + let{ (str, cmds) = case str' of + ':' : rest -> (rest, builtin_commands) + _ -> (str', macros ++ builtin_commands) } -- look for exact match first, then the first prefix match return $ case [ c | c <- cmds, str == cmdName c ] of c:_ -> Just c @@ -855,7 +881,7 @@ changeDirectory dir = do outputStr "Warning: changing directory causes all loaded modules to be unloaded,\nbecause the search path has changed.\n" prev_context <- GHC.getContext GHC.setTargets [] - GHC.load LoadAllTargets + _ <- GHC.load LoadAllTargets lift $ setContextAfterLoad prev_context False [] GHC.workingDirectoryChanged dir <- expandPath dir @@ -874,7 +900,7 @@ editFile str = let cmd = editor st when (null cmd) $ ghcError (CmdLineError "editor not set, use :set editor") - io $ system (cmd ++ ' ':file) + _ <- io $ system (cmd ++ ' ':file) return () -- The user didn't specify a file so we pick one for them. @@ -910,6 +936,8 @@ chooseEditFile = fromTarget _ = Nothing -- when would we get a module target? defineMacro :: Bool{-overwrite-} -> String -> GHCi () +defineMacro _ (':':_) = + io $ putStrLn "macro name cannot start with a colon" defineMacro overwrite s = do let (macro_name, definition) = break isSpace s macros <- io (readIORef macros_ref) @@ -969,17 +997,17 @@ loadModule :: [(FilePath, Maybe Phase)] -> InputT GHCi SuccessFlag loadModule fs = timeIt (loadModule' fs) loadModule_ :: [FilePath] -> InputT GHCi () -loadModule_ fs = do loadModule (zip fs (repeat Nothing)); return () +loadModule_ fs = loadModule (zip fs (repeat Nothing)) >> return () loadModule' :: [(FilePath, Maybe Phase)] -> InputT GHCi SuccessFlag loadModule' files = do prev_context <- GHC.getContext -- unload first - GHC.abandonAll + _ <- GHC.abandonAll lift discardActiveBreakPoints GHC.setTargets [] - GHC.load LoadAllTargets + _ <- GHC.load LoadAllTargets let (filenames, phases) = unzip files exp_filenames <- mapM expandPath filenames @@ -1016,7 +1044,7 @@ checkModule m = do reloadModule :: String -> InputT GHCi () reloadModule m = do prev_context <- GHC.getContext - doLoad True prev_context $ + _ <- doLoad True prev_context $ if null m then LoadAllTargets else LoadUpTo (GHC.mkModuleName m) return () @@ -1434,7 +1462,7 @@ newDynFlags minus_opts = do when (packageFlags dflags /= pkg_flags) $ do io $ hPutStrLn stderr "package flags have changed, resetting and loading new packages..." GHC.setTargets [] - GHC.load LoadAllTargets + _ <- GHC.load LoadAllTargets io (linkPackages dflags new_pkgs) -- package flags changed, we can't re-use any of the old context setContextAfterLoad ([],[]) False [] @@ -1568,6 +1596,7 @@ showPackages = do where showFlag (ExposePackage p) = text $ " -package " ++ p showFlag (HidePackage p) = text $ " -hide-package " ++ p showFlag (IgnorePackage p) = text $ " -ignore-package " ++ p + showFlag (ExposePackageId p) = text $ " -package-id " ++ p showLanguages :: GHCi () showLanguages = do @@ -1602,9 +1631,13 @@ ghciCompleteWord line@(left,_) = case firstWord of Nothing -> return completeFilename completeCmd = wrapCompleter " " $ \w -> do - cmds <- liftIO $ readIORef macros_ref - return (filter (w `isPrefixOf`) (map (':':) - (map cmdName (builtin_commands ++ cmds)))) + macros <- liftIO $ readIORef macros_ref + let macro_names = map (':':) . map cmdName $ macros + let command_names = map (':':) . map cmdName $ builtin_commands + let{ candidates = case w of + ':' : ':' : _ -> map (':':) command_names + _ -> nub $ macro_names ++ command_names } + return $ filter (w `isPrefixOf`) candidates completeMacro = wrapIdentCompleter $ \w -> do cmds <- liftIO $ readIORef macros_ref @@ -1778,7 +1811,7 @@ pprintCommand bind force str = do stepCmd :: String -> GHCi () stepCmd [] = doContinue (const True) GHC.SingleStep -stepCmd expression = do runStmt expression GHC.SingleStep; return () +stepCmd expression = runStmt expression GHC.SingleStep >> return () stepLocalCmd :: String -> GHCi () stepLocalCmd [] = do @@ -1816,7 +1849,7 @@ enclosingTickSpan mod src = do traceCmd :: String -> GHCi () traceCmd [] = doContinue (const True) GHC.RunAndLogSteps -traceCmd expression = do runStmt expression GHC.RunAndLogSteps; return () +traceCmd expression = runStmt expression GHC.RunAndLogSteps >> return () continueCmd :: String -> GHCi () continueCmd = noArgs $ doContinue (const True) GHC.RunToCompletion @@ -1825,7 +1858,7 @@ continueCmd = noArgs $ doContinue (const True) GHC.RunToCompletion doContinue :: (SrcSpan -> Bool) -> SingleStep -> GHCi () doContinue pred step = do runResult <- resume pred step - afterRunStmt pred runResult + _ <- afterRunStmt pred runResult return () abandonCmd :: String -> GHCi () @@ -2211,7 +2244,7 @@ lookupModule modName discardActiveBreakPoints :: GHCi () discardActiveBreakPoints = do st <- getGHCiState - mapM (turnOffBreak.snd) (breaks st) + mapM_ (turnOffBreak.snd) (breaks st) setGHCiState $ st { breaks = [] } deleteBreak :: Int -> GHCi () @@ -2223,7 +2256,7 @@ deleteBreak identity = do then printForUser (text "Breakpoint" <+> ppr identity <+> text "does not exist") else do - mapM (turnOffBreak.snd) this + mapM_ (turnOffBreak.snd) this setGHCiState $ st { breaks = rest } turnOffBreak :: BreakLocation -> GHCi Bool