X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=65e210cde81f5c643bbbe8a067da70cb95647d4b;hb=07e3238de5aff7456a5e8e4b5ba39040dae6806a;hp=dd75a09e320f3166604a82639c580d8e04df12e6;hpb=96b4db39ccb5c3d37c555c49e1dbe9baf0421298;p=ghc-hetmet.git diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs index dd75a09..65e210c 100644 --- a/compiler/ghci/InteractiveUI.hs +++ b/compiler/ghci/InteractiveUI.hs @@ -19,7 +19,7 @@ import Debugger import qualified GHC import GHC ( Session, LoadHowMuch(..), Target(..), TargetId(..), Module, ModuleName, TyThing(..), Phase, - BreakIndex, SrcSpan, Resume, SingleStep, Id ) + BreakIndex, SrcSpan, Resume, SingleStep ) import PprTyThing import DynFlags @@ -31,7 +31,7 @@ import UniqFM import HscTypes ( implicitTyThings ) import qualified RdrName ( getGRE_NameQualifier_maybes ) -- should this come via GHC? -import Outputable hiding (printForUser) +import Outputable hiding (printForUser, printForUserPartWay) import Module -- for ModuleEnv import Name import SrcLoc @@ -47,12 +47,12 @@ import Util import NameSet import Maybes ( orElse ) import FastString +import Encoding #ifndef mingw32_HOST_OS import System.Posix hiding (getEnv) #else import GHC.ConsoleHandler ( flushConsole ) -import System.Win32 ( setConsoleCP, setConsoleOutputCP ) import qualified System.Win32 #endif @@ -75,14 +75,13 @@ import System.Exit ( exitWith, ExitCode(..) ) import System.Directory import System.IO import System.IO.Error as IO -import System.IO.Unsafe import Data.Char import Data.Dynamic import Data.Array import Control.Monad as Monad import Text.Printf - -import Foreign.StablePtr ( newStablePtr ) +import Foreign +import Foreign.C ( withCStringLen ) import GHC.Exts ( unsafeCoerce# ) import GHC.IOBase ( IOErrorType(InvalidArgument) ) @@ -339,7 +338,7 @@ runGHCi paths maybe_expr = do either_hdl <- io (IO.try (openFile "./.ghci" ReadMode)) case either_hdl of Left _e -> return () - Right hdl -> runCommands (fileLoop hdl False) + Right hdl -> runCommands (fileLoop hdl False False) when (read_dot_files) $ do -- Read in $HOME/.ghci @@ -355,7 +354,7 @@ runGHCi paths maybe_expr = do either_hdl <- io (IO.try (openFile file ReadMode)) case either_hdl of Left _e -> return () - Right hdl -> runCommands (fileLoop hdl False) + Right hdl -> runCommands (fileLoop hdl False False) -- Perform a :load for files given on the GHCi command line -- When in -e mode, if the load fails then we want to stop @@ -386,9 +385,6 @@ 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 @@ -418,9 +414,9 @@ interactiveLoop is_tty show_prompt = #ifdef USE_READLINE if (is_tty) then runCommands readlineLoop - else runCommands (fileLoop stdin show_prompt) + else runCommands (fileLoop stdin show_prompt is_tty) #else - runCommands (fileLoop stdin show_prompt) + runCommands (fileLoop stdin show_prompt is_tty) #endif @@ -456,8 +452,8 @@ checkPerms name = else return True #endif -fileLoop :: Handle -> Bool -> GHCi (Maybe String) -fileLoop hdl show_prompt = do +fileLoop :: Handle -> Bool -> Bool -> GHCi (Maybe String) +fileLoop hdl show_prompt is_tty = do when show_prompt $ do prompt <- mkPrompt (io (putStr prompt)) @@ -471,7 +467,33 @@ fileLoop hdl show_prompt = do -- this can happen if the user closed stdin, or -- perhaps did getContents which closes stdin at -- EOF. - Right l -> return (Just l) + Right l -> do + str <- io $ consoleInputToUnicode is_tty l + return (Just str) + +#ifdef mingw32_HOST_OS +-- Convert the console input into Unicode according to the current code page. +-- The Windows console stores Unicode characters directly, so this is a +-- rather roundabout way of doing things... oh well. +-- See #782, #1483, #1649 +consoleInputToUnicode :: Bool -> String -> IO String +consoleInputToUnicode is_tty str + | is_tty = do + cp <- System.Win32.getConsoleCP + System.Win32.stringToUnicode cp str + | otherwise = + decodeStringAsUTF8 str +#else +-- for Unix, assume the input is in UTF-8 and decode it to a Unicode String. +-- See #782. +consoleInputToUnicode :: Bool -> String -> IO String +consoleInputToUnicode _is_tty str = decodeStringAsUTF8 str +#endif + +decodeStringAsUTF8 :: String -> IO String +decodeStringAsUTF8 str = + withCStringLen str $ \(cstr,len) -> + utf8DecodeString (castPtr cstr :: Ptr Word8) len mkPrompt :: GHCi String mkPrompt = do @@ -524,7 +546,8 @@ readlineLoop = do Nothing -> return Nothing Just l -> do io (addHistory l) - return (Just l) + str <- io $ consoleInputToUnicode True l + return (Just str) #endif queryQueue :: GHCi (Maybe String) @@ -634,8 +657,8 @@ afterRunStmt step_here run_result = do let namesSorted = sortBy compareNames names tythings <- catMaybes `liftM` io (mapM (GHC.lookupName session) namesSorted) - - printTypeAndContents session [id | AnId id <- tythings] + docs <- io$ pprTypeAndContents session [id | AnId id <- tythings] + printForUserPartWay docs maybe (return ()) runBreakCmd mb_info -- run the command set with ":set stop " st <- getGHCiState @@ -679,15 +702,7 @@ printTypeOfName session n Nothing -> return () Just thing -> printTyThing thing -printTypeAndContents :: Session -> [Id] -> GHCi () -printTypeAndContents session ids = do - terms <- mapM (io . GHC.obtainTermB session 10 False) ids - docs_terms <- mapM (io . showTerm session) terms - dflags <- getDynFlags - let pefas = dopt Opt_PrintExplicitForalls dflags - printForUser $ vcat $ zipWith (\ty cts -> ty <+> equals <+> cts) - (map (pprTyThing pefas . AnId) ids) - docs_terms + specialCommand :: String -> GHCi Bool @@ -1455,7 +1470,9 @@ showBindings :: GHCi () showBindings = do s <- getSession bindings <- io (GHC.getBindings s) - printTypeAndContents s [ id | AnId id <- sortBy compareTyThings bindings] + docs <- io$ pprTypeAndContents s + [ id | AnId id <- sortBy compareTyThings bindings] + printForUserPartWay docs compareTyThings :: TyThing -> TyThing -> Ordering t1 `compareTyThings` t2 = getName t1 `compareNames` getName t2 @@ -1710,33 +1727,6 @@ wantNameFromInterpretedModule noCanDo str and_then = do text " is not interpreted" else and_then n --- ---------------------------------------------------------------------------- --- 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. Doing it this way does lead to problems, - -- however: see bug #1649. - -- - -- 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()). - -- - -- This call has been known to hang on some machines, see bug #1483 - -- - setConsoleCP 28591 -- ISO Latin-1 - setConsoleOutputCP 28591 -- ISO Latin-1 -#endif - return () - -- ----------------------------------------------------------------------------- -- commands for debugger