X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=2e474bef7bc47a6f14ef8c1867cfc70ed279dad6;hb=501db4a71483f4a6943008dd4c84e01fb9b55170;hp=fc2f7b4b75c7086de0fc017268e2f869b8020d83;hpb=c0174c80e2888ff5bcf1d6535ee873ae44ce6ec4;p=ghc-hetmet.git

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index fc2f7b4..2e474be 100644
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -38,6 +38,7 @@ import Name
 import SrcLoc
 
 -- Other random utilities
+import ErrUtils
 import Digraph
 import BasicTypes hiding (isTopLevel)
 import Panic      hiding (showException)
@@ -229,6 +230,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 +357,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 +455,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
@@ -726,7 +727,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 +897,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 +1096,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
@@ -1405,13 +1406,13 @@ setCmd ""
           vcat (text "other dynamic, non-language, flag settings:" 
                :map (flagSetting dflags) nonLanguageDynFlags)
           ))
-  where flagSetting dflags (str,f)
+  where flagSetting dflags (str, f, _)
           | dopt f dflags = text "  " <> text "-f"    <> text str
           | otherwise     = text "  " <> text "-fno-" <> text str
-        (ghciFlags,others)  = partition (\(_,f)->f `elem` flags) 
+        (ghciFlags,others)  = partition (\(_, f, _) -> f `elem` flags)
                                         DynFlags.fFlags
-        nonLanguageDynFlags = filter (\(_,f)->not $ f `elem` map snd xFlags) 
-                                     others
+        nonLanguageDynFlags = filterOut (\(_, f, _) -> f `elem` languageOptions)
+                                        others
         flags = [Opt_PrintExplicitForalls
                 ,Opt_PrintBindResult
                 ,Opt_BreakOnException
@@ -1487,7 +1488,8 @@ newDynFlags :: [String] -> GHCi ()
 newDynFlags minus_opts = do
       dflags <- getDynFlags
       let pkg_flags = packageFlags dflags
-      (dflags',leftovers) <- io $ GHC.parseDynamicFlags dflags minus_opts
+      (dflags', leftovers, warns) <- io $ GHC.parseDynamicFlags dflags minus_opts
+      io $ handleFlagWarnings dflags' warns
 
       if (not (null leftovers))
 		then throwDyn (CmdLineError ("unrecognised flags: " ++ 
@@ -1635,7 +1637,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
@@ -1645,7 +1648,7 @@ showLanguages = do
    dflags <- getDynFlags
    io $ putStrLn $ showSDoc $ vcat $
       text "active language flags:" :
-      [text ("  -X" ++ str) | (str,f) <- DynFlags.xFlags, dopt f dflags]
+      [text ("  -X" ++ str) | (str, f, _) <- DynFlags.xFlags, dopt f dflags]
 
 -- -----------------------------------------------------------------------------
 -- Completion
@@ -1686,7 +1689,7 @@ completeWord w start end = do
                                      (s,r') = span isBreak r
                                  in (n,w):words' isBreak (n+length w+length s) r'
           -- In a Haskell expression we want to parse 'a-b' as three words
-          -- where a compiler flag (ie. -fno-monomorphism-restriction) should
+          -- where a compiler flag (e.g. -ddump-simpl) should
           -- only be a single word.
           selectWord [] = (0,w)
           selectWord ((offset,x):xs)