X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=0685168e3dfa11eb3674ca41eda4fa4bfeeef798;hb=5527bc59052caeb5d03cc24a972edacb32ccd9c8;hp=8a20fb1b991d1075813b7052beb490057f48a529;hpb=61d2625ae2e6a4cdae2ffc92df828905e81c24cc;p=ghc-hetmet.git diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs index 8a20fb1..0685168 100644 --- a/compiler/ghci/InteractiveUI.hs +++ b/compiler/ghci/InteractiveUI.hs @@ -25,7 +25,8 @@ import NameEnv ( delListFromNameEnv ) import TcType ( tidyTopType ) import qualified Id ( setIdType ) import IdInfo ( GlobalIdDetails(..) ) -import Linker ( HValue, extendLinkEnv, withExtendedLinkEnv,initDynLinker ) +import Linker ( HValue, extendLinkEnv, withExtendedLinkEnv, + initDynLinker ) import PrelNames ( breakpointJumpName, breakpointCondJumpName ) #endif @@ -55,9 +56,10 @@ import BasicTypes ( failed, successIf ) import Panic ( panic, installSignalHandlers ) import Config import StaticFlags ( opt_IgnoreDotGhci ) -import Linker ( showLinkerState ) +import Linker ( showLinkerState, linkPackages ) import Util ( removeSpaces, handle, global, toArgs, - looksLikeModuleName, prefixMatch, sortLe ) + looksLikeModuleName, prefixMatch, sortLe, + joinFileName ) #ifndef mingw32_HOST_OS import System.Posix @@ -67,6 +69,7 @@ import System.Posix #else import GHC.ConsoleHandler ( flushConsole ) import System.Win32 ( setConsoleCP, setConsoleOutputCP ) +import qualified System.Win32 #endif #ifdef USE_READLINE @@ -83,7 +86,7 @@ import Data.Dynamic import Numeric import Data.List import Data.Int ( Int64 ) -import Data.Maybe ( isJust, fromMaybe, catMaybes ) +import Data.Maybe ( isJust, isNothing, fromMaybe, catMaybes ) import System.Cmd import System.CPUTime import System.Environment @@ -122,6 +125,9 @@ builtin_commands = [ ("browse", keepGoing browseCmd, False, completeModule), ("cd", keepGoing changeDirectory, False, completeFilename), ("def", keepGoing defineMacro, False, completeIdentifier), + ("e", keepGoing editFile, False, completeFilename), + -- Hugs users are accustomed to :e, so make sure it doesn't overlap + ("edit", keepGoing editFile, False, completeFilename), ("help", keepGoing help, False, completeNone), ("?", keepGoing help, False, completeNone), ("info", keepGoing info, False, completeIdentifier), @@ -158,6 +164,8 @@ helpText = " :browse [*] display the names defined by \n" ++ " :cd change directory to \n" ++ " :def define a command :\n" ++ + " :edit edit file\n" ++ + " :edit edit last module\n" ++ " :help, :? display this list of commands\n" ++ " :info [ ...] display information about the given names\n" ++ " :load ... load module(s) and their dependents\n" ++ @@ -169,12 +177,13 @@ helpText = " :set args ... set the arguments returned by System.getArgs\n" ++ " :set prog set the value returned by System.getProgName\n" ++ " :set prompt set the prompt used in GHCi\n" ++ + " :set editor set the comand used for :edit\n" ++ "\n" ++ " :show modules show the currently loaded modules\n" ++ " :show bindings show the current bindings made at the prompt\n" ++ "\n" ++ " :ctags [] create tags file for Vi (default: \"tags\")\n" ++ - " :etags [] create tags file for Emacs (defauilt: \"TAGS\")\n" ++ + " :etags [] create tags file for Emacs (defauilt: \"TAGS\")\n" ++ " :type show the type of \n" ++ " :kind show the kind of \n" ++ " :undef undefine user-defined command :\n" ++ @@ -241,11 +250,13 @@ jumpFunction session@(Session ref) (I# idsPtr) hValues location b writeIORef ref (hsc_env { hsc_IC = new_ic }) is_tty <- hIsTerminalDevice stdin prel_mod <- GHC.findModule session prel_name Nothing + default_editor <- findEditor withExtendedLinkEnv (zip names hValues) $ startGHCi (interactiveLoop is_tty True) GHCiState{ progname = "", args = [], prompt = location++"> ", + editor = default_editor, session = session, options = [], prelude = prel_mod } @@ -254,6 +265,16 @@ jumpFunction session@(Session ref) (I# idsPtr) hValues location b return b #endif +findEditor = do + getEnv "EDITOR" + `IO.catch` \_ -> do +#if mingw32_HOST_OS + win <- System.Win32.getWindowsDirectory + return (win `joinFileName` "notepad.exe") +#else + return "" +#endif + interactiveUI :: Session -> [(FilePath, Maybe Phase)] -> Maybe String -> IO () interactiveUI session srcs maybe_expr = do #if defined(GHCI) && defined(BREAKPOINT) @@ -273,15 +294,19 @@ interactiveUI session srcs maybe_expr = do newStablePtr stdout newStablePtr stderr - hFlush stdout - hSetBuffering stdout NoBuffering - -- Initialise buffering for the *interpreted* I/O system initInterpBuffering session + when (isNothing maybe_expr) $ do + -- Only for GHCi (not runghc and ghc -e): + -- Turn buffering off for the compiled program's stdout/stderr + turnOffBuffering + -- Turn buffering off for GHCi's stdout + hFlush stdout + hSetBuffering stdout NoBuffering -- We don't want the cmd line to buffer any input that might be -- intended for the program, so unbuffer stdin. - hSetBuffering stdin NoBuffering + hSetBuffering stdin NoBuffering -- initial context is just the Prelude prel_mod <- GHC.findModule session prel_name Nothing @@ -301,10 +326,13 @@ interactiveUI session srcs maybe_expr = do Readline.setCompleterWordBreakCharacters word_break_chars #endif + default_editor <- findEditor + startGHCi (runGHCi srcs maybe_expr) GHCiState{ progname = "", args = [], prompt = "%s> ", + editor = default_editor, session = session, options = [], prelude = prel_mod } @@ -485,8 +513,8 @@ mkPrompt toplevs exports prompt f (x:xs) = char x <> f xs f [] = empty - perc_s = hsep (map (\m -> char '*' <> pprModule m) toplevs) <+> - hsep (map pprModule exports) + perc_s = hsep (map (\m -> char '*' <> ppr (GHC.moduleName m)) toplevs) <+> + hsep (map (ppr . GHC.moduleName) exports) #ifdef USE_READLINE @@ -648,8 +676,6 @@ initInterpBuffering session Just hval -> writeIORef flush_interp (unsafeCoerce# hval :: IO ()) _ -> panic "interactiveUI:flush" - turnOffBuffering -- Turn it off right now - return () @@ -736,6 +762,27 @@ changeDirectory dir = do dir <- expandPath dir io (setCurrentDirectory dir) +editFile :: String -> GHCi () +editFile str + | null str = do + -- find the name of the "topmost" file loaded + session <- getSession + graph0 <- io (GHC.getModuleGraph session) + graph1 <- filterM (io . GHC.isLoaded session . GHC.ms_mod_name) graph0 + let graph2 = flattenSCCs (GHC.topSortModuleGraph True graph1 Nothing) + case GHC.ml_hs_file (GHC.ms_location (last graph2)) of + Just file -> do_edit file + Nothing -> throwDyn (CmdLineError "unknown file name") + | otherwise = do_edit str + where + do_edit file = do + st <- getGHCiState + let cmd = editor st + when (null cmd) $ + throwDyn (CmdLineError "editor not set, use :set editor") + io $ system (cmd ++ ' ':file) + return () + defineMacro :: String -> GHCi () defineMacro s = do let (macro_name, definition) = break isSpace s @@ -1166,11 +1213,13 @@ setCmd "" else hsep (map (\o -> char '+' <> text (optToStr o)) opts) )) setCmd str - = case words str of + = case toArgs str of ("args":args) -> setArgs args ("prog":prog) -> setProg prog - ("prompt":prompt) -> setPrompt (dropWhile isSpace $ drop 6 $ dropWhile isSpace str) + ("prompt":prompt) -> setPrompt (after 6) + ("editor":cmd) -> setEditor (after 6) wds -> setOptions wds + where after n = dropWhile isSpace $ drop n $ dropWhile isSpace str setArgs args = do st <- getGHCiState @@ -1182,6 +1231,10 @@ setProg [prog] = do setProg _ = do io (hPutStrLn stderr "syntax: :set prog ") +setEditor cmd = do + st <- getGHCiState + setGHCiState st{ editor = cmd } + setPrompt value = do st <- getGHCiState if null value @@ -1198,21 +1251,28 @@ setOptions wds = -- then, dynamic flags dflags <- getDynFlags + let pkg_flags = packageFlags dflags (dflags',leftovers) <- io $ GHC.parseDynamicFlags dflags minus_opts - setDynFlags dflags' - - -- update things if the users wants more packages -{- TODO: - let new_packages = pkgs_after \\ pkgs_before - when (not (null new_packages)) $ - newPackages new_packages --} if (not (null leftovers)) then throwDyn (CmdLineError ("unrecognised flags: " ++ unwords leftovers)) else return () + new_pkgs <- setDynFlags dflags' + + -- if the package flags changed, we should reset the context + -- and link the new packages. + dflags <- getDynFlags + when (packageFlags dflags /= pkg_flags) $ do + io $ hPutStrLn stderr "package flags have changed, ressetting and loading new packages..." + session <- getSession + io (GHC.setTargets session []) + io (GHC.load session LoadAllTargets) + io (linkPackages dflags new_pkgs) + setContextAfterLoad session [] + return () + unsetOptions :: String -> GHCi () unsetOptions str @@ -1259,16 +1319,6 @@ optToStr ShowTiming = "s" optToStr ShowType = "t" optToStr RevertCAFs = "r" -{- ToDo -newPackages new_pkgs = do -- The new packages are already in v_Packages - session <- getSession - io (GHC.setTargets session []) - io (GHC.load session Nothing) - dflags <- getDynFlags - io (linkPackages dflags new_pkgs) - setContextAfterLoad [] --} - -- --------------------------------------------------------------------------- -- code for `:show' @@ -1431,6 +1481,7 @@ data GHCiState = GHCiState progname :: String, args :: [String], prompt :: String, + editor :: String, session :: GHC.Session, options :: [GHCiOption], prelude :: Module