X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=73b1e47684d6261159940b08e71b27f921040ed7;hb=c24bd1bbbdc4e20ea5c31b8779a70a5421f44962;hp=e4439d65436222328a56cf0374e0c8b1c1a7f270;hpb=be3eef905a72a5b21b5ec6fe51662e958249ca60;p=ghc-hetmet.git diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs index e4439d6..73b1e47 100644 --- a/compiler/ghci/InteractiveUI.hs +++ b/compiler/ghci/InteractiveUI.hs @@ -54,6 +54,7 @@ import System.Posix hiding (getEnv) #else import GHC.ConsoleHandler ( flushConsole ) import qualified System.Win32 +import System.FilePath #endif #ifdef USE_READLINE @@ -137,6 +138,7 @@ builtin_commands = [ ("print", keepGoing printCmd, Nothing, completeIdentifier), ("quit", quit, Nothing, completeNone), ("reload", keepGoing reloadModule, Nothing, completeNone), + ("run", keepGoing runRun, Nothing, completeIdentifier), ("set", keepGoing setCmd, Just flagWordBreakChars, completeSetOptions), ("show", keepGoing showCmd, Nothing, completeNone), ("sprint", keepGoing sprintCmd, Nothing, completeIdentifier), @@ -158,11 +160,15 @@ builtin_commands = [ -- -- NOTE: in order for us to override the default correctly, any custom entry -- must be a SUBSET of word_break_chars. -word_break_chars, flagWordBreakChars, filenameWordBreakChars :: String +#ifdef USE_READLINE +word_break_chars :: String word_break_chars = let symbols = "!#$%&*+/<=>?@\\^|-~" specials = "(),;[]`{}" spaces = " \t\n" in spaces ++ specials ++ symbols +#endif + +flagWordBreakChars, filenameWordBreakChars :: String flagWordBreakChars = " \t\n" filenameWordBreakChars = " \t\n\\`@$><=;|&{(" -- bash defaults @@ -171,7 +177,11 @@ keepGoing :: (String -> GHCi ()) -> (String -> GHCi Bool) keepGoing a str = a str >> return False keepGoingPaths :: ([FilePath] -> GHCi ()) -> (String -> GHCi Bool) -keepGoingPaths a str = a (toArgs str) >> return False +keepGoingPaths a str + = do case toArgs str of + Left err -> io (hPutStrLn stderr err) + Right args -> a args + return False shortHelpText :: String shortHelpText = "use :? for help.\n" @@ -201,6 +211,7 @@ helpText = " :module [+/-] [*] ... set the context for expression evaluation\n" ++ " :quit exit GHCi\n" ++ " :reload reload the current module set\n" ++ + " :run function [ ...] run the function with the given arguments\n" ++ " :type show the type of \n" ++ " :undef undefine user-defined command :\n" ++ " :! run the shell command \n" ++ @@ -299,13 +310,15 @@ interactiveUI session srcs maybe_expr = do hSetBuffering stdin NoBuffering #ifdef USE_READLINE - Readline.initialize - Readline.setAttemptedCompletionFunction (Just completeWord) - --Readline.parseAndBind "set show-all-if-ambiguous 1" - - Readline.setBasicWordBreakCharacters word_break_chars - Readline.setCompleterWordBreakCharacters word_break_chars - Readline.setCompletionAppendCharacter Nothing + is_tty <- hIsTerminalDevice stdin + when is_tty $ do + Readline.initialize + Readline.setAttemptedCompletionFunction (Just completeWord) + --Readline.parseAndBind "set show-all-if-ambiguous 1" + + Readline.setBasicWordBreakCharacters word_break_chars + Readline.setCompleterWordBreakCharacters word_break_chars + Readline.setCompletionAppendCharacter Nothing #endif -- initial context is just the Prelude @@ -844,9 +857,22 @@ pprInfo pefas (thing, fixity, insts) | otherwise = ppr fix <+> ppr (GHC.getName thing) runMain :: String -> GHCi () -runMain args = do - let ss = concat $ intersperse "," (map (\ s -> ('"':s)++"\"") (toArgs args)) - enqueueCommands ['[': ss ++ "] `System.Environment.withArgs` main"] +runMain s = case toArgs s of + Left err -> io (hPutStrLn stderr err) + Right args -> + do dflags <- getDynFlags + case mainFunIs dflags of + Nothing -> doWithArgs args "main" + Just f -> doWithArgs args f + +runRun :: String -> GHCi () +runRun s = case toCmdArgs s of + Left err -> io (hPutStrLn stderr err) + Right (cmd, args) -> doWithArgs args cmd + +doWithArgs :: [String] -> String -> GHCi () +doWithArgs args cmd = enqueueCommands ["System.Environment.withArgs " ++ + show args ++ " (" ++ cmd ++ ")"] addModule :: [FilePath] -> GHCi () addModule files = do @@ -1391,27 +1417,32 @@ setCmd "" ,Opt_PrintEvldWithShow ] setCmd str - = case toArgs str of - ("args":args) -> setArgs args - ("prog":prog) -> setProg prog - ("prompt":_) -> setPrompt (after 6) - ("editor":_) -> setEditor (after 6) - ("stop":_) -> setStop (after 4) - wds -> setOptions wds - where after n = dropWhile isSpace $ drop n $ dropWhile isSpace str - -setArgs, setProg, setOptions :: [String] -> GHCi () -setEditor, setStop, setPrompt :: String -> GHCi () + = case getCmd str of + Right ("args", rest) -> + case toArgs rest of + Left err -> io (hPutStrLn stderr err) + Right args -> setArgs args + Right ("prog", rest) -> + case toArgs rest of + Right [prog] -> setProg prog + _ -> io (hPutStrLn stderr "syntax: :set prog ") + Right ("prompt", rest) -> setPrompt $ dropWhile isSpace rest + Right ("editor", rest) -> setEditor $ dropWhile isSpace rest + Right ("stop", rest) -> setStop $ dropWhile isSpace rest + _ -> case toArgs str of + Left err -> io (hPutStrLn stderr err) + Right wds -> setOptions wds + +setArgs, setOptions :: [String] -> GHCi () +setProg, setEditor, setStop, setPrompt :: String -> GHCi () setArgs args = do st <- getGHCiState setGHCiState st{ args = args } -setProg [prog] = do +setProg prog = do st <- getGHCiState setGHCiState st{ progname = prog } -setProg _ = do - io (hPutStrLn stderr "syntax: :set prog ") setEditor cmd = do st <- getGHCiState @@ -2132,9 +2163,23 @@ listCmd :: String -> GHCi () listCmd "" = do mb_span <- getCurrentBreakSpan case mb_span of - Nothing -> printForUser $ text "not stopped at a breakpoint; nothing to list" - Just span | GHC.isGoodSrcSpan span -> io $ listAround span True - | otherwise -> printForUser $ text "unable to list source for" <+> ppr span + Nothing -> + printForUser $ text "Not stopped at a breakpoint; nothing to list" + Just span + | GHC.isGoodSrcSpan span -> io $ listAround span True + | otherwise -> + do s <- getSession + resumes <- io $ GHC.getResumeContext s + case resumes of + [] -> panic "No resumes" + (r:_) -> + do let traceIt = case GHC.resumeHistory r of + [] -> text "rerunning with :trace," + _ -> empty + doWhat = traceIt <+> text ":back then :list" + printForUser (text "Unable to list source for" <+> + ppr span + $$ text "Try" <+> doWhat) listCmd str = list2 (words str) list2 :: [String] -> GHCi ()