Implement :main (see ticket #662)
Patch from Volker Stolz, minor mods by me
When matching commands, we now look for (a) an exact match, and (b)
the first prefix match we find in the list. This is so that :module
can still be abbreviated by :m, to avoid surprise.
Docs still to do.
("info", keepGoing info),
("load", keepGoingPaths loadModule_),
("module", keepGoing setContext),
("info", keepGoing info),
("load", keepGoingPaths loadModule_),
("module", keepGoing setContext),
+ ("main", keepGoing runMain),
("reload", keepGoing reloadModule),
("check", keepGoing checkModule),
("set", keepGoing setCmd),
("reload", keepGoing reloadModule),
("check", keepGoing checkModule),
("set", keepGoing setCmd),
" :info [<name> ...] display information about the given names\n" ++
" :load <filename> ... load module(s) and their dependents\n" ++
" :module [+/-] [*]<mod> ... set the context for expression evaluation\n" ++
" :info [<name> ...] display information about the given names\n" ++
" :load <filename> ... load module(s) and their dependents\n" ++
" :module [+/-] [*]<mod> ... set the context for expression evaluation\n" ++
+ " :main [<arguments> ...] run the main function with the given arguments\n" ++
" :reload reload the current module set\n" ++
"\n" ++
" :set <option> ... set options\n" ++
" :reload reload the current module set\n" ++
"\n" ++
" :set <option> ... set options\n" ++
specialCommand str = do
let (cmd,rest) = break isSpace str
cmds <- io (readIORef commands)
specialCommand str = do
let (cmd,rest) = break isSpace str
cmds <- io (readIORef commands)
- case [ (s,f) | (s,f) <- cmds, prefixMatch cmd s ] of
- [] -> io (hPutStr stdout ("unknown command ':" ++ cmd ++ "'\n"
+ -- look for exact match first, then the first prefix match
+ case [ (s,f) | (s,f) <- cmds, cmd == s ] of
+ (_,f):_ -> f (dropWhile isSpace rest)
+ [] -> case [ (s,f) | (s,f) <- cmds, prefixMatch cmd s ] of
+ [] -> io (hPutStr stdout ("unknown command ':" ++ cmd ++ "'\n"
++ shortHelpText) >> return False)
++ shortHelpText) >> return False)
- [(_,f)] -> f (dropWhile isSpace rest)
- cs -> io (hPutStrLn stdout ("prefix " ++ cmd ++
- " matches multiple commands (" ++
- foldr1 (\a b -> a ++ ',':b) (map fst cs)
- ++ ")") >> return False)
+ (_,f):_ -> f (dropWhile isSpace rest)
-----------------------------------------------------------------------------
-- To flush buffers for the *interpreted* computation we need
-----------------------------------------------------------------------------
-- To flush buffers for the *interpreted* computation we need
-----------------------------------------------------------------------------
-- Commands
-----------------------------------------------------------------------------
-- Commands
+runMain :: String -> GHCi ()
+runMain args = do
+ let ss = concat $ intersperse "," (map (\ s -> ('"':s)++"\"") (toArgs args))
+ runCommand $ '[': ss ++ "] `System.Environment.withArgs` main"
+ return ()
+
addModule :: [FilePath] -> GHCi ()
addModule files = do
io (revertCAFs) -- always revert CAFs on load/add.
addModule :: [FilePath] -> GHCi ()
addModule files = do
io (revertCAFs) -- always revert CAFs on load/add.
case maybe_hv of
Nothing -> return ()
Just hv -> io (writeIORef commands --
case maybe_hv of
Nothing -> return ()
Just hv -> io (writeIORef commands --
- ((macro_name, keepGoing (runMacro hv)) : cmds))
+ (cmds ++ [(macro_name, keepGoing (runMacro hv))]))
runMacro :: GHC.HValue{-String -> IO String-} -> String -> GHCi ()
runMacro fun s = do
runMacro :: GHC.HValue{-String -> IO String-} -> String -> GHCi ()
runMacro fun s = do