Comments only

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

diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs
index 7135359..0817259 100644 (file)
--- a/compiler/ghci/Debugger.hs
+++ b/compiler/ghci/Debugger.hs
@@ -38,12 +38,12 @@ import ErrUtils
 import FastString
 import SrcLoc
 import Util
+import Maybes
 
 import Control.Exception
 import Control.Monad
 import qualified Data.Map as Map
 import Data.Array.Unboxed
-import Data.Traversable ( traverse )
 import Data.Typeable             ( Typeable )
 import Data.Maybe
 import Data.IORef
@@ -77,9 +77,9 @@ pprintClosureCommand bindThings force str = do
 
   -- Give names to suspensions and bind them in the local env
   mb_terms' <- if bindThings
-               then io$ mapM (traverse (bindSuspensions cms)) mb_terms
+               then io$ mapM (fmapMMaybe (bindSuspensions cms)) mb_terms
                else return mb_terms
-  ppr_terms <- io$ mapM (traverse (printTerm cms)) mb_terms' 
+  ppr_terms <- io$ mapM (fmapMMaybe (printTerm cms)) mb_terms' 
   let docs = [ ppr id <+> char '=' <+> t | (Just t,id) <- zip ppr_terms ids]
   unqual  <- io$ GHC.getPrintUnqual cms
   io . putStrLn . showSDocForUser unqual $ Outputable.vcat docs
@@ -108,7 +108,6 @@ pprintClosureCommand bindThings force str = do
       , substFiltered <- filter (not.isTyVarTy) . varEnvElts . getTvSubstEnv $ subst
       , not . null $ substFiltered
       , all (flip notElemTvSubst subst) ty_vars
---      , pprTrace "subst" (ppr subst) True
       = True
       | otherwise = False
       where bindOnlyTy1 tyv | tyv `elem` ty_vars = AvoidMe
@@ -298,11 +297,19 @@ stripUnknowns _ id = id
 -----------------------------
 -- | The :breakpoint command
 -----------------------------
-bkptOptions :: String -> GHCi ()
+bkptOptions :: String -> GHCi Bool
+bkptOptions "continue" = -- We want to quit if in an inferior session
+                         liftM not isTopLevel 
+bkptOptions "stop" = do
+  inside_break <- liftM not isTopLevel
+  when inside_break $ throwDyn StopChildSession 
+  return False
+
 bkptOptions cmd = do 
   dflags <- getDynFlags
   bt     <- getBkptTable
   bkptOptions' (words cmd) bt
+  return False
    where
     bkptOptions' ["list"] bt = do 
       let msgs = [ ppr mod <+> colon <+> ppr coords 
@@ -314,10 +321,6 @@ bkptOptions cmd = do
                             else vcat num_msgs
       io$ putStrLn msg
 
-    bkptOptions' ["stop"] bt = do
-        inside_break <- liftM not isTopLevel
-        when inside_break $ throwDyn StopChildSession
-
     bkptOptions' ("add":cmds) bt 
       | [mod_name,line]<- cmds
       , [(lineNum,[])] <- reads line
@@ -374,12 +377,14 @@ bkptOptions cmd = do
                io$ putStrLn delMsg
 
     bkptOptions' _ _ = throwDyn $ CmdLineError $ 
-                         "syntax: :breakpoint (list|stop|add|del)"
+                         "syntax: :breakpoint (list|continue|stop|add|del)"
 
+-- Error messages
     handleBkptEx :: Module -> Debugger.BkptException -> a
-    handleBkptEx _ NoBkptFound = error "No suitable breakpoint site found"  --TODO Automatically add to the next suitable line
+    handleBkptEx _ NoBkptFound = error "No suitable breakpoint site found"  
+         -- ^ TODO Instead of complaining, set a bkpt in the next suitable line
     handleBkptEx _ NotNeeded   = error "Nothing to do"
-    handleBkptEx m NotHandled  = error$ "Module " ++ showSDoc (ppr m) ++  " was not loaded under debugging mode. Enable debugging mode and reload it"
+    handleBkptEx m NotHandled  = error$ "Module " ++ showSDoc (ppr m) ++  " was not loaded under debugging mode. Enable debugging mode with -fdebugging (and reload your module)"
 
 -------------------------
 -- Breakpoint Tables
@@ -510,8 +515,7 @@ getSiteCoords bt a site
                   , s == site ]
 
 -- addModule is dumb and inefficient, but it does the job
---addModule fn siteCoords _ | trace ("addModule: " ++ moduleString (unsafeCoerce# fn) ++ " - " ++ show siteCoords) False = undefined
-addModule a [] bt = bt
+addModule a [] bt = bt {sites = Map.insert a [] (sites bt)}
 addModule a siteCoords bt 
    | nrows        <- maximum$ [i | (_,(i,j)) <- siteCoords ]
    , sitesByRow   <- [ [(s,c) | (s,(r,c)) <- siteCoords, r==i] 
@@ -525,7 +529,7 @@ isBkptEnabled bt (a,site)
    | Just bkpts <- bkptsOf bt a 
    , inRange (bounds bkpts) site
    = bkpts ! site 
-   | otherwise = throwDyn NotHandled            -- This is an error
+   | otherwise = panic "unexpected condition: I don't know that breakpoint site"
 
 -----------------
 -- Other stuff
@@ -534,7 +538,7 @@ refreshBkptTable :: [ModSummary] -> GHCi ()
 refreshBkptTable [] = return ()
 refreshBkptTable (ms:mod_sums) = do
     sess   <- getSession
-    when (Opt_Debugging `elem` flags (GHC.ms_hspp_opts ms)) $ do
+    when isDebugging $ do
       old_table <- getBkptTable
       new_table <- addModuleGHC sess old_table (GHC.ms_mod ms)
       setBkptTable new_table
@@ -547,3 +551,8 @@ refreshBkptTable (ms:mod_sums) = do
                 (ppr mod <> text ": inserted " <> int (length sites) <>
                  text " breakpoints")
           return$ addModule mod sites bt
+#if defined(GHCI) && defined(DEBUGGER)
+        isDebugging = Opt_Debugging `elem` flags (GHC.ms_hspp_opts ms)
+#else
+        isDebugging = False
+#endif