Fix exception message with ghc -e
[ghc-hetmet.git] / compiler / ghci / InteractiveUI.hs
index 8cc1513..afd9702 100644 (file)
@@ -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
@@ -81,9 +82,10 @@ import Data.Array
 import Control.Monad as Monad
 import Text.Printf
 import Foreign
-import Foreign.C        ( withCStringLen )
+import Foreign.C
 import GHC.Exts                ( unsafeCoerce# )
 import GHC.IOBase      ( IOErrorType(InvalidArgument) )
+import GHC.TopHandler
 
 import Data.IORef      ( IORef, readIORef, writeIORef )
 
@@ -106,54 +108,81 @@ GLOBAL_VAR(macros_ref, [], [Command])
 builtin_commands :: [Command]
 builtin_commands = [
        -- Hugs users are accustomed to :e, so make sure it doesn't overlap
-  ("?",                keepGoing help,                 False, completeNone),
-  ("add",      keepGoingPaths addModule,       False, completeFilename),
-  ("abandon",   keepGoing abandonCmd,           False, completeNone),
-  ("break",     keepGoing breakCmd,             False, completeIdentifier),
-  ("back",      keepGoing backCmd,              False, completeNone),
-  ("browse",    keepGoing (browseCmd False),   False, completeModule),
-  ("browse!",   keepGoing (browseCmd True),    False, completeModule),
-  ("cd",       keepGoing changeDirectory,      False, completeFilename),
-  ("check",    keepGoing checkModule,          False, completeHomeModule),
-  ("continue",  keepGoing continueCmd,          False, completeNone),
-  ("cmd",       keepGoing cmdCmd,               False, completeIdentifier),
-  ("ctags",    keepGoing createCTagsFileCmd,   False, completeFilename),
-  ("def",      keepGoing (defineMacro False),  False, completeIdentifier),
-  ("def!",     keepGoing (defineMacro True),   False, completeIdentifier),
-  ("delete",    keepGoing deleteCmd,            False, completeNone),
-  ("e",        keepGoing editFile,             False, completeFilename),
-  ("edit",     keepGoing editFile,             False, completeFilename),
-  ("etags",    keepGoing createETagsFileCmd,   False, completeFilename),
-  ("force",     keepGoing forceCmd,             False, completeIdentifier),
-  ("forward",   keepGoing forwardCmd,           False, completeNone),
-  ("help",     keepGoing help,                 False, completeNone),
-  ("history",   keepGoing historyCmd,           False, completeNone), 
-  ("info",      keepGoing info,                        False, completeIdentifier),
-  ("kind",     keepGoing kindOfType,           False, completeIdentifier),
-  ("load",     keepGoingPaths loadModule_,     False, completeHomeModuleOrFile),
-  ("list",     keepGoing listCmd,              False, completeNone),
-  ("module",   keepGoing setContext,           False, completeModule),
-  ("main",     keepGoing runMain,              False, completeIdentifier),
-  ("print",     keepGoing printCmd,             False, completeIdentifier),
-  ("quit",     quit,                           False, completeNone),
-  ("reload",   keepGoing reloadModule,         False, completeNone),
-  ("set",      keepGoing setCmd,               True,  completeSetOptions),
-  ("show",     keepGoing showCmd,              False, completeNone),
-  ("sprint",    keepGoing sprintCmd,            False, completeIdentifier),
-  ("step",      keepGoing stepCmd,              False, completeIdentifier), 
-  ("steplocal", keepGoing stepLocalCmd,         False, completeIdentifier), 
-  ("stepmodule",keepGoing stepModuleCmd,        False, completeIdentifier), 
-  ("type",     keepGoing typeOfExpr,           False, completeIdentifier),
-  ("trace",     keepGoing traceCmd,             False, completeIdentifier), 
-  ("undef",     keepGoing undefineMacro,       False, completeMacro),
-  ("unset",    keepGoing unsetOptions,         True,  completeSetOptions)
+  ("?",                keepGoing help,                 Nothing, completeNone),
+  ("add",      keepGoingPaths addModule,       Just filenameWordBreakChars, completeFilename),
+  ("abandon",   keepGoing abandonCmd,           Nothing, completeNone),
+  ("break",     keepGoing breakCmd,             Nothing, completeIdentifier),
+  ("back",      keepGoing backCmd,              Nothing, completeNone),
+  ("browse",    keepGoing (browseCmd False),   Nothing, completeModule),
+  ("browse!",   keepGoing (browseCmd True),    Nothing, completeModule),
+  ("cd",       keepGoing changeDirectory,      Just filenameWordBreakChars, completeFilename),
+  ("check",    keepGoing checkModule,          Nothing, completeHomeModule),
+  ("continue",  keepGoing continueCmd,          Nothing, completeNone),
+  ("cmd",       keepGoing cmdCmd,               Nothing, completeIdentifier),
+  ("ctags",    keepGoing createCTagsFileCmd,   Just filenameWordBreakChars, completeFilename),
+  ("def",      keepGoing (defineMacro False),  Nothing, completeIdentifier),
+  ("def!",     keepGoing (defineMacro True),   Nothing, completeIdentifier),
+  ("delete",    keepGoing deleteCmd,            Nothing, completeNone),
+  ("e",        keepGoing editFile,             Just filenameWordBreakChars, completeFilename),
+  ("edit",     keepGoing editFile,             Just filenameWordBreakChars, completeFilename),
+  ("etags",    keepGoing createETagsFileCmd,   Just filenameWordBreakChars, completeFilename),
+  ("force",     keepGoing forceCmd,             Nothing, completeIdentifier),
+  ("forward",   keepGoing forwardCmd,           Nothing, completeNone),
+  ("help",     keepGoing help,                 Nothing, completeNone),
+  ("history",   keepGoing historyCmd,           Nothing, completeNone), 
+  ("info",      keepGoing info,                        Nothing, completeIdentifier),
+  ("kind",     keepGoing kindOfType,           Nothing, completeIdentifier),
+  ("load",     keepGoingPaths loadModule_,     Just filenameWordBreakChars, completeHomeModuleOrFile),
+  ("list",     keepGoing listCmd,              Nothing, completeNone),
+  ("module",   keepGoing setContext,           Nothing, completeModule),
+  ("main",     keepGoing runMain,              Nothing, completeIdentifier),
+  ("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),
+  ("step",      keepGoing stepCmd,              Nothing, completeIdentifier), 
+  ("steplocal", keepGoing stepLocalCmd,         Nothing, completeIdentifier), 
+  ("stepmodule",keepGoing stepModuleCmd,        Nothing, completeIdentifier), 
+  ("type",     keepGoing typeOfExpr,           Nothing, completeIdentifier),
+  ("trace",     keepGoing traceCmd,             Nothing, completeIdentifier), 
+  ("undef",     keepGoing undefineMacro,       Nothing, completeMacro),
+  ("unset",    keepGoing unsetOptions,         Just flagWordBreakChars,  completeSetOptions)
   ]
 
+
+-- We initialize readline (in the interactiveUI function) to use 
+-- word_break_chars as the default set of completion word break characters.
+-- This can be overridden for a particular command (for example, filename
+-- expansion shouldn't consider '/' to be a word break) by setting the third
+-- entry in the Command tuple above.
+-- 
+-- NOTE: in order for us to override the default correctly, any custom entry
+-- must be a SUBSET of word_break_chars.
+#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
+
+
 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"
@@ -183,6 +212,7 @@ helpText =
  "   :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" ++
@@ -245,14 +275,15 @@ findEditor = do
   getEnv "EDITOR" 
     `IO.catch` \_ -> do
 #if mingw32_HOST_OS
-       win <- System.Win32.getWindowsDirectory
-       return (win `joinFileName` "notepad.exe")
+        win <- System.Win32.getWindowsDirectory
+        return (win </> "notepad.exe")
 #else
-       return ""
+        return ""
 #endif
 
-interactiveUI :: Session -> [(FilePath, Maybe Phase)] -> Maybe String -> IO ()
-interactiveUI session srcs maybe_expr = do
+interactiveUI :: Session -> [(FilePath, Maybe Phase)] -> Maybe [String]
+              -> IO ()
+interactiveUI session srcs maybe_exprs = do
    -- HACK! If we happen to get into an infinite loop (eg the user
    -- types 'let x=x in x' at the prompt), then the thread will block
    -- on a blackhole, and become unreachable during GC.  The GC will
@@ -268,7 +299,7 @@ interactiveUI session srcs maybe_expr = do
     -- Initialise buffering for the *interpreted* I/O system
    initInterpBuffering session
 
-   when (isNothing maybe_expr) $ do
+   when (isNothing maybe_exprs) $ do
         -- Only for GHCi (not runghc and ghc -e):
 
         -- Turn buffering off for the compiled program's stdout/stderr
@@ -280,35 +311,33 @@ interactiveUI session srcs maybe_expr = do
         -- intended for the program, so unbuffer stdin.
         hSetBuffering stdin NoBuffering
 
-        -- initial context is just the Prelude
+#ifdef USE_READLINE
+        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
    prel_mod <- GHC.findModule session (GHC.mkModuleName "Prelude") 
                                       (Just basePackageId)
    GHC.setContext session [] [prel_mod]
 
-#ifdef USE_READLINE
-   Readline.initialize
-   Readline.setAttemptedCompletionFunction (Just completeWord)
-   --Readline.parseAndBind "set show-all-if-ambiguous 1"
-
-   let symbols = "!#$%&*+/<=>?@\\^|-~"
-       specials = "(),;[]`{}"
-       spaces = " \t\n"
-       word_break_chars = spaces ++ specials ++ symbols
-
-   Readline.setBasicWordBreakCharacters word_break_chars
-   Readline.setCompleterWordBreakCharacters word_break_chars
-#endif
-
    default_editor <- findEditor
 
-   startGHCi (runGHCi srcs maybe_expr)
-       GHCiState{ progname = "<interactive>",
-                  args = [],
+   startGHCi (runGHCi srcs maybe_exprs)
+        GHCiState{ progname = "<interactive>",
+                   args = [],
                    prompt = "%s> ",
                    stop = "",
-                  editor = default_editor,
-                  session = session,
-                  options = [],
+                   editor = default_editor,
+                   session = session,
+                   options = [],
                    prelude = prel_mod,
                    break_ctr = 0,
                    breaks = [],
@@ -324,8 +353,8 @@ interactiveUI session srcs maybe_expr = do
 
    return ()
 
-runGHCi :: [(FilePath, Maybe Phase)] -> Maybe String -> GHCi ()
-runGHCi paths maybe_expr = do
+runGHCi :: [(FilePath, Maybe Phase)] -> Maybe [String] -> GHCi ()
+runGHCi paths maybe_exprs = do
   let read_dot_files = not opt_IgnoreDotGhci
 
   when (read_dot_files) $ do
@@ -336,35 +365,35 @@ runGHCi paths maybe_expr = do
        dir_ok  <- io (checkPerms ".")
        file_ok <- io (checkPerms file)
        when (dir_ok && file_ok) $ do
-         either_hdl <- io (IO.try (openFile "./.ghci" ReadMode))
-         case either_hdl of
-            Left _e   -> return ()
-            Right hdl -> runCommands (fileLoop hdl False False)
-    
+          either_hdl <- io (IO.try (openFile "./.ghci" ReadMode))
+          case either_hdl of
+             Left _e   -> return ()
+             Right hdl -> runCommands (fileLoop hdl False False)
+
   when (read_dot_files) $ do
     -- Read in $HOME/.ghci
     either_dir <- io (IO.try getHomeDirectory)
     case either_dir of
        Left _e -> return ()
        Right dir -> do
-         cwd <- io (getCurrentDirectory)
-         when (dir /= cwd) $ do
-            let file = dir ++ "/.ghci"
-            ok <- io (checkPerms file)
-            when ok $ do
-              either_hdl <- io (IO.try (openFile file ReadMode))
-              case either_hdl of
-                 Left _e   -> return ()
-                 Right hdl -> runCommands (fileLoop hdl False False)
+          cwd <- io (getCurrentDirectory)
+          when (dir /= cwd) $ do
+             let file = dir ++ "/.ghci"
+             ok <- io (checkPerms file)
+             when ok $ do
+               either_hdl <- io (IO.try (openFile file ReadMode))
+               case either_hdl of
+                  Left _e   -> return ()
+                  Right hdl -> runCommands (fileLoop hdl False False)
 
   -- Perform a :load for files given on the GHCi command line
   -- When in -e mode, if the load fails then we want to stop
   -- immediately rather than going on to evaluate the expression.
   when (not (null paths)) $ do
-     ok <- ghciHandle (\e -> do showException e; return Failed) $ 
-               loadModule paths
-     when (isJust maybe_expr && failed ok) $
-       io (exitWith (ExitFailure 1))
+     ok <- ghciHandle (\e -> do showException e; return Failed) $
+                loadModule paths
+     when (isJust maybe_exprs && failed ok) $
+        io (exitWith (ExitFailure 1))
 
   -- if verbosity is greater than 0, or we are connected to a
   -- terminal, display the prompt in the interactive loop.
@@ -372,7 +401,7 @@ runGHCi paths maybe_expr = do
   dflags <- getDynFlags
   let show_prompt = verbosity dflags > 0 || is_tty
 
-  case maybe_expr of
+  case maybe_exprs of
         Nothing ->
           do
 #if defined(mingw32_HOST_OS)
@@ -388,15 +417,25 @@ runGHCi paths maybe_expr = do
 #endif
             -- enter the interactive loop
             interactiveLoop is_tty show_prompt
-        Just expr -> do
+        Just exprs -> do
             -- just evaluate the expression we were given
-            runCommandEval expr
-            return ()
+            enqueueCommands exprs
+            let handle e = do st <- getGHCiState
+                                   -- Jump through some hoops to get the
+                                   -- current progname in the exception text:
+                                   -- <progname>: <exception>
+                              io $ withProgName (progname st)
+                                   -- The "fast exit" part just calls exit()
+                                   -- directly instead of doing an orderly
+                                   -- runtime shutdown, otherwise the main
+                                   -- GHCi thread will complain about being
+                                   -- interrupted.
+                                 $ topHandlerFastExit e
+            runCommands' handle (return Nothing)
 
   -- and finally, exit
   io $ do when (verbosity dflags > 0) $ putStrLn "Leaving GHCi."
 
-
 interactiveLoop :: Bool -> Bool -> GHCi ()
 interactiveLoop is_tty show_prompt =
   -- Ignore ^C exceptions caught here
@@ -567,14 +606,18 @@ queryQueue = do
                return (Just c)
 
 runCommands :: GHCi (Maybe String) -> GHCi ()
-runCommands getCmd = do
+runCommands = runCommands' handler
+
+runCommands' :: (Exception -> GHCi Bool) -- Exception handler
+             -> GHCi (Maybe String) -> GHCi ()
+runCommands' eh getCmd = do
   mb_cmd <- noSpace queryQueue
   mb_cmd <- maybe (noSpace getCmd) (return . Just) mb_cmd
   case mb_cmd of 
     Nothing -> return ()
     Just c  -> do
-      b <- ghciHandle handler (doCommand c)
-      if b then return () else runCommands getCmd
+      b <- ghciHandle eh (doCommand c)
+      if b then return () else runCommands' eh getCmd
   where
     noSpace q = q >>= maybe (return Nothing)
                             (\c->case removeSpaces c of 
@@ -615,24 +658,6 @@ enqueueCommands cmds = do
   setGHCiState st{ cmdqueue = cmds ++ cmdqueue st }
 
 
--- This version is for the GHC command-line option -e.  The only difference
--- from runCommand is that it catches the ExitException exception and
--- exits, rather than printing out the exception.
-runCommandEval :: String -> GHCi Bool
-runCommandEval c = ghciHandle handleEval (doCommand c)
-  where 
-    handleEval (ExitException code) = io (exitWith code)
-    handleEval e                    = do handler e
-                                        io (exitWith (ExitFailure 1))
-
-    doCommand (':' : command) = specialCommand command
-    doCommand stmt
-       = do r <- runStmt stmt GHC.RunToCompletion
-           case r of 
-               False -> io (exitWith (ExitFailure 1))
-                 -- failure to run the command causes exit(1) for ghc -e.
-               _       -> return True
-
 runStmt :: String -> SingleStep -> GHCi Bool
 runStmt stmt step
  | null (filter (not.isSpace) stmt) = return False
@@ -830,9 +855,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
@@ -936,7 +974,7 @@ defineMacro overwrite s = do
   case maybe_hv of
      Nothing -> return ()
      Just hv -> io (writeIORef macros_ref --
-                   (filtered ++ [(macro_name, runMacro hv, False, completeNone)]))
+                   (filtered ++ [(macro_name, runMacro hv, Nothing, completeNone)]))
 
 runMacro :: GHC.HValue{-String -> IO String-} -> String -> GHCi Bool
 runMacro fun s = do
@@ -1377,27 +1415,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 <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 }
 
-setProg [prog] = do
+setProg prog = do
   st <- getGHCiState
   setGHCiState st{ progname = prog }
-setProg _ = do
-  io (hPutStrLn stderr "syntax: :set prog <progname>")
 
 setEditor cmd = do
   st <- getGHCiState
@@ -1619,23 +1662,24 @@ completeWord w start end = do
      ':':_ | all isSpace (take (start-1) line) -> wrapCompleter completeCmd w
      _other
        | ((':':c) : _) <- line_words -> do
-          maybe_cmd <- lookupCommand' c
-           let (n,w') = selectWord (words' 0 line)
-          case maybe_cmd of
-            Nothing -> return Nothing
-            Just (_,_,False,complete) -> wrapCompleter complete w
-            Just (_,_,True,complete) -> let complete' w = do rets <- complete w
-                                                              return (map (drop n) rets)
-                                         in wrapCompleter complete' w'
+           completionVars <- lookupCompletionVars c
+          case completionVars of
+            (Nothing,complete) -> wrapCompleter complete w
+            (Just breakChars,complete) 
+                    -> let (n,w') = selectWord 
+                                        (words' (`elem` breakChars) 0 line)
+                           complete' w = do rets <- complete w
+                                            return (map (drop n) rets)
+                       in wrapCompleter complete' w'
         | ("import" : _) <- line_words ->
                 wrapCompleter completeModule w
        | otherwise     -> do
                --printf "complete %s, start = %d, end = %d\n" w start end
                wrapCompleter completeIdentifier w
-    where words' _ [] = []
-          words' n str = let (w,r) = break isSpace str
-                             (s,r') = span isSpace r
-                         in (n,w):words' (n+length w+length s) r'
+    where words' _ _ [] = []
+          words' isBreak n str = let (w,r) = break isBreak str
+                                     (s,r') = span isBreak r
+                                 in (n,w):words' isBreak (n+length w+length s) r'
           -- In a Haskell expression we want to parse 'a-b' as three words
           -- where a compiler flag (ie. -fno-monomorphism-restriction) should
           -- only be a single word.
@@ -1643,6 +1687,16 @@ completeWord w start end = do
           selectWord ((offset,x):xs)
               | offset+length x >= start = (start-offset,take (end-offset) x)
               | otherwise = selectWord xs
+          
+          lookupCompletionVars ('!':_) = return (Just filenameWordBreakChars,
+                                            completeFilename)
+          lookupCompletionVars c = do
+              maybe_cmd <- lookupCommand' c
+              case maybe_cmd of
+                  Just (_,_,ws,f) -> return (ws,f)
+                  Nothing -> return (Just filenameWordBreakChars,
+                                        completeFilename)
+
 
 completeCmd :: String -> IO [String]
 completeCmd w = do
@@ -1675,7 +1729,18 @@ completeSetOptions w = do
   return (filter (w `isPrefixOf`) options)
     where options = "args":"prog":allFlags
 
-completeFilename = Readline.filenameCompletionFunction
+completeFilename w = do
+    ws <- Readline.filenameCompletionFunction w
+    case ws of
+        -- If we only found one result, and it's a directory, 
+        -- add a trailing slash.
+        [file] -> do
+                isDir <- expandPathIO file >>= doesDirectoryExist
+                if isDir && last file /= '/'
+                    then return [file ++ "/"]
+                    else return [file]
+        _ -> return ws
+                
 
 completeHomeModuleOrFile = unionComplete completeHomeModule completeFilename
 
@@ -1689,8 +1754,10 @@ wrapCompleter :: (String -> IO [String]) -> String -> IO (Maybe (String,[String]
 wrapCompleter fun w =  do
   strs <- fun w
   case strs of
-    []  -> return Nothing
-    [x] -> return (Just (x,[]))
+    []  -> Readline.setAttemptedCompletionOver True >> return Nothing
+    [x] -> -- Add a trailing space, unless it already has an appended slash.
+           let appended = if last x == '/' then x else x ++ " "
+           in return (Just (appended,[]))
     xs  -> case getCommonPrefix xs of
                ""   -> return (Just ("",xs))
                pref -> return (Just (pref,xs))
@@ -1771,10 +1838,13 @@ ghciUnblock (GHCi a) = GHCi $ \s -> Exception.unblock (a s)
 -- Utils
 
 expandPath :: String -> GHCi String
-expandPath path = 
+expandPath path = io (expandPathIO path)
+
+expandPathIO :: String -> IO String
+expandPathIO path = 
   case dropWhile isSpace path of
    ('~':d) -> do
-       tilde <- io getHomeDirectory -- will fail if HOME not defined
+       tilde <- getHomeDirectory -- will fail if HOME not defined
        return (tilde ++ '/':d)
    other -> 
        return other
@@ -1912,15 +1982,19 @@ historyCmd arg
       (r:_) -> do
         let hist = GHC.resumeHistory r
             (took,rest) = splitAt num hist
-        spans <- mapM (io . GHC.getHistorySpan s) took
-        let nums  = map (printf "-%-3d:") [(1::Int)..]
-        let names = map GHC.historyEnclosingDecl took
-        printForUser (vcat(zipWith3 
-                             (\x y z -> x <+> y <+> z) 
-                             (map text nums) 
-                             (map (bold . ppr) names)
-                             (map (parens . ppr) spans)))
-        io $ putStrLn $ if null rest then "<end of history>" else "..."
+        case hist of
+          [] -> io $ putStrLn $ 
+                   "Empty history. Perhaps you forgot to use :trace?"
+          _  -> do
+                 spans <- mapM (io . GHC.getHistorySpan s) took
+                 let nums  = map (printf "-%-3d:") [(1::Int)..]
+                     names = map GHC.historyEnclosingDecl took
+                 printForUser (vcat(zipWith3 
+                                 (\x y z -> x <+> y <+> z) 
+                                 (map text nums) 
+                                 (map (bold . ppr) names)
+                                 (map (parens . ppr) spans)))
+                 io $ putStrLn $ if null rest then "<end of history>" else "..."
 
 bold :: SDoc -> SDoc
 bold c | do_bold   = text start_bold <> c <> text end_bold
@@ -2087,9 +2161,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 ()