X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=8cc15132a808e9eb1ec9413f9217f3b231e791e1;hb=5109078b26bdbf226acdf1b0fe7c2861a7114571;hp=f792acca5e24d9720bc1bb76c6d7547264342154;hpb=037aa382bad090cf5d39fbfdf00a6634be69ddc4;p=ghc-hetmet.git

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index f792acc..8cc1513 100644
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -97,8 +97,6 @@ ghciWelcomeMsg :: String
 ghciWelcomeMsg = "GHCi, version " ++ cProjectVersion ++
                  ": http://www.haskell.org/ghc/  :? for help"
 
-type Command = (String, String -> GHCi Bool, Bool, String -> IO [String])
-
 cmdName :: Command -> String
 cmdName (n,_,_,_) = n
 
@@ -165,10 +163,11 @@ helpText =
  " Commands available from the prompt:\n" ++
  "\n" ++
  "   <statement>                 evaluate/run <statement>\n" ++
+ "   :                           repeat last command\n" ++
  "   :{\\n ..lines.. \\n:}\\n       multiline command\n" ++
  "   :add <filename> ...         add module(s) to the current target set\n" ++
- "   :browse[!] [-s] [[*]<mod>]  display the names defined by module <mod>\n" ++
- "                               (!: more details; -s: sort; *: all top-level names)\n" ++
+ "   :browse[!] [[*]<mod>]       display the names defined by module <mod>\n" ++
+ "                               (!: more details; *: all top-level names)\n" ++
  "   :cd <dir>                   change directory to <dir>\n" ++
  "   :cmd <expr>                 run the commands returned by <expr>::IO String\n" ++
  "   :ctags [<file>]             create tags file for Vi (default: \"tags\")\n" ++
@@ -314,6 +313,7 @@ interactiveUI session srcs maybe_expr = do
                    break_ctr = 0,
                    breaks = [],
                    tickarrays = emptyModuleEnv,
+                   last_command = Nothing,
                    cmdqueue = [],
                    remembered_ctx = Nothing
                  }
@@ -711,29 +711,48 @@ printTypeOfName session n
             Just thing -> printTyThing thing
 
 
-
+data MaybeCommand = GotCommand Command | BadCommand | NoLastCommand
 
 specialCommand :: String -> GHCi Bool
 specialCommand ('!':str) = shellEscape (dropWhile isSpace str)
 specialCommand str = do
   let (cmd,rest) = break isSpace str
-  maybe_cmd <- io (lookupCommand cmd)
+  maybe_cmd <- lookupCommand cmd
   case maybe_cmd of
-    Nothing -> io (hPutStr stdout ("unknown command ':" ++ cmd ++ "'\n" 
-		                    ++ shortHelpText) >> return False)
-    Just (_,f,_,_) -> f (dropWhile isSpace rest)
-
-lookupCommand :: String -> IO (Maybe Command)
+    GotCommand (_,f,_,_) -> f (dropWhile isSpace rest)
+    BadCommand ->
+      do io $ hPutStr stdout ("unknown command ':" ++ cmd ++ "'\n"
+                           ++ shortHelpText)
+         return False
+    NoLastCommand ->
+      do io $ hPutStr stdout ("there is no last command to perform\n"
+                           ++ shortHelpText)
+         return False
+
+lookupCommand :: String -> GHCi (MaybeCommand)
+lookupCommand "" = do
+  st <- getGHCiState
+  case last_command st of
+      Just c -> return $ GotCommand c
+      Nothing -> return NoLastCommand
 lookupCommand str = do
+  mc <- io $ lookupCommand' str
+  st <- getGHCiState
+  setGHCiState st{ last_command = mc }
+  return $ case mc of
+           Just c -> GotCommand c
+           Nothing -> BadCommand
+
+lookupCommand' :: String -> IO (Maybe Command)
+lookupCommand' str = do
   macros <- readIORef macros_ref
   let cmds = builtin_commands ++ macros
   -- look for exact match first, then the first prefix match
-  case [ c | c <- cmds, str == cmdName c ] of
-     c:_ -> return (Just c)
-     [] -> case [ c | c@(s,_,_,_) <- cmds, str `isPrefixOf` s ] of
-     		[] -> return Nothing
-     		c:_ -> return (Just c)
-
+  return $ case [ c | c <- cmds, str == cmdName c ] of
+           c:_ -> Just c
+           [] -> case [ c | c@(s,_,_,_) <- cmds, str `isPrefixOf` s ] of
+                 [] -> Nothing
+                 c:_ -> Just c
 
 getCurrentBreakSpan :: GHCi (Maybe SrcSpan)
 getCurrentBreakSpan = do
@@ -827,6 +846,12 @@ addModule files = do
   afterLoad ok session False prev_context
 
 changeDirectory :: String -> GHCi ()
+changeDirectory "" = do
+  -- :cd on its own changes to the user's home directory
+  either_dir <- io (IO.try getHomeDirectory)
+  case either_dir of
+     Left _e -> return ()
+     Right dir -> changeDirectory dir
 changeDirectory dir = do
   session <- getSession
   graph <- io (GHC.getModuleGraph session)
@@ -1171,15 +1196,19 @@ browseCmd bang m =
 browseModule :: Bool -> Module -> Bool -> GHCi ()
 browseModule bang modl exports_only = do
   s <- getSession
+  -- :browse! reports qualifiers wrt current context
+  current_unqual <- io (GHC.getPrintUnqual s)
   -- Temporarily set the context to the module we're interested in,
   -- just so we can get an appropriate PrintUnqualified
   (as,bs) <- io (GHC.getContext s)
   prel_mod <- getPrelude
   io (if exports_only then GHC.setContext s [] [prel_mod,modl]
                       else GHC.setContext s [modl] [])
-  unqual <- io (GHC.getPrintUnqual s)
+  target_unqual <- io (GHC.getPrintUnqual s)
   io (GHC.setContext s as bs)
 
+  let unqual = if bang then current_unqual else target_unqual
+
   mb_mod_info <- io $ GHC.getModuleInfo s modl
   case mb_mod_info of
     Nothing -> throwDyn (CmdLineError ("unknown module: " ++
@@ -1220,7 +1249,7 @@ browseModule bang modl exports_only = do
             labels  [] = text "-- not currently imported"
             labels  l  = text $ intercalate "\n" $ map qualifier l
             qualifier  = maybe "-- defined locally" 
-                             (("-- imported from "++) . intercalate ", " 
+                             (("-- imported via "++) . intercalate ", " 
                                . map GHC.moduleNameString)
             importInfo = RdrName.getGRE_NameQualifier_maybes rdr_env
             modNames   = map (importInfo . GHC.getName) things
@@ -1590,7 +1619,7 @@ completeWord w start end = do
      ':':_ | all isSpace (take (start-1) line) -> wrapCompleter completeCmd w
      _other
 	| ((':':c) : _) <- line_words -> do
-	   maybe_cmd <- lookupCommand c
+	   maybe_cmd <- lookupCommand' c
            let (n,w') = selectWord (words' 0 line)
 	   case maybe_cmd of
 	     Nothing -> return Nothing