add :cmd

[ghc-hetmet.git] / compiler / ghci / InteractiveUI.hs

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index 6d0a870..4fb9269 100644 (file)
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -110,6 +110,7 @@ builtin_commands = [
   ("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, completeIdentifier),
   ("delete",    keepGoing deleteCmd,            False, completeNone),
@@ -154,6 +155,7 @@ helpText =
  "   :add <filename> ...         add module(s) to the current target set\n" ++
  "   :browse [*]<module>         display the names defined by <module>\n" ++
  "   :cd <dir>                   change directory to <dir>\n" ++
+ "   :cmd <expr>                 run the commands returned by <expr>::IO String"++
  "   :ctags [<file>]             create tags file for Vi (default: \"tags\")\n" ++
  "   :def <cmd> <expr>           define a command :<cmd>\n" ++
  "   :edit <file>                edit file\n" ++
@@ -570,12 +572,12 @@ afterRunStmt run_result = do
      GHC.RunOk names -> do
         show_types <- isOptionSet ShowType
         when show_types $ mapM_ (showTypeOfName session) names
-     GHC.RunBreak _ names info -> do
+     GHC.RunBreak _ names mb_info -> do
         resumes <- io $ GHC.getResumeContext session
         printForUser $ ptext SLIT("Stopped at") <+> 
                        ppr (GHC.resumeSpan (head resumes))
         mapM_ (showTypeOfName session) names
-        runBreakCmd info
+        maybe (return ()) runBreakCmd mb_info
         -- run the command set with ":set stop <cmd>"
         st <- getGHCiState
         enqueueCommands [stop st]
@@ -782,6 +784,17 @@ undefineMacro macro_name = do
        else do
   io (writeIORef commands (filter ((/= macro_name) . cmdName) cmds))
 
+cmdCmd :: String -> GHCi ()
+cmdCmd str = do
+  let expr = '(' : str ++ ") :: IO String"
+  session <- getSession
+  maybe_hv <- io (GHC.compileExpr session expr)
+  case maybe_hv of
+    Nothing -> return ()
+    Just hv -> do 
+        cmds <- io $ (unsafeCoerce# hv :: IO String)
+        enqueueCommands (lines cmds)
+        return ()
 
 loadModule :: [(FilePath, Maybe Phase)] -> GHCi SuccessFlag
 loadModule fs = timeIt (loadModule' fs)
@@ -1695,7 +1708,8 @@ listCmd "" = do
    mb_span <- getCurrentBreakSpan
    case mb_span of
       Nothing  -> printForUser $ text "not stopped at a breakpoint; nothing to list"
-      Just span -> io $ listAround span True
+      Just span | GHC.isGoodSrcSpan span -> io $ listAround span True
+                | otherwise              -> printForUser $ text "unable to list source for" <+> ppr span
 listCmd str = list2 (words str)
 
 list2 [arg] | all isDigit arg = do