From 1df34b328128f4949ef812c8be952ab1f85df7ac Mon Sep 17 00:00:00 2001
From: Pepe Iborra <mnislaih@gmail.com>
Date: Sun, 10 Dec 2006 22:24:24 +0000
Subject: [PATCH] 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.
---
 compiler/ghci/ByteCodeLink.lhs |    3 +++
 compiler/main/Breakpoints.hs   |   22 ++++++++++++++++++++++
 2 files changed, 25 insertions(+)

diff --git a/compiler/ghci/ByteCodeLink.lhs b/compiler/ghci/ByteCodeLink.lhs
index 427fa1e..c58ae87 100644
--- a/compiler/ghci/ByteCodeLink.lhs
+++ b/compiler/ghci/ByteCodeLink.lhs
@@ -27,6 +27,7 @@ import Module
 import PackageConfig
 import FastString
 import Panic
+import Breakpoints
 
 #ifdef DEBUG
 import Outputable
@@ -211,6 +212,8 @@ lookupName :: ClosureEnv -> Name -> IO HValue
 lookupName ce nm
    = case lookupNameEnv ce nm of
         Just (_,aa) -> return aa
+        Nothing | Just bk <- lookupBogusBreakpointVal nm
+           -> return bk
         Nothing 
            -> ASSERT2(isExternalName nm, ppr nm)
 	      do let sym_to_find = nameToCLabel nm "closure"
diff --git a/compiler/main/Breakpoints.hs b/compiler/main/Breakpoints.hs
index 14d9ea2..b1b0118 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
-- 
1.7.10.4