compiler/ghci/Debugger.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- GHCi Interactive debugging commands
   4 --
   5 -- Pepe Iborra (supported by Google SoC) 2006
   6 --
   7 -----------------------------------------------------------------------------
   8
   9 module Debugger where
  10
  11 import Linker
  12 import Breakpoints
  13 import RtClosureInspect
  14
  15 import PrelNames
  16 import HscTypes
  17 import IdInfo
  18 --import Id
  19 import Var hiding ( varName )
  20 import VarSet
  21 import VarEnv
  22 import Name
  23 import NameEnv
  24 import RdrName
  25 import Module
  26 import Finder
  27 import UniqSupply
  28 import Type
  29 import TyCon
  30 import DataCon
  31 import TcGadt
  32 import GHC
  33 import GhciMonad
  34 import PackageConfig
  35
  36 import Outputable
  37 import ErrUtils
  38 import FastString
  39 import SrcLoc
  40 import Util
  41 import Maybes
  42
  43 import Control.Exception
  44 import Control.Monad
  45 import qualified Data.Map as Map
  46 import Data.Array.Unboxed
  47 import Data.Typeable             ( Typeable )
  48 import Data.Maybe
  49 import Data.IORef
  50
  51 import System.IO
  52 import GHC.Exts
  53
  54 #include "HsVersions.h"
  55
  56 -------------------------------------
  57 -- | The :print & friends commands
  58 -------------------------------------
  59 pprintClosureCommand :: Bool -> Bool -> String -> GHCi ()
  60 pprintClosureCommand bindThings force str = do
  61   cms <- getSession
  62   let strs = words str
  63   mbThings <- io$ ( mapM (GHC.lookupName cms) =<<)
  64                   . liftM concat
  65                   . mapM (GHC.parseName cms)
  66                    $ strs
  67   newvarsNames <- io$ do
  68            uniques <- liftM uniqsFromSupply (mkSplitUniqSupply 'q')
  69            return$ map (\u-> (mkSysTvName u (mkFastString "a"))) uniques
  70   let ids_ = [id | Just (AnId id) <- mbThings]
  71
  72   -- Clean up 'Unknown' types artificially injected into tyvars
  73       ids = map (stripUnknowns newvarsNames) ids_
  74
  75  -- Obtain the terms
  76   mb_terms  <- io$ mapM (obtainTerm cms force) ids
  77
  78   -- Give names to suspensions and bind them in the local env
  79   mb_terms' <- if bindThings
  80                then io$ mapM (fmapMMaybe (bindSuspensions cms)) mb_terms
  81                else return mb_terms
  82   ppr_terms <- io$ mapM (fmapMMaybe (printTerm cms)) mb_terms'
  83   let docs = [ ppr id <+> char '=' <+> t | (Just t,id) <- zip ppr_terms ids]
  84   unqual  <- io$ GHC.getPrintUnqual cms
  85   io . putStrLn . showSDocForUser unqual $ Outputable.vcat docs
  86
  87   -- Type reconstruction may have obtained more defined types for some ids
  88   -- So we refresh their types.
  89   let new_ids0 = [ setIdType id ty | (id,Just t) <- zip ids mb_terms
  90                                    , let Just ty = termType t
  91                                    , ty `isMoreSpecificThan` idType id
  92                                    ]
  93   new_ids <- io$ mapM (\x->liftM (setIdType x) . instantiateTyVarsToUnknown cms . idType $ x)
  94                       new_ids0
  95   let Session ref = cms
  96   hsc_env <- io$ readIORef ref
  97   let ictxt = hsc_IC hsc_env
  98       type_env = ic_type_env ictxt
  99       filtered_type_env = delListFromNameEnv type_env (map idName new_ids)
 100       new_type_env =  extendTypeEnvWithIds filtered_type_env new_ids
 101       new_ic = ictxt {ic_type_env = new_type_env }
 102   io$ writeIORef ref (hsc_env {hsc_IC = new_ic })
 103
 104   where
 105     isMoreSpecificThan :: Type -> Type -> Bool
 106     ty `isMoreSpecificThan   ` ty1
 107       | Just subst    <- tcUnifyTys bindOnlyTy1 [repType' ty] [repType' ty1]
 108       , substFiltered <- filter (not.isTyVarTy) . varEnvElts . getTvSubstEnv $ subst
 109       , not . null $ substFiltered
 110       , all (flip notElemTvSubst subst) ty_vars
 111 --      , pprTrace "subst" (ppr subst) True
 112       = True
 113       | otherwise = False
 114       where bindOnlyTy1 tyv | tyv `elem` ty_vars = AvoidMe
 115                             | otherwise = BindMe
 116             ty_vars = varSetElems$ tyVarsOfType ty
 117
 118     bindSuspensions :: Session -> Term -> IO Term
 119     bindSuspensions cms@(Session ref) t = do
 120       hsc_env <- readIORef ref
 121       inScope <- GHC.getBindings cms
 122       let ictxt        = hsc_IC hsc_env
 123           rn_env       = ic_rn_local_env ictxt
 124           type_env     = ic_type_env ictxt
 125           prefix       = "_t"
 126           alreadyUsedNames = map (occNameString . nameOccName . getName) inScope
 127           availNames   = [n | n <- map ((prefix++) . show) [1..]
 128                             , n `notElem` alreadyUsedNames ]
 129       availNames_var  <- newIORef availNames
 130       (t', stuff)     <- foldTerm (nameSuspensionsAndGetInfos availNames_var) t
 131       let (names, tys, hvals) = unzip3 stuff
 132       concrete_tys    <- mapM (instantiateTyVarsToUnknown cms) tys
 133       let ids = [ mkGlobalId VanillaGlobal name ty vanillaIdInfo
 134                   | (name,ty) <- zip names concrete_tys]
 135           new_type_env = extendTypeEnvWithIds type_env ids
 136           new_rn_env   = extendLocalRdrEnv rn_env names
 137           new_ic       = ictxt { ic_rn_local_env = new_rn_env,
 138                                  ic_type_env     = new_type_env }
 139       extendLinkEnv (zip names hvals)
 140       writeIORef ref (hsc_env {hsc_IC = new_ic })
 141       return t'
 142      where
 143
 144 --    Processing suspensions. Give names and recopilate info
 145         nameSuspensionsAndGetInfos :: IORef [String] -> TermFold (IO (Term, [(Name,Type,HValue)]))
 146         nameSuspensionsAndGetInfos freeNames = TermFold
 147                       {
 148                         fSuspension = doSuspension freeNames
 149                       , fTerm = \ty dc v tt -> do
 150                                     tt' <- sequence tt
 151                                     let (terms,names) = unzip tt'
 152                                     return (Term ty dc v terms, concat names)
 153                       , fPrim    = \ty n ->return (Prim ty n,[])
 154                       }
 155         doSuspension freeNames ct mb_ty hval Nothing = do
 156           name <- atomicModifyIORef freeNames (\x->(tail x, head x))
 157           n <- newGrimName cms name
 158           let ty' = fromMaybe (error "unexpected") mb_ty
 159           return (Suspension ct mb_ty hval (Just n), [(n,ty',hval)])
 160
 161
 162 --  A custom Term printer to enable the use of Show instances
 163     printTerm cms@(Session ref) = customPrintTerm customPrint
 164       where
 165         customPrint = \p-> customPrintShowable : customPrintTermBase p
 166         customPrintShowable t@Term{ty=ty, dc=dc, val=val} = do
 167           let hasType = isEmptyVarSet (tyVarsOfType ty)  -- redundant
 168               isEvaled = isFullyEvaluatedTerm t
 169           if isEvaled -- && hasType
 170            then do
 171               hsc_env <- readIORef ref
 172               dflags  <- GHC.getSessionDynFlags cms
 173               do
 174                    (new_env, bname) <- bindToFreshName hsc_env ty "showme"
 175                    writeIORef ref (new_env)
 176                    let noop_log _ _ _ _ = return ()
 177                        expr = "show " ++ showSDoc (ppr bname)
 178                    GHC.setSessionDynFlags cms dflags{log_action=noop_log}
 179                    mb_txt <- withExtendedLinkEnv [(bname, val)]
 180                                (GHC.compileExpr cms expr)
 181                    case mb_txt of
 182                      Just txt -> return . Just . text . unsafeCoerce# $ txt
 183                      Nothing  -> return Nothing
 184                `finally` do
 185                    writeIORef ref hsc_env
 186                    GHC.setSessionDynFlags cms dflags
 187            else return Nothing
 188
 189         bindToFreshName hsc_env ty userName = do
 190           name <- newGrimName cms userName
 191           let ictxt    = hsc_IC hsc_env
 192               rn_env   = ic_rn_local_env ictxt
 193               type_env = ic_type_env ictxt
 194               id       = mkGlobalId VanillaGlobal name ty vanillaIdInfo
 195               new_type_env = extendTypeEnv type_env (AnId id)
 196               new_rn_env   = extendLocalRdrEnv rn_env [name]
 197               new_ic       = ictxt { ic_rn_local_env = new_rn_env,
 198                                      ic_type_env     = new_type_env }
 199           return (hsc_env {hsc_IC = new_ic }, name)
 200 --    Create new uniques and give them sequentially numbered names
 201 --    newGrimName :: Session -> String -> IO Name
 202     newGrimName cms userName  = do
 203       us <- mkSplitUniqSupply 'b'
 204       let unique  = uniqFromSupply us
 205           occname = mkOccName varName userName
 206           name    = mkInternalName unique occname noSrcLoc
 207       return name
 208
 209 ----------------------------------------------------------------------------
 210 -- | Replace all the tyvars in a Term with the opaque type GHC.Base.Unknown
 211 ----------------------------------------------------------------------------
 212 instantiateTyVarsToUnknown :: Session -> Type -> IO Type
 213 instantiateTyVarsToUnknown cms ty
 214 -- We have a GADT, so just fix its tyvars
 215     | Just (tycon, args) <- splitTyConApp_maybe ty
 216     , tycon /= funTyCon
 217     , isGADT tycon
 218     = mapM fixTyVars args >>= return . mkTyConApp tycon
 219 -- We have a regular TyCon, so map recursively to its args
 220     | Just (tycon, args) <- splitTyConApp_maybe ty
 221     , tycon /= funTyCon
 222     = do unknownTyVar <- unknownTV
 223          args' <- mapM (instantiateTyVarsToUnknown cms) args
 224          return$ mkTyConApp tycon args'
 225 -- we have a tyvar of kind *
 226     | Just tyvar <- getTyVar_maybe ty
 227     , ([],_) <- splitKindFunTys (tyVarKind tyvar)
 228     = unknownTV
 229 -- we have a higher kind tyvar, so insert an unknown of the appropriate kind
 230     | Just tyvar <- getTyVar_maybe ty
 231     , (args,_) <- splitKindFunTys (tyVarKind tyvar)
 232     = liftM mkTyConTy $ unknownTC !! length args
 233 -- Base case
 234     | otherwise    = return ty
 235
 236  where unknownTV = do
 237          Just (ATyCon unknown_tc) <- lookupName cms unknownTyConName
 238          return$ mkTyConTy unknown_tc
 239        unknownTC = [undefined, unknownTC1, unknownTC2, unknownTC3]
 240        unknownTC1 = do
 241          Just (ATyCon unknown_tc) <- lookupName cms unknown1TyConName
 242          return unknown_tc
 243        unknownTC2 = do
 244          Just (ATyCon unknown_tc) <- lookupName cms unknown2TyConName
 245          return unknown_tc
 246        unknownTC3 = do
 247          Just (ATyCon unknown_tc) <- lookupName cms unknown3TyConName
 248          return unknown_tc
 249 --       isGADT ty | pprTrace' "isGADT" (ppr ty <> colon <> ppr(isGadtSyntaxTyCon ty)) False = undefined
 250        isGADT tc | Just dcs <- tyConDataCons_maybe tc = any (not . null . dataConEqSpec) dcs
 251                  | otherwise = False
 252        fixTyVars ty
 253            | Just (tycon, args) <- splitTyConApp_maybe ty
 254            = mapM fixTyVars args >>= return . mkTyConApp tycon
 255 -- Fix the tyvar so that the interactive environment doesn't choke on it TODO
 256            | Just tv <- getTyVar_maybe ty = return ty --TODO
 257            | otherwise = return ty
 258
 259 -- | The inverse function. Strip the GHC.Base.Unknowns in the type of the id, they correspond to tyvars. The caller must provide an infinite list of fresh names
 260 stripUnknowns :: [Name] -> Id -> Id
 261 stripUnknowns names id = setIdType id . sigmaType . fst . go names . idType
 262                            $ id
 263  where
 264    sigmaType ty = mkForAllTys (varSetElems$ tyVarsOfType (dropForAlls ty)) ty
 265    go tyvarsNames@(v:vv) ty
 266     | Just (ty1,ty2) <- splitFunTy_maybe ty = let
 267                (ty1',vv') = go tyvarsNames ty1
 268                (ty2',vv'')= go vv' ty2
 269                in (mkFunTy ty1' ty2', vv'')
 270     | Just (ty1,ty2) <- splitAppTy_maybe ty = let
 271                (ty1',vv') = go tyvarsNames ty1
 272                (ty2',vv'')= go vv' ty2
 273                in (mkAppTy ty1' ty2', vv'')
 274     | Just (tycon, args) <- splitTyConApp_maybe ty
 275     , Just (tycon', vv') <- (fixTycon tycon tyvarsNames)
 276     , (args',vv'') <- foldr (\arg (aa,vv) -> let (arg',vv') = go vv' arg
 277                                              in (arg':aa,vv'))
 278                             ([],vv') args
 279     = (mkAppTys tycon' args',vv'')
 280     | Just (tycon, args) <- splitTyConApp_maybe ty
 281     , (args',vv') <- foldr (\arg (aa,vv) -> let (arg',vv') = go vv' arg
 282                                             in (arg':aa,vv'))
 283                            ([],tyvarsNames) args
 284     = (mkTyConApp tycon args',vv')
 285     | otherwise = (ty, tyvarsNames)
 286     where  fixTycon tycon (v:vv) = do
 287                k <- lookup (tyConName tycon) kinds
 288                return (mkTyVarTy$ mkTyVar v k, vv)
 289            kinds = [ (unknownTyConName, liftedTypeKind)
 290                    , (unknown1TyConName, kind1)
 291                    , (unknown2TyConName, kind2)
 292                    , (unknown3TyConName, kind3)]
 293            kind1 = mkArrowKind liftedTypeKind liftedTypeKind
 294            kind2 = mkArrowKind kind1 liftedTypeKind
 295            kind3 = mkArrowKind kind2 liftedTypeKind
 296 stripUnknowns _ id = id
 297
 298 -----------------------------
 299 -- | The :breakpoint command
 300 -----------------------------
 301 bkptOptions :: String -> GHCi ()
 302 bkptOptions cmd = do
 303   dflags <- getDynFlags
 304   bt     <- getBkptTable
 305   bkptOptions' (words cmd) bt
 306    where
 307     bkptOptions' ["list"] bt = do
 308       let msgs = [ ppr mod <+> colon <+> ppr coords
 309                    | (mod,site) <- btList bt
 310                    , let coords = getSiteCoords bt mod site]
 311           num_msgs = [parens (int n) <+> msg | (n,msg) <- zip [1..] msgs]
 312       msg <- showForUser$ if null num_msgs
 313                             then text "There are no enabled breakpoints"
 314                             else vcat num_msgs
 315       io$ putStrLn msg
 316
 317     bkptOptions' ["stop"] bt = do
 318         inside_break <- liftM not isTopLevel
 319         when inside_break $ throwDyn StopChildSession
 320
 321     bkptOptions' ("add":cmds) bt
 322       | [mod_name,line]<- cmds
 323       , [(lineNum,[])] <- reads line
 324       =  handleAdd mod_name $ (\mod->addBkptByLine mod lineNum)
 325
 326       | [mod_name,line,col] <- cmds
 327       = handleAdd mod_name $ (\mod->addBkptByCoord mod (read line, read col))
 328
 329       | otherwise = throwDyn $ CmdLineError $
 330                        "syntax: :breakpoint add Module line [col]"
 331        where
 332          handleAdd mod_name f = do
 333            sess        <- getSession
 334            dflags      <- getDynFlags
 335            mod         <- io$ GHC.findModule sess (GHC.mkModuleName mod_name) Nothing
 336            ghciHandleDyn (handleBkptEx mod) $
 337             case f mod bt of
 338              (newTable, site)  -> do
 339                setBkptTable newTable
 340                io (putStrLn ("Breakpoint set at " ++
 341                               show (getSiteCoords newTable mod site)))
 342
 343     bkptOptions' ("del":cmds) bt
 344       | [i']     <- cmds
 345       , [(i,[])] <- reads i'
 346       , bkpts    <- btList bt
 347       = if i > length bkpts
 348            then throwDyn $ CmdLineError
 349               "Not a valid breakpoint #. Use :breakpoint list to see the current breakpoints."
 350            else
 351              let (mod, site) = bkpts !! (i-1)
 352              in handleDel mod $ delBkptBySite mod site
 353
 354       | [fn,line]      <- cmds
 355       , [(lineNum,[])] <- reads line
 356       , mod            <- GHC.mkModule mainPackageId (GHC.mkModuleName fn)
 357       = handleDel mod $  delBkptByLine mod lineNum
 358
 359       | [fn,line,col]  <- cmds
 360       , [(lineNum,[])] <- reads line
 361       , [(colNum,[])]  <- reads col
 362       , mod            <- GHC.mkModule mainPackageId (GHC.mkModuleName fn)
 363       = handleDel mod $ delBkptByCoord mod (lineNum, colNum)
 364
 365       | otherwise = throwDyn $ CmdLineError $
 366              "syntax: :breakpoint del (breakpoint # | Module line [col])"
 367
 368        where delMsg = "Breakpoint deleted"
 369              handleDel mod f = ghciHandleDyn (handleBkptEx mod) $ do
 370                modifyBkptTable f
 371                newTable <- getBkptTable
 372                sess <- getSession
 373                dflags <- getDynFlags
 374                io$ putStrLn delMsg
 375
 376     bkptOptions' _ _ = throwDyn $ CmdLineError $
 377                          "syntax: :breakpoint (list|stop|add|del)"
 378
 379     handleBkptEx :: Module -> Debugger.BkptException -> a
 380     handleBkptEx _ NoBkptFound = error "No suitable breakpoint site found"  --TODO Automatically add to the next suitable line
 381     handleBkptEx _ NotNeeded   = error "Nothing to do"
 382     handleBkptEx m NotHandled  = error$ "Module " ++ showSDoc (ppr m) ++  " was not loaded under debugging mode. Enable debugging mode and reload it"
 383
 384 -------------------------
 385 -- Breakpoint Tables
 386 -------------------------
 387
 388 data BkptTable a  = BkptTable {
 389                            -- | An array of breaks, indexed by site number
 390      breakpoints :: Map.Map a (UArray Int Bool)
 391                            -- | A list of lines, each line can have zero or more sites, which are annotated with a column number
 392    , sites       :: Map.Map a [[(SiteNumber, Int)]]
 393    }
 394
 395 sitesOf :: Ord a => BkptTable a -> a -> Maybe [[(SiteNumber, Int)]]
 396 sitesOf bt fn = Map.lookup fn (sites bt)
 397 bkptsOf bt fn = Map.lookup fn (breakpoints bt)
 398
 399
 400 -- The functions for manipulating BkptTables do throw exceptions
 401 data BkptException =
 402                     NotHandled
 403                   | NoBkptFound
 404                   | NotNeeded   -- Used when a breakpoint was already enabled
 405   deriving Typeable
 406
 407 emptyBkptTable :: Ord a => BkptTable a
 408 addModule      :: Ord a => a -> [(SiteNumber,Coord)] -> BkptTable a -> BkptTable a
 409 -- | Lines start at index 1
 410 addBkptByLine  :: Ord a => a -> Int        -> BkptTable a -> (BkptTable a, SiteNumber)
 411 addBkptByCoord :: Ord a => a -> Coord      -> BkptTable a -> (BkptTable a, SiteNumber)
 412 delBkptByLine  :: Ord a => a -> Int        -> BkptTable a -> BkptTable a
 413 delBkptBySite  :: Ord a => a -> SiteNumber -> BkptTable a -> BkptTable a
 414 delBkptByCoord :: Ord a => a -> Coord      -> BkptTable a -> BkptTable a
 415
 416 isBkptEnabled  :: Ord a => BkptTable a -> BkptLocation a -> Bool
 417 btElems        :: Ord a => BkptTable a -> [(a, [SiteNumber])]
 418 btList         :: Ord a => BkptTable a -> [BkptLocation a]
 419 sitesList      :: Ord a => BkptTable a -> [(a, [Coord])]
 420 getSiteCoords  :: Ord a => BkptTable a -> a -> SiteNumber -> Coord
 421
 422 emptyBkptTable = BkptTable Map.empty Map.empty
 423
 424 addBkptByLine a i bt
 425    | Just lines    <- sitesOf bt a
 426    , Just bkptsArr <- bkptsOf bt a
 427    , i < length lines
 428    = case lines!!i of
 429        []    -> throwDyn NoBkptFound
 430        (x:_) -> let (siteNum,col) = x
 431                     wasAlreadyOn  = bkptsArr ! siteNum
 432                     newArr        = bkptsArr // [(siteNum, True)]
 433                     newTable      = Map.insert a newArr (breakpoints bt)
 434         in if wasAlreadyOn
 435            then throwDyn NotNeeded
 436            else (bt{breakpoints=newTable}, siteNum)
 437
 438    | Just sites    <- sitesOf bt a
 439    = throwDyn NoBkptFound
 440    | otherwise     = throwDyn NotHandled
 441
 442 addBkptByCoord a (r,c) bt
 443    | Just lines    <- sitesOf bt a
 444    , Just bkptsArr <- bkptsOf bt a
 445    , r < length lines
 446        = case [ (sn,col) | (sn,col)<-lines!!r, col>=c] of
 447        []    -> throwDyn NoBkptFound
 448        (x:_) -> let (siteNum, col) = x
 449                     wasAlreadyOn  = bkptsArr ! siteNum
 450                     newArr        = bkptsArr // [(siteNum, True)]
 451                     newTable      = Map.insert a newArr (breakpoints bt)
 452         in if wasAlreadyOn
 453            then throwDyn NotNeeded
 454            else (bt{breakpoints=newTable}, siteNum)
 455
 456    | Just sites    <- sitesOf bt a
 457    = throwDyn NoBkptFound
 458    | otherwise     = throwDyn NotHandled
 459
 460 delBkptBySite a i bt
 461    | Just bkptsArr <- bkptsOf bt a
 462    , not (inRange (bounds bkptsArr) i)
 463    = throwDyn NoBkptFound
 464
 465    | Just bkptsArr <- bkptsOf bt a
 466    , bkptsArr ! i     -- Check that there was a enabled bkpt here
 467    , newArr        <- bkptsArr // [(i,False)]
 468    , newTable      <- Map.insert a newArr (breakpoints bt)
 469    = bt {breakpoints=newTable}
 470
 471    | Just sites    <- sitesOf bt a
 472    = throwDyn NotNeeded
 473
 474    | otherwise = throwDyn NotHandled
 475
 476 delBkptByLine a l bt
 477    | Just sites    <- sitesOf bt a
 478    , (site:_)      <- [s | (s,c') <- sites !! l]
 479    = delBkptBySite a site bt
 480
 481    | Just sites    <- sitesOf bt a
 482    = throwDyn NoBkptFound
 483
 484    | otherwise = throwDyn NotHandled
 485
 486 delBkptByCoord a (r,c) bt
 487    | Just sites    <- sitesOf bt a
 488    , (site:_)      <- [s | (s,c') <- sites !! r, c>=c', isBkptEnabled bt (a,s)]
 489    = delBkptBySite a site bt
 490
 491    | Just sites    <- sitesOf bt a
 492    = throwDyn NoBkptFound
 493
 494    | otherwise = throwDyn NotHandled
 495
 496 btElems bt = [ (a, [i | (i,True) <- assocs siteArr])
 497              | (a, siteArr) <- Map.assocs (breakpoints bt) ]
 498
 499 btList bt =  [(a,site) | (a, sites) <- btElems bt, site <- sites]
 500
 501 sitesList bt = [ (a, sitesCoords sitesCols) | (a, sitesCols) <- Map.assocs (sites bt) ]
 502     where sitesCoords sitesCols =
 503               [ (row,col)
 504                 | (row, cols) <- zip [0..] sitesCols, (_,col) <- cols ]
 505
 506 getSiteCoords bt a site
 507    | Just rows <- sitesOf bt a
 508    = head [ (r,c) | (r,row) <- zip [0..] rows
 509                   , (s,c)   <- row
 510                   , s == site ]
 511
 512 -- addModule is dumb and inefficient, but it does the job
 513 --addModule fn siteCoords _ | trace ("addModule: " ++ moduleString (unsafeCoerce# fn) ++ " - " ++ show siteCoords) False = undefined
 514 addModule a [] bt = bt
 515 addModule a siteCoords bt
 516    | nrows        <- maximum$ [i | (_,(i,j)) <- siteCoords ]
 517    , sitesByRow   <- [ [(s,c) | (s,(r,c)) <- siteCoords, r==i]
 518                        | i <- [0..nrows] ]
 519    , nsites       <- length siteCoords
 520    , initialBkpts <- listArray (1, nsites) (repeat False)
 521    = bt{ sites       = Map.insert a sitesByRow (sites bt)
 522        , breakpoints = Map.insert a initialBkpts (breakpoints bt) }
 523
 524 isBkptEnabled bt (a,site)
 525    | Just bkpts <- bkptsOf bt a
 526    , inRange (bounds bkpts) site
 527    = bkpts ! site
 528    | otherwise = throwDyn NotHandled            -- This is an error
 529
 530 -----------------
 531 -- Other stuff
 532 -----------------
 533 refreshBkptTable :: [ModSummary] -> GHCi ()
 534 refreshBkptTable [] = return ()
 535 refreshBkptTable (ms:mod_sums) = do
 536     sess   <- getSession
 537     when isDebugging $ do
 538       old_table <- getBkptTable
 539       new_table <- addModuleGHC sess old_table (GHC.ms_mod ms)
 540       setBkptTable new_table
 541     refreshBkptTable mod_sums
 542   where addModuleGHC sess bt mod = do
 543           Just mod_info <- io$ GHC.getModuleInfo sess mod
 544           dflags <- getDynFlags
 545           let sites = GHC.modInfoBkptSites mod_info
 546           io$ debugTraceMsg dflags 2
 547                 (ppr mod <> text ": inserted " <> int (length sites) <>
 548                  text " breakpoints")
 549           return$ addModule mod sites bt
 550 #if defined(GHCI) && defined(DEBUGGER)
 551         isDebugging = Opt_Debugging `elem` flags (GHC.ms_hspp_opts ms)
 552 #else
 553         isDebugging = False
 554 #endif