Fix bugs and documentation for #13456

7 files changed, 68 insertions, 32 deletions

diff --git a/docs/users_guide/ghci.rst b/docs/users_guide/ghci.rst
index e0523161ea..d320419f3d 100644
--- a/docs/users_guide/ghci.rst
+++ b/docs/users_guide/ghci.rst
@@ -2366,7 +2366,10 @@ commonly used commands.
     Typing ``:def`` on its own lists the currently-defined macros.
     Attempting to redefine an existing command name results in an error
     unless the ``:def!`` form is used, in which case the old command
-    with that name is silently overwritten.
+    with that name is silently overwritten. However for builtin commands
+    the old command can still be used by preceeding the command name with
+    a double colon (eg ``::load``).
+    It's not possible to redefine the commands ``:{``, ``:}`` and ``:!``.
 
 .. ghci-cmd:: :delete; * | ⟨num⟩ ...
 
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index aeb8067bcc..da288c5e1e 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -1618,8 +1618,11 @@ chooseEditFile =
 -- :def
 
 defineMacro :: GhciMonad m => Bool{-overwrite-} -> String -> m ()
-defineMacro _ (':':_) =
-  liftIO $ putStrLn "macro name cannot start with a colon"
+defineMacro _ (':':_) = liftIO $ putStrLn
+                          "macro name cannot start with a colon"
+defineMacro _ ('!':_) = liftIO $ putStrLn
+                          "macro name cannot start with an exclamation mark"
+                          -- little code duplication allows to grep error msg
 defineMacro overwrite s = do
   let (macro_name, definition) = break isSpace s
   macros <- ghci_macros <$> getGHCiState
@@ -1629,33 +1632,38 @@ defineMacro overwrite s = do
                 then liftIO $ putStrLn "no macros defined"
                 else liftIO $ putStr ("the following macros are defined:\n" ++
                                       unlines defined)
-        else do
-  if (not overwrite && macro_name `elem` defined)
-        then throwGhcException (CmdLineError
-                ("macro '" ++ macro_name ++ "' is already defined"))
-        else do
-
-  -- compile the expression
-  handleSourceError GHC.printException $ do
-    step <- getGhciStepIO
-    expr <- GHC.parseExpr definition
-    -- > ghciStepIO . definition :: String -> IO String
-    let stringTy = nlHsTyVar stringTy_RDR
-        ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy
-        body = nlHsVar compose_RDR `mkHsApp` (nlHsPar step)
-                                   `mkHsApp` (nlHsPar expr)
-        tySig = mkLHsSigWcType (stringTy `nlHsFunTy` ioM)
-        new_expr = L (getLoc expr) $ ExprWithTySig noExt body tySig
-    hv <- GHC.compileParsedExprRemote new_expr
-
-    let newCmd = Command { cmdName = macro_name
-                         , cmdAction = lift . runMacro hv
-                         , cmdHidden = False
-                         , cmdCompletionFunc = noCompletion
-                         }
-
-    -- later defined macros have precedence
-    modifyGHCiState $ \s ->
+  else do
+    isCommand <- isJust <$> lookupCommand' macro_name
+    let check_newname
+          | macro_name `elem` defined = throwGhcException (CmdLineError
+            ("macro '" ++ macro_name ++ "' is already defined. " ++ hint))
+          | isCommand = throwGhcException (CmdLineError
+            ("macro '" ++ macro_name ++ "' overwrites builtin command. " ++ hint))
+          | otherwise = return ()
+        hint = " Use ':def!' to overwrite."
+
+    unless overwrite check_newname
+    -- compile the expression
+    handleSourceError GHC.printException $ do
+      step <- getGhciStepIO
+      expr <- GHC.parseExpr definition
+      -- > ghciStepIO . definition :: String -> IO String
+      let stringTy = nlHsTyVar stringTy_RDR
+          ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy
+          body = nlHsVar compose_RDR `mkHsApp` (nlHsPar step)
+                                     `mkHsApp` (nlHsPar expr)
+          tySig = mkLHsSigWcType (stringTy `nlHsFunTy` ioM)
+          new_expr = L (getLoc expr) $ ExprWithTySig noExt body tySig
+      hv <- GHC.compileParsedExprRemote new_expr
+
+      let newCmd = Command { cmdName = macro_name
+                           , cmdAction = lift . runMacro hv
+                           , cmdHidden = False
+                           , cmdCompletionFunc = noCompletion
+                           }
+
+      -- later defined macros have precedence
+      modifyGHCiState $ \s ->
         let filtered = [ cmd | cmd <- macros, cmdName cmd /= macro_name ]
         in s { ghci_macros = newCmd : filtered }
 
diff --git a/testsuite/tests/ghci/scripts/T8113.script b/testsuite/tests/ghci/scripts/T8113.script
index 9392c23c41..0def091061 100644
--- a/testsuite/tests/ghci/scripts/T8113.script
+++ b/testsuite/tests/ghci/scripts/T8113.script
@@ -1,4 +1,4 @@
-:def type (\e -> putStrLn ("called :type for "++show e++" (ignoring)") >> return "")
+:def! type (\e -> putStrLn ("called :type for "++show e++" (ignoring)") >> return "")
 :def
 :t ()
 :ty True
diff --git a/testsuite/tests/ghci/scripts/ghci005.stdout b/testsuite/tests/ghci/scripts/ghci005.stdout
index e94f822e46..1c65dcbd03 100644
--- a/testsuite/tests/ghci/scripts/ghci005.stdout
+++ b/testsuite/tests/ghci/scripts/ghci005.stdout
@@ -3,7 +3,7 @@ the following macros are defined:
 echo
 hello, world!
 hello, world!
-macro 'echo' is already defined
+macro 'echo' is already defined.  Use ':def!' to overwrite.
 HELLO, WORLD!
 hello, world!
 macro 'f' is not defined
diff --git a/testsuite/tests/ghci/should_run/T13456.script b/testsuite/tests/ghci/should_run/T13456.script
new file mode 100644
index 0000000000..39385312f4
--- /dev/null
+++ b/testsuite/tests/ghci/should_run/T13456.script
@@ -0,0 +1,13 @@
+let macro _ = putStrLn "I'm a macro" >> return ""
+:def ! macro
+:def type macro
+:def ty macro
+:def! type macro
+:type macro
+:t macro
+::t macro
+::type macro
+:def test macro
+:def test macro
+:def! test macro
+:def
diff --git a/testsuite/tests/ghci/should_run/T13456.stdout b/testsuite/tests/ghci/should_run/T13456.stdout
new file mode 100644
index 0000000000..8bfc0283fd
--- /dev/null
+++ b/testsuite/tests/ghci/should_run/T13456.stdout
@@ -0,0 +1,11 @@
+macro name cannot start with an exclamation mark
+macro 'type' overwrites builtin command.  Use ':def!' to overwrite.
+macro 'ty' overwrites builtin command.  Use ':def!' to overwrite.
+I'm a macro
+I'm a macro
+macro :: p -> IO [Char]
+macro :: p -> IO [Char]
+macro 'test' is already defined.  Use ':def!' to overwrite.
+the following macros are defined:
+test
+type
diff --git a/testsuite/tests/ghci/should_run/all.T b/testsuite/tests/ghci/should_run/all.T
index 934360b0d5..3335ad7ef2 100644
--- a/testsuite/tests/ghci/should_run/all.T
+++ b/testsuite/tests/ghci/should_run/all.T
@@ -32,6 +32,7 @@ test('T12128',     just_ghci, ghci_script, ['T12128.script'])
 test('T12456',     just_ghci, ghci_script, ['T12456.script'])
 test('T12525',     just_ghci, ghci_script, ['T12525.script'])
 test('T12549',     just_ghci, ghci_script, ['T12549.script'])
+test('T13456',     [just_ghci, combined_output], ghci_script, ['T13456.script'])
 test('BinaryArray', normal, compile_and_run, [''])
 test('T14125a',    just_ghci, ghci_script, ['T14125a.script'])
 test('T13825-ghci',just_ghci, ghci_script, ['T13825-ghci.script'])