X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2FInteractiveUI.hs;h=82c9aab84c94f400aa208dcbabf7261311c12801;hb=1c83695b5b9ae3175c18908c1d58aeadb1f225ae;hp=4aa441eb3695147e699f0e9a13fe7e7a2a509dfd;hpb=46aed8a4a084add708bbd119d19905105d5f0d72;p=ghc-hetmet.git diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index 4aa441e..82c9aab 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -2,6 +2,7 @@ -- -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 @@ -38,6 +39,7 @@ import Outputable hiding (printForUser, printForUserPartWay) import Module -- for ModuleEnv import Name import SrcLoc +import ObjLink -- Other random utilities import CmdLineParser @@ -53,6 +55,11 @@ import Maybes ( orElse, expectJust ) import FastString import Encoding +#if __GLASGOW_HASKELL__ < 611 +import Foreign.C +import Encoding +#endif + #ifndef mingw32_HOST_OS import System.Posix hiding (getEnv) #else @@ -86,7 +93,13 @@ import Control.Monad as Monad import Text.Printf import Foreign import GHC.Exts ( unsafeCoerce# ) + +#if __GLASGOW_HASKELL__ >= 611 +import GHC.IO.Exception ( IOErrorType(InvalidArgument) ) +#else import GHC.IOBase ( IOErrorType(InvalidArgument) ) +#endif + import GHC.TopHandler import Data.IORef ( IORef, readIORef, writeIORef ) @@ -285,6 +298,13 @@ findEditor = do 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) $ + ghcError (InstallationError "GHCi cannot be used when compiled with -prof") + -- HACK! If we happen to get into an infinite loop (eg the user -- types 'let x=x in x' at the prompt), then the thread will block -- on a blackhole, and become unreachable during GC. The GC will @@ -411,7 +431,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 @@ -439,13 +459,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 @@ -481,7 +502,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 @@ -491,7 +512,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