Handle breakpoint jumps while splicing TH functions in ghci

The dynamic linker has been modified so that it won't panic if one of the breakpointJump functions fails to resolve.
Now, if the dynamic linker fails to find a HValue for a Name, before looking for a static symbol it will ask to

Breakpoints.lookupBogusBreakpointVal :: Name -> Maybe HValue

which returns an identity function for the Jump names or Nothing else.

A TH function might contain a call to a breakpoint function. So if it is compiled to bytecodes, the breakpoints will be desugared to 'jumps'. Whenever this code is spliced, the linker will fail to find the jumpfunctions unless there is a default.

1 files changed, 22 insertions, 0 deletions

diff --git a/compiler/main/Breakpoints.hs b/compiler/main/Breakpoints.hs
index 14d9ea299d..b1b0118179 100644
--- a/compiler/main/Breakpoints.hs
+++ b/compiler/main/Breakpoints.hs
@@ -9,7 +9,16 @@
 

 module Breakpoints where

 

+#ifdef GHCI

+import {-#SOURCE#-} ByteCodeLink ( HValue ) 

+#endif

+

 import {-#SOURCE#-} HscTypes     ( Session )

+import Name

+import Var                       ( Id )

+import PrelNames

+

+import GHC.Exts                  ( unsafeCoerce# )

 

 data BkptHandler a = BkptHandler {

      handleBreakpoint  :: forall b. Session -> [(Id,HValue)] -> BkptLocation a ->  String -> b -> IO b

@@ -29,3 +38,16 @@ type Coord        = (Int, Int)
 

 noDbgSites :: SiteMap

 noDbgSites = []

+

+-- | Returns the 'identity' jumps

+--   Used to deal with spliced code, where we don't want breakpoints

+#ifdef GHCI

+lookupBogusBreakpointVal :: Name -> Maybe HValue

+lookupBogusBreakpointVal name 

+  | name == breakpointJumpName     = Just$ unsafeCoerce# (\_ _ _ _ a->a)

+  | name == breakpointAutoJumpName = Just$ unsafeCoerce# (\_ _ _ _ a->a)

+  | name == breakpointCondJumpName = Just$ unsafeCoerce# (\_ _ _ _ _ a->a)

+  | otherwise = Nothing

+#else 

+lookupBogusBreakpointVal _ = Nothing

+#endif //GHCI