FIX #1765, #1766

- :def! now overwrites a previous command with the same name
- :def on its own lists the defined macros
- ":undef f g" undefines both f and g

2 files changed, 57 insertions, 45 deletions

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index 045cf63d5f..83b5966089 100644
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -103,8 +103,8 @@ type Command = (String, String -> GHCi Bool, Bool, String -> IO [String])
 cmdName :: Command -> String
 cmdName (n,_,_,_) = n
 
-commands :: IORef [Command]
-GLOBAL_VAR(commands, builtin_commands, [Command])
+macros_ref :: IORef [Command]
+GLOBAL_VAR(macros_ref, [], [Command])
 
 builtin_commands :: [Command]
 builtin_commands = [
@@ -121,7 +121,8 @@ builtin_commands = [
   ("continue",  keepGoing continueCmd,          False, completeNone),
   ("cmd",       keepGoing cmdCmd,               False, completeIdentifier),
   ("ctags",	keepGoing createCTagsFileCmd, 	False, completeFilename),
-  ("def",	keepGoing defineMacro,		False, completeIdentifier),
+  ("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),
@@ -699,7 +700,8 @@ specialCommand str = do
 
 lookupCommand :: String -> IO (Maybe Command)
 lookupCommand str = do
-  cmds <- readIORef commands
+  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)
@@ -854,18 +856,24 @@ chooseEditFile =
   where fromTarget (GHC.Target (GHC.TargetFile f _) _) = Just f
         fromTarget _ = Nothing -- when would we get a module target?
 
-defineMacro :: String -> GHCi ()
-defineMacro s = do
+defineMacro :: Bool{-overwrite-} -> String -> GHCi ()
+defineMacro overwrite s = do
   let (macro_name, definition) = break isSpace s
-  cmds <- io (readIORef commands)
+  macros <- io (readIORef macros_ref)
+  let defined = map cmdName macros
   if (null macro_name) 
-	then throwDyn (CmdLineError "invalid macro name") 
+	then if null defined
+                then io $ putStrLn "no macros defined"
+                else io $ putStr ("the following macros are defined:\n" ++
+                                  unlines defined)
 	else do
-  if (macro_name `elem` map cmdName cmds)
+  if (not overwrite && macro_name `elem` defined)
 	then throwDyn (CmdLineError 
-		("command '" ++ macro_name ++ "' is already defined"))
+		("macro '" ++ macro_name ++ "' is already defined"))
 	else do
 
+  let filtered = [ cmd | cmd <- macros, cmdName cmd /= macro_name ]
+
   -- give the expression a type signature, so we can be sure we're getting
   -- something of the right type.
   let new_expr = '(' : definition ++ ") :: String -> IO String"
@@ -875,8 +883,8 @@ defineMacro s = do
   maybe_hv <- io (GHC.compileExpr cms new_expr)
   case maybe_hv of
      Nothing -> return ()
-     Just hv -> io (writeIORef commands --
-		    (cmds ++ [(macro_name, runMacro hv, False, completeNone)]))
+     Just hv -> io (writeIORef macros_ref --
+		    (filtered ++ [(macro_name, runMacro hv, False, completeNone)]))
 
 runMacro :: GHC.HValue{-String -> IO String-} -> String -> GHCi Bool
 runMacro fun s = do
@@ -885,17 +893,14 @@ runMacro fun s = do
   return False
 
 undefineMacro :: String -> GHCi ()
-undefineMacro macro_name = do
-  cmds <- io (readIORef commands)
-  if (macro_name `elem` map cmdName builtin_commands) 
-	then throwDyn (CmdLineError
-		("command '" ++ macro_name ++ "' cannot be undefined"))
-	else do
-  if (macro_name `notElem` map cmdName cmds) 
-	then throwDyn (CmdLineError 
-		("command '" ++ macro_name ++ "' not defined"))
-	else do
-  io (writeIORef commands (filter ((/= macro_name) . cmdName) cmds))
+undefineMacro str = mapM_ undef (words str) 
+ where undef macro_name = do
+        cmds <- io (readIORef macros_ref)
+        if (macro_name `notElem` map cmdName cmds) 
+      	   then throwDyn (CmdLineError 
+      		("macro '" ++ macro_name ++ "' is not defined"))
+      	   else do
+            io (writeIORef macros_ref (filter ((/= macro_name) . cmdName) cmds))
 
 cmdCmd :: String -> GHCi ()
 cmdCmd str = do
@@ -1533,13 +1538,13 @@ completeWord w start end = do
 
 completeCmd :: String -> IO [String]
 completeCmd w = do
-  cmds <- readIORef commands
-  return (filter (w `isPrefixOf`) (map (':':) (map cmdName cmds)))
+  cmds <- readIORef macros_ref
+  return (filter (w `isPrefixOf`) (map (':':) 
+             (map cmdName (builtin_commands ++ cmds))))
 
 completeMacro w = do
-  cmds <- readIORef commands
-  let cmds' = [ cmd | cmd <- map cmdName cmds, cmd `elem` map cmdName builtin_commands ]
-  return (filter (w `isPrefixOf`) cmds')
+  cmds <- readIORef macros_ref
+  return (filter (w `isPrefixOf`) (map cmdName cmds))
 
 completeIdentifier w = do
   s <- restoreSession
diff --git a/docs/users_guide/ghci.xml b/docs/users_guide/ghci.xml
index 28e9972b24..b092953b36 100644
--- a/docs/users_guide/ghci.xml
+++ b/docs/users_guide/ghci.xml
@@ -1817,26 +1817,27 @@ $ ghci -lm
 
       <varlistentry>
 	<term>
-          <literal>:def</literal> <replaceable>name</replaceable> <replaceable>expr</replaceable>
+          <literal>:def<optional>!</optional> <optional><replaceable>name</replaceable> <replaceable>expr</replaceable></optional></literal>
           <indexterm><primary><literal>:def</literal></primary></indexterm>
         </term>
 	<listitem>
-	  <para>The command <literal>:def</literal>
-	  <replaceable>name</replaceable>
-	  <replaceable>expr</replaceable> defines a new GHCi command
-	  <literal>:<replaceable>name</replaceable></literal>,
-	  implemented by the Haskell expression
-	  <replaceable>expr</replaceable>, which must have type
-	  <literal>String -> IO String</literal>.  When
-	  <literal>:<replaceable>name</replaceable>
-	  <replaceable>args</replaceable></literal> is typed at the
-	  prompt, GHCi will run the expression
-	  <literal>(<replaceable>name</replaceable>
-	  <replaceable>args</replaceable>)</literal>, take the
-	  resulting <literal>String</literal>, and feed it back into
-	  GHCi as a new sequence of commands.  Separate commands in
-	  the result must be separated by
-	  &lsquo;<literal>\n</literal>&rsquo;.</para>
+          <para><literal>:def</literal> is used to define new
+          commands, or macros, in GHCi.  The command
+          <literal>:def</literal> <replaceable>name</replaceable>
+          <replaceable>expr</replaceable> defines a new GHCi command
+          <literal>:<replaceable>name</replaceable></literal>,
+          implemented by the Haskell expression
+          <replaceable>expr</replaceable>, which must have type
+          <literal>String -> IO String</literal>.  When
+          <literal>:<replaceable>name</replaceable>
+          <replaceable>args</replaceable></literal> is typed at the
+          prompt, GHCi will run the expression
+          <literal>(<replaceable>name</replaceable>
+          <replaceable>args</replaceable>)</literal>, take the
+          resulting <literal>String</literal>, and feed it back into
+          GHCi as a new sequence of commands.  Separate commands in
+          the result must be separated by
+          &lsquo;<literal>\n</literal>&rsquo;.</para>
 
 	  <para>That's all a little confusing, so here's a few
 	  examples.  To start with, here's a new GHCi command which
@@ -1880,6 +1881,12 @@ Prelude> :. cmds.ghci
           <literal>:.</literal>, by analogy with the
           &lsquo;<literal>.</literal>&rsquo; Unix shell command that
           does the same thing.</para>
+
+          <para>Typing <literal>:def</literal> on its own lists the
+          currently-defined macros.  Attempting to redefine an
+          existing command name results in an error unless the
+          <literal>:def!</literal> form is used, in which case the old
+          command with that name is silently overwritten.</para>
 	</listitem>
       </varlistentry>