Use OPTIONS rather than OPTIONS_GHC for pragmas

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

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index dffae16..dddbb34 100644 (file)
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -6,6 +6,13 @@
 -- (c) The GHC Team 2005-2006
 --
 -----------------------------------------------------------------------------
 -- (c) The GHC Team 2005-2006
 --
 -----------------------------------------------------------------------------

+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/CodingStyle#Warnings
+-- for details
+

 module InteractiveUI ( interactiveUI, ghciWelcomeMsg ) where
 
 #include "HsVersions.h"
 module InteractiveUI ( interactiveUI, ghciWelcomeMsg ) where
 
 #include "HsVersions.h"

@@ -130,7 +137,8 @@ builtin_commands = [
   ("show",     keepGoing showCmd,              False, completeNone),
   ("sprint",    keepGoing sprintCmd,            False, completeIdentifier),
   ("step",      keepGoing stepCmd,              False, completeIdentifier), 
   ("show",     keepGoing showCmd,              False, completeNone),
   ("sprint",    keepGoing sprintCmd,            False, completeIdentifier),
   ("step",      keepGoing stepCmd,              False, completeIdentifier), 

-  ("stepover",  keepGoing stepOverCmd,          False, completeIdentifier), 
+  ("steplocal", keepGoing stepLocalCmd,         False, completeIdentifier), 
+  ("stepmodule",keepGoing stepModuleCmd,        False, completeIdentifier), 

   ("type",     keepGoing typeOfExpr,           False, completeIdentifier),
   ("trace",     keepGoing traceCmd,             False, completeIdentifier), 
   ("undef",     keepGoing undefineMacro,       False, completeMacro),
   ("type",     keepGoing typeOfExpr,           False, completeIdentifier),
   ("trace",     keepGoing traceCmd,             False, completeIdentifier), 
   ("undef",     keepGoing undefineMacro,       False, completeMacro),

@@ -186,7 +194,8 @@ helpText =
  "   :sprint [<name> ...]        simplifed version of :print\n" ++
  "   :step                       single-step after stopping at a breakpoint\n"++
  "   :step <expr>                single-step into <expr>\n"++
  "   :sprint [<name> ...]        simplifed version of :print\n" ++
  "   :step                       single-step after stopping at a breakpoint\n"++
  "   :step <expr>                single-step into <expr>\n"++

- "   :stepover                   single-step without following function applications\n"++
+ "   :steplocal                  single-step restricted to the current top level decl.\n"++
+ "   :stepmodule                 single-step restricted to the current module\n"++

  "   :trace                      trace after stopping at a breakpoint\n"++
  "   :trace <expr>               trace into <expr> (remembers breakpoints for :history)\n"++
 
  "   :trace                      trace after stopping at a breakpoint\n"++
  "   :trace <expr>               trace into <expr> (remembers breakpoints for :history)\n"++
 

@@ -566,7 +575,7 @@ runStmt stmt step
 --afterRunStmt :: GHC.RunResult -> GHCi Bool
                                  -- False <=> the statement failed to compile
 afterRunStmt _ (GHC.RunException e) = throw e
 --afterRunStmt :: GHC.RunResult -> GHCi Bool
                                  -- False <=> the statement failed to compile
 afterRunStmt _ (GHC.RunException e) = throw e

-afterRunStmt pred run_result = do
+afterRunStmt step_here run_result = do

   session     <- getSession
   resumes <- io $ GHC.getResumeContext session
   case run_result of
   session     <- getSession
   resumes <- io $ GHC.getResumeContext session
   case run_result of

@@ -575,7 +584,7 @@ afterRunStmt pred run_result = do
         when show_types $ printTypeOfNames session names
      GHC.RunBreak _ names mb_info 
          | isNothing  mb_info || 
         when show_types $ printTypeOfNames session names
      GHC.RunBreak _ names mb_info 
          | isNothing  mb_info || 

-           pred (GHC.resumeSpan $ head resumes) -> do
+           step_here (GHC.resumeSpan $ head resumes) -> do

                printForUser $ ptext SLIT("Stopped at") <+> 
                        ppr (GHC.resumeSpan $ head resumes)
 --               printTypeOfNames session names
                printForUser $ ptext SLIT("Stopped at") <+> 
                        ppr (GHC.resumeSpan $ head resumes)
 --               printTypeOfNames session names

@@ -586,7 +595,7 @@ afterRunStmt pred run_result = do
                enqueueCommands [stop st]
                return ()
          | otherwise -> io(GHC.resume session GHC.SingleStep) >>= 
                enqueueCommands [stop st]
                return ()
          | otherwise -> io(GHC.resume session GHC.SingleStep) >>= 

-                        afterRunStmt pred >> return ()
+                        afterRunStmt step_here >> return ()

      _ -> return ()
 
   flushInterpBuffers
      _ -> return ()
 
   flushInterpBuffers

@@ -599,9 +608,9 @@ afterRunStmt pred run_result = do
       where printTypeAndContentOfNames session names = do
               let namesSorted = sortBy compareNames names
               tythings <- catMaybes `liftM` 
       where printTypeAndContentOfNames session names = do
               let namesSorted = sortBy compareNames names
               tythings <- catMaybes `liftM` 

-                              io (mapM (GHC.lookupName session) names)
+                              io (mapM (GHC.lookupName session) namesSorted)

               docs_ty  <- mapM showTyThing tythings
               docs_ty  <- mapM showTyThing tythings

-              terms    <- mapM (io . GHC.obtainTerm session False)
+              terms    <- mapM (io . GHC.obtainTermB session 10 False)

                                [ id | (AnId id, Just _) <- zip tythings docs_ty]
               docs_terms <- mapM (io . showTerm session) terms                                   
               printForUser $ vcat $ zipWith (\ty cts -> ty <> text " = " <> cts)
                                [ id | (AnId id, Just _) <- zip tythings docs_ty]
               docs_terms <- mapM (io . showTerm session) terms                                   
               printForUser $ vcat $ zipWith (\ty cts -> ty <> text " = " <> cts)

@@ -1567,43 +1576,31 @@ stepCmd :: String -> GHCi ()
 stepCmd []         = doContinue (const True) GHC.SingleStep
 stepCmd expression = do runStmt expression GHC.SingleStep; return ()
 
 stepCmd []         = doContinue (const True) GHC.SingleStep
 stepCmd expression = do runStmt expression GHC.SingleStep; return ()
 

-stepOverCmd [] = do 
+stepLocalCmd :: String -> GHCi ()
+stepLocalCmd  [] = do 

   mb_span <- getCurrentBreakSpan
   case mb_span of
     Nothing  -> stepCmd []
     Just loc -> do
        Just mod <- getCurrentBreakModule
   mb_span <- getCurrentBreakSpan
   case mb_span of
     Nothing  -> stepCmd []
     Just loc -> do
        Just mod <- getCurrentBreakModule

-       parent   <- enclosingTickSpan mod loc
-       allTicksRightmost <- (sortBy rightmost . map snd) `fmap` 
-                               ticksIn mod parent
-       let lastTick = null allTicksRightmost || 
-                      head allTicksRightmost == loc
-       if not lastTick
-              then doContinue (`isSubspanOf` parent) GHC.SingleStep
-              else doContinue (const True) GHC.SingleStep
-
-stepOverCmd expression = stepCmd expression
-
-{- 
- So, the only tricky part in stepOver is detecting that we have 
- arrived to the last tick in an expression, in which case we must
- step normally to the next tick.
- What we do is:
-  1. Retrieve the enclosing expression block (with a tick)
-  2. Retrieve all the ticks there and sort them out by 'rightness'
-  3. See if the current tick turned out the first one in the list
--}
-
---ticksIn :: Module -> SrcSpan -> GHCi [Tick]
-ticksIn mod src = do
-  ticks <- getTickArray mod
-  let lines = [srcSpanStartLine src .. srcSpanEndLine src]
-  return [  t   | line <- lines
-                , t@(_,span) <- ticks ! line
-                , srcSpanStart src <= srcSpanStart span
-                , srcSpanEnd src   >= srcSpanEnd span
-                ]
+       current_toplevel_decl <- enclosingTickSpan mod loc
+       doContinue (`isSubspanOf` current_toplevel_decl) GHC.SingleStep
+
+stepLocalCmd expression = stepCmd expression
+
+stepModuleCmd :: String -> GHCi ()
+stepModuleCmd  [] = do 
+  mb_span <- getCurrentBreakSpan
+  case mb_span of
+    Nothing  -> stepCmd []
+    Just loc -> do
+       Just span <- getCurrentBreakSpan
+       let f some_span = optSrcSpanFileName span == optSrcSpanFileName some_span
+       doContinue f GHC.SingleStep
+
+stepModuleCmd expression = stepCmd expression

 
 

+-- | Returns the span of the largest tick containing the srcspan given

 enclosingTickSpan :: Module -> SrcSpan -> GHCi SrcSpan
 enclosingTickSpan mod src = do
   ticks <- getTickArray mod
 enclosingTickSpan :: Module -> SrcSpan -> GHCi SrcSpan
 enclosingTickSpan mod src = do
   ticks <- getTickArray mod