X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FDebugger.hs;h=071e370228bab54a943b4a2ad0f8cf9a446d3830;hb=c3ea5e95aa2498f19f99848c85b9be2b517d9e7f;hp=16089339c9d35d76efb5362a24c36a0440798d62;hpb=8ea920f1ef9e66e3cecc81822e594943f8957d60;p=ghc-hetmet.git

diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs
index 1608933..071e370 100644
--- a/compiler/ghci/Debugger.hs
+++ b/compiler/ghci/Debugger.hs
@@ -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,13 +297,22 @@ 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
+  sess   <- getSession
+  bkptOptions' sess (words cmd) bt
+  return False
    where
-    bkptOptions' ["list"] bt = do 
+    bkptOptions' _ ["list"] bt = do 
       let msgs = [ ppr mod <+> colon <+> ppr coords 
                    | (mod,site) <- btList bt
                    , let coords = getSiteCoords bt mod site]
@@ -314,11 +322,7 @@ 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 
+    bkptOptions' s ("add":cmds) bt 
       | [mod_name,line]<- cmds
       , [(lineNum,[])] <- reads line
       =  handleAdd mod_name $ (\mod->addBkptByLine mod lineNum)
@@ -330,17 +334,15 @@ bkptOptions cmd = do
                        "syntax: :breakpoint add Module line [col]"
        where 
          handleAdd mod_name f = do
-           sess        <- getSession
-           dflags      <- getDynFlags
-           mod         <- io$ GHC.findModule sess (GHC.mkModuleName mod_name) Nothing
-           ghciHandleDyn (handleBkptEx mod) $
+           mod         <- io$ GHC.findModule s (GHC.mkModuleName mod_name) Nothing
+           ghciHandleDyn (handleBkptEx s mod) $
             case f mod bt of
              (newTable, site)  -> do
                setBkptTable newTable 
                io (putStrLn ("Breakpoint set at " ++ 
                               show (getSiteCoords newTable mod site)))
 
-    bkptOptions' ("del":cmds) bt 
+    bkptOptions' s ("del":cmds) bt 
       | [i']     <- cmds 
       , [(i,[])] <- reads i'
       , bkpts    <- btList bt
@@ -366,20 +368,29 @@ bkptOptions cmd = do
              "syntax: :breakpoint del (breakpoint # | Module line [col])"
 
        where delMsg = "Breakpoint deleted"
-             handleDel mod f = ghciHandleDyn (handleBkptEx mod) $ do
-               modifyBkptTable f
-               newTable <- getBkptTable
-               sess <- getSession
-               dflags <- getDynFlags
-               io$ putStrLn delMsg
-
-    bkptOptions' _ _ = throwDyn $ CmdLineError $ 
-                         "syntax: :breakpoint (list|stop|add|del)"
-
-    handleBkptEx :: Module -> Debugger.BkptException -> a
-    handleBkptEx _ NoBkptFound = error "No suitable breakpoint site found"  --TODO Automatically add to 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"
+             handleDel mod f = ghciHandleDyn (handleBkptEx s mod) 
+                                             (modifyBkptTable f >> io (putStrLn delMsg))
+
+    bkptOptions' _ _ _ = throwDyn $ CmdLineError $ 
+                         "syntax: :breakpoint (list|continue|stop|add|del)"
+
+-- Error messages
+--    handleBkptEx :: Session -> Module -> Debugger.BkptException -> a
+    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 s m NotHandled  = io$
+                                   findModSummary m                  >>= \mod_summary ->
+                                   isModuleInterpreted s mod_summary >>= \it -> 
+       if it
+        then error$ "Module " ++ showSDoc (ppr m) ++  " was not loaded under debugging mode.\n" 
+                 ++ "Enable debugging mode with -fdebugging (and reload your module)"
+        else error$ "Module " ++ showSDoc (ppr m) ++  " was loaded in compiled (.o) mode.\n" 
+                 ++ "You must load a module in interpreted mode and with -fdebugging on to debug it."
+                     where findModSummary m = getModuleGraph s >>= \mod_graph ->  
+                               case [ modsum | modsum <- mod_graph
+                                             , ms_mod modsum == m ] of
+                                 [modsum] -> return modsum
 
 -------------------------
 -- Breakpoint Tables
@@ -510,7 +521,6 @@ 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 {sites = Map.insert a [] (sites bt)}
 addModule a siteCoords bt 
    | nrows        <- maximum$ [i | (_,(i,j)) <- siteCoords ]
@@ -525,7 +535,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
@@ -533,7 +543,8 @@ isBkptEnabled bt (a,site)
 refreshBkptTable :: [ModSummary] -> GHCi ()
 refreshBkptTable [] = return ()
 refreshBkptTable (ms:mod_sums) = do
-    sess   <- getSession
+    sess        <- getSession
+    isDebugging <- io(isDebuggingM sess)
     when isDebugging $ do
       old_table <- getBkptTable
       new_table <- addModuleGHC sess old_table (GHC.ms_mod ms)
@@ -548,7 +559,10 @@ refreshBkptTable (ms:mod_sums) = do
                  text " breakpoints")
           return$ addModule mod sites bt
 #if defined(GHCI) && defined(DEBUGGER)
-        isDebugging = Opt_Debugging `elem` flags (GHC.ms_hspp_opts ms)
+        isDebuggingM sess = isModuleInterpreted sess ms >>= \isInterpreted -> 
+                            return (Opt_Debugging `elem` dflags && target == HscInterpreted && isInterpreted)
+        dflags = flags     (GHC.ms_hspp_opts ms)
+        target = hscTarget (GHC.ms_hspp_opts ms)
 #else
-        isDebugging = False
+        isDebuggingM _ = return False
 #endif