From: Ian Lynagh Date: Sat, 19 Jan 2008 16:49:23 +0000 (+0000) Subject: Add :run and tweak :main X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=c24bd1bbbdc4e20ea5c31b8779a70a5421f44962 Add :run and tweak :main You can now give :main a Haskell [String] as an argument, e.g. :main ["foo", "bar"] and :run is a variant that takes the name of the function to run. Also, :main now obeys the -main-is flag. --- diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs index 30f1de6..73b1e47 100644 --- a/compiler/ghci/InteractiveUI.hs +++ b/compiler/ghci/InteractiveUI.hs @@ -138,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), @@ -176,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" @@ -206,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" ++ @@ -851,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 @@ -1398,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 diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs index 01685f3..59f3b47 100644 --- a/compiler/utils/Util.lhs +++ b/compiler/utils/Util.lhs @@ -53,7 +53,7 @@ module Util ( -- module names looksLikeModuleName, - toArgs, + getCmd, toCmdArgs, toArgs, -- Floating point stuff readRational, @@ -657,44 +657,51 @@ looksLikeModuleName (c:cs) = isUpper c && go cs \end{code} Akin to @Prelude.words@, but acts like the Bourne shell, treating -quoted strings and escaped characters within the input as solid blocks -of characters. Doesn't raise any exceptions on malformed escapes or -quoting. +quoted strings as Haskell Strings, and also parses Haskell [String] +syntax. \begin{code} -toArgs :: String -> [String] -toArgs "" = [] -toArgs s = - case dropWhile isSpace s of -- drop initial spacing - [] -> [] -- empty, so no more tokens - rem -> let (tok,aft) = token rem [] in tok : toArgs aft +getCmd :: String -> Either String -- Error + (String, String) -- (Cmd, Rest) +getCmd s = case break isSpace $ dropWhile isSpace s of + ([], _) -> Left ("Couldn't find command in " ++ show s) + res -> Right res + +toCmdArgs :: String -> Either String -- Error + (String, [String]) -- (Cmd, Args) +toCmdArgs s = case getCmd s of + Left err -> Left err + Right (cmd, s') -> case toArgs s' of + Left err -> Left err + Right args -> Right (cmd, args) + +toArgs :: String -> Either String -- Error + [String] -- Args +toArgs str + = case dropWhile isSpace str of + s@('[':_) -> case reads s of + [(args, spaces)] + | all isSpace spaces -> + Right args + _ -> + Left ("Couldn't read " ++ show str ++ "as [String]") + s -> toArgs' s where - -- Grab a token off the string, given that the first character exists and - -- isn't whitespace. The second argument is an accumulator which has to be - -- reversed at the end. - token [] acc = (reverse acc,[]) -- out of characters - token ('\\':c:aft) acc -- escapes - = token aft ((escape c) : acc) - token (q:aft) acc | q == '"' || q == '\'' -- open quotes - = let (aft',acc') = quote q aft acc in token aft' acc' - token (c:aft) acc | isSpace c -- unescaped, unquoted spacing - = (reverse acc,aft) - token (c:aft) acc -- anything else goes in the token - = token aft (c:acc) - - -- Get the appropriate character for a single-character escape. - escape 'n' = '\n' - escape 't' = '\t' - escape 'r' = '\r' - escape c = c - - -- Read into accumulator until a quote character is found. - quote qc = - let quote' [] acc = ([],acc) - quote' ('\\':c:aft) acc = quote' aft ((escape c) : acc) - quote' (c:aft) acc | c == qc = (aft,acc) - quote' (c:aft) acc = quote' aft (c:acc) - in quote' + toArgs' s = case dropWhile isSpace s of + [] -> Right [] + ('"' : _) -> case reads s of + [(arg, rest)] + -- rest must either be [] or start with a space + | all isSpace (take 1 rest) -> + case toArgs' rest of + Left err -> Left err + Right args -> Right (arg : args) + _ -> + Left ("Couldn't read " ++ show s ++ "as String") + s' -> case break isSpace s' of + (arg, s'') -> case toArgs' s'' of + Left err -> Left err + Right args -> Right (arg : args) \end{code} -- ----------------------------------------------------------------------------- diff --git a/docs/users_guide/ghci.xml b/docs/users_guide/ghci.xml index 528a652..9fa5d87 100644 --- a/docs/users_guide/ghci.xml +++ b/docs/users_guide/ghci.xml @@ -611,7 +611,7 @@ Prelude IO> - The <literal>:main</literal> command + The <literal>:main</literal> and <literal>:run</literal> commands When a program is compiled and executed, it can use the @@ -636,6 +636,37 @@ Prelude> :main foo bar ["foo","bar"] + + We can also quote arguments which contains characters like + spaces, and they are treated like Haskell strings, or we can + just use Haskell list syntax: + + + +Prelude> :main foo "bar baz" +["foo","bar baz"] +Prelude> :main ["foo", "bar baz"] +["foo","bar baz"] + + + + Finally, other functions can be called, either with the + -main-is flag or the :run + command: + + + +Prelude> let foo = putStrLn "foo" >> System.Environment.getArgs >>= print +Prelude> let bar = putStrLn "bar" >> System.Environment.getArgs >>= print +Prelude> :set -main-is foo +Prelude> :main foo "bar baz" +foo +["foo","bar baz"] +Prelude> :run bar ["foo", "bar baz"] +bar +["foo","bar baz"] + + @@ -2119,6 +2150,37 @@ Prelude> :main foo bar ["foo","bar"] + + We can also quote arguments which contains characters like + spaces, and they are treated like Haskell strings, or we can + just use Haskell list syntax: + + + +Prelude> :main foo "bar baz" +["foo","bar baz"] +Prelude> :main ["foo", "bar baz"] +["foo","bar baz"] + + + + Finally, other functions can be called, either with the + -main-is flag or the :run + command: + + + +Prelude> let foo = putStrLn "foo" >> System.Environment.getArgs >>= print +Prelude> let bar = putStrLn "bar" >> System.Environment.getArgs >>= print +Prelude> :set -main-is foo +Prelude> :main foo "bar baz" +foo +["foo","bar baz"] +Prelude> :run bar ["foo", "bar baz"] +bar +["foo","bar baz"] + +