1 -----------------------------------------------------------------------------
3 -- GHCi Interactive debugging commands
5 -- Pepe Iborra (supported by Google SoC) 2006
7 -----------------------------------------------------------------------------
13 import RtClosureInspect
19 import Var hiding ( varName )
42 import Control.Exception
44 import qualified Data.Map as Map
45 import Data.Array.Unboxed
46 import Data.Traversable ( traverse )
47 import Data.Typeable ( Typeable )
54 #include "HsVersions.h"
56 -----------------------------
57 -- | The :breakpoint command
58 -----------------------------
59 bkptOptions :: String -> GHCi ()
63 bkptOptions' (words cmd) bt
65 bkptOptions' ["list"] bt = do
66 let msgs = [ ppr mod <+> colon <+> ppr coords
67 | (mod,site) <- btList bt
68 , let coords = getSiteCoords bt mod site]
69 num_msgs = [parens (int n) <+> msg | (n,msg) <- zip [1..] msgs]
70 msg <- showForUser$ if null num_msgs
71 then text "There are no enabled breakpoints"
75 bkptOptions' ["stop"] bt = do
76 inside_break <- liftM not isTopLevel
77 when inside_break $ throwDyn StopChildSession
79 bkptOptions' ("add":cmds) bt
80 | [mod_name,line]<- cmds
81 , [(lineNum,[])] <- reads line
82 = handleAdd mod_name $ (\mod->addBkptByLine mod lineNum)
84 | [mod_name,line,col] <- cmds
85 = handleAdd mod_name $ (\mod->addBkptByCoord mod (read line, read col))
87 | otherwise = throwDyn $ CmdLineError $
88 "syntax: :breakpoint add Module line [col]"
90 handleAdd mod_name f = do
93 mod <- io$ GHC.findModule sess (GHC.mkModuleName mod_name) Nothing
94 ghciHandleDyn (handleBkptEx mod) $
96 (newTable, site) -> do
98 io (putStrLn ("Breakpoint set at " ++
99 show (getSiteCoords newTable mod site)))
101 bkptOptions' ("del":cmds) bt
103 , [(i,[])] <- reads i'
105 = if i > length bkpts
106 then throwDyn $ CmdLineError
107 "Not a valid breakpoint #. Use :breakpoint list to see the current breakpoints."
109 let (mod, site) = bkpts !! (i-1)
110 in handleDel mod $ delBkptBySite mod site
113 , [(lineNum,[])] <- reads line
114 , mod <- GHC.mkModule mainPackageId (GHC.mkModuleName fn)
115 = handleDel mod $ delBkptByLine mod lineNum
117 | [fn,line,col] <- cmds
118 , [(lineNum,[])] <- reads line
119 , [(colNum,[])] <- reads col
120 , mod <- GHC.mkModule mainPackageId (GHC.mkModuleName fn)
121 = handleDel mod $ delBkptByCoord mod (lineNum, colNum)
123 | otherwise = throwDyn $ CmdLineError $
124 "syntax: :breakpoint del (breakpoint # | Module line [col])"
126 where delMsg = "Breakpoint deleted"
127 handleDel mod f = ghciHandleDyn (handleBkptEx mod) $ do
129 newTable <- getBkptTable
131 dflags <- getDynFlags
134 bkptOptions' _ _ = throwDyn $ CmdLineError $
135 "syntax: :breakpoint (list|stop|add|del)"
137 handleBkptEx :: Module -> Debugger.BkptException -> a
138 handleBkptEx _ NoBkptFound = error "No suitable breakpoint site found" --TODO Automatically add to the next suitable line
139 handleBkptEx _ NotNeeded = error "Nothing to do"
140 handleBkptEx m NotHandled = error$ "Module " ++ showSDoc (ppr m) ++ " was not loaded under debugging mode. Enable debugging mode and reload it"
142 -------------------------
144 -------------------------
146 data BkptTable a = BkptTable {
147 -- | An array of breaks, indexed by site number
148 breakpoints :: Map.Map a (UArray Int Bool)
149 -- | A list of lines, each line can have zero or more sites, which are annotated with a column number
150 , sites :: Map.Map a [[(SiteNumber, Int)]]
153 sitesOf :: Ord a => BkptTable a -> a -> Maybe [[(SiteNumber, Int)]]
154 sitesOf bt fn = Map.lookup fn (sites bt)
155 bkptsOf bt fn = Map.lookup fn (breakpoints bt)
158 -- The functions for manipulating BkptTables do throw exceptions
162 | NotNeeded -- Used when a breakpoint was already enabled
165 emptyBkptTable :: Ord a => BkptTable a
166 addModule :: Ord a => a -> [(SiteNumber,Coord)] -> BkptTable a -> BkptTable a
167 -- | Lines start at index 1
168 addBkptByLine :: Ord a => a -> Int -> BkptTable a -> (BkptTable a, SiteNumber)
169 addBkptByCoord :: Ord a => a -> Coord -> BkptTable a -> (BkptTable a, SiteNumber)
170 delBkptByLine :: Ord a => a -> Int -> BkptTable a -> BkptTable a
171 delBkptBySite :: Ord a => a -> SiteNumber -> BkptTable a -> BkptTable a
172 delBkptByCoord :: Ord a => a -> Coord -> BkptTable a -> BkptTable a
174 isBkptEnabled :: Ord a => BkptTable a -> BkptLocation a -> Bool
175 btElems :: Ord a => BkptTable a -> [(a, [SiteNumber])]
176 btList :: Ord a => BkptTable a -> [BkptLocation a]
177 sitesList :: Ord a => BkptTable a -> [(a, [Coord])]
178 getSiteCoords :: Ord a => BkptTable a -> a -> SiteNumber -> Coord
180 emptyBkptTable = BkptTable Map.empty Map.empty
183 | Just lines <- sitesOf bt a
184 , Just bkptsArr <- bkptsOf bt a
187 [] -> throwDyn NoBkptFound
188 (x:_) -> let (siteNum,col) = x
189 wasAlreadyOn = bkptsArr ! siteNum
190 newArr = bkptsArr // [(siteNum, True)]
191 newTable = Map.insert a newArr (breakpoints bt)
193 then throwDyn NotNeeded
194 else (bt{breakpoints=newTable}, siteNum)
196 | Just sites <- sitesOf bt a
197 = throwDyn NoBkptFound
198 | otherwise = throwDyn NotHandled
200 addBkptByCoord a (r,c) bt
201 | Just lines <- sitesOf bt a
202 , Just bkptsArr <- bkptsOf bt a
204 = case [ (sn,col) | (sn,col)<-lines!!r, col>=c] of
205 [] -> throwDyn NoBkptFound
206 (x:_) -> let (siteNum, col) = x
207 wasAlreadyOn = bkptsArr ! siteNum
208 newArr = bkptsArr // [(siteNum, True)]
209 newTable = Map.insert a newArr (breakpoints bt)
211 then throwDyn NotNeeded
212 else (bt{breakpoints=newTable}, siteNum)
214 | Just sites <- sitesOf bt a
215 = throwDyn NoBkptFound
216 | otherwise = throwDyn NotHandled
219 | Just bkptsArr <- bkptsOf bt a
220 , not (inRange (bounds bkptsArr) i)
221 = throwDyn NoBkptFound
223 | Just bkptsArr <- bkptsOf bt a
224 , bkptsArr ! i -- Check that there was a enabled bkpt here
225 , newArr <- bkptsArr // [(i,False)]
226 , newTable <- Map.insert a newArr (breakpoints bt)
227 = bt {breakpoints=newTable}
229 | Just sites <- sitesOf bt a
232 | otherwise = throwDyn NotHandled
235 | Just sites <- sitesOf bt a
236 , (site:_) <- [s | (s,c') <- sites !! l]
237 = delBkptBySite a site bt
239 | Just sites <- sitesOf bt a
240 = throwDyn NoBkptFound
242 | otherwise = throwDyn NotHandled
244 delBkptByCoord a (r,c) bt
245 | Just sites <- sitesOf bt a
246 , (site:_) <- [s | (s,c') <- sites !! r, c>=c', isBkptEnabled bt (a,s)]
247 = delBkptBySite a site bt
249 | Just sites <- sitesOf bt a
250 = throwDyn NoBkptFound
252 | otherwise = throwDyn NotHandled
254 btElems bt = [ (a, [i | (i,True) <- assocs siteArr])
255 | (a, siteArr) <- Map.assocs (breakpoints bt) ]
257 btList bt = [(a,site) | (a, sites) <- btElems bt, site <- sites]
259 sitesList bt = [ (a, sitesCoords sitesCols) | (a, sitesCols) <- Map.assocs (sites bt) ]
260 where sitesCoords sitesCols =
262 | (row, cols) <- zip [0..] sitesCols, (_,col) <- cols ]
264 getSiteCoords bt a site
265 | Just rows <- sitesOf bt a
266 = head [ (r,c) | (r,row) <- zip [0..] rows
270 -- addModule is dumb and inefficient, but it does the job
271 --addModule fn siteCoords _ | trace ("addModule: " ++ moduleString (unsafeCoerce# fn) ++ " - " ++ show siteCoords) False = undefined
272 addModule a [] bt = bt
273 addModule a siteCoords bt
274 | nrows <- maximum$ [i | (_,(i,j)) <- siteCoords ]
275 , sitesByRow <- [ [(s,c) | (s,(r,c)) <- siteCoords, r==i]
277 , nsites <- length siteCoords
278 , initialBkpts <- listArray (1, nsites) (repeat False)
279 = bt{ sites = Map.insert a sitesByRow (sites bt)
280 , breakpoints = Map.insert a initialBkpts (breakpoints bt) }
282 isBkptEnabled bt (a,site)
283 | Just bkpts <- bkptsOf bt a
284 , inRange (bounds bkpts) site
286 | otherwise = throwDyn NotHandled -- This is an error
291 refreshBkptTable :: [ModSummary] -> GHCi ()
292 refreshBkptTable [] = return ()
293 refreshBkptTable (ms:mod_sums) = do
295 when (Opt_Debugging `elem` flags (GHC.ms_hspp_opts ms)) $ do
296 old_table <- getBkptTable
297 new_table <- addModuleGHC sess old_table (GHC.ms_mod ms)
298 setBkptTable new_table
299 refreshBkptTable mod_sums
300 where addModuleGHC sess bt mod = do
301 Just mod_info <- io$ GHC.getModuleInfo sess mod
302 dflags <- getDynFlags
303 let sites = GHC.modInfoBkptSites mod_info
304 io$ debugTraceMsg dflags 2
305 (ppr mod <> text ": inserted " <> int (length sites) <>
307 return$ addModule mod sites bt