X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=inline;f=compiler%2Fghci%2FInteractiveUI.hs;h=a49109abfbeb6012f7617a376d26d6d86d847218;hb=526c3af1dc98987b6949f4df73c0debccf9875bd;hp=c0d9405c28e1b58d53088df3bac2c913cc172297;hpb=24f608a8eca2d5648d52ce656f8c3a965922ba5f;p=ghc-hetmet.git

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index c0d9405..a49109a 100644
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -229,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"++
@@ -353,7 +356,8 @@ interactiveUI session srcs maybe_exprs = do
                    last_command = Nothing,
                    cmdqueue = [],
                    remembered_ctx = [],
-                   virtual_path   = cwd
+                   virtual_path   = cwd,
+                   ghc_e = isJust maybe_exprs
                  }
 
 #ifdef USE_EDITLINE
@@ -450,12 +454,8 @@ runGHCi paths maybe_exprs = do
                                    -- current progname in the exception text:
                                    -- <progname>: <exception>
                               io $ withProgName (progname st)
-                                   -- The "fast exit" part just calls exit()
-                                   -- directly instead of doing an orderly
-                                   -- runtime shutdown, otherwise the main
-                                   -- GHCi thread will complain about being
-                                   -- interrupted.
-                                 $ topHandlerFastExit e
+                                   -- this used to be topHandlerFastExit, see #2228
+                                 $ topHandler e
             runCommands' handle (return Nothing)
 
   -- and finally, exit
@@ -706,7 +706,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
@@ -726,7 +726,7 @@ afterRunStmt step_here run_result = do
   flushInterpBuffers
   io installSignalHandlers
   b <- isOptionSet RevertCAFs
-  io (when b revertCAFs)
+  when b revertCAFs
 
   return (case run_result of GHC.RunOk _ -> True; _ -> False)
 
@@ -896,7 +896,7 @@ doWithArgs args cmd = enqueueCommands ["System.Environment.withArgs " ++
 
 addModule :: [FilePath] -> GHCi ()
 addModule files = do
-  io (revertCAFs)			-- always revert CAFs on load/add.
+  revertCAFs			-- always revert CAFs on load/add.
   files <- mapM expandPath files
   targets <- mapM (\m -> io (GHC.guessTarget m Nothing)) files
   session <- getSession
@@ -1095,7 +1095,7 @@ doLoad session retain_context prev_context howmuch = do
 
 afterLoad :: SuccessFlag -> Session -> Bool -> ([Module],[Module]) -> GHCi ()
 afterLoad ok session retain_context prev_context = do
-  io (revertCAFs)  -- always revert CAFs on load.
+  revertCAFs  -- always revert CAFs on load.
   discardTickArrays
   loaded_mod_summaries <- getLoadedModules session
   let loaded_mods = map GHC.ms_mod loaded_mod_summaries
@@ -1623,8 +1623,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
@@ -1635,7 +1635,8 @@ showPackages = do
   pkg_ids <- fmap (preloadPackages . pkgState) getDynFlags
   io $ putStrLn $ showSDoc $ vcat $
     text "packages currently loaded:" 
-    : map (nest 2 . text . packageIdString) pkg_ids
+    : map (nest 2 . text . packageIdString) 
+               (sortBy (compare `on` packageIdFS) pkg_ids)
   where showFlag (ExposePackage p) = text $ "  -package " ++ p
         showFlag (HidePackage p)   = text $ "  -hide-package " ++ p
         showFlag (IgnorePackage p) = text $ "  -ignore-package " ++ p
@@ -2010,7 +2011,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
@@ -2021,8 +2022,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