unused import

[ghc-hetmet.git] / compiler / ghci / InteractiveUI.hs

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index 9e9c262..55384bc 100644 (file)
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -26,7 +26,7 @@ import TcType           ( tidyTopType )
 import qualified Id     ( setIdType )
 import IdInfo           ( GlobalIdDetails(..) )
 import Linker           ( HValue, extendLinkEnv, withExtendedLinkEnv,initDynLinker  )
-import PrelNames        ( breakpointJumpName )
+import PrelNames        ( breakpointJumpName, breakpointCondJumpName )
 #endif
 
 -- The GHC interface
@@ -67,6 +67,7 @@ import System.Posix
 #endif
 #else
 import GHC.ConsoleHandler ( flushConsole )
+import System.Win32      ( setConsoleCP, setConsoleOutputCP )
 #endif
 
 #ifdef USE_READLINE
@@ -209,6 +210,11 @@ printScopeMsg session location ids
         nest 2 (pprWithCommas showId ids)
     where showId id = ppr (idName id) <+> dcolon <+> ppr (idType id)
 
+jumpCondFunction :: Session -> Int -> [HValue] -> String -> Bool -> b -> b
+jumpCondFunction session ptr hValues location True b = b
+jumpCondFunction session ptr hValues location False b
+    = jumpFunction session ptr hValues location b
+
 jumpFunction :: Session -> Int -> [HValue] -> String -> b -> b
 jumpFunction session@(Session ref) (I# idsPtr) hValues location b
     = unsafePerformIO $
@@ -235,8 +241,9 @@ jumpFunction session@(Session ref) (I# idsPtr) hValues location b
              new_ic = ictxt { ic_rn_local_env = new_rn_env, 
                              ic_type_env     = new_type_env }
          writeIORef ref (hsc_env { hsc_IC = new_ic })
+         is_tty <- hIsTerminalDevice stdin
          withExtendedLinkEnv (zip names hValues) $
-           startGHCi (runGHCi [] Nothing)
+           startGHCi (interactiveLoop is_tty True)
                      GHCiState{ progname = "<interactive>",
                                 args = [],
                                 prompt = location++"> ",
@@ -251,7 +258,8 @@ interactiveUI :: Session -> [(FilePath, Maybe Phase)] -> Maybe String -> IO ()
 interactiveUI session srcs maybe_expr = do
 #if defined(GHCI) && defined(BREAKPOINT)
    initDynLinker =<< GHC.getSessionDynFlags session
-   extendLinkEnv [(breakpointJumpName,unsafeCoerce# (jumpFunction session))]
+   extendLinkEnv [(breakpointJumpName,unsafeCoerce# (jumpFunction session))
+                 ,(breakpointCondJumpName,unsafeCoerce# (jumpCondFunction session))]
 #endif
    -- 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
@@ -355,8 +363,8 @@ runGHCi paths maybe_expr = do
 
   case maybe_expr of
        Nothing -> 
-#if defined(mingw32_HOST_OS)
           do
+#if defined(mingw32_HOST_OS)
             -- The win32 Console API mutates the first character of 
             -- type-ahead when reading from it in a non-buffered manner. Work
             -- around this by flushing the input buffer of type-ahead characters,
@@ -367,6 +375,9 @@ runGHCi paths maybe_expr = do
                      | otherwise -> io (ioError err)
             Right () -> return ()
 #endif
+           -- initialise the console if necessary
+           io setUpConsole
+
            -- enter the interactive loop
            interactiveLoop is_tty show_prompt
        Just expr -> do
@@ -454,13 +465,13 @@ fileLoop hdl show_prompt = do
            l  -> do quit <- runCommand l
                      if quit then return () else fileLoop hdl show_prompt
 
-stringLoop :: [String] -> GHCi ()
-stringLoop [] = return ()
+stringLoop :: [String] -> GHCi Bool{-True: we quit-}
+stringLoop [] = return False
 stringLoop (s:ss) = do
    case removeSpaces s of
        "" -> stringLoop ss
        l  -> do quit <- runCommand l
-                 if quit then return () else stringLoop ss
+                 if quit then return True else stringLoop ss
 
 mkPrompt toplevs exports prompt
   = showSDoc $ f prompt
@@ -512,7 +523,7 @@ runCommand c = ghciHandle handler (doCommand c)
 runCommandEval c = ghciHandle handleEval (doCommand c)
   where 
     handleEval (ExitException code) = io (exitWith code)
-    handleEval e                    = do showException e
+    handleEval e                    = do handler e
                                         io (exitWith (ExitFailure 1))
 
     doCommand (':' : command) = specialCommand command
@@ -743,9 +754,9 @@ defineMacro s = do
   case maybe_hv of
      Nothing -> return ()
      Just hv -> io (writeIORef commands --
-                   (cmds ++ [(macro_name, keepGoing (runMacro hv), False, completeNone)]))
+                   (cmds ++ [(macro_name, runMacro hv, False, completeNone)]))
 
-runMacro :: GHC.HValue{-String -> IO String-} -> String -> GHCi ()
+runMacro :: GHC.HValue{-String -> IO String-} -> String -> GHCi Bool
 runMacro fun s = do
   str <- io ((unsafeCoerce# fun :: String -> IO String) s)
   stringLoop (lines str)
@@ -831,7 +842,8 @@ afterLoad ok session = do
   setContextAfterLoad session graph'
   modulesLoadedMsg ok (map GHC.ms_mod graph')
 #if defined(GHCI) && defined(BREAKPOINT)
-  io (extendLinkEnv [(breakpointJumpName,unsafeCoerce# (jumpFunction session))])
+  io (extendLinkEnv [(breakpointJumpName,unsafeCoerce# (jumpFunction session))
+                    ,(breakpointCondJumpName,unsafeCoerce# (jumpCondFunction session))])
 #endif
 
 setContextAfterLoad session [] = do
@@ -1521,7 +1533,7 @@ revertCAFs = do
 foreign import ccall "revertCAFs" rts_revertCAFs  :: IO ()  
        -- Make it "safe", just in case
 
--- -----------------------------------------------------------------------------
+-- ----------------------------------------------------------------------------
 -- Utils
 
 expandPath :: String -> GHCi String
@@ -1532,3 +1544,27 @@ expandPath path =
        return (tilde ++ '/':d)
    other -> 
        return other
+
+-- ----------------------------------------------------------------------------
+-- Windows console setup
+
+setUpConsole :: IO ()
+setUpConsole = do
+#ifdef mingw32_HOST_OS
+       -- On Windows we need to set a known code page, otherwise the characters
+       -- we read from the console will be be in some strange encoding, and
+       -- similarly for characters we write to the console.
+       --
+       -- At the moment, GHCi pretends all input is Latin-1.  In the
+       -- future we should support UTF-8, but for now we set the code pages
+       -- to Latin-1.
+       --
+       -- It seems you have to set the font in the console window to
+       -- a Unicode font in order for output to work properly,
+       -- otherwise non-ASCII characters are mapped wrongly.  sigh.
+       -- (see MSDN for SetConsoleOutputCP()).
+       --
+       setConsoleCP 28591       -- ISO Latin-1
+       setConsoleOutputCP 28591 -- ISO Latin-1
+#endif
+       return ()