X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=ca4a20e4ebf95ac86621a1abf241976692652eeb;hb=41d215c848a9334107519605e01ad371248a5e92;hp=598341ad4c071bed3b87ecb340733788e16a769b;hpb=6fb850636267af7a0a52322c0a670963034ae784;p=ghc-hetmet.git

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index 598341a..ca4a20e 100644
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -11,12 +11,13 @@ module InteractiveUI ( interactiveUI, ghciWelcomeMsg ) where
 
 #include "HsVersions.h"
 
-import GhciMonad
+import qualified GhciMonad
+import GhciMonad hiding (runStmt)
 import GhciTags
 import Debugger
 
 -- The GHC interface
-import qualified GHC
+import qualified GHC hiding (resume, runStmt)
 import GHC              ( Session, LoadHowMuch(..), Target(..),  TargetId(..),
                           Module, ModuleName, TyThing(..), Phase,
                           BreakIndex, SrcSpan, Resume, SingleStep )
@@ -228,6 +229,9 @@ helpText =
  "   :force <expr>               print <expr>, forcing unevaluated parts\n" ++
  "   :forward                    go forward in the history (after :back)\n" ++
  "   :history [<n>]              after :trace, show the execution history\n" ++
+ "   :list                       show the source code around current breakpoint\n" ++
+ "   :list identifier            show the source code for <identifier>\n" ++
+ "   :list [<module>] <line>     show the source code around line number <line>\n" ++
  "   :print [<name> ...]         prints a value without forcing its computation\n" ++
  "   :sprint [<name> ...]        simplifed version of :print\n" ++
  "   :step                       single-step after stopping at a breakpoint\n"++
@@ -335,6 +339,8 @@ interactiveUI session srcs maybe_exprs = do
 
    default_editor <- findEditor
 
+   cwd <- getCurrentDirectory
+
    startGHCi (runGHCi srcs maybe_exprs)
         GHCiState{ progname = "<interactive>",
                    args = [],
@@ -349,7 +355,8 @@ interactiveUI session srcs maybe_exprs = do
                    tickarrays = emptyModuleEnv,
                    last_command = Nothing,
                    cmdqueue = [],
-                   remembered_ctx = []
+                   remembered_ctx = [],
+                   virtual_path   = cwd
                  }
 
 #ifdef USE_EDITLINE
@@ -685,13 +692,9 @@ runStmt stmt step
  | null (filter (not.isSpace) stmt) = return False
  | ["import", mod] <- words stmt    = keepGoing setContext ('+':mod)
  | otherwise
- = do st <- getGHCiState
-      session <- getSession
-      result <- io $ withProgName (progname st) $ withArgs (args st) $
-	     	     GHC.runStmt session stmt step
+ = do result <- GhciMonad.runStmt stmt step
       afterRunStmt (const True) result
 
-
 --afterRunStmt :: GHC.RunResult -> GHCi Bool
                                  -- False <=> the statement failed to compile
 afterRunStmt :: (SrcSpan -> Bool) -> GHC.RunResult -> GHCi Bool
@@ -706,7 +709,7 @@ afterRunStmt step_here run_result = do
      GHC.RunBreak _ names mb_info 
          | isNothing  mb_info || 
            step_here (GHC.resumeSpan $ head resumes) -> do
-               printForUser $ ptext SLIT("Stopped at") <+> 
+               printForUser $ ptext (sLit "Stopped at") <+> 
                        ppr (GHC.resumeSpan $ head resumes)
 --               printTypeOfNames session names
                let namesSorted = sortBy compareNames names
@@ -719,7 +722,7 @@ afterRunStmt step_here run_result = do
                st <- getGHCiState
                enqueueCommands [stop st]
                return ()
-         | otherwise -> io(GHC.resume session GHC.SingleStep) >>= 
+         | otherwise -> resume GHC.SingleStep >>=
                         afterRunStmt step_here >> return ()
      _ -> return ()
 
@@ -1623,8 +1626,8 @@ showContext = do
    printForUser $ vcat (map pp_resume (reverse resumes))
   where
    pp_resume resume =
-        ptext SLIT("--> ") <> text (GHC.resumeStmt resume)
-        $$ nest 2 (ptext SLIT("Stopped at") <+> ppr (GHC.resumeSpan resume))
+        ptext (sLit "--> ") <> text (GHC.resumeStmt resume)
+        $$ nest 2 (ptext (sLit "Stopped at") <+> ppr (GHC.resumeSpan resume))
 
 showPackages :: GHCi ()
 showPackages = do
@@ -1946,8 +1949,7 @@ continueCmd = noArgs $ doContinue (const True) GHC.RunToCompletion
 -- doContinue :: SingleStep -> GHCi ()
 doContinue :: (SrcSpan -> Bool) -> SingleStep -> GHCi ()
 doContinue pred step = do 
-  session <- getSession
-  runResult <- io $ GHC.resume session step
+  runResult <- resume step
   afterRunStmt pred runResult
   return ()
 
@@ -2011,7 +2013,7 @@ backCmd :: String -> GHCi ()
 backCmd = noArgs $ do
   s <- getSession
   (names, _, span) <- io $ GHC.back s
-  printForUser $ ptext SLIT("Logged breakpoint at") <+> ppr span
+  printForUser $ ptext (sLit "Logged breakpoint at") <+> ppr span
   printTypeOfNames s names
    -- run the command set with ":set stop <cmd>"
   st <- getGHCiState
@@ -2022,8 +2024,8 @@ forwardCmd = noArgs $ do
   s <- getSession
   (names, ix, span) <- io $ GHC.forward s
   printForUser $ (if (ix == 0)
-                    then ptext SLIT("Stopped at")
-                    else ptext SLIT("Logged breakpoint at")) <+> ppr span
+                    then ptext (sLit "Stopped at")
+                    else ptext (sLit "Logged breakpoint at")) <+> ppr span
   printTypeOfNames s names
    -- run the command set with ":set stop <cmd>"
   st <- getGHCiState