compiler/main/Breakpoints.hs

   1 -----------------------------------------------------------------------------\r
   2 --\r
   3 -- GHC API breakpoints. This module includes the main API (BkptHandler) and\r
   4 -- utility code for implementing a client to this API used in GHCi \r
   5 --\r
   6 -- Pepe Iborra (supported by Google SoC) 2006\r
   7 --\r
   8 -----------------------------------------------------------------------------\r
   9 \r
  10 module Breakpoints where\r
  11 \r
  12 #ifdef GHCI\r
  13 import {-#SOURCE#-} ByteCodeLink ( HValue ) \r
  14 #endif\r
  15 \r
  16 import {-#SOURCE#-} HscTypes     ( Session )\r
  17 import Name\r
  18 import Var                       ( Id )\r
  19 import PrelNames\r
  20 \r
  21 import GHC.Exts\r
  22 \r
  23 #ifdef GHCI\r
  24 data BkptHandler a = BkptHandler {\r
  25      handleBreakpoint  :: forall b. Session -> [(Id,HValue)] -> BkptLocation a ->  String -> b -> IO b\r
  26    , isAutoBkptEnabled :: Session -> BkptLocation a -> IO Bool\r
  27    }\r
  28 \r
  29 nullBkptHandler = BkptHandler {\r
  30     isAutoBkptEnabled = \ _ _     -> return False,\r
  31     handleBreakpoint  = \_ _ _ _ b -> putStrLn "null Bkpt Handler" >> return b\r
  32                               }\r
  33 #endif\r
  34 \r
  35 type BkptLocation a = (a, SiteNumber)\r
  36 type SiteNumber   = Int\r
  37 \r
  38 type SiteMap      = [(SiteNumber, Coord)]\r
  39 type Coord        = (Int, Int)\r
  40 \r
  41 noDbgSites :: SiteMap\r
  42 noDbgSites = []\r
  43 \r
  44 -- | Returns the 'identity' jumps\r
  45 --   Used to deal with spliced code, where we don't want breakpoints\r
  46 #ifdef GHCI\r
  47 lookupBogusBreakpointVal :: Name -> Maybe HValue\r
  48 lookupBogusBreakpointVal name \r
  49   | name == breakpointJumpName     = Just$ unsafeCoerce# (\_ _ a->a)\r
  50   | name == breakpointAutoJumpName = Just$ unsafeCoerce# (\_ _ a->a)\r
  51   | name == breakpointCondJumpName = Just$ unsafeCoerce# (\_ _ _ a->a)\r
  52   | otherwise = Nothing\r
  53 #else \r
  54 lookupBogusBreakpointVal _ = Nothing\r
  55 #endif /* GHCI */\r
  56 \r