diff options
author | Roland Senn <rsx@bluewin.ch> | 2019-04-14 14:21:40 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-05-10 16:32:38 -0400 |
commit | c7913f71bc8ed8910c829a84b78d2f56b05f0473 (patch) | |
tree | 9132f648948d7e2423fdd1fb9c7fe203c1786b6b | |
parent | 5eb9445444c4099fc9ee0803ba45db390900a80f (diff) | |
download | haskell-c7913f71bc8ed8910c829a84b78d2f56b05f0473.tar.gz |
Fix bugs and documentation for #13456
-rw-r--r-- | docs/users_guide/ghci.rst | 5 | ||||
-rw-r--r-- | ghc/GHCi/UI.hs | 66 | ||||
-rw-r--r-- | testsuite/tests/ghci/scripts/T8113.script | 2 | ||||
-rw-r--r-- | testsuite/tests/ghci/scripts/ghci005.stdout | 2 | ||||
-rw-r--r-- | testsuite/tests/ghci/should_run/T13456.script | 13 | ||||
-rw-r--r-- | testsuite/tests/ghci/should_run/T13456.stdout | 11 | ||||
-rw-r--r-- | testsuite/tests/ghci/should_run/all.T | 1 |
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']) |