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),
   ("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),
   ("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" ++
  "   :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" ++
  "   :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.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
         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]
         -- 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))
 
        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)
 
 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"
    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
 listCmd str = list2 (words str)
 
 list2 [arg] | all isDigit arg = do