X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2FInteractiveUI.hs;h=367539863cfae08f96b00a9258536a0088fff2d1;hb=cab2a4c125b422d675aa5ba086e3f94e97e9f81b;hp=d6202907d1515428b4f35ad8f02d0243fad1d5c8;hpb=e16df2647fde526846e4c13470250ee5b475bdd2;p=ghc-hetmet.git

diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index d620290..3675398 100644
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -23,14 +23,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 )
@@ -39,7 +39,6 @@ import Outputable       hiding (printForUser, printForUserPartWay)
 import Module           -- for ModuleEnv
 import Name
 import SrcLoc
-import ObjLink
 
 -- Other random utilities
 import CmdLineParser
@@ -54,6 +53,7 @@ import NameSet
 import Maybes		( orElse, expectJust )
 import FastString
 import Encoding
+import Foreign.C
 
 #ifndef mingw32_HOST_OS
 import System.Posix hiding (getEnv)
@@ -68,7 +68,6 @@ import Control.Monad.Trans
 --import SystemExts
 
 import Exception hiding (catch, block, unblock)
-import qualified Exception
 
 -- import Control.Concurrent
 
@@ -88,7 +87,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 )
@@ -284,14 +290,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
@@ -302,9 +310,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
@@ -320,6 +328,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
@@ -501,7 +515,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 (BS.pack l))
+        Right l -> return (Just l)
 
 mkPrompt :: GHCi String
 mkPrompt = do
@@ -611,7 +625,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 ()
@@ -625,7 +639,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
@@ -857,7 +880,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
@@ -876,7 +899,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.
@@ -971,17 +994,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
@@ -1018,7 +1041,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 ()
@@ -1436,7 +1459,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 []
@@ -1780,7 +1803,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 
@@ -1818,7 +1841,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
@@ -1827,7 +1850,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 ()
@@ -2213,7 +2236,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 ()
@@ -2225,7 +2248,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