X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=909eaeca0a273bb1667fcff76a134557b057e43d;hb=1f5536dd423a71d721b7c9563f4680c4f798ebe8;hp=5a54af2ca0ca697cd7934d78e6bc6c34c10ef9d0;hpb=b02735551ba8e60a0be2d1a4f9b91564763cc759;p=ghc-hetmet.git diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs index 5a54af2..909eaec 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,7 +56,7 @@ 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 ) @@ -83,7 +84,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 +123,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 +162,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,6 +175,7 @@ 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" ++ @@ -241,11 +248,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 +263,17 @@ jumpFunction session@(Session ref) (I# idsPtr) hValues location b return b #endif +findEditor = do + getEnv "EDITOR" + `IO.catch` \_ -> do +#if 0 + -- ToDo: mingw32_HOST_OS + win <- 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 +293,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 +325,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 } @@ -648,8 +675,6 @@ initInterpBuffering session Just hval -> writeIORef flush_interp (unsafeCoerce# hval :: IO ()) _ -> panic "interactiveUI:flush" - turnOffBuffering -- Turn it off right now - return () @@ -736,6 +761,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 +1212,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 +1230,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 +1250,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 +1318,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 +1480,7 @@ data GHCiState = GHCiState progname :: String, args :: [String], prompt :: String, + editor :: String, session :: GHC.Session, options :: [GHCiOption], prelude :: Module