-isBkptEnabled :: Ord a => BkptTable a -> BkptLocation a -> Bool
-btElems :: Ord a => BkptTable a -> [(a, [SiteNumber])]
-btList :: Ord a => BkptTable a -> [BkptLocation a]
-sitesList :: Ord a => BkptTable a -> [(a, [Coord])]
-getSiteCoords :: Ord a => BkptTable a -> a -> SiteNumber -> Coord
-
-emptyBkptTable = BkptTable Map.empty Map.empty
-
-addBkptByLine a i bt
- | Just lines <- sitesOf bt a
- , Just bkptsArr <- bkptsOf bt a
- , i < length lines
- = case [line | line <- drop i lines, not (null line)] of
- ((x:_):_) -> let (siteNum,col) = x
- wasAlreadyOn = bkptsArr ! siteNum
- newArr = bkptsArr // [(siteNum, True)]
- newTable = Map.insert a newArr (breakpoints bt)
- in if wasAlreadyOn
- then Left NotNeeded
- else Right (bt{breakpoints=newTable}, siteNum)
- otherwise -> Left NoBkptFound
-
- | Just sites <- sitesOf bt a
- = Left NoBkptFound
- | otherwise = Left NotHandled
-
-addBkptByCoord a (r,c) bt
- | Just lines <- sitesOf bt a
- , Just bkptsArr <- bkptsOf bt a
- , r < length lines
- = case [ (sn,col) | (sn,col)<-lines!!r, col>=c] of
- [] -> Left NoBkptFound
- (x:_) -> let (siteNum, col) = x
- wasAlreadyOn = bkptsArr ! siteNum
- newArr = bkptsArr // [(siteNum, True)]
- newTable = Map.insert a newArr (breakpoints bt)
- in if wasAlreadyOn
- then Left NotNeeded
- else Right (bt{breakpoints=newTable}, siteNum)
-
- | Just sites <- sitesOf bt a
- = Left NoBkptFound
- | otherwise = Left NotHandled
-
-delBkptBySite a i bt
- | Just bkptsArr <- bkptsOf bt a
- , not (inRange (bounds bkptsArr) i)
- = Left NoBkptFound
-
- | Just bkptsArr <- bkptsOf bt a
- , bkptsArr ! i -- Check that there was a enabled bkpt here
- , newArr <- bkptsArr // [(i,False)]
- , newTable <- Map.insert a newArr (breakpoints bt)
- = Right bt {breakpoints=newTable}
-
- | Just sites <- sitesOf bt a
- = Left NotNeeded
-
- | otherwise = Left NotHandled
-
-delBkptByLine a l bt
- | Just sites <- sitesOf bt a
- , (site:_) <- [s | (s,c') <- sites !! l]
- = delBkptBySite a site bt
-
- | Just sites <- sitesOf bt a
- = Left NoBkptFound
-
- | otherwise = Left NotHandled
-
-delBkptByCoord a (r,c) bt
- | Just sites <- sitesOf bt a
- , (site:_) <- [s | (s,c') <- sites !! r, c>=c', isBkptEnabled bt (a,s)]
- = delBkptBySite a site bt
-
- | Just sites <- sitesOf bt a
- = Left NoBkptFound
-
- | otherwise = Left NotHandled
-
-btElems bt = [ (a, [i | (i,True) <- assocs siteArr])
- | (a, siteArr) <- Map.assocs (breakpoints bt) ]
-
-btList bt = [(a,site) | (a, sites) <- btElems bt, site <- sites]
-
-sitesList bt = [ (a, sitesCoords sitesCols) | (a, sitesCols) <- Map.assocs (sites bt) ]
- where sitesCoords sitesCols =
- [ (row,col)
- | (row, cols) <- zip [0..] sitesCols, (_,col) <- cols ]
-
-getSiteCoords bt a site
- | Just rows <- sitesOf bt a
- = head [ (r,c) | (r,row) <- zip [0..] rows
- , (s,c) <- row
- , s == site ]
-
--- addModule is dumb and inefficient, but it does the job
-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]
- | i <- [0..nrows] ]
- , nsites <- length siteCoords
- , initialBkpts <- listArray (1, nsites) (repeat False)
- = bt{ sites = Map.insert a sitesByRow (sites bt)
- , breakpoints = Map.insert a initialBkpts (breakpoints bt) }
-
-isBkptEnabled bt (a,site)
- | Just bkpts <- bkptsOf bt a
- , inRange (bounds bkpts) site
- = bkpts ! site
- | otherwise = panic "unexpected condition: I don't know that breakpoint site"
-
------------------
--- Other stuff
------------------
-refreshBkptTable :: Session -> BkptTable Module -> [ModSummary] -> IO (BkptTable Module)
-refreshBkptTable sess = foldM updIfDebugging
- where
- updIfDebugging bt ms = do
- isDebugging <- isDebuggingM ms
- if isDebugging
- then addModuleGHC sess bt (GHC.ms_mod ms)
- else return bt
- addModuleGHC sess bt mod = do
- Just mod_info <- GHC.getModuleInfo sess mod
- dflags <- GHC.getSessionDynFlags sess
- let sites = GHC.modInfoBkptSites mod_info
- debugTraceMsg dflags 2
- (ppr mod <> text ": inserted " <> int (length sites) <>
- text " breakpoints")
- return$ addModule mod sites bt
-#if defined(GHCI) && defined(DEBUGGER)
- isDebuggingM ms = isModuleInterpreted sess ms >>= \isInterpreted ->
- return (Opt_Debugging `elem` dflags &&
- target == HscInterpreted && isInterpreted)
- where dflags = flags (GHC.ms_hspp_opts ms)
- target = hscTarget (GHC.ms_hspp_opts ms)
-#else
- isDebuggingM _ = return False
-#endif