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 (file)
--- 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),
   ("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),
   ("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)
 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"
 
 shortHelpText :: String
 shortHelpText = "use :? for help.\n"

@@ -206,6 +211,7 @@ helpText =
  "   :module [+/-] [*]<mod> ...  set the context for expression evaluation\n" ++
  "   :quit                       exit GHCi\n" ++
  "   :reload                     reload the current module set\n" ++
  "   :module [+/-] [*]<mod> ...  set the context for expression evaluation\n" ++
  "   :quit                       exit GHCi\n" ++
  "   :reload                     reload the current module set\n" ++

+ "   :run function [<arguments> ...] run the function with the given arguments\n" ++

  "   :type <expr>                show the type of <expr>\n" ++
  "   :undef <cmd>                undefine user-defined command :<cmd>\n" ++
  "   :!<command>                 run the shell command <command>\n" ++
  "   :type <expr>                show the type of <expr>\n" ++
  "   :undef <cmd>                undefine user-defined command :<cmd>\n" ++
  "   :!<command>                 run the shell command <command>\n" ++

@@ -851,9 +857,22 @@ pprInfo pefas (thing, fixity, insts)
        | otherwise                = ppr fix <+> ppr (GHC.getName thing)
 
 runMain :: String -> GHCi ()
        | 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
 
 addModule :: [FilePath] -> GHCi ()
 addModule files = do

@@ -1398,27 +1417,32 @@ setCmd ""
                 ,Opt_PrintEvldWithShow
                 ] 
 setCmd str
                 ,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 <progname>")
+    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 }
 
 
 setArgs args = do
   st <- getGHCiState
   setGHCiState st{ args = args }
 

-setProg [prog] = do
+setProg prog = do

   st <- getGHCiState
   setGHCiState st{ progname = prog }
   st <- getGHCiState
   setGHCiState st{ progname = prog }

-setProg _ = do
-  io (hPutStrLn stderr "syntax: :set prog <progname>")

 
 setEditor cmd = do
   st <- getGHCiState
 
 setEditor cmd = do
   st <- getGHCiState

diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs
index 01685f3..59f3b47 100644 (file)
--- a/compiler/utils/Util.lhs
+++ b/compiler/utils/Util.lhs
@@ -53,7 +53,7 @@ module Util (
         -- module names
         looksLikeModuleName,
 
         -- module names
         looksLikeModuleName,
 

-        toArgs,
+        getCmd, toCmdArgs, toArgs,

 
         -- Floating point stuff
         readRational,
 
         -- 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
 \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}
 
 \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
  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}
 
 -- -----------------------------------------------------------------------------
 \end{code}
 
 -- -----------------------------------------------------------------------------

diff --git a/docs/users_guide/ghci.xml b/docs/users_guide/ghci.xml
index 528a652..9fa5d87 100644 (file)
--- a/docs/users_guide/ghci.xml
+++ b/docs/users_guide/ghci.xml
@@ -611,7 +611,7 @@ Prelude IO>
       </sect3>
 
       <sect3>
       </sect3>
 
       <sect3>

-        <title>The <literal>:main</literal> command</title>
+        <title>The <literal>:main</literal> and <literal>:run</literal> commands</title>

 
         <para>
           When a program is compiled and executed, it can use the
 
         <para>
           When a program is compiled and executed, it can use the

@@ -636,6 +636,37 @@ Prelude> :main foo bar
 ["foo","bar"]
 </screen>
 
 ["foo","bar"]
 </screen>
 

+        <para>
+            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:
+        </para>
+
+<screen>
+Prelude> :main foo "bar baz"
+["foo","bar baz"]
+Prelude> :main ["foo", "bar baz"]
+["foo","bar baz"]
+</screen>
+
+        <para>
+            Finally, other functions can be called, either with the
+            <literal>-main-is</literal> flag or the <literal>:run</literal>
+            command:
+        </para>
+
+<screen>
+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"]
+</screen>
+

       </sect3>
     </sect2>
   
       </sect3>
     </sect2>
   

@@ -2119,6 +2150,37 @@ Prelude> :main foo bar
 ["foo","bar"]
 </screen>
 
 ["foo","bar"]
 </screen>
 

+        <para>
+            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:
+        </para>
+
+<screen>
+Prelude> :main foo "bar baz"
+["foo","bar baz"]
+Prelude> :main ["foo", "bar baz"]
+["foo","bar baz"]
+</screen>
+
+        <para>
+            Finally, other functions can be called, either with the
+            <literal>-main-is</literal> flag or the <literal>:run</literal>
+            command:
+        </para>
+
+<screen>
+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"]
+</screen>
+

         </listitem>
       </varlistentry>
 
         </listitem>
       </varlistentry>