Re-working of the breakpoint support

This is the result of Bernie Pope's internship work at MSR Cambridge,
with some subsequent improvements by me.  The main plan was to

 (a) Reduce the overhead for breakpoints, so we could enable 
     the feature by default without incurrent a significant penalty
 (b) Scatter more breakpoint sites throughout the code

Currently we can set a breakpoint on almost any subexpression, and the
overhead is around 1.5x slower than normal GHCi.  I hope to be able to
get this down further and/or allow breakpoints to be turned off.

This patch also fixes up :print following the recent changes to
constructor info tables.  (most of the :print tests now pass)

We now support single-stepping, which just enables all breakpoints.

  :step <expr>     executes <expr> with single-stepping turned on
  :step            single-steps from the current breakpoint

The mechanism is quite different to the previous implementation.  We
share code with the HPC (haskell program coverage) implementation now.
The coverage pass annotates source code with "tick" locations which
are tracked by the coverage tool.  In GHCi, each "tick" becomes a
potential breakpoint location.

Previously breakpoints were compiled into code that magically invoked
a nested instance of GHCi.  Now, a breakpoint causes the current
thread to block and control is returned to GHCi.

See the wiki page for more details and the current ToDo list:

  http://hackage.haskell.org/trac/ghc/wiki/NewGhciDebugger

47 files changed, 1377 insertions, 1200 deletions

diff --git a/compiler/Makefile b/compiler/Makefile
index 1e8322b79a..e16bf4eca1 100644
--- a/compiler/Makefile
+++ b/compiler/Makefile
@@ -415,10 +415,6 @@ ifeq "$(GhcWithInterpreter) $(bootstrapped)" "YES YES"
 SRC_HC_OPTS += -DGHCI -package template-haskell
 PKG_DEPENDS += template-haskell
 
-# Should the debugger commands be enabled?
-ifeq "$(GhciWithDebugger)" "YES"
-SRC_HC_OPTS += -DDEBUGGER
-endif
 # Should GHCI be building info tables in the TABLES_NEXT_TO_CODE style
 # or not?
 ifeq "$(GhcEnableTablesNextToCode) $(GhcUnregisterised)" "YES NO"
diff --git a/compiler/basicTypes/IdInfo.lhs b/compiler/basicTypes/IdInfo.lhs
index 02ef0db142..b59ddf9654 100644
--- a/compiler/basicTypes/IdInfo.lhs
+++ b/compiler/basicTypes/IdInfo.lhs
@@ -718,8 +718,8 @@ zapFragileInfo info = Just (info `setSpecInfo` emptySpecInfo
 type TickBoxId = Int
 
 data TickBoxOp 
-   = TickBox Module !TickBoxId  -- ^Tick box for Hpc-style coverage,
-				-- type = State# Void#
+   = TickBox Module {-# UNPACK #-} !TickBoxId
+          -- ^Tick box for Hpc-style coverage
 
 instance Outputable TickBoxOp where
     ppr (TickBox mod n)         = ptext SLIT("tick") <+> ppr (mod,n)
diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index 741ca5886d..67cf5e4a6c 100644
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -18,7 +18,7 @@ module MkId (
 
 	mkDataConIds,
 	mkRecordSelId, 
-	mkPrimOpId, mkFCallId, mkTickBoxOpId, 
+	mkPrimOpId, mkFCallId, mkTickBoxOpId, mkBreakPointOpId,
 
 	mkReboxingAlt, wrapNewTypeBody, unwrapNewTypeBody,
         mkUnpackCase, mkProductBox,
@@ -905,17 +905,28 @@ mkFCallId uniq fcall ty
     arity	 = length arg_tys
     strict_sig   = mkStrictSig (mkTopDmdType (replicate arity evalDmd) TopRes)
 
-mkTickBoxOpId :: Unique 
-	      -> Module
-	      -> TickBoxId
-	      -> Id
-mkTickBoxOpId uniq mod ix =  mkGlobalId (TickBoxOpId tickbox) name ty info    
+-- Tick boxes and breakpoints are both represented as TickBoxOpIds,
+-- except for the type:
+--
+--    a plain HPC tick box has type (State# RealWorld)
+--    a breakpoint Id has type forall a.a
+--
+-- The breakpoint Id will be applied to a list of arbitrary free variables,
+-- which is why it needs a polymorphic type.
+
+mkTickBoxOpId :: Unique -> Module -> TickBoxId -> Id
+mkTickBoxOpId uniq mod ix = mkTickBox' uniq mod ix realWorldStatePrimTy
+
+mkBreakPointOpId :: Unique -> Module -> TickBoxId -> Id
+mkBreakPointOpId uniq mod ix = mkTickBox' uniq mod ix ty
+ where ty = mkSigmaTy [openAlphaTyVar] [] openAlphaTy
+
+mkTickBox' uniq mod ix ty = mkGlobalId (TickBoxOpId tickbox) name ty info    
   where
     tickbox = TickBox mod ix
     occ_str = showSDoc (braces (ppr tickbox))
     name    = mkTickBoxOpName uniq occ_str
     info    = noCafIdInfo
-    ty      = realWorldStatePrimTy 
 \end{code}
 
 
diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index 72a57137c2..bd350722ff 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -607,6 +607,7 @@ stmtMacros = listToUFM [
   ( FSLIT("RET_NN"),	\[a,b] ->     emitRetUT [(NonPtrArg,a),(NonPtrArg,b)]),
   ( FSLIT("RET_NP"),	\[a,b] ->     emitRetUT [(NonPtrArg,a),(PtrArg,b)]),
   ( FSLIT("RET_PPP"),	\[a,b,c] ->   emitRetUT [(PtrArg,a),(PtrArg,b),(PtrArg,c)]),
+  ( FSLIT("RET_NPP"),	\[a,b,c] ->   emitRetUT [(NonPtrArg,a),(PtrArg,b),(PtrArg,c)]),
   ( FSLIT("RET_NNP"),	\[a,b,c] ->   emitRetUT [(NonPtrArg,a),(NonPtrArg,b),(PtrArg,c)]),
   ( FSLIT("RET_NNNP"),	\[a,b,c,d] -> emitRetUT [(NonPtrArg,a),(NonPtrArg,b),(NonPtrArg,c),(PtrArg,d)]),
   ( FSLIT("RET_NPNP"),	\[a,b,c,d] -> emitRetUT [(NonPtrArg,a),(PtrArg,b),(NonPtrArg,c),(PtrArg,d)])
diff --git a/compiler/deSugar/Coverage.lhs b/compiler/deSugar/Coverage.lhs
index 64e65a4057..8624780231 100644
--- a/compiler/deSugar/Coverage.lhs
+++ b/compiler/deSugar/Coverage.lhs
@@ -1,5 +1,6 @@
 %
 % (c) Galois, 2006
+% (c) University of Glasgow, 2007
 %
 \section[Coverage]{@coverage@: the main function}
 
@@ -20,7 +21,9 @@ import Bag
 import Var
 import Data.List
 import FastString
+import StaticFlags
 
+import Data.Array
 import System.Time (ClockTime(..))
 import System.Directory (getModificationTime)
 import System.IO   (FilePath)
@@ -29,6 +32,9 @@ import Compat.Directory ( createDirectoryIfMissing )
 #else
 import System.Directory ( createDirectoryIfMissing )
 #endif
+
+import HscTypes 
+import BreakArray 
 \end{code}
 
 %************************************************************************
@@ -38,15 +44,20 @@ import System.Directory ( createDirectoryIfMissing )
 %************************************************************************
 
 \begin{code}
+addCoverageTicksToBinds
+        :: DynFlags
+        -> Module
+        -> ModLocation          -- of the current module
+        -> LHsBinds Id
+        -> IO (LHsBinds Id, Int, ModBreaks)
+
 addCoverageTicksToBinds dflags mod mod_loc binds = do 
   let orig_file = 
              case ml_hs_file mod_loc of
 		    Just file -> file
 		    Nothing -> panic "can not find the original file during hpc trans"
 
-  if "boot" `isSuffixOf` orig_file then return (binds, 0) else do
-
-  modTime <- getModificationTime' orig_file
+  if "boot" `isSuffixOf` orig_file then return (binds, 0, emptyModBreaks) else do
 
   let mod_name = moduleNameString (moduleName mod)
 
@@ -58,19 +69,32 @@ addCoverageTicksToBinds dflags mod mod_loc binds = do
 		      , mixEntries   = []
 		      }
 
-  let hpc_dir = hpcDir dflags
+  let entries = reverse $ mixEntries st
 
   -- write the mix entries for this module
-  let tabStop = 1 -- <tab> counts as a normal char in GHC's location ranges.
-
-  createDirectoryIfMissing True hpc_dir
-
-  mixCreate hpc_dir mod_name (Mix orig_file modTime tabStop $ reverse $ mixEntries st)
+  when opt_Hpc $ do
+     let hpc_dir = hpcDir dflags
+     let tabStop = 1 -- <tab> counts as a normal char in GHC's location ranges.
+     createDirectoryIfMissing True hpc_dir
+     modTime <- getModificationTime' orig_file
+     mixCreate hpc_dir mod_name (Mix orig_file modTime tabStop entries)
+
+  -- Todo: use proper src span type
+  breakArray <- newBreakArray $ length entries
+  let fn = mkFastString orig_file
+  let locsTicks = listArray (0,tickBoxCount st-1)
+                        [ mkSrcSpan (mkSrcLoc fn r1 c1) (mkSrcLoc fn r2 c2)
+                        | (P r1 c1 r2 c2, _box) <- entries ] 
+
+  let modBreaks = emptyModBreaks 
+                  { modBreaks_array = breakArray 
+                  , modBreaks_ticks = locsTicks 
+                  } 
 
   doIfSet_dyn dflags  Opt_D_dump_hpc $ do
 	  printDump (pprLHsBinds binds1)
---	  putStrLn (showSDocDebug (pprLHsBinds binds3))
-  return (binds1, tickBoxCount st)
+
+  return (binds1, tickBoxCount st, modBreaks)
 \end{code}
 
 
@@ -87,20 +111,32 @@ addTickLHsBind :: LHsBind Id -> TM (LHsBind Id)
 addTickLHsBind (L pos (AbsBinds abs_tvs abs_dicts abs_exports abs_binds)) = do
   abs_binds' <- addTickLHsBinds abs_binds
   return $ L pos $ AbsBinds abs_tvs abs_dicts abs_exports abs_binds'
-addTickLHsBind (L pos (funBind@(FunBind { fun_id = (L _ id)  })))  = do
+
+addTickLHsBind (L pos (funBind@(FunBind { fun_id = (L _ id)  }))) = do 
   let name = getOccString id
   decl_path <- getPathEntry
 
-  tick_no <- allocATickBox (if null decl_path
-			    then TopLevelBox [name]
-			    else LocalBox (name : decl_path))
-			  pos
-
-  mg@(MatchGroup matches' ty) <- addPathEntry (getOccString id)  
+  mg@(MatchGroup matches' ty) <- addPathEntry name  
 				 $ addTickMatchGroup (fun_matches funBind)
-  return $ L pos $ funBind { fun_matches = MatchGroup matches' ty 
-			   , fun_tick = tick_no
-			   }
+
+  -- Todo: we don't want redundant ticks on simple pattern bindings
+  if not opt_Hpc && isSimplePatBind funBind
+     then 
+        return $ L pos $ funBind { fun_matches = MatchGroup matches' ty 
+                                 , fun_tick = Nothing 
+                                 }
+     else do
+        tick_no <- allocATickBox (if null decl_path
+                                     then TopLevelBox [name]
+                                     else LocalBox (name : decl_path)) pos
+
+        return $ L pos $ funBind { fun_matches = MatchGroup matches' ty 
+                                 , fun_tick = tick_no
+                                 }
+   where
+   -- a binding is a simple pattern binding if it is a funbind with zero patterns
+   isSimplePatBind :: HsBind a -> Bool
+   isSimplePatBind funBind = matchGroupArity (fun_matches funBind) == 0
 
 -- TODO: Revisit this
 addTickLHsBind (L pos (pat@(PatBind { pat_rhs = rhs }))) = do
@@ -121,14 +157,47 @@ addTickLHsBind (VarBind var_id var_rhs) = do
 -}
 addTickLHsBind other = return other
 
-addTickLHsExpr :: LHsExpr Id -> TM (LHsExpr Id)
-addTickLHsExpr (L pos e0) = do
+-- add a tick to the expression no matter what it is
+addTickLHsExprAlways :: LHsExpr Id -> TM (LHsExpr Id)
+addTickLHsExprAlways (L pos e0) = do
     e1 <- addTickHsExpr e0
     fn <- allocTickBox ExpBox pos 
     return $ fn $ L pos e1
 
+-- always a breakpoint tick, maybe an HPC tick
+addTickLHsExprBreakAlways :: LHsExpr Id -> TM (LHsExpr Id)
+addTickLHsExprBreakAlways e
+    | opt_Hpc   = addTickLHsExpr e
+    | otherwise = addTickLHsExprAlways e
+
+-- selectively add ticks to interesting expressions
+addTickLHsExpr :: LHsExpr Id -> TM (LHsExpr Id)
+addTickLHsExpr (L pos e0) = do
+    e1 <- addTickHsExpr e0
+    if opt_Hpc || isGoodBreakExpr e0
+       then do
+          fn <- allocTickBox ExpBox pos 
+          return $ fn $ L pos e1
+       else
+          return $ L pos e1 
+
+-- general heuristic: expressions which do not denote values are good break points
+isGoodBreakExpr :: HsExpr Id -> Bool
+isGoodBreakExpr (HsApp {})     = True
+isGoodBreakExpr (OpApp {})     = True
+isGoodBreakExpr (NegApp {})    = True
+isGoodBreakExpr (HsCase {})    = True
+isGoodBreakExpr (HsIf {})      = True
+isGoodBreakExpr (RecordCon {}) = True
+isGoodBreakExpr (RecordUpd {}) = True
+isGoodBreakExpr (ArithSeq {})  = True
+isGoodBreakExpr (PArrSeq {})   = True
+isGoodBreakExpr other          = False 
+
 addTickLHsExprOptAlt :: Bool -> LHsExpr Id -> TM (LHsExpr Id)
-addTickLHsExprOptAlt oneOfMany (L pos e0) = do
+addTickLHsExprOptAlt oneOfMany (L pos e0)
+  | not opt_Hpc = addTickLHsExpr (L pos e0)
+  | otherwise = do
     e1 <- addTickHsExpr e0
     fn <- allocTickBox (if oneOfMany then AltBox else ExpBox) pos 
     return $ fn $ L pos e1
@@ -145,7 +214,6 @@ addBinTickLHsExpr :: (Bool -> BoxLabel) -> LHsExpr Id -> TM (LHsExpr Id)
 addBinTickLHsExpr boxLabel (L pos e0) = do
     e1 <- addTickHsExpr e0
     allocBinTickBox boxLabel $ L pos e1
-    
 
 addTickHsExpr :: HsExpr Id -> TM (HsExpr Id)
 addTickHsExpr e@(HsVar _) = return e
@@ -162,7 +230,7 @@ addTickHsExpr (OpApp e1 e2 fix e3) =
 		(addTickLHsExpr' e2)
 		(return fix)
 		(addTickLHsExpr e3)
-addTickHsExpr ( NegApp e neg) =
+addTickHsExpr (NegApp e neg) =
 	liftM2 NegApp
 		(addTickLHsExpr e) 
 		(addTickSyntaxExpr hpcSrcSpan neg)
@@ -201,11 +269,11 @@ addTickHsExpr (HsDo cxt stmts last_exp srcloc) =
 addTickHsExpr (ExplicitList ty es) = 
 	liftM2 ExplicitList 
 		(return ty)
-		(mapM addTickLHsExpr es)
+		(mapM (addTickLHsExpr) es)
 addTickHsExpr (ExplicitPArr	 {}) = error "addTickHsExpr: ExplicitPArr"
 addTickHsExpr (ExplicitTuple es box) =
 	liftM2 ExplicitTuple
-		(mapM addTickLHsExpr es)
+		(mapM (addTickLHsExpr) es)
 		(return box)
 addTickHsExpr (RecordCon	 id ty rec_binds) = 
 	liftM3 RecordCon
@@ -242,7 +310,7 @@ addTickHsExpr e@(HsSpliceE  {}) = return e
 addTickHsExpr (HsProc pat cmdtop) =
 	liftM2 HsProc
 		(addTickLPat pat)
-		(liftL addTickHsCmdTop cmdtop)
+		(liftL (addTickHsCmdTop) cmdtop)
 addTickHsExpr (HsWrap w e) = 
 	liftM2 HsWrap
 		(return w)
@@ -258,7 +326,7 @@ addTickHsExpr (HsArrForm e fix cmdtop) =
         liftM3 HsArrForm
 	       (addTickLHsExpr e)
 	       (return fix)
-	       (mapM (liftL addTickHsCmdTop) cmdtop)
+	       (mapM (liftL (addTickHsCmdTop)) cmdtop)
 
 addTickHsExpr e@(HsType ty) = return e
 
@@ -288,15 +356,15 @@ addTickGRHSs isOneOfMany (GRHSs guarded local_binds) = do
 addTickGRHS :: Bool -> GRHS Id -> TM (GRHS Id)
 addTickGRHS isOneOfMany (GRHS stmts expr) = do
   stmts' <- mapM (liftL (addTickStmt (Just $ GuardBinBox))) stmts
-  expr' <- addTickLHsExprOptAlt isOneOfMany expr
+  expr' <- if opt_Hpc then addTickLHsExprOptAlt isOneOfMany expr
+                      else addTickLHsExprAlways expr 
   return $ GRHS stmts' expr'
 
-
 addTickStmt :: (Maybe (Bool -> BoxLabel)) -> Stmt Id -> TM (Stmt Id)
 addTickStmt isGuard (BindStmt pat e bind fail) =
 	liftM4 BindStmt
 		(addTickLPat pat)
-		(addTickLHsExpr e)
+		(addTickLHsExprBreakAlways e)
 		(addTickSyntaxExpr hpcSrcSpan bind)
 		(addTickSyntaxExpr hpcSrcSpan fail)
 addTickStmt isGuard (ExprStmt e bind' ty) =
@@ -305,8 +373,8 @@ addTickStmt isGuard (ExprStmt e bind' ty) =
 		(addTickSyntaxExpr hpcSrcSpan bind')
 		(return ty)
   where
-	addTick e | Just fn <- isGuard = addBinTickLHsExpr fn e
-		  | otherwise          = addTickLHsExpr e
+   addTick e | Just fn <- isGuard = addBinTickLHsExpr fn e
+             | otherwise          = addTickLHsExprBreakAlways e
 
 addTickStmt isGuard (LetStmt binds) =
 	liftM LetStmt
@@ -346,7 +414,7 @@ addTickHsValBinds (ValBindsOut binds sigs) =
 
 addTickHsIPBinds (IPBinds ipbinds dictbinds) =
 	liftM2 IPBinds
-		(mapM (liftL addTickIPBind) ipbinds)
+		(mapM (liftL (addTickIPBind)) ipbinds)
 		(addTickDictBinds dictbinds)
 
 addTickIPBind :: IPBind Id -> TM (IPBind Id)
@@ -372,7 +440,7 @@ addTickHsCmdTop (HsCmdTop cmd tys ty syntaxtable) =
 		(return ty)
 		(return syntaxtable)
 
-addTickLHsCmd :: LHsCmd Id -> TM (LHsCmd Id)
+addTickLHsCmd ::  LHsCmd Id -> TM (LHsCmd Id)
 addTickLHsCmd x = addTickLHsExpr x
 
 addTickDictBinds :: DictBinds Id -> TM (DictBinds Id)
@@ -461,12 +529,18 @@ allocBinTickBox boxLabel (L pos e) | Just hpcPos <- mkHpcPos pos = TM $ \ st ->
       meE = (hpcPos,ExpBox)
       c = tickBoxCount st
       mes = mixEntries st
-  in ( L pos $ HsTick c $ L pos $ HsBinTick (c+1) (c+2) (L pos e)
-	-- notice that F and T are reversed,
-	-- because we are building the list in
-	-- reverse...
-     , st {tickBoxCount=c+3,mixEntries=meF:meT:meE:mes}
-     )
+  in 
+     if opt_Hpc 
+        then ( L pos $ HsTick c $ L pos $ HsBinTick (c+1) (c+2) (L pos e)
+           -- notice that F and T are reversed,
+           -- because we are building the list in
+           -- reverse...
+             , st {tickBoxCount=c+3,mixEntries=meF:meT:meE:mes}
+             )
+        else
+             ( L pos $ HsTick c $ L pos e
+             , st {tickBoxCount=c+1,mixEntries=meE:mes}
+             )
 
 allocBinTickBox boxLabel e = return e
 
diff --git a/compiler/deSugar/Desugar.lhs b/compiler/deSugar/Desugar.lhs
index 9da049d5e0..4b60768fc3 100644
--- a/compiler/deSugar/Desugar.lhs
+++ b/compiler/deSugar/Desugar.lhs
@@ -45,7 +45,6 @@ import Util
 import Coverage
 import IOEnv
 import Data.IORef
-
 \end{code}
 
 %************************************************************************
@@ -85,28 +84,24 @@ deSugar hsc_env
 	-- Desugar the program
         ; let export_set = availsToNameSet exports
 	; let auto_scc = mkAutoScc mod export_set
-        ; let noDbgSites = []
         ; let target = hscTarget dflags
 	; mb_res <- case target of
-	             HscNothing -> return (Just ([], [], NoStubs, noHpcInfo, noDbgSites))
-                     _        -> do (binds_cvr,ds_hpc_info) 
-					      <- if opt_Hpc
+	             HscNothing -> return (Just ([], [], NoStubs, noHpcInfo, emptyModBreaks))
+                     _        -> do (binds_cvr,ds_hpc_info, modBreaks) 
+					      <- if opt_Hpc || target == HscInterpreted
                                                  then addCoverageTicksToBinds dflags mod mod_loc binds
-                                                 else return (binds, noHpcInfo)
+                                                 else return (binds, noHpcInfo, emptyModBreaks)
                                     initDs hsc_env mod rdr_env type_env $ do
 		                        { core_prs <- dsTopLHsBinds auto_scc binds_cvr
 		                        ; (ds_fords, foreign_prs) <- dsForeigns fords
 		                        ; let all_prs = foreign_prs ++ core_prs
 		                              local_bndrs = mkVarSet (map fst all_prs)
 		                        ; ds_rules <- mappM (dsRule mod local_bndrs) rules
-		                        ; return (all_prs, catMaybes ds_rules, ds_fords, ds_hpc_info)
-                                        ; dbgSites_var <- getBkptSitesDs
-                                        ; dbgSites <- ioToIOEnv$ readIORef dbgSites_var
-		                        ; return (all_prs, catMaybes ds_rules, ds_fords, ds_hpc_info, dbgSites)
+		                        ; return (all_prs, catMaybes ds_rules, ds_fords, ds_hpc_info, modBreaks)
 		                        }
 	; case mb_res of {
 	   Nothing -> return Nothing ;
-	   Just (all_prs, ds_rules, ds_fords,ds_hpc_info, dbgSites) -> do
+	   Just (all_prs, ds_rules, ds_fords,ds_hpc_info, modBreaks) -> do
 
 	{ 	-- Add export flags to bindings
 	  keep_alive <- readIORef keep_var
@@ -177,7 +172,7 @@ deSugar hsc_env
 		mg_binds     	= ds_binds,
 		mg_foreign   	= ds_fords,
 		mg_hpc_info  	= ds_hpc_info,
-                mg_dbg_sites 	= dbgSites }
+                mg_modBreaks    = modBreaks }
         ; return (Just mod_guts)
 	}}}
 
diff --git a/compiler/deSugar/DsBinds.lhs b/compiler/deSugar/DsBinds.lhs
index d974c0579f..51d6daf6ce 100644
--- a/compiler/deSugar/DsBinds.lhs
+++ b/compiler/deSugar/DsBinds.lhs
@@ -23,7 +23,6 @@ import {-# SOURCE #-}	Match( matchWrapper )
 import DsMonad
 import DsGRHSs
 import DsUtils
-import DsBreakpoint
 
 import HsSyn		-- lots of things
 import CoreSyn		-- lots of things
@@ -63,23 +62,7 @@ import Data.List
 
 \begin{code}
 dsTopLHsBinds :: AutoScc -> LHsBinds Id -> DsM [(Id,CoreExpr)]
-dsTopLHsBinds auto_scc binds = do
-  mb_mod_name_ref <- getModNameRefDs
-  debugging <- breakpoints_enabled
-  case mb_mod_name_ref of 
-    Nothing | debugging -> do  -- Inject a CAF with the module name as literal
-      mod <- getModuleDs
-      mod_name_ref <- do
-                 u <- newUnique 
-                 let n = mkSystemName u (mkVarOcc "_module")
-                 return (mkLocalId n stringTy)
-      let mod_name = moduleNameFS$ moduleName mod
-      mod_lit <- dsExpr (HsLit (HsString mod_name))
-      withModNameRefDs mod_name_ref $ do
-                 res <- ds_lhs_binds auto_scc binds
-                 return$ (mod_name_ref, mod_lit) : res
-    _  -> ds_lhs_binds auto_scc binds
-
+dsTopLHsBinds auto_scc binds = ds_lhs_binds auto_scc binds
 
 dsLHsBinds :: LHsBinds Id -> DsM [(Id,CoreExpr)]
 dsLHsBinds binds = ds_lhs_binds NoSccs binds
diff --git a/compiler/deSugar/DsBreakpoint.lhs b/compiler/deSugar/DsBreakpoint.lhs
deleted file mode 100644
index c6a090e230..0000000000
--- a/compiler/deSugar/DsBreakpoint.lhs
+++ /dev/null
@@ -1,217 +0,0 @@
------------------------------------------------------------------------------
---
--- Support code for instrumentation and expansion of the breakpoint combinator
---
--- Pepe Iborra (supported by Google SoC) 2006
---
------------------------------------------------------------------------------
-
-\begin{code}
-module DsBreakpoint( debug_enabled
-                   , dsAndThenMaybeInsertBreakpoint
-                   , maybeInsertBreakpoint
-                   , breakpoints_enabled
-                   , mkBreakpointExpr
-                   ) where
-
-import TysPrim
-import TysWiredIn
-import PrelNames        
-import Module
-import SrcLoc
-import TyCon
-import TypeRep
-import DataCon          
-import Type             
-import Id 
-
-import IdInfo
-import BasicTypes
-import OccName
-
-import TcRnMonad
-import HsSyn            
-import HsLit
-import CoreSyn
-import CoreUtils
-import Outputable
-import ErrUtils
-import FastString
-import DynFlags
-import MkId
- 
-import DsMonad 
-import {-#SOURCE#-}DsExpr ( dsLExpr ) 
-import Control.Monad
-import Data.IORef
-import Foreign.StablePtr
-import GHC.Exts
-
-#ifdef GHCI
-mkBreakpointExpr :: SrcSpan -> Id -> Type -> DsM (LHsExpr Id)
-mkBreakpointExpr loc bkptFuncId ty = do
-        scope <- getScope
-        mod   <- getModuleDs
-        u     <- newUnique
-        let valId = mkUserLocal (mkVarOcc "_result") u ty noSrcLoc 
-        when (not instrumenting) $
-              warnDs (text "Extracted ids:" <+> (ppr scope $$ 
-                                                   ppr (map idType scope)))
-        stablePtr <- ioToIOEnv $ newStablePtr (valId:scope)
-        site      <- if instrumenting
-                        then recordBkpt (srcSpanStart loc)
-                        else return 0
-        ATyCon opaqueTyCon <- dsLookupGlobal opaqueTyConName
-        jumpFuncId         <- mkJumpFunc bkptFuncId
-        Just mod_name_ref  <- getModNameRefDs 
-        let [opaqueDataCon] = tyConDataCons opaqueTyCon
-            opaqueId = dataConWrapId opaqueDataCon
-            opaqueTy = mkTyConApp opaqueTyCon []
-            wrapInOpaque id = 
-                  l(HsApp (l(HsWrap (WpTyApp (idType id)) (HsVar opaqueId)))
-                          (l(HsVar id)))
-           -- Yes, I know... I'm gonna burn in hell.
-            Ptr addr# = castStablePtrToPtr stablePtr
-            locals    = ExplicitList opaqueTy (map wrapInOpaque scope)
-            locInfo = nlTuple [ HsVar mod_name_ref
-                              , HsLit (HsInt (fromIntegral site))]
-            funE  = l$ HsVar jumpFuncId
-            ptrE  = (HsLit (HsInt (fromIntegral (I# (addr2Int# addr#)))))
-            locE  = locInfo
-            msgE  = srcSpanLit loc
-            argsE = nlTuple [ptrE, locals, msgE]
-            lazy_argsE = HsApp (l$ HsWrap (WpTyApp argsT) (HsVar lazyId)) (l argsE)
-            argsT = mkTupleType [intTy, mkListTy opaqueTy, stringTy]
-        return $ 
-            l(l(funE `HsApp` l locE) `HsApp` l lazy_argsE)
-
-    where l = L loc
-          nlTuple exps = ExplicitTuple (map noLoc exps) Boxed
-          srcSpanLit :: SrcSpan -> HsExpr Id
-          srcSpanLit span = HsLit (HsString (mkFastString (showSDoc (ppr span))))
-          instrumenting = idName bkptFuncId == breakpointAutoName
-          mkTupleType tys = mkTupleTy Boxed (length tys) tys
-#else
-mkBreakpointExpr = undefined    -- A stage1 ghc doesn't care about breakpoints
-#endif
-
-getScope :: DsM [Id]
-getScope = getLocalBindsDs >>= return . filter(isValidType .idType )
-    where isValidType (FunTy a b)  = isValidType a && isValidType b
-          isValidType (NoteTy _ t) = isValidType t
-          isValidType (AppTy a b)  = isValidType a && isValidType b
-          isValidType (TyConApp con ts) = not (isUnLiftedTyCon con) && 
-                                          all isValidType ts
---        isValidType (PredTy p `FunTy` ty ) = False -- TODO: Too restrictive ? 
-          isValidType _ = True
-
-dynBreakpoint :: SrcSpan -> DsM (LHsExpr Id)
-#ifdef DEBUG
-dynBreakpoint loc | not (isGoodSrcSpan loc) = 
-                         pprPanic "dynBreakpoint: bad SrcSpan" (ppr loc)
-#endif
-dynBreakpoint loc = do 
-    let autoBreakpoint = Id.mkGlobalId VanillaGlobal breakpointAutoName 
-                         breakpointAutoTy vanillaIdInfo
-    dflags <- getDOptsDs 
-    ioToIOEnv$ debugTraceMsg dflags 3 (text "Breakpoint inserted at " <> ppr loc)
-    return$ L loc (HsVar autoBreakpoint)
-  where breakpointAutoTy = (ForAllTy alphaTyVar
-                                (FunTy (TyVarTy  alphaTyVar)
-                                 (TyVarTy alphaTyVar)))
-
--- Records a breakpoint site and returns the site number
-recordBkpt :: SrcLoc -> DsM (Int)
-recordBkpt loc = do
-    sites_var <- getBkptSitesDs
-    sites     <- ioToIOEnv$ readIORef sites_var
-    let site   = length sites + 1
-    let coords = (srcLocLine loc, srcLocCol loc)
-    ioToIOEnv$ writeIORef sites_var ((site, coords) : sites) 
-    return site
-
-mkJumpFunc :: Id -> DsM Id  
-mkJumpFunc bkptFuncId
-    | idName bkptFuncId == breakpointName 
-    = build breakpointJumpName id
-    | idName bkptFuncId == breakpointCondName 
-    = build breakpointCondJumpName (FunTy boolTy)
-    | idName bkptFuncId == breakpointAutoName 
-    = build breakpointAutoJumpName id
-  where 
-        tyvar = alphaTyVar
-        basicType extra opaqueTy = 
-               (FunTy (mkTupleType [stringTy, intTy])
-                 (FunTy (mkTupleType [intTy, mkListTy opaqueTy, stringTy])
-                          (ForAllTy tyvar
-                               (extra
-                                (FunTy (TyVarTy tyvar)
-                                 (TyVarTy tyvar))))))
-        build name extra  = do 
-            ATyCon opaqueTyCon <- dsLookupGlobal opaqueTyConName
-            return$ Id.mkGlobalId VanillaGlobal name
-                      (basicType extra (mkTyConApp opaqueTyCon [])) vanillaIdInfo
-        mkTupleType tys = mkTupleTy Boxed (length tys) tys
-
-debug_enabled, breakpoints_enabled :: DsM Bool
-dsAndThenMaybeInsertBreakpoint :: LHsExpr Id -> DsM CoreExpr
-maybeInsertBreakpoint :: LHsExpr Id -> Type ->  DsM (LHsExpr Id)
-
-#if defined(GHCI) && defined(DEBUGGER)
-debug_enabled = do
-    debugging      <- doptDs Opt_Debugging
-    b_enabled      <- breakpoints_enabled
-    return (debugging && b_enabled)
-
-breakpoints_enabled = do
-    ghcMode            <- getGhcModeDs
-    currentModule      <- getModuleDs
-    dflags             <- getDOptsDs
-    ignore_breakpoints <- doptDs Opt_IgnoreBreakpoints
-    return ( not ignore_breakpoints 
-          && hscTarget dflags == HscInterpreted
-          && currentModule /= iNTERACTIVE )
-
-maybeInsertBreakpoint lhsexpr@(L loc _) ty = do 
-  instrumenting <- isInstrumentationSpot lhsexpr
-  scope         <- getScope
-  if instrumenting && not(isUnLiftedType ty) && 
-     not(isEnabledNullScopeCoalescing && null scope)
-         then do L _ dynBkpt <- dynBreakpoint loc 
-                 return$ l(HsApp (l$ HsWrap (WpTyApp ty) dynBkpt) lhsexpr)
-         else return lhsexpr
-  where l = L loc
-dsAndThenMaybeInsertBreakpoint expr@(L loc _) = do
-  coreExpr      <- dsLExpr expr
-  instrumenting <- isInstrumentationSpot expr
-  scope         <- getScope
-  let ty = exprType coreExpr
-  if instrumenting && not (isUnLiftedType (exprType coreExpr)) &&
-     not(isEnabledNullScopeCoalescing && null scope)
-         then do L _ dynBkpt<- dynBreakpoint loc
-                 bkptCore   <- dsLExpr (l$ HsWrap (WpTyApp ty) dynBkpt)
-                 return (bkptCore `App` coreExpr)
-         else return coreExpr
-  where l = L loc
-#else
-maybeInsertBreakpoint expr _ = return expr
-dsAndThenMaybeInsertBreakpoint coreExpr = dsLExpr coreExpr
-breakpoints_enabled = return False
-debug_enabled = return False
-#endif
-
-
-isInstrumentationSpot (L loc e) = do
-  ghcmode   <- getGhcModeDs
-  instrumenting <- debug_enabled 
-  return$ instrumenting     
-          && isGoodSrcSpan loc          -- Avoids 'derived' code
-          && (not$ isRedundant e)
-
-isEnabledNullScopeCoalescing = True
-isRedundant HsLet  {} = True
-isRedundant HsDo   {} = True
-isRedundant HsCase {} = False
-isRedundant     _     = False
-
-\end{code}
diff --git a/compiler/deSugar/DsExpr.lhs b/compiler/deSugar/DsExpr.lhs
index 982e315780..d09196d33b 100644
--- a/compiler/deSugar/DsExpr.lhs
+++ b/compiler/deSugar/DsExpr.lhs
@@ -22,11 +22,8 @@ import DsMonad
 
 #ifdef GHCI
 import PrelNames
-import DsBreakpoint
 	-- Template Haskell stuff iff bootstrapped
 import DsMeta
-#else
-import DsBreakpoint
 #endif
 
 import HsSyn
@@ -52,8 +49,6 @@ import Util
 import Bag
 import Outputable
 import FastString
-
-import Data.Maybe
 \end{code}
 
 
@@ -189,21 +184,6 @@ scrungleMatch var scrut body
 \begin{code}
 dsLExpr :: LHsExpr Id -> DsM CoreExpr
 
-#if defined(GHCI)
-dsLExpr (L loc expr@(HsWrap w (HsVar v)))
-    | idName v `elem` [breakpointName, breakpointCondName, breakpointAutoName]
-    , WpTyApp ty <- simpWrapper w
-    = do areBreakpointsEnabled <- breakpoints_enabled
-         if areBreakpointsEnabled
-           then do
-              L _ breakpointExpr <- mkBreakpointExpr loc v ty
-              dsLExpr (L loc $ HsWrap w breakpointExpr)
-           else putSrcSpanDs loc $ dsExpr expr
-       where simpWrapper (WpCompose w1 WpHole) = w1
-             simpWrapper (WpCompose WpHole w1) = w1
-             simpWrapper w = w
-#endif
-
 dsLExpr (L loc e) = putSrcSpanDs loc $ dsExpr e
 
 dsExpr :: HsExpr Id -> DsM CoreExpr
@@ -300,7 +280,7 @@ dsExpr (HsCase discrim matches)
 --       This is to avoid silliness in breakpoints
 dsExpr (HsLet binds body)
   = (bindLocalsDs (map unLoc $ collectLocalBinders binds) $ 
-     dsAndThenMaybeInsertBreakpoint body) `thenDs` \ body' ->
+     dsLExpr body) `thenDs` \ body' ->
     dsLocalBinds binds body'
 
 -- We need the `ListComp' form to use `deListComp' (rather than the "do" form)
@@ -602,10 +582,10 @@ dsDo	:: [LStmt Id]
 dsDo stmts body result_ty
   = go (map unLoc stmts)
   where
-    go [] = dsAndThenMaybeInsertBreakpoint body
+    go [] = dsLExpr body
     
     go (ExprStmt rhs then_expr _ : stmts)
-      = do { rhs2 <- dsAndThenMaybeInsertBreakpoint rhs
+      = do { rhs2 <- dsLExpr rhs
 	   ; then_expr2 <- dsExpr then_expr
 	   ; rest <- go stmts
 	   ; returnDs (mkApps then_expr2 [rhs2, rest]) }
@@ -625,7 +605,7 @@ dsDo stmts body result_ty
 	   ; match <- matchSinglePat (Var var) (StmtCtxt DoExpr) pat
     				  result_ty (cantFailMatchResult body)
 	   ; match_code <- handle_failure pat match fail_op
-           ; rhs'       <- dsAndThenMaybeInsertBreakpoint rhs
+           ; rhs'       <- dsLExpr rhs
 	   ; bind_op'   <- dsExpr bind_op
 	   ; returnDs (mkApps bind_op' [rhs', Lam var match_code]) }
     
@@ -675,7 +655,7 @@ dsMDo tbl stmts body result_ty
 	   ; dsLocalBinds binds rest }
 
     go (ExprStmt rhs _ rhs_ty : stmts)
-      = do { rhs2 <- dsAndThenMaybeInsertBreakpoint rhs
+      = do { rhs2 <- dsLExpr rhs
 	   ; rest <- go stmts
 	   ; returnDs (mkApps (Var then_id) [Type rhs_ty, Type b_ty, rhs2, rest]) }
     
@@ -688,7 +668,7 @@ dsMDo tbl stmts body result_ty
 	   ; let fail_expr = mkApps (Var fail_id) [Type b_ty, fail_msg]
 	   ; match_code <- extractMatchResult match fail_expr
 
-	   ; rhs'       <- dsAndThenMaybeInsertBreakpoint rhs
+	   ; rhs'       <- dsLExpr rhs
 	   ; returnDs (mkApps (Var bind_id) [Type (hsLPatType pat), Type b_ty, 
 					     rhs', Lam var match_code]) }
     
diff --git a/compiler/deSugar/DsGRHSs.lhs b/compiler/deSugar/DsGRHSs.lhs
index 8f24239e15..31d48b6eca 100644
--- a/compiler/deSugar/DsGRHSs.lhs
+++ b/compiler/deSugar/DsGRHSs.lhs
@@ -21,7 +21,6 @@ import Type
 
 import DsMonad
 import DsUtils
-import DsBreakpoint
 import Unique
 import PrelInfo
 import TysWiredIn
@@ -73,8 +72,7 @@ dsGRHSs hs_ctx pats (GRHSs grhss binds) rhs_ty =
               patsBinders  = collectPatsBinders (map (L undefined) pats) 
 
 dsGRHS hs_ctx pats rhs_ty (L loc (GRHS guards rhs))
-  = do rhs' <- maybeInsertBreakpoint rhs rhs_ty
-       matchGuards (map unLoc guards) hs_ctx rhs' rhs_ty
+  = matchGuards (map unLoc guards) hs_ctx rhs rhs_ty
 \end{code}
 
 
diff --git a/compiler/deSugar/DsMonad.lhs b/compiler/deSugar/DsMonad.lhs
index 9251a818ee..ac6a0c0ed7 100644
--- a/compiler/deSugar/DsMonad.lhs
+++ b/compiler/deSugar/DsMonad.lhs
@@ -23,7 +23,7 @@ module DsMonad (
 
 	DsMetaEnv, DsMetaVal(..), dsLookupMetaEnv, dsExtendMetaEnv,
 
-        bindLocalsDs, getLocalBindsDs, getBkptSitesDs, getModNameRefDs, withModNameRefDs,
+        bindLocalsDs, getLocalBindsDs,
 	-- Warnings
 	DsWarning, warnDs, failWithDs,
 
@@ -57,7 +57,6 @@ import OccName
 import DynFlags
 import ErrUtils
 import Bag
-import Breakpoints
 import OccName
 
 import Data.IORef
@@ -136,17 +135,14 @@ data DsGblEnv = DsGblEnv {
 	ds_mod	   :: Module,       		-- For SCC profiling
 	ds_unqual  :: PrintUnqualified,
 	ds_msgs    :: IORef Messages,		-- Warning messages
-	ds_if_env  :: (IfGblEnv, IfLclEnv),	-- Used for looking up global, 
+	ds_if_env  :: (IfGblEnv, IfLclEnv)	-- Used for looking up global, 
 						-- possibly-imported things
-        ds_bkptSites :: IORef SiteMap  -- Inserted Breakpoints sites
     }
 
 data DsLclEnv = DsLclEnv {
 	ds_meta	   :: DsMetaEnv,	-- Template Haskell bindings
 	ds_loc	   :: SrcSpan,		-- to put in pattern-matching error msgs
-        ds_locals  :: OccEnv Id,        -- For locals in breakpoints
-        ds_mod_name_ref :: Maybe Id     -- The Id used to store the Module name 
-                                        --  used by the breakpoint desugaring 
+        ds_locals  :: OccEnv Id         -- For locals in breakpoints
      }
 
 -- Inside [| |] brackets, the desugarer looks 
@@ -209,12 +205,10 @@ mkDsEnvs mod rdr_env type_env msg_var
                gbl_env = DsGblEnv { ds_mod = mod, 
     			            ds_if_env = (if_genv, if_lenv),
     			            ds_unqual = mkPrintUnqualified rdr_env,
-    			            ds_msgs = msg_var,
-                                    ds_bkptSites = sites_var}
+    			            ds_msgs = msg_var}
                lcl_env = DsLclEnv { ds_meta = emptyNameEnv, 
 			            ds_loc = noSrcSpan,
-                                    ds_locals = emptyOccEnv,
-                                    ds_mod_name_ref = Nothing }
+                                    ds_locals = emptyOccEnv }
 
        return (gbl_env, lcl_env)
 
@@ -340,21 +334,10 @@ dsExtendMetaEnv menv thing_inside
 getLocalBindsDs :: DsM [Id]
 getLocalBindsDs = do { env <- getLclEnv; return (occEnvElts$ ds_locals env) }
 
-getModNameRefDs :: DsM (Maybe Id)
-getModNameRefDs = do { env <- getLclEnv; return (ds_mod_name_ref env) }
-
-withModNameRefDs :: Id -> DsM a -> DsM a
-withModNameRefDs id thing_inside =
-    updLclEnv (\env -> env {ds_mod_name_ref = Just id}) thing_inside
-
 bindLocalsDs :: [Id] -> DsM a -> DsM a
 bindLocalsDs new_ids enclosed_scope = 
     updLclEnv (\env-> env {ds_locals = ds_locals env `extendOccEnvList` occnamed_ids})
 	      enclosed_scope
   where occnamed_ids = [ (nameOccName (idName id),id) | id <- new_ids ] 
-
-getBkptSitesDs :: DsM (IORef SiteMap)
-getBkptSitesDs = do { env <- getGblEnv; return (ds_bkptSites env) }
-
 \end{code}
 
diff --git a/compiler/deSugar/DsUtils.lhs b/compiler/deSugar/DsUtils.lhs
index 455db042f9..3c565674f2 100644
--- a/compiler/deSugar/DsUtils.lhs
+++ b/compiler/deSugar/DsUtils.lhs
@@ -69,6 +69,8 @@ import SrcLoc
 import Util
 import ListSetOps
 import FastString
+import StaticFlags
+
 import Data.Char
 
 infixl 4 `mkDsApp`, `mkDsApps`
@@ -942,15 +944,22 @@ mkTickBox :: Int -> CoreExpr -> DsM CoreExpr
 mkTickBox ix e = do
        uq <- newUnique 	
        mod <- getModuleDs
-       let tick = mkTickBoxOpId uq mod ix
+       let tick | opt_Hpc   = mkTickBoxOpId uq mod ix
+                | otherwise = mkBreakPointOpId uq mod ix
        uq2 <- newUnique 	
        let occName = mkVarOcc "tick"
        let name = mkInternalName uq2 occName noSrcLoc   -- use mkSysLocal?
        let var  = Id.mkLocalId name realWorldStatePrimTy
-       return $ Case (Var tick) 
-	             var
-		     ty
-	             [(DEFAULT,[],e)]
+       scrut <- 
+          if opt_Hpc 
+            then return (Var tick)
+            else do
+              locals <- getLocalBindsDs
+              let tickVar = Var tick
+              let tickType = mkFunTys (map idType locals) realWorldStatePrimTy 
+              let scrutApTy = App tickVar (Type tickType)
+              return (mkApps scrutApTy (map Var locals) :: Expr Id)
+       return $ Case scrut var ty [(DEFAULT,[],e)]
   where
      ty = exprType e
 
@@ -966,4 +975,4 @@ mkBinaryTickBox ixT ixF e = do
                        [ (DataAlt falseDataCon, [], falseBox)
                        , (DataAlt trueDataCon,  [], trueBox)
                        ]
-\end{code}
\ No newline at end of file
+\end{code}
diff --git a/compiler/ghci/ByteCodeAsm.lhs b/compiler/ghci/ByteCodeAsm.lhs
index 28263f9f74..31cbd251cb 100644
--- a/compiler/ghci/ByteCodeAsm.lhs
+++ b/compiler/ghci/ByteCodeAsm.lhs
@@ -46,7 +46,7 @@ import Data.Bits
 import Data.Int		( Int64 )
 import Data.Char	( ord )
 
-import GHC.Base		( ByteArray# )
+import GHC.Base		( ByteArray#, MutableByteArray#, RealWorld )
 import GHC.IOBase	( IO(..) )
 import GHC.Ptr		( Ptr(..) )
 
@@ -71,13 +71,15 @@ data UnlinkedBCO
 	unlinkedBCOInstrs :: ByteArray#,		 -- insns
 	unlinkedBCOBitmap :: ByteArray#,		 -- bitmap
         unlinkedBCOLits   :: (SizedSeq BCONPtr),        -- non-ptrs
-        unlinkedBCOPtrs   :: (SizedSeq BCOPtr) 	        -- ptrs
+        unlinkedBCOPtrs   :: (SizedSeq BCOPtr)   	-- ptrs
    }
 
 data BCOPtr
   = BCOPtrName   Name
   | BCOPtrPrimOp PrimOp
   | BCOPtrBCO    UnlinkedBCO
+  | BCOPtrBreakInfo  BreakInfo
+  | BCOPtrArray (MutableByteArray# RealWorld)
 
 data BCONPtr
   = BCONPtrWord  Word
@@ -158,8 +160,7 @@ assembleBCO (ProtoBCO nm instrs bitmap bsize arity origin malloced)
 	     bitmap_arr = mkBitmapArray bsize bitmap
              bitmap_barr = case bitmap_arr of UArray _lo _hi barr -> barr
 
-         let ul_bco = UnlinkedBCO nm arity insns_barr bitmap_barr final_lits 
-					final_ptrs
+         let ul_bco = UnlinkedBCO nm arity insns_barr bitmap_barr final_lits final_ptrs 
 
          -- 8 Aug 01: Finalisers aren't safe when attached to non-primitive
          -- objects, since they might get run too early.  Disable this until
@@ -299,6 +300,11 @@ mkBits findLabel st proto_insns
                RETURN_UBX rep     -> instr1 st (return_ubx rep)
                CCALL off m_addr   -> do (np, st2) <- addr st m_addr
                                         instr3 st2 bci_CCALL off np
+               BRK_FUN array index info -> do 
+                  (p1, st2) <- ptr st  (BCOPtrArray array) 
+                  (p2, st3) <- ptr st2 (BCOPtrBreakInfo info)
+                  instr4 st3 bci_BRK_FUN p1 index p2
+               PUSH_LLL  o1 o2 o3 -> instr4 st bci_PUSH_LLL o1 o2 o3
 
        i2s :: Int -> Word16
        i2s = fromIntegral
@@ -448,6 +454,7 @@ instrSize16s instr
         RETURN_UBX{}		-> 1
 	CCALL{}			-> 3
         SWIZZLE{}		-> 3
+        BRK_FUN{}               -> 4 
 
 -- Make lists of host-sized words for literals, so that when the
 -- words are placed in memory at increasing addresses, the
diff --git a/compiler/ghci/ByteCodeGen.lhs b/compiler/ghci/ByteCodeGen.lhs
index 72586abc55..ca66250c8b 100644
--- a/compiler/ghci/ByteCodeGen.lhs
+++ b/compiler/ghci/ByteCodeGen.lhs
@@ -49,7 +49,7 @@ import Constants
 
 import Data.List	( intersperse, sortBy, zip4, zip6, partition )
 import Foreign		( Ptr, castPtr, mallocBytes, pokeByteOff, Word8,
-			  withForeignPtr, castFunPtrToPtr )
+			  withForeignPtr, castFunPtrToPtr, nullPtr, plusPtr )
 import Foreign.C
 import Control.Exception	( throwDyn )
 
@@ -58,21 +58,29 @@ import GHC.Exts		( Int(..), ByteArray# )
 import Control.Monad	( when )
 import Data.Char	( ord, chr )
 
+import UniqSupply
+import BreakArray
+import Data.Maybe
+import Module 
+import IdInfo 
+
 -- -----------------------------------------------------------------------------
 -- Generating byte code for a complete module 
 
 byteCodeGen :: DynFlags
             -> [CoreBind]
 	    -> [TyCon]
+            -> ModBreaks 
             -> IO CompiledByteCode
-byteCodeGen dflags binds tycs
+byteCodeGen dflags binds tycs modBreaks 
    = do showPass dflags "ByteCodeGen"
 
         let flatBinds = [ (bndr, freeVars rhs) 
 			| (bndr, rhs) <- flattenBinds binds]
 
-        (BcM_State final_ctr mallocd, proto_bcos)
-           <- runBc (mapM schemeTopBind flatBinds)
+        us <- mkSplitUniqSupply 'y'  
+        (BcM_State _us final_ctr mallocd _, proto_bcos) 
+           <- runBc us modBreaks (mapM schemeTopBind flatBinds)  
 
         when (notNull mallocd)
              (panic "ByteCodeGen.byteCodeGen: missing final emitBc?")
@@ -98,8 +106,11 @@ coreExprToBCOs dflags expr
       let invented_name  = mkSystemVarName (mkPseudoUniqueE 0) FSLIT("ExprTopLevel")
           invented_id    = Id.mkLocalId invented_name (panic "invented_id's type")
 	  
-      (BcM_State final_ctr mallocd, proto_bco) 
-         <- runBc (schemeTopBind (invented_id, freeVars expr))
+      -- the uniques are needed to generate fresh variables when we introduce new
+      -- let bindings for ticked expressions
+      us <- mkSplitUniqSupply 'y'
+      (BcM_State _us final_ctr mallocd _ , proto_bco)  
+         <- runBc us emptyModBreaks (schemeTopBind (invented_id, freeVars expr))
 
       when (notNull mallocd)
            (panic "ByteCodeGen.coreExprToBCOs: missing final emitBc?")
@@ -141,8 +152,7 @@ mkProtoBCO
    -> Bool   	-- True <=> is a return point, rather than a function
    -> [BcPtr]
    -> ProtoBCO name
-mkProtoBCO nm instrs_ordlist origin arity bitmap_size bitmap
-  is_ret mallocd_blocks
+mkProtoBCO nm instrs_ordlist origin arity bitmap_size bitmap is_ret mallocd_blocks 
    = ProtoBCO {
 	protoBCOName = nm,
 	protoBCOInstrs = maybe_with_stack_check,
@@ -199,22 +209,24 @@ argBits (rep : args)
 schemeTopBind :: (Id, AnnExpr Id VarSet) -> BcM (ProtoBCO Name)
 
 
-schemeTopBind (id, rhs)
+schemeTopBind (id, rhs) 
   | Just data_con <- isDataConWorkId_maybe id,
-    isNullaryRepDataCon data_con
-  = 	-- Special case for the worker of a nullary data con.
+    isNullaryRepDataCon data_con = do
+    	-- Special case for the worker of a nullary data con.
 	-- It'll look like this:	Nil = /\a -> Nil a
 	-- If we feed it into schemeR, we'll get 
 	--	Nil = Nil
 	-- because mkConAppCode treats nullary constructor applications
 	-- by just re-using the single top-level definition.  So
 	-- for the worker itself, we must allocate it directly.
+    -- ioToBc (putStrLn $ "top level BCO")
     emitBc (mkProtoBCO (getName id) (toOL [PACK data_con 0, ENTER])
-                       (Right rhs) 0 0 [{-no bitmap-}] False{-not alts-})
+                       (Right rhs) 0 0 [{-no bitmap-}] False{-not alts-}) 
 
   | otherwise
   = schemeR [{- No free variables -}] (id, rhs)
 
+
 -- -----------------------------------------------------------------------------
 -- schemeR
 
@@ -232,7 +244,7 @@ schemeR :: [Id] 		-- Free vars of the RHS, ordered as they
 				-- top-level things, which have no free vars.
 	-> (Id, AnnExpr Id VarSet)
 	-> BcM (ProtoBCO Name)
-schemeR fvs (nm, rhs) 
+schemeR fvs (nm, rhs)
 {-
    | trace (showSDoc (
               (char ' '
@@ -245,11 +257,13 @@ schemeR fvs (nm, rhs)
 -}
    = schemeR_wrk fvs nm rhs (collect [] rhs)
 
+collect :: [Var] -> AnnExpr Id VarSet -> ([Var], AnnExpr' Id VarSet)
 collect xs (_, AnnNote note e) = collect xs e
 collect xs (_, AnnCast e _)    = collect xs e
 collect xs (_, AnnLam x e)     = collect (if isTyVar x then xs else (x:xs)) e
 collect xs (_, not_lambda)     = (reverse xs, not_lambda)
 
+schemeR_wrk :: [Id] -> Id -> AnnExpr Id VarSet -> ([Var], AnnExpr' Var VarSet) -> BcM (ProtoBCO Name) 
 schemeR_wrk fvs nm original_body (args, body)
    = let 
 	 all_args  = reverse args ++ fvs
@@ -267,10 +281,36 @@ schemeR_wrk fvs nm original_body (args, body)
 	 bitmap_size = length bits
 	 bitmap = mkBitmap bits
      in do
-     body_code <- schemeE szw_args 0 p_init body
+     body_code <- schemeER_wrk szw_args p_init body   
+ 
      emitBc (mkProtoBCO (getName nm) body_code (Right original_body)
 		arity bitmap_size bitmap False{-not alts-})
 
+-- introduce break instructions for ticked expressions
+schemeER_wrk :: Int -> BCEnv -> AnnExpr' Id VarSet -> BcM BCInstrList
+schemeER_wrk d p rhs
+   | Just (tickInfo, (_annot, newRhs)) <- isTickedExp' rhs = do 
+        code <- schemeE d 0 p newRhs 
+        arr <- getBreakArray 
+        let idOffSets = getVarOffSets d p tickInfo 
+        let tickNumber = tickInfo_number tickInfo
+        let breakInfo = BreakInfo 
+                        { breakInfo_module = tickInfo_module tickInfo
+                        , breakInfo_number = tickNumber 
+                        , breakInfo_vars = idOffSets
+                        }
+        let breakInstr = case arr of (BA arr#) -> BRK_FUN arr# tickNumber breakInfo 
+        return $ breakInstr `consOL` code
+   | otherwise = schemeE d 0 p rhs 
+
+getVarOffSets :: Int -> BCEnv -> TickInfo -> [(Id, Int)]
+getVarOffSets d p = catMaybes . map (getOffSet d p) . tickInfo_locals 
+
+getOffSet :: Int -> BCEnv -> Id -> Maybe (Id, Int)
+getOffSet d env id 
+   = case lookupBCEnv_maybe env id of
+        Nothing     -> Nothing 
+        Just offset -> Just (id, d - offset)
 
 fvsToEnv :: BCEnv -> VarSet -> [Id]
 -- Takes the free variables of a right-hand side, and
@@ -288,6 +328,18 @@ fvsToEnv p fvs = [v | v <- varSetElems fvs,
 -- -----------------------------------------------------------------------------
 -- schemeE
 
+data TickInfo 
+   = TickInfo   
+     { tickInfo_number :: Int     -- the (module) unique number of the tick
+     , tickInfo_module :: Module  -- the origin of the ticked expression 
+     , tickInfo_locals :: [Id]    -- the local vars in scope at the ticked expression
+     } 
+
+instance Outputable TickInfo where
+   ppr info = text "TickInfo" <+> 
+              parens (int (tickInfo_number info) <+> ppr (tickInfo_module info) <+>
+                      ppr (tickInfo_locals info))
+
 -- Compile code to apply the given expression to the remaining args
 -- on the stack, returning a HNF.
 schemeE :: Int -> Sequel -> BCEnv -> AnnExpr' Id VarSet -> BcM BCInstrList
@@ -382,7 +434,18 @@ schemeE d s p (AnnLet binds (_,body))
      thunk_codes <- sequence compile_binds
      return (alloc_code `appOL` concatOL thunk_codes `appOL` body_code)
 
-
+-- introduce a let binding for a ticked case expression. This rule *should* only fire when the
+-- expression was not already let-bound (the code gen for let bindings should take care of that). 
+-- Todo: we call exprFreeVars on a deAnnotated expression, this may not be the best way
+-- to calculate the free vars but it seemed like the least intrusive thing to do
+schemeE d s p exp@(AnnCase {})
+   | Just (tickInfo, _exp) <- isTickedExp' exp = do 
+        let fvs = exprFreeVars $ deAnnotate' exp
+        let ty = exprType $ deAnnotate' exp
+        id <- newId ty
+        -- Todo: is emptyVarSet correct on the next line?
+        let letExp = AnnLet (AnnNonRec id (fvs, exp)) (emptyVarSet, AnnVar id)
+        schemeE d s p letExp
 
 schemeE d s p (AnnCase scrut bndr _ [(DataAlt dc, [bind1, bind2], rhs)])
    | isUnboxedTupleCon dc, VoidArg <- typeCgRep (idType bind1)
@@ -396,11 +459,11 @@ schemeE d s p (AnnCase scrut bndr _ [(DataAlt dc, [bind1, bind2], rhs)])
 	-- envt (it won't be bound now) because we never look such things up.
 
    = --trace "automagic mashing of case alts (# VoidArg, a #)" $
-     doCase d s p scrut bind2 [(DEFAULT, [], rhs)] True{-unboxed tuple-}
+     doCase d s p scrut bind2 [(DEFAULT, [], rhs)] True{-unboxed tuple-} 
 
    | isUnboxedTupleCon dc, VoidArg <- typeCgRep (idType bind2)
    = --trace "automagic mashing of case alts (# a, VoidArg #)" $
-     doCase d s p scrut bind1 [(DEFAULT, [], rhs)] True{-unboxed tuple-}
+     doCase d s p scrut bind1 [(DEFAULT, [], rhs)] True{-unboxed tuple-} 
 
 schemeE d s p (AnnCase scrut bndr _ [(DataAlt dc, [bind1], rhs)])
    | isUnboxedTupleCon dc
@@ -409,10 +472,10 @@ schemeE d s p (AnnCase scrut bndr _ [(DataAlt dc, [bind1], rhs)])
 	-- to
 	--	case .... of a { DEFAULT -> ... }
    = --trace "automagic mashing of case alts (# a #)"  $
-     doCase d s p scrut bind1 [(DEFAULT, [], rhs)] True{-unboxed tuple-}
+     doCase d s p scrut bind1 [(DEFAULT, [], rhs)] True{-unboxed tuple-} 
 
 schemeE d s p (AnnCase scrut bndr _ alts)
-   = doCase d s p scrut bndr alts False{-not an unboxed tuple-}
+   = doCase d s p scrut bndr alts False{-not an unboxed tuple-} 
 
 schemeE d s p (AnnNote note (_, body))
    = schemeE d s p body
@@ -424,6 +487,56 @@ schemeE d s p other
    = pprPanic "ByteCodeGen.schemeE: unhandled case" 
                (pprCoreExpr (deAnnotate' other))
 
+{- 
+   Ticked Expressions
+   ------------------
+  
+   A ticked expression looks like this:
+
+      case tick<n> var1 ... varN of DEFAULT -> e
+
+   (*) <n> is the number of the tick, which is unique within a module
+   (*) var1 ... varN are the local variables in scope at the tick site
+
+   If we find a ticked expression we return:
+
+      Just ((n, [var1 ... varN]), e)
+
+  otherwise we return Nothing.
+
+  The idea is that the "case tick<n> ..." is really just an annotation on 
+  the code. When we find such a thing, we pull out the useful information,
+  and then compile the code as if it was just the expression "e".
+
+-}
+
+isTickedExp :: AnnExpr Id a -> Maybe (TickInfo, AnnExpr Id a)
+isTickedExp (annot, expr) = isTickedExp' expr 
+
+isTickedExp' :: AnnExpr' Id a -> Maybe (TickInfo, AnnExpr Id a)
+isTickedExp' (AnnCase scrut _bndr _type alts)
+   | Just tickInfo <- isTickedScrut scrut,
+     [(DEFAULT, _bndr, rhs)] <- alts 
+     = Just (tickInfo, rhs)
+   where
+   isTickedScrut :: (AnnExpr Id a) -> Maybe TickInfo 
+   isTickedScrut expr
+      | Var id <- f,
+        Just (TickBox modName tickNumber) <- isTickBoxOp_maybe id
+           = Just $ TickInfo { tickInfo_number = tickNumber
+                             , tickInfo_module = modName
+                             , tickInfo_locals = idsOfArgs args
+                             }
+      | otherwise = Nothing
+      where
+      (f, args) = collectArgs $ deAnnotate expr
+      idsOfArgs :: [Expr Id] -> [Id]
+      idsOfArgs = catMaybes . map exprId 
+      exprId :: Expr Id -> Maybe Id
+      exprId (Var id) = Just id
+      exprId other    = Nothing
+
+isTickedExp' other = Nothing
 
 -- Compile code to do a tail call.  Specifically, push the fn,
 -- slide the on-stack app back down to the sequel depth,
@@ -640,8 +753,7 @@ doCase  :: Int -> Sequel -> BCEnv
 	-> AnnExpr Id VarSet -> Id -> [AnnAlt Id VarSet]
 	-> Bool  -- True <=> is an unboxed tuple case, don't enter the result
 	-> BcM BCInstrList
-doCase d s p (_,scrut)
- bndr alts is_unboxed_tuple
+doCase d s p (_,scrut) bndr alts is_unboxed_tuple 
   = let
         -- Top of stack is the return itbl, as usual.
         -- underneath it is the pointer to the alt_code BCO.
@@ -670,9 +782,10 @@ doCase d s p (_,scrut)
         isAlgCase = not (isUnLiftedType bndr_ty) && not is_unboxed_tuple
 
         -- given an alt, return a discr and code for it.
-	codeALt alt@(DEFAULT, _, (_,rhs))
+	codeAlt alt@(DEFAULT, _, (_,rhs))
 	   = do rhs_code <- schemeE d_alts s p_alts rhs
 	        return (NoDiscr, rhs_code)
+
         codeAlt alt@(discr, bndrs, (_,rhs))
 	   -- primitive or nullary constructor alt: no need to UNPACK
 	   | null real_bndrs = do
@@ -696,7 +809,6 @@ doCase d s p (_,scrut)
 	   where
 	     real_bndrs = filter (not.isTyVar) bndrs
 
-
         my_discr (DEFAULT, binds, rhs) = NoDiscr {-shouldn't really happen-}
         my_discr (DataAlt dc, binds, rhs) 
            | isUnboxedTupleCon dc
@@ -745,6 +857,7 @@ doCase d s p (_,scrut)
      in do
      alt_stuff <- mapM codeAlt alts
      alt_final <- mkMultiBranch maybe_ncons alt_stuff
+
      let 
          alt_bco_name = getName bndr
          alt_bco = mkProtoBCO alt_bco_name alt_final (Left alts)
@@ -1315,9 +1428,12 @@ type BcPtr = Either ItblPtr (Ptr ())
 
 data BcM_State 
    = BcM_State { 
+        uniqSupply :: UniqSupply,       -- for generating fresh variable names
 	nextlabel :: Int,		-- for generating local labels
-	malloced  :: [BcPtr] }		-- thunks malloced for current BCO
+	malloced  :: [BcPtr],		-- thunks malloced for current BCO
 					-- Should be free()d when it is GCd
+        breakArray :: BreakArray        -- array of breakpoint flags 
+        }
 
 newtype BcM r = BcM (BcM_State -> IO (BcM_State, r))
 
@@ -1326,8 +1442,11 @@ ioToBc io = BcM $ \st -> do
   x <- io 
   return (st, x)
 
-runBc :: BcM r -> IO (BcM_State, r)
-runBc (BcM m) = m (BcM_State 0 []) 
+runBc :: UniqSupply -> ModBreaks -> BcM r -> IO (BcM_State, r)
+runBc us modBreaks (BcM m) 
+   = m (BcM_State us 0 [] breakArray)   
+   where
+   breakArray = modBreaks_array modBreaks
 
 thenBc :: BcM a -> (a -> BcM b) -> BcM b
 thenBc (BcM expr) cont = BcM $ \st0 -> do
@@ -1370,4 +1489,18 @@ getLabelsBc :: Int -> BcM [Int]
 getLabelsBc n
   = BcM $ \st -> let ctr = nextlabel st 
 		 in return (st{nextlabel = ctr+n}, [ctr .. ctr+n-1])
+
+getBreakArray :: BcM BreakArray 
+getBreakArray = BcM $ \st -> return (st, breakArray st)
+
+newUnique :: BcM Unique
+newUnique = BcM $
+   \st -> case splitUniqSupply (uniqSupply st) of
+             (us1, us2) -> let newState = st { uniqSupply = us2 } 
+                           in  return (newState, uniqFromSupply us1) 
+
+newId :: Type -> BcM Id
+newId ty = do 
+    uniq <- newUnique
+    return $ mkSysLocal FSLIT("ticked") uniq ty
 \end{code}
diff --git a/compiler/ghci/ByteCodeInstr.lhs b/compiler/ghci/ByteCodeInstr.lhs
index 5239139eb2..3f57d187dc 100644
--- a/compiler/ghci/ByteCodeInstr.lhs
+++ b/compiler/ghci/ByteCodeInstr.lhs
@@ -5,7 +5,7 @@ ByteCodeInstrs: Bytecode instruction definitions
 
 \begin{code}
 module ByteCodeInstr ( 
- 	BCInstr(..), ProtoBCO(..), bciStackUse
+ 	BCInstr(..), ProtoBCO(..), bciStackUse, BreakInfo (..) 
   ) where
 
 #include "HsVersions.h"
@@ -26,6 +26,10 @@ import SMRep
 
 import GHC.Ptr
 
+import Module (Module)
+import GHC.Prim
+
+
 -- ----------------------------------------------------------------------------
 -- Bytecode instructions
 
@@ -129,6 +133,22 @@ data BCInstr
    | RETURN		-- return a lifted value
    | RETURN_UBX CgRep -- return an unlifted value, here's its rep
 
+   -- Breakpoints 
+   | BRK_FUN          (MutableByteArray# RealWorld) Int BreakInfo
+
+data BreakInfo 
+   = BreakInfo
+   { breakInfo_module :: Module
+   , breakInfo_number :: Int
+   , breakInfo_vars   :: [(Id,Int)]
+   }
+
+instance Outputable BreakInfo where
+   ppr info = text "BreakInfo" <+>
+              parens (ppr (breakInfo_module info) <+>
+                      ppr (breakInfo_number info) <+>
+                      ppr (breakInfo_vars info))
+
 -- -----------------------------------------------------------------------------
 -- Printing bytecode instructions
 
@@ -196,6 +216,7 @@ instance Outputable BCInstr where
    ppr ENTER                 = text "ENTER"
    ppr RETURN		     = text "RETURN"
    ppr (RETURN_UBX pk)       = text "RETURN_UBX  " <+> ppr pk
+   ppr (BRK_FUN breakArray index info) = text "BRK_FUN" <+> text "<array>" <+> int index <+> ppr info 
 
 -- -----------------------------------------------------------------------------
 -- The stack use, in words, of each bytecode insn.  These _must_ be
@@ -251,6 +272,7 @@ bciStackUse RETURN{}		  = 0
 bciStackUse RETURN_UBX{}	  = 1
 bciStackUse CCALL{} 		  = 0
 bciStackUse SWIZZLE{}    	  = 0
+bciStackUse BRK_FUN{}    	  = 0
 
 -- These insns actually reduce stack use, but we need the high-tide level,
 -- so can't use this info.  Not that it matters much.
diff --git a/compiler/ghci/ByteCodeItbls.lhs b/compiler/ghci/ByteCodeItbls.lhs
index 2973c03e47..9b2dac0618 100644
--- a/compiler/ghci/ByteCodeItbls.lhs
+++ b/compiler/ghci/ByteCodeItbls.lhs
@@ -22,6 +22,7 @@ import Constants	( mIN_PAYLOAD_SIZE, wORD_SIZE )
 import CgHeapery	( mkVirtHeapOffsets )
 import FastString	( FastString(..) )
 import Util             ( lengthIs, listLengthCmp )
+import Outputable
 
 import Foreign
 import Foreign.C
@@ -32,7 +33,8 @@ import GHC.Exts		( Int(I#), addr2Int# )
 import GHC.Ptr		( Ptr(..) )
 import GHC.Prim
 
-import Outputable
+import Debug.Trace
+import Text.Printf
 \end{code}
 
 %************************************************************************
@@ -48,9 +50,12 @@ itblCode :: ItblPtr -> Ptr ()
 itblCode (ItblPtr ptr)
    = (castPtr ptr)
 #ifdef GHCI_TABLES_NEXT_TO_CODE
-                 `plusPtr` (3 * wORD_SIZE)
+                 `plusPtr` conInfoTableSizeB
 #endif
 
+-- XXX bogus
+conInfoTableSizeB = 3 * wORD_SIZE
+
 type ItblEnv = NameEnv (Name, ItblPtr)
 	-- We need the Name in the range so we know which
 	-- elements to filter out when unloading a module
@@ -290,7 +295,7 @@ instance Storable StgConInfoTable where
               StgConInfoTable 
               { 
 #ifdef GHCI_TABLES_NEXT_TO_CODE
-                conDesc   = castPtr $ ptr `plusPtr` wORD_SIZE `plusPtr` desc
+                conDesc   = castPtr $ ptr `plusPtr` conInfoTableSizeB `plusPtr` desc
 #else
                 conDesc   = desc
 #endif
@@ -299,7 +304,7 @@ instance Storable StgConInfoTable where
    poke ptr itbl 
       = runState (castPtr ptr) $ do
 #ifdef GHCI_TABLES_NEXT_TO_CODE
-           store (conDesc itbl `minusPtr` (ptr `plusPtr` wORD_SIZE))
+           store (conDesc itbl `minusPtr` (ptr `plusPtr` conInfoTableSizeB))
 #endif
            store (infoTable itbl)
 #ifndef GHCI_TABLES_NEXT_TO_CODE
diff --git a/compiler/ghci/ByteCodeLink.lhs b/compiler/ghci/ByteCodeLink.lhs
index 9988325dd3..7304d0290b 100644
--- a/compiler/ghci/ByteCodeLink.lhs
+++ b/compiler/ghci/ByteCodeLink.lhs
@@ -27,7 +27,6 @@ import Module
 import PackageConfig
 import FastString
 import Panic
-import Breakpoints
 
 #ifdef DEBUG
 import Outputable
@@ -47,7 +46,7 @@ import GHC.Exts
 import GHC.Arr		( Array(..) )
 import GHC.IOBase	( IO(..) )
 import GHC.Ptr		( Ptr(..), castPtr )
-import GHC.Base		( writeArray#, RealWorld, Int(..) )
+import GHC.Base		( writeArray#, RealWorld, Int(..), Word# )  
 \end{code}
 
 
@@ -143,6 +142,10 @@ mkPtrsArray ie ce n_ptrs ptrs = do
     fill (BCOPtrBCO ul_bco) i = do
 	BCO bco# <- linkBCO' ie ce ul_bco
 	writeArrayBCO marr i bco#
+    fill (BCOPtrBreakInfo brkInfo) i =                    
+        unsafeWrite marr i (unsafeCoerce# brkInfo)
+    fill (BCOPtrArray brkArray) i =                    
+        unsafeWrite marr i (unsafeCoerce# brkArray)
   zipWithM fill ptrs [0..]
   unsafeFreeze marr
 
@@ -163,10 +166,16 @@ writeArrayBCO (IOArray (STArray _ _ marr#)) (I# i#) bco# = IO $ \s# ->
   case (unsafeCoerce# writeArray#) marr# i# bco# s# of { s# ->
   (# s#, () #) }
 
+{-
+writeArrayMBA :: IOArray Int a -> Int -> MutableByteArray# a -> IO ()
+writeArrayMBA (IOArray (STArray _ _ marr#)) (I# i#) mba# = IO $ \s# ->
+  case (unsafeCoerce# writeArray#) marr# i# bco# s# of { s# ->
+  (# s#, () #) }
+-}
+
 data BCO = BCO BCO#
 
-newBCO :: ByteArray# -> ByteArray# -> Array# a
-	 -> Int# -> ByteArray# -> IO BCO
+newBCO :: ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> IO BCO
 newBCO instrs lits ptrs arity bitmap
    = IO $ \s -> case newBCO# instrs lits ptrs arity bitmap s of 
 		  (# s1, bco #) -> (# s1, BCO bco #)
@@ -201,8 +210,6 @@ 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/ghci/Debugger.hs b/compiler/ghci/Debugger.hs
index a43d4fdf95..f0f8973033 100644
--- a/compiler/ghci/Debugger.hs
+++ b/compiler/ghci/Debugger.hs
@@ -6,10 +6,9 @@
 --
 -----------------------------------------------------------------------------
 
-module Debugger where
+module Debugger (pprintClosureCommand, instantiateTyVarsToUnknown) where
 
 import Linker
-import Breakpoints
 import RtClosureInspect
 
 import PrelNames
@@ -22,8 +21,6 @@ import VarEnv
 import Name 
 import NameEnv
 import RdrName
-import Module
-import Finder
 import UniqSupply
 import Type
 import TyCon
@@ -31,23 +28,15 @@ import DataCon
 import TcGadt
 import GHC
 import GhciMonad
-import PackageConfig
 
 import Outputable
 import Pretty                    ( Mode(..), showDocWith )
-import ErrUtils
 import FastString
 import SrcLoc
-import Util
-import Maybes
 
 import Control.Exception
 import Control.Monad
-import qualified Data.Map as Map
-import Data.Array.Unboxed
-import Data.Array.Base
 import Data.List
-import Data.Typeable             ( Typeable )
 import Data.Maybe
 import Data.IORef
 
@@ -300,288 +289,3 @@ stripUnknowns names id = setIdType id . fst . go names . idType
            kind1 = mkArrowKind liftedTypeKind liftedTypeKind
            kind2 = mkArrowKind kind1 liftedTypeKind
            kind3 = mkArrowKind kind2 liftedTypeKind
-
------------------------------
--- | The :breakpoint command
------------------------------
-bkptOptions :: String -> GHCi Bool
-bkptOptions "continue" = -- We want to quit if in an inferior session
-                         liftM not isTopLevel 
-bkptOptions "stop" = do
-  inside_break <- liftM not isTopLevel
-  when inside_break $ throwDyn StopChildSession 
-  return False
-
-bkptOptions cmd = do 
-  dflags <- getDynFlags
-  bt     <- getBkptTable
-  sess   <- getSession
-  bkptOptions' sess (words cmd) bt
-  return False
-   where
-    bkptOptions' _ ["list"] bt = do 
-      let msgs = [ ppr mod <+> colon <+> ppr coords 
-                   | (mod,site) <- btList bt
-                   , let coords = getSiteCoords bt mod site]
-          num_msgs = [parens (int n) <+> msg | (n,msg) <- zip [1..] msgs]
-      msg <- showForUser$ if null num_msgs 
-                            then text "There are no enabled breakpoints"
-                            else vcat num_msgs
-      io$ putStrLn msg
-
-    bkptOptions' s ("add":cmds) bt 
-      | [line]         <- cmds
-      , [(lineNum,[])] <- reads line
-      = do (toplevel,_) <- io$ GHC.getContext s
-           case toplevel of
-             (m:_) -> handleAdd (\mod->addBkptByLine mod lineNum) m
-             [] -> throwDyn $ CmdLineError $ "No module loaded in debugging mode"
-
-      | [mod_name,line]<- cmds
-      , [(lineNum,[])] <- reads line
-      = io(GHC.findModule s (GHC.mkModuleName mod_name) Nothing) >>=
-         handleAdd (\mod->addBkptByLine mod lineNum)
-
-      | [mod_name,line,col] <- cmds
-      = io(GHC.findModule s (GHC.mkModuleName mod_name) Nothing) >>=
-         handleAdd (\mod->addBkptByCoord mod (read line, read col))
-
-      | otherwise = throwDyn $ CmdLineError $ 
-                       "syntax: :breakpoint add Module line [col]"
-       where 
-         handleAdd f mod = 
-           either 
-             (handleBkptEx s mod)
-             (\(newTable, site) -> do
-               setBkptTable newTable
-               let (x,y) = getSiteCoords newTable mod site
-               io (putStrLn ("Breakpoint set at " ++ showSDoc (ppr mod) 
-                    ++ ':' : show x  ++ ':' : show y)))
-             (f mod bt) 
-
-    bkptOptions' s ("del":cmds) bt 
-      | [i']     <- cmds 
-      , [(i,[])] <- reads i'
-      , bkpts    <- btList bt
-      = if i > length bkpts
-           then throwDyn $ CmdLineError 
-              "Not a valid breakpoint #. Use :breakpoint list to see the current breakpoints."
-           else 
-             let (mod, site) = bkpts !! (i-1)
-             in handleDel mod $ delBkptBySite mod site
-
-      | [fn,line]      <- cmds 
-      , [(lineNum,[])] <- reads line
-      , mod            <- GHC.mkModule mainPackageId (GHC.mkModuleName fn)
-      = handleDel mod $  delBkptByLine mod lineNum
-
-      | [fn,line,col]  <- cmds 
-      , [(lineNum,[])] <- reads line
-      , [(colNum,[])]  <- reads col
-      , mod            <- GHC.mkModule mainPackageId (GHC.mkModuleName fn)
-      = handleDel mod $ delBkptByCoord mod (lineNum, colNum)
-        
-      | otherwise = throwDyn $ CmdLineError $ 
-             "syntax: :breakpoint del (breakpoint # | [Module] line [col])"
-
-       where delMsg = "Breakpoint deleted"
-             handleDel mod f = either (handleBkptEx s mod)
-                                      (\newtable-> setBkptTable newtable >> io (putStrLn delMsg))
-                                      (f bt)
-                                      
-    bkptOptions' _ _ _ = throwDyn $ CmdLineError $ 
-                         "syntax: :breakpoint (list|continue|stop|add|del)"
-
--- Error messages
---    handleBkptEx :: Session -> Module -> Debugger.BkptException -> a
-    handleBkptEx s m NotHandled  = io$ do
-       isInterpreted <- findModSummary m >>= isModuleInterpreted s
-       if isInterpreted
-        then error$ "Module " ++ showSDoc (ppr m) ++  " was not loaded under debugging mode.\n" 
-                 ++ "Enable debugging mode with -fdebugging (and reload your module)"
-        else error$ "Module " ++ showSDoc (ppr m) ++  " was loaded in compiled (.o) mode.\n" 
-                 ++ "You must load a module in interpreted mode and with -fdebugging on to debug it."
-         where findModSummary m = do 
-                 mod_graph <- getModuleGraph s 
-                 return$ head [ modsum | modsum <- mod_graph, ms_mod modsum == m]
-    handleBkptEx _ _ e = error (show e)
-
--------------------------
--- Breakpoint Tables
--------------------------
-
-data BkptTable a  = BkptTable { 
-                           -- | An array of breaks, indexed by site number
-     breakpoints :: Map.Map a (UArray Int Bool)  
-                           -- | A list of lines, each line can have zero or more sites, which are annotated with a column number
-   , sites       :: Map.Map a [[(SiteNumber, Int)]] 
-   }
-                  deriving Show
-
-sitesOf :: Ord a => BkptTable a -> a -> Maybe [[(SiteNumber, Int)]] 
-sitesOf bt fn = Map.lookup fn (sites bt)
-bkptsOf bt fn = Map.lookup fn (breakpoints bt)
-
-
-data BkptError =
-                    NotHandled  -- Trying to manipulate a element not handled by this BkptTable 
-                  | NoBkptFound
-                  | NotNeeded   -- Used when a breakpoint was already enabled
-  deriving Typeable
-
-instance Show BkptError where
-  show NoBkptFound = "No suitable breakpoint site found"
-  show NotNeeded  = "Nothing to do"
-  show NotHandled  = "BkptTable: Element not controlled by this table"
-
-emptyBkptTable :: Ord a => BkptTable a
-addModule      :: Ord a => a -> [(SiteNumber,Coord)] -> BkptTable a -> BkptTable a
--- | Lines start at index 1
-addBkptByLine  :: Ord a => a -> Int        -> BkptTable a -> Either BkptError (BkptTable a, SiteNumber)
-addBkptByCoord :: Ord a => a -> Coord      -> BkptTable a -> Either BkptError (BkptTable a, SiteNumber)
-delBkptByLine  :: Ord a => a -> Int        -> BkptTable a -> Either BkptError (BkptTable a)
-delBkptBySite  :: Ord a => a -> SiteNumber -> BkptTable a -> Either BkptError (BkptTable a)
-delBkptByCoord :: Ord a => a -> Coord      -> BkptTable a -> Either BkptError (BkptTable a)
-
-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 (0, nsites+1) (repeat False) 
-   = bt{ sites       = Map.insert a sitesByRow (sites bt) 
-       , breakpoints = Map.insert a initialBkpts (breakpoints bt) }
-
--- This MUST be fast
-isBkptEnabled bt site | bt `seq` site `seq` False = undefined
-isBkptEnabled bt (a,site) 
-   | Just bkpts <- bkptsOf bt a 
-   = ASSERT (inRange (bounds bkpts) site) 
-     unsafeAt bkpts 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
diff --git a/compiler/ghci/Debugger.hs-boot b/compiler/ghci/Debugger.hs-boot
deleted file mode 100644
index d310308683..0000000000
--- a/compiler/ghci/Debugger.hs-boot
+++ /dev/null
@@ -1,12 +0,0 @@
-module Debugger where
-import Breakpoints
-import qualified Data.Map as Map
-import Data.Array.Unboxed
-
-
-data BkptTable a  = BkptTable { 
-                           -- | An array of breaks, indexed by site number
-     breakpoints :: Map.Map a (UArray Int Bool)  
-                           -- | A list of lines, each line can have zero or more sites, which are annotated with a column number
-   , sites       :: Map.Map a [[(SiteNumber, Int)]] 
-   }
diff --git a/compiler/ghci/GhciMonad.hs b/compiler/ghci/GhciMonad.hs
index eaea844991..3cab56b40c 100644
--- a/compiler/ghci/GhciMonad.hs
+++ b/compiler/ghci/GhciMonad.hs
@@ -11,12 +11,12 @@ module GhciMonad where
 #include "HsVersions.h"
 
 import qualified GHC
-import {-#SOURCE#-} Debugger
-import Breakpoints
 import Outputable
 import Panic hiding (showException)
 import Util
 import DynFlags
+import HscTypes
+import SrcLoc
 
 import Numeric
 import Control.Exception as Exception
@@ -43,8 +43,9 @@ data GHCiState = GHCiState
 	session        :: GHC.Session,
 	options        :: [GHCiOption],
         prelude        :: GHC.Module,
-        bkptTable      :: IORef (BkptTable GHC.Module),
-	topLevel       :: Bool
+	topLevel       :: Bool,
+        resume         :: [IO GHC.RunResult],
+        breaks         :: !ActiveBreakPoints
      }
 
 data GHCiOption 
@@ -53,6 +54,73 @@ data GHCiOption
 	| RevertCAFs		-- revert CAFs after every evaluation
 	deriving Eq
 
+data ActiveBreakPoints
+   = ActiveBreakPoints
+   { breakCounter   :: !Int
+   , breakLocations :: ![(Int, BreakLocation)]  -- break location uniquely numbered 
+   }
+
+instance Outputable ActiveBreakPoints where
+   ppr activeBrks = prettyLocations $ breakLocations activeBrks 
+
+emptyActiveBreakPoints :: ActiveBreakPoints
+emptyActiveBreakPoints 
+   = ActiveBreakPoints { breakCounter = 0, breakLocations = [] }
+
+data BreakLocation
+   = BreakLocation
+   { breakModule :: !GHC.Module
+   , breakLoc    :: !SrcSpan
+   , breakTick   :: {-# UNPACK #-} !Int
+   } 
+   deriving Eq
+
+prettyLocations :: [(Int, BreakLocation)] -> SDoc
+prettyLocations []   = text "No active breakpoints." 
+prettyLocations locs = vcat $ map (\(i, loc) -> brackets (int i) <+> ppr loc) $ reverse $ locs
+
+instance Outputable BreakLocation where
+   ppr loc = (ppr $ breakModule loc) <+> ppr (breakLoc loc)
+
+getActiveBreakPoints :: GHCi ActiveBreakPoints
+getActiveBreakPoints = liftM breaks getGHCiState 
+
+-- don't reset the counter back to zero?
+clearActiveBreakPoints :: GHCi ()
+clearActiveBreakPoints = do
+   st <- getGHCiState
+   let oldActiveBreaks = breaks st
+       newActiveBreaks = oldActiveBreaks { breakLocations = [] } 
+   setGHCiState $ st { breaks = newActiveBreaks }
+
+deleteBreak :: Int -> GHCi ()
+deleteBreak identity = do
+   st <- getGHCiState
+   let oldActiveBreaks = breaks st
+       oldLocations    = breakLocations oldActiveBreaks
+       newLocations    = filter (\loc -> fst loc /= identity) oldLocations
+       newActiveBreaks = oldActiveBreaks { breakLocations = newLocations }   
+   setGHCiState $ st { breaks = newActiveBreaks }
+
+recordBreak :: BreakLocation -> GHCi (Bool{- was already present -}, Int)
+recordBreak brkLoc = do
+   st <- getGHCiState
+   let oldActiveBreaks = breaks st 
+   let oldLocations    = breakLocations oldActiveBreaks
+   -- don't store the same break point twice
+   case [ nm | (nm, loc) <- oldLocations, loc == brkLoc ] of
+     (nm:_) -> return (True, nm)
+     [] -> do
+      let oldCounter = breakCounter oldActiveBreaks 
+          newCounter = oldCounter + 1
+          newActiveBreaks = 
+             oldActiveBreaks 
+             { breakCounter   = newCounter 
+             , breakLocations = (oldCounter, brkLoc) : oldLocations 
+             }
+      setGHCiState $ st { breaks = newActiveBreaks }
+      return (False, oldCounter)
+
 newtype GHCi a = GHCi { unGHCi :: IORef GHCiState -> IO a }
 
 startGHCi :: GHCi a -> GHCiState -> IO a
@@ -107,20 +175,25 @@ io m = GHCi { unGHCi = \s -> m >>= return }
 isTopLevel :: GHCi Bool
 isTopLevel = getGHCiState >>= return . topLevel
 
-getBkptTable :: GHCi (BkptTable GHC.Module)
-getBkptTable = do table_ref <- getGHCiState >>= return . bkptTable
-                  io$ readIORef table_ref
-
-setBkptTable :: BkptTable GHC.Module -> GHCi ()
-setBkptTable new_table = do 
-    table_ref <- getGHCiState >>= return . bkptTable
-    io$ writeIORef table_ref new_table
-                  
-modifyBkptTable :: (BkptTable GHC.Module -> BkptTable GHC.Module) -> GHCi ()
-modifyBkptTable f = do 
-    bt <- getBkptTable
-    new_bt <- io . evaluate$ f bt 
-    setBkptTable new_bt
+getResume :: GHCi (Maybe (IO GHC.RunResult))
+getResume = do
+   st <- getGHCiState
+   case (resume st) of
+      []    -> return Nothing
+      (x:_) -> return $ Just x
+
+popResume :: GHCi ()
+popResume = do
+   st <- getGHCiState 
+   case (resume st) of
+      []     -> return () 
+      (_:xs) -> setGHCiState $ st { resume = xs } 
+         
+pushResume :: IO GHC.RunResult -> GHCi ()
+pushResume resumeAction = do
+   st <- getGHCiState
+   let oldResume = resume st
+   setGHCiState $ st { resume = resumeAction : oldResume }
 
 showForUser :: SDoc -> GHCi String
 showForUser doc = do
@@ -129,17 +202,6 @@ showForUser doc = do
   return $! showSDocForUser unqual doc
 
 -- --------------------------------------------------------------------------
--- Inferior Sessions Exceptions (used by the debugger)
-
-data InfSessionException = 
-             StopChildSession -- A child session requests to be stopped
-           | StopParentSession -- A child session requests to be stopped 
-                               -- AND that the parent session quits after that
-           | ChildSessionStopped String  -- A child session has stopped
-  deriving Typeable
-
-
--- --------------------------------------------------------------------------
 -- timing & statistics
 
 timeIt :: GHCi a -> GHCi a
diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index cea3b29c6a..b794436b95 100644
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -41,8 +41,7 @@ import Linker
 import Util
 
 -- The debugger
-import Breakpoints
-import Debugger hiding  ( addModule )
+import Debugger 
 import HscTypes
 import Id
 import Var       ( globaliseId )
@@ -74,9 +73,7 @@ import System.Console.Readline as Readline
 import Control.Exception as Exception
 -- import Control.Concurrent
 
-import Numeric
 import Data.List
-import Data.Int		( Int64 )
 import Data.Maybe	( isJust, isNothing, fromMaybe, catMaybes )
 import System.Cmd
 import System.Environment
@@ -86,16 +83,23 @@ import System.IO
 import System.IO.Error as IO
 import Data.Char
 import Data.Dynamic
+import Data.Array
 import Control.Monad as Monad
-import Foreign.StablePtr	( newStablePtr )
+import Foreign.StablePtr	( StablePtr, newStablePtr, deRefStablePtr, freeStablePtr )
 
 import GHC.Exts		( unsafeCoerce# )
-import GHC.IOBase	( IOErrorType(InvalidArgument) )
+import GHC.IOBase	( IOErrorType(InvalidArgument), IO(IO) )
 
-import Data.IORef	( IORef, newIORef, readIORef, writeIORef )
+import Data.IORef	( IORef, readIORef, writeIORef )
 
 import System.Posix.Internals ( setNonBlockingFD )
 
+-- these are needed by the new ghci debugger
+import ByteCodeLink (HValue)
+import ByteCodeInstr (BreakInfo (..))
+import BreakArray
+import TickTree 
+
 -----------------------------------------------------------------------------
 
 ghciWelcomeMsg =
@@ -112,41 +116,37 @@ GLOBAL_VAR(commands, builtin_commands, [Command])
 
 builtin_commands :: [Command]
 builtin_commands = [
+	-- Hugs users are accustomed to :e, so make sure it doesn't overlap
+  ("?",		keepGoing help,			False, completeNone),
   ("add",	tlC$ keepGoingPaths addModule,	False, completeFilename),
+  ("break",     breakCmd, False, completeNone),   
   ("browse",    keepGoing browseCmd,		False, completeModule),
-#ifdef DEBUGGER
-        -- I think that :c should mean :continue rather than :cd, makes more sense
-        --  (pepe 01.11.07)
-  ("continue",  const(bkptOptions "continue"),  False, completeNone),
-#endif
   ("cd",    	tlC$ keepGoing changeDirectory,	False, completeFilename),
+  ("check",	keepGoing checkModule,		False, completeHomeModule),
+  ("continue",  continueCmd, False, completeNone),
+  ("ctags",	keepGoing createCTagsFileCmd, 	False, completeFilename),
   ("def",	keepGoing defineMacro,		False, completeIdentifier),
+  ("delete",    deleteCmd, False, completeNone),   
   ("e", 	keepGoing editFile,		False, completeFilename),
-	-- Hugs users are accustomed to :e, so make sure it doesn't overlap
   ("edit",	keepGoing editFile,		False, completeFilename),
+  ("etags",	keepGoing createETagsFileCmd,	False, completeFilename),
+  ("force",     keepGoing (pprintClosureCommand False True), False, completeIdentifier),
   ("help",	keepGoing help,			False, completeNone),
-  ("?",		keepGoing help,			False, completeNone),
   ("info",      keepGoing info,			False, completeIdentifier),
+  ("kind",	keepGoing kindOfType,		False, completeIdentifier),
   ("load",	tlC$ keepGoingPaths loadModule_,False, completeHomeModuleOrFile),
   ("module",	keepGoing setContext,		False, completeModule),
   ("main",	tlC$ keepGoing runMain,		False, completeIdentifier),
+  ("print",     keepGoing (pprintClosureCommand True False), False, completeIdentifier),
+  ("quit",	quit,				False, completeNone),
   ("reload", 	tlC$ keepGoing reloadModule,  	False, completeNone),
-  ("check",	keepGoing checkModule,		False, completeHomeModule),
   ("set",	keepGoing setCmd,		True,  completeSetOptions),
   ("show",	keepGoing showCmd,		False, completeNone),
-  ("etags",	keepGoing createETagsFileCmd,	False, completeFilename),
-  ("ctags",	keepGoing createCTagsFileCmd, 	False, completeFilename),
-  ("type",	keepGoing typeOfExpr,		False, completeIdentifier),
-#if defined(DEBUGGER)
-  ("print",     keepGoing (pprintClosureCommand True False), False, completeIdentifier),
   ("sprint",    keepGoing (pprintClosureCommand False False),False, completeIdentifier),
-  ("force",     keepGoing (pprintClosureCommand False True), False, completeIdentifier),
-  ("breakpoint",bkptOptions,                    False, completeBkpt),
-#endif
-  ("kind",	keepGoing kindOfType,		False, completeIdentifier),
-  ("unset",	keepGoing unsetOptions,		True,  completeSetOptions),
+  ("step",      stepCmd, False, completeNone), 
+  ("type",	keepGoing typeOfExpr,		False, completeIdentifier),
   ("undef",     keepGoing undefineMacro,	False, completeMacro),
-  ("quit",	quit,				False, completeNone)
+  ("unset",	keepGoing unsetOptions,		True,  completeSetOptions)
   ]
 
 keepGoing :: (String -> GHCi ()) -> (String -> GHCi Bool)
@@ -171,10 +171,8 @@ helpText =
  "\n" ++
  "   <stmt>                      evaluate/run <stmt>\n" ++
  "   :add <filename> ...         add module(s) to the current target set\n" ++
- "   :breakpoint <option>        commands for the GHCi debugger\n" ++
  "   :browse [*]<module>         display the names defined by <module>\n" ++
  "   :cd <dir>                   change directory to <dir>\n" ++
- "   :continue                   equivalent to ':breakpoint continue'\n"  ++
  "   :def <cmd> <expr>           define a command :<cmd>\n" ++
  "   :edit <file>                edit file\n" ++
  "   :edit                       edit last module\n" ++
@@ -212,14 +210,8 @@ helpText =
  "    +t            print type after evaluation\n" ++
  "    -<flags>      most GHC command line flags can also be set here\n" ++
  "                         (eg. -v2, -fglasgow-exts, etc.)\n" ++
- "\n" ++
- " Options for ':breakpoint':\n" ++
- "   list                                     list the current breakpoints\n" ++
- "   add [Module] line [col]                    add a new breakpoint\n" ++
- "   del (breakpoint# | Module line [col])    delete a breakpoint\n" ++
- "   continue                                 continue execution\n"  ++
- "   stop                   Stop a computation and return to the top level\n" ++
- "   step [count]           Step by step execution (DISABLED)\n"
+ "\n" 
+-- Todo: add help for breakpoint commands here
 
 findEditor = do
   getEnv "EDITOR" 
@@ -277,8 +269,6 @@ interactiveUI session srcs maybe_expr = do
    Readline.setCompleterWordBreakCharacters word_break_chars
 #endif
 
-   bkptTable <- newIORef emptyBkptTable
-   GHC.setBreakpointHandler session (instrumentationBkptHandler bkptTable)
    default_editor <- findEditor
 
    startGHCi (runGHCi srcs maybe_expr)
@@ -289,8 +279,9 @@ interactiveUI session srcs maybe_expr = do
 		   session = session,
 		   options = [],
                    prelude = prel_mod,
-                   bkptTable = bkptTable,
-		   topLevel  = True
+		   topLevel = True,
+                   resume = [],
+                   breaks = emptyActiveBreakPoints
                  }
 
 #ifdef USE_READLINE
@@ -530,10 +521,84 @@ runStmt stmt
       session <- getSession
       result <- io $ withProgName (progname st) $ withArgs (args st) $
 	     	     GHC.runStmt session stmt
-      case result of
-	GHC.RunFailed      -> return Nothing
-	GHC.RunException e -> throw e  -- this is caught by runCommand(Eval)
-	GHC.RunOk names    -> return (Just names)
+      switchOnRunResult result
+
+switchOnRunResult :: GHC.RunResult -> GHCi (Maybe [Name])
+switchOnRunResult GHC.RunFailed = return Nothing
+switchOnRunResult (GHC.RunException e) = throw e
+switchOnRunResult (GHC.RunOk names) = return $ Just names
+switchOnRunResult (GHC.RunBreak apStack _threadId info resume) = do  -- Todo: we don't use threadID, perhaps delete?
+   session <- getSession
+   Just mod_info <- io $ GHC.getModuleInfo session (breakInfo_module info) 
+   let modBreaks  = GHC.modInfoModBreaks mod_info
+   let ticks      = modBreaks_ticks modBreaks
+   io $ displayBreakInfo session ticks info
+   io $ extendEnvironment session apStack (breakInfo_vars info) 
+   pushResume resume
+   return Nothing
+
+displayBreakInfo :: Session -> Array Int SrcSpan -> BreakInfo -> IO ()
+displayBreakInfo session ticks info = do
+   unqual <- GHC.getPrintUnqual session
+   let location = ticks ! breakInfo_number info
+   printForUser stdout unqual $
+      ptext SLIT("Stopped at") <+> ppr location $$ localsMsg 
+   where
+   vars = map fst $ breakInfo_vars info 
+   localsMsg = if null vars
+                  then text "No locals in scope."
+                  else text "Locals:" <+> (pprWithCommas showId vars)
+   showId id = ppr (idName id) <+> dcolon <+> ppr (idType id) 
+
+-- Todo: turn this into a primop, and provide special version(s) for unboxed things
+foreign import ccall "rts_getApStackVal" getApStackVal :: StablePtr a -> Int -> IO (StablePtr b)
+
+getIdValFromApStack :: a -> (Id, Int) -> IO (Id, HValue)
+getIdValFromApStack apStack (identifier, stackDepth) = do
+   -- ToDo: check the type of the identifer and decide whether it is unboxed or not
+   apSptr <- newStablePtr apStack
+   resultSptr <- getApStackVal apSptr (stackDepth - 1)
+   result <- deRefStablePtr resultSptr
+   freeStablePtr apSptr
+   freeStablePtr resultSptr 
+   return (identifier, unsafeCoerce# result)
+
+extendEnvironment :: Session -> a -> [(Id, Int)] -> IO ()
+extendEnvironment s@(Session ref) apStack idsOffsets = do
+   idsVals <- mapM (getIdValFromApStack apStack) idsOffsets 
+   let (ids, hValues) = unzip idsVals 
+   let names = map idName ids
+   let global_ids = map globaliseAndTidy ids
+   typed_ids  <- mapM instantiateIdType global_ids
+   hsc_env <- readIORef ref
+   let ictxt = hsc_IC hsc_env
+       rn_env   = ic_rn_local_env ictxt
+       type_env = ic_type_env ictxt
+       bound_names = map idName typed_ids
+       new_rn_env  = extendLocalRdrEnv rn_env bound_names
+       -- Remove any shadowed bindings from the type_env;
+       -- they are inaccessible but might, I suppose, cause 
+       -- a space leak if we leave them there
+       shadowed = [ n | name <- bound_names,
+                    let rdr_name = mkRdrUnqual (nameOccName name),
+                    Just n <- [lookupLocalRdrEnv rn_env rdr_name] ]
+       filtered_type_env = delListFromNameEnv type_env shadowed
+       new_type_env = extendTypeEnvWithIds filtered_type_env (typed_ids)
+       new_ic = ictxt { ic_rn_local_env = new_rn_env, 
+		        ic_type_env     = new_type_env }
+   writeIORef ref (hsc_env { hsc_IC = new_ic })
+   extendLinkEnv (zip names hValues) -- ToDo: we must remember to restore the old env after we finish a breakpoint
+   where
+   globaliseAndTidy :: Id -> Id
+   globaliseAndTidy id
+      = let tidied_type = tidyTopType$ idType id
+        in setIdType (globaliseId VanillaGlobal id) tidied_type
+
+   -- | Instantiate the tyVars with GHC.Base.Unknown
+   instantiateIdType :: Id -> IO Id
+   instantiateIdType id = do
+      instantiatedType <- instantiateTyVarsToUnknown s (idType id)
+      return$ setIdType id instantiatedType
 
 -- possibly print the type and revert CAFs after evaluating an expression
 finishEvalExpr mb_names
@@ -779,10 +844,6 @@ afterLoad ok session = do
   graph <- io (GHC.getModuleGraph session)
   graph' <- filterM (io . GHC.isLoaded session . GHC.ms_mod_name) graph
   setContextAfterLoad session graph'
-  do 
-     bt  <- getBkptTable
-     bt' <- io$ refreshBkptTable session bt graph'
-     setBkptTable bt'
   modulesLoadedMsg ok (map GHC.ms_mod_name graph')
 
 setContextAfterLoad session [] = do
@@ -851,13 +912,9 @@ kindOfType str
 	  Nothing    -> return ()
 	  Just ty    -> do tystr <- showForUser (ppr ty)
 		           io (putStrLn (str ++ " :: " ++ tystr))
-
-quit :: String -> GHCi Bool
-quit _ =  do in_inferior_session <- liftM not isTopLevel 
-             if in_inferior_session 
-               then throwDyn StopParentSession
-               else return True
           
+quit :: String -> GHCi Bool
+quit _ = return True
 
 shellEscape :: String -> GHCi Bool
 shellEscape str = io (system str >> return False)
@@ -1219,7 +1276,7 @@ showCmd str =
 	["modules" ] -> showModules
 	["bindings"] -> showBindings
 	["linker"]   -> io showLinkerState
-        ["breakpoints"] -> showBkptTable
+        ["breaks"] -> showBkptTable
 	_ -> throwDyn (CmdLineError "syntax:  :show [modules|bindings]")
 
 showModules = do
@@ -1252,12 +1309,10 @@ cleanType ty = do
 
 showBkptTable :: GHCi ()
 showBkptTable = do
-  bt     <- getBkptTable
-  msg <- showForUser . vcat $ 
-             [ ppr mod <> colon <+> fcat 
-                       [ parens(int row <> comma <> int col) | (row,col) <- sites]
-               | (mod, sites) <-  sitesList bt ]
-  io (putStrLn msg)
+   activeBreaks <- getActiveBreakPoints 
+   str <- showForUser $ ppr activeBreaks 
+   io $ putStrLn str
+
 -- -----------------------------------------------------------------------------
 -- Completion
 
@@ -1329,12 +1384,6 @@ completeSetOptions w = do
   return (filter (w `isPrefixOf`) options)
     where options = "args":"prog":allFlags
 
-completeBkpt = unionComplete completeModule completeBkptCmds
-
-completeBkptCmds w = do
-  return (filter (w `isPrefixOf`) options)
-    where options = ["add","del","list","stop"]
-
 completeFilename = Readline.filenameCompletionFunction
 
 completeHomeModuleOrFile = unionComplete completeHomeModule completeFilename
@@ -1395,18 +1444,6 @@ completeBkpt       = completeNone
 -- handler arond the flushing operation, so if stderr is closed
 -- GHCi will just die gracefully rather than going into an infinite loop.
 handler :: Exception -> GHCi Bool
-handler (DynException dyn) 
-  | Just StopChildSession <- fromDynamic dyn 
-     -- propagate to the parent session
-  = do ASSERTM (liftM not isTopLevel) 
-       throwDyn StopChildSession
-
-  | Just StopParentSession <- fromDynamic dyn 
-  = do at_topLevel <-  isTopLevel
-       if at_topLevel then return True else throwDyn StopParentSession
-  
-  | Just (ChildSessionStopped msg) <- fromDynamic dyn     
-  = io(putStrLn msg) >> return False
 
 handler exception = do
   flushInterpBuffers
@@ -1476,84 +1513,163 @@ setUpConsole = do
 #endif
 	return ()
 
+-- commands for debugger
+foreign import ccall "rts_setStepFlag" setStepFlag :: IO () 
+
+stepCmd :: String -> GHCi Bool
+stepCmd [] = doContinue setStepFlag 
+stepCmd expression = do
+   io $ setStepFlag
+   runCommand expression
+
+continueCmd :: String -> GHCi Bool
+continueCmd [] = doContinue $ return () 
+continueCmd other = do
+   io $ putStrLn "The continue command accepts no arguments."
+   return False
+
+doContinue :: IO () -> GHCi Bool
+doContinue actionBeforeCont = do 
+   resumeAction <- getResume
+   popResume
+   case resumeAction of
+      Nothing -> do 
+         io $ putStrLn "There is no computation running."
+         return False
+      Just action -> do
+         io $ actionBeforeCont
+         runResult <- io action
+         names <- switchOnRunResult runResult
+         finishEvalExpr names
+         return False 
+
+deleteCmd :: String -> GHCi Bool
+deleteCmd argLine = do
+   deleteSwitch $ words argLine
+   return False
+   where
+   deleteSwitch :: [String] -> GHCi ()
+   deleteSwitch [] = 
+      io $ putStrLn "The delete command requires at least one argument."
+   -- delete all break points
+   deleteSwitch ("*":_rest) = clearActiveBreakPoints
+   deleteSwitch idents = do
+      mapM_ deleteOneBreak idents 
+      where
+      deleteOneBreak :: String -> GHCi ()
+      deleteOneBreak str
+         | all isDigit str = deleteBreak (read str)
+         | otherwise = return ()
+
+-- handle the "break" command
+breakCmd :: String -> GHCi Bool
+breakCmd argLine = do
+   session <- getSession
+   breakSwitch session $ words argLine
+
+breakSwitch :: Session -> [String] -> GHCi Bool
+breakSwitch _session [] = do
+   io $ putStrLn "The break command requires at least one argument."
+   return False
+breakSwitch session args@(arg1:rest) 
+   | looksLikeModule arg1 = do
+        mod     <- lookupModule session arg1 
+        breakByModule mod rest
+        return False
+   | otherwise = do
+        (toplevel, _) <- io $ GHC.getContext session 
+        case toplevel of
+           (mod : _) -> breakByModule mod args 
+           [] -> do 
+              io $ putStrLn "Cannot find default module for breakpoint." 
+              io $ putStrLn "Perhaps no modules are loaded for debugging?"
+        return False
+   where
+   -- Todo there may be a nicer way to test this
+   looksLikeModule :: String -> Bool
+   looksLikeModule []    = False
+   looksLikeModule (x:_) = isUpper x
+
+breakByModule :: Module -> [String] -> GHCi () 
+breakByModule mod args@(arg1:rest)
+   | all isDigit arg1 = do  -- looks like a line number
+        breakByModuleLine mod (read arg1) rest
+   | looksLikeVar arg1 = do
+        -- break by a function definition
+        io $ putStrLn "Break by function definition not implemented."
+   | otherwise = io $ putStrLn "Invalid arguments to break command."
+   where
+   -- Todo there may be a nicer way to test this
+   looksLikeVar :: String -> Bool
+   looksLikeVar [] = False
+   looksLikeVar (x:_) = isLower x || x `elem` "~!@#$%^&*-+"
+
+breakByModuleLine :: Module -> Int -> [String] -> GHCi ()
+breakByModuleLine mod line args
+   | [] <- args = findBreakAndSet mod $ lookupTickTreeLine line
+   | [col] <- args, all isDigit col =
+        findBreakAndSet mod $ lookupTickTreeCoord (line, read col)
+   | otherwise = io $ putStrLn "Invalid arguments to break command."
+        
+findBreakAndSet :: Module -> (TickTree -> Maybe (Int, SrcSpan)) -> GHCi ()
+findBreakAndSet mod lookupTickTree = do 
+   (breakArray, ticks) <- getModBreak mod 
+   let tickTree   = tickTreeFromList (assocs ticks)
+   case lookupTickTree tickTree of 
+      Nothing  -> io $ putStrLn $ "No breakpoints found at that location."
+      Just (tick, span) -> do
+         success <- io $ setBreakFlag True breakArray tick 
+         session <- getSession
+         unqual  <- io $ GHC.getPrintUnqual session
+         if success 
+            then do
+               (alreadySet, nm) <- 
+                     recordBreak $ BreakLocation
+                             { breakModule = mod
+                             , breakLoc = span
+                             , breakTick = tick
+                             }
+               io $ printForUser stdout unqual $
+                  text "Breakpoint " <> ppr nm <>
+                  if alreadySet 
+                     then text " was already set at " <> ppr span
+                     else text " activated at " <> ppr span
+            else do
+            str <- showForUser $ text "Breakpoint could not be activated at" 
+                                 <+> ppr span
+            io $ putStrLn str
+
+getModBreak :: Module -> GHCi (BreakArray, Array Int SrcSpan)
+getModBreak mod = do
+   session <- getSession
+   Just mod_info <- io $ GHC.getModuleInfo session mod
+   let modBreaks  = GHC.modInfoModBreaks mod_info
+   let array      = modBreaks_array modBreaks
+   let ticks      = modBreaks_ticks modBreaks
+   return (array, ticks)
 
-instrumentationBkptHandler :: IORef (BkptTable Module) -> BkptHandler Module
-instrumentationBkptHandler ref_bkptTable = BkptHandler {
-    isAutoBkptEnabled = \sess bkptLoc -> do 
-      bktpTable <- readIORef ref_bkptTable
-      return$ isBkptEnabled bktpTable bkptLoc
-
-  , handleBreakpoint = doBreakpoint ref_bkptTable 
-  }
-
-doBreakpoint :: IORef (BkptTable Module)-> Session -> [(Id,HValue)] -> BkptLocation Module -> String -> b -> IO b
-doBreakpoint ref_bkptTable s@(Session ref) values _ locMsg b = do
-         let (ids, hValues) = unzip values
-             names = map idName ids
-         ASSERT (length names == length hValues) return ()
-         let global_ids = map globaliseAndTidy ids
-         printScopeMsg locMsg global_ids
-         typed_ids  <- mapM instantiateIdType global_ids
-         hsc_env <- readIORef ref
-         let ictxt = hsc_IC hsc_env
-             rn_env   = ic_rn_local_env ictxt
-             type_env = ic_type_env ictxt
-             bound_names = map idName typed_ids
-             new_rn_env  = extendLocalRdrEnv rn_env bound_names
-		-- Remove any shadowed bindings from the type_env;
-		-- they are inaccessible but might, I suppose, cause 
-		-- a space leak if we leave them there
-             shadowed = [ n | name <- bound_names,
-                          let rdr_name = mkRdrUnqual (nameOccName name),
-                          Just n <- [lookupLocalRdrEnv rn_env rdr_name] ]
-             filtered_type_env = delListFromNameEnv type_env shadowed
-             new_type_env = extendTypeEnvWithIds filtered_type_env (typed_ids)
-             new_ic = ictxt { ic_rn_local_env = new_rn_env, 
-		  	      ic_type_env     = new_type_env }
-         writeIORef ref (hsc_env { hsc_IC = new_ic })
-         is_tty <- hIsTerminalDevice stdin
-         prel_mod <- GHC.findModule s prel_name Nothing
-         withExtendedLinkEnv (zip names hValues) $ 
-           startGHCi (interactiveLoop is_tty True) GHCiState{ 
-                              progname = "<interactive>",
-                              args     = [],
-                              prompt   = locMsg ++ "> ",
-                              session  = s,
-                              options  = [],
-                              bkptTable= ref_bkptTable,
-                              prelude  = prel_mod,
-			      topLevel = False }
-             `catchDyn` (\e -> case e of 
-                           StopChildSession -> evaluate$
-                                               throwDyn (ChildSessionStopped "")
-                           StopParentSession -> throwDyn StopParentSession
-           ) `finally` do
-             writeIORef ref hsc_env
-             putStrLn $ "Returning to normal execution..."
-         return b
-  where 
-     printScopeMsg :: String -> [Id] -> IO ()
-     printScopeMsg location ids = do
-       unqual  <- GHC.getPrintUnqual s
-       printForUser stdout unqual $
-         text "Stopped at a breakpoint in " <> text (stripColumn location) <>
-         char '.' <+> text "Local bindings in scope:" $$
-         nest 2 (pprWithCommas showId ids)
-      where 
-           showId id = 
-                ppr (idName id) <+> dcolon <+> ppr (idType id) 
-           stripColumn = reverse . tail . dropWhile (/= ':') . reverse
-
--- | Give the Id a Global Name, and tidy its type
-     globaliseAndTidy :: Id -> Id
-     globaliseAndTidy id
-      = let tidied_type = tidyTopType$ idType id
-        in setIdType (globaliseId VanillaGlobal id) tidied_type
+lookupModule :: Session -> String -> GHCi Module
+lookupModule session modName
+   = io (GHC.findModule session (GHC.mkModuleName modName) Nothing)
+
+setBreakFlag :: Bool -> BreakArray -> Int -> IO Bool 
+setBreakFlag toggle array index
+   | toggle    = setBreakOn array index 
+   | otherwise = setBreakOff array index
+
+
+{- these should probably go to the GHC API at some point -}
+enableBreakPoint  :: Session -> Module -> Int -> IO ()
+enableBreakPoint session mod index = return ()
+
+disableBreakPoint :: Session -> Module -> Int -> IO ()
+disableBreakPoint session mod index = return ()
 
--- | Instantiate the tyVars with GHC.Base.Unknown
-     instantiateIdType :: Id -> IO Id
-     instantiateIdType id = do
-       instantiatedType <- instantiateTyVarsToUnknown s (idType id)
-       return$ setIdType id instantiatedType
+activeBreakPoints :: Session -> IO [(Module,Int)]
+activeBreakPoints session = return []
 
+enableSingleStep  :: Session -> IO ()
+enableSingleStep session = return ()
 
+disableSingleStep :: Session -> IO ()
+disableSingleStep session = return ()
diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs
index 2c1b668e65..38d584a633 100644
--- a/compiler/ghci/Linker.lhs
+++ b/compiler/ghci/Linker.lhs
@@ -18,7 +18,7 @@ module Linker ( HValue, getHValue, showLinkerState,
 		linkExpr, unload, extendLinkEnv, withExtendedLinkEnv,
                 extendLoadedPkgs,
 		linkPackages,initDynLinker,
-                recoverDataCon
+                dataConInfoPtrToName
 	) where
 
 #include "HsVersions.h"
@@ -28,8 +28,9 @@ import ByteCodeLink
 import ByteCodeItbls
 import ByteCodeAsm
 import RtClosureInspect
+import CgInfoTbls
+import SMRep
 import IfaceEnv
-import OccName
 import TcRnMonad
 import Packages
 import DriverPhases
@@ -38,6 +39,7 @@ import HscTypes
 import Name
 import NameEnv
 import NameSet
+import qualified OccName
 import UniqFM
 import Module
 import ListSetOps
@@ -52,6 +54,7 @@ import ErrUtils
 import DriverPhases
 import SrcLoc
 import UniqSet
+import Constants
 
 -- Standard libraries
 import Control.Monad
@@ -151,12 +154,13 @@ extendLinkEnv new_bindings
 --   We use this string to lookup the interpreter's internal representation of the name
 --   using the lookupOrig.    
 
-recoverDataCon :: a -> TcM Name
-recoverDataCon x = do 
+dataConInfoPtrToName :: Ptr () -> TcM Name
+dataConInfoPtrToName x = do 
    theString <- ioToTcRn $ do
-      let ptr = getInfoTablePtr x 
+      let ptr = castPtr x :: Ptr StgInfoTable
       conDescAddress <- getConDescAddress ptr 
-      peekCString conDescAddress  
+      str <- peekCString conDescAddress  
+      return str
    let (pkg, mod, occ) = parse theString 
        occName = mkOccName OccName.dataName occ
        modName = mkModule (stringToPackageId pkg) (mkModuleName mod) 
@@ -207,18 +211,10 @@ recoverDataCon x = do
    getConDescAddress :: Ptr StgInfoTable -> IO (Ptr CChar)
    getConDescAddress ptr = do
 #ifdef GHCI_TABLES_NEXT_TO_CODE
-       offsetToString <- peek $ intPtrToPtr $ (ptrToIntPtr ptr) + offset
-       return $ ptr `plusPtr` offsetToString
-       where
-       -- subtract a word number of bytes 
-       offset = negate (fromIntegral SIZEOF_VOID_P)
-#endif
-#ifndef GHCI_TABLES_NEXT_TO_CODE
-        peek $ intPtrToPtr $ (ptrToIntPtr ptr) + offset
-      where 
-      -- add the standard info table size in bytes 
-      infoTableSizeBytes = sTD_ITBL_SIZE * wORD_SIZE
-      offset = infoTableSizeBytes 
+       offsetToString <- peek $ ptr `plusPtr` (- wORD_SIZE)
+       return $ (ptr `plusPtr` stdInfoTableSizeB) `plusPtr` (fromIntegral (offsetToString :: StgWord))
+#else
+       peek $ intPtrToPtr $ (ptrToIntPtr ptr) + stdInfoTableSizeB
 #endif
 
    -- parsing names is a little bit fiddly because we have a string in the form: 
diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs
index 26816a03ec..b12d29628f 100644
--- a/compiler/ghci/RtClosureInspect.hs
+++ b/compiler/ghci/RtClosureInspect.hs
@@ -12,11 +12,9 @@ module RtClosureInspect(
 
      ClosureType(..), 
      getClosureData,     -- :: a -> IO Closure
-     Closure ( tipe, infoTable, ptrs, nonPtrs ), 
-     getClosureType,     -- :: a -> IO ClosureType
+     Closure ( tipe, infoPtr, ptrs, nonPtrs ), 
      isConstr,           -- :: ClosureType -> Bool
      isIndirection,      -- :: ClosureType -> Bool
-     getInfoTablePtr,    -- :: a -> Ptr StgInfoTable
 
      Term(..), 
      printTerm, 
@@ -77,6 +75,8 @@ import Data.Array.Base
 import Data.List        ( partition )
 import Foreign.Storable
 
+import IO
+
 ---------------------------------------------
 -- * A representation of semi evaluated Terms
 ---------------------------------------------
@@ -139,6 +139,7 @@ data ClosureType = Constr
  deriving (Show, Eq)
 
 data Closure = Closure { tipe         :: ClosureType 
+                       , infoPtr      :: Ptr ()
                        , infoTable    :: StgInfoTable
                        , ptrs         :: Array Int HValue
                         -- What would be the type here? HValue is ok? Should I build a Ptr?
@@ -148,14 +149,6 @@ data Closure = Closure { tipe         :: ClosureType
 instance Outputable ClosureType where
   ppr = text . show 
 
-getInfoTablePtr :: a -> Ptr StgInfoTable
-getInfoTablePtr x = 
-    case infoPtr# x of
-      itbl_ptr -> castPtr ( Ptr itbl_ptr )
-
-getClosureType :: a -> IO ClosureType
-getClosureType = liftM (readCType . BCI.tipe ) . peek . getInfoTablePtr
-
 #include "../includes/ClosureTypes.h"
 
 aP_CODE = AP
@@ -164,14 +157,14 @@ pAP_CODE = PAP
 #undef PAP
 
 getClosureData :: a -> IO Closure
-getClosureData a = do
-   itbl <- peek (getInfoTablePtr a)
-   let tipe = readCType (BCI.tipe itbl)
-   case closurePayload# a of 
-     (# ptrs, nptrs #) -> 
-           let elems = BCI.ptrs itbl 
+getClosureData a =
+   case unpackClosure# a of 
+     (# iptr, ptrs, nptrs #) -> do
+           itbl <- peek (Ptr iptr)
+           let tipe = readCType (BCI.tipe itbl)
+               elems = BCI.ptrs itbl 
                ptrsList = Array 0 (fromIntegral$ elems) ptrs
-           in ptrsList `seq` return (Closure tipe itbl ptrsList nptrs)
+           ptrsList `seq` return (Closure tipe (Ptr iptr) itbl ptrsList nptrs)
 
 readCType :: Integral a => a -> ClosureType
 readCType i
@@ -481,9 +474,10 @@ instScheme ty = liftTcM$ liftM trd (tcInstType (liftM fst3 . tcInstTyVars) ty)
           trd  (x,y,z) = z
 
 cvObtainTerm :: HscEnv -> Bool -> Maybe Type -> HValue -> IO Term
-cvObtainTerm hsc_env force mb_ty a = 
- -- Obtain the term and tidy the type before returning it
-     cvObtainTerm1 hsc_env force mb_ty a >>= return . tidyTypes 
+cvObtainTerm hsc_env force mb_ty a = do
+   -- Obtain the term and tidy the type before returning it
+   term <- cvObtainTerm1 hsc_env force mb_ty a
+   return $ tidyTypes term
    where 
          tidyTypes = foldTerm idTermFold {
             fTerm = \ty dc hval tt -> Term (tidy ty) dc hval tt,
@@ -505,21 +499,18 @@ cvObtainTerm1 hsc_env force mb_ty hval = runTR hsc_env $ do
    go tv hval
     where 
   go tv a = do 
-    ctype <- trIO$ getClosureType a
-    case ctype of
+    clos <- trIO $ getClosureData a
+    case tipe clos of
 -- Thunks we may want to force
       Thunk _ | force -> seq a $ go tv a
 -- We always follow indirections 
-      _       | isIndirection ctype -> do
-        clos   <- trIO$ getClosureData a
-        (go tv $! (ptrs clos ! 0))
+      Indirection _ -> go tv $! (ptrs clos ! 0)
  -- The interesting case
       Constr -> do
-        m_dc <- trIO$ tcRnRecoverDataCon hsc_env a
+        m_dc <- trIO$ tcRnRecoverDataCon hsc_env (infoPtr clos)
         case m_dc of
           Nothing -> panic "Can't find the DataCon for a term"
           Just dc -> do 
-            clos          <- trIO$ getClosureData a
             let extra_args = length(dataConRepArgTys dc) - length(dataConOrigArgTys dc)
                 subTtypes  = drop extra_args (dataConRepArgTys dc)
                 (subTtypesP, subTtypesNP) = partition isPointed subTtypes
@@ -537,7 +528,7 @@ cvObtainTerm1 hsc_env force mb_ty hval = runTR hsc_env $ do
             return (Term tv dc a subTerms)
 -- The otherwise case: can be a Thunk,AP,PAP,etc.
       otherwise -> do
-         return (Suspension ctype (Just tv) a Nothing)
+         return (Suspension (tipe clos) (Just tv) a Nothing)
 
 -- Access the array of pointers and recurse down. Needs to be done with
 -- care of no introducing a thunk! or go will fail to do its job 
diff --git a/compiler/ghci/TickTree.hs b/compiler/ghci/TickTree.hs
new file mode 100644
index 0000000000..a472e59e75
--- /dev/null
+++ b/compiler/ghci/TickTree.hs
@@ -0,0 +1,110 @@
+-----------------------------------------------------------------------------
+--
+-- Trees of source spans used by the breakpoint machinery
+--
+-- (c) The University of Glasgow 2007
+--
+-----------------------------------------------------------------------------
+
+module TickTree 
+   ( TickTree, lookupTickTreeCoord, lookupTickTreeLine, tickTreeFromList )
+   where
+
+import SrcLoc
+
+import Data.List (partition, foldl') 
+
+type TickNumber = Int
+
+newtype TickTree = Root [SpanTree]
+
+data SpanTree 
+   = Node 
+     { spanTreeTick     :: TickNumber 
+     , spanTreeLoc      :: SrcSpan
+     , spanTreeChildren :: [SpanTree]
+     }
+
+mkNode :: TickNumber -> SrcSpan -> [SpanTree] -> SpanTree
+mkNode tick loc kids
+   = Node { spanTreeTick = tick, spanTreeLoc = loc, spanTreeChildren = kids }
+
+emptyTickTree :: TickTree
+emptyTickTree = Root []
+
+tickTreeFromList :: [(TickNumber, SrcSpan)] -> TickTree
+tickTreeFromList 
+   = foldl' (\tree (tick,loc) -> insertTickTree tick loc tree) emptyTickTree 
+
+insertTickTree :: TickNumber -> SrcSpan -> TickTree -> TickTree
+insertTickTree tick loc (Root children)
+   = Root $ insertSpanTree tick loc children
+
+insertSpanTree :: TickNumber -> SrcSpan -> [SpanTree] -> [SpanTree]
+insertSpanTree tick loc [] = [mkNode tick loc []] 
+insertSpanTree tick loc children@(kid:siblings) 
+   | null containedKids = insertDeeper tick loc children
+   | otherwise = mkNode tick loc children : rest
+   where
+   (containedKids, rest) = getContainedKids loc children
+   insertDeeper :: TickNumber -> SrcSpan -> [SpanTree] -> [SpanTree]
+   insertDeeper tick loc [] = [mkNode tick loc []] 
+   insertDeeper tick loc nodes@(kid:siblings)
+      | srcSpanStart loc < srcSpanStart kidLoc = newBranch : nodes 
+      | kidLoc `contains` loc = newKid : siblings 
+      | otherwise = kid : insertDeeper tick loc siblings
+      where
+      newBranch = mkNode tick loc []
+      kidLoc = spanTreeLoc kid
+      newKid = mkNode (spanTreeTick kid) (spanTreeLoc kid)
+                      (insertSpanTree tick loc $ spanTreeChildren kid)
+
+getContainedKids :: SrcSpan -> [SpanTree] -> ([SpanTree], [SpanTree])
+getContainedKids loc = Data.List.partition (\tree -> loc `contains` (spanTreeLoc tree)) 
+
+-- True if the left loc contains the right loc
+contains :: SrcSpan -> SrcSpan -> Bool
+contains span1 span2
+   = srcSpanStart span1 <= srcSpanStart span2 &&
+     srcSpanEnd   span1 <= srcSpanEnd   span2   
+
+type TickLoc = (TickNumber, SrcSpan)
+type LineNumber = Int
+type ColumnNumber = Int
+type Coord = (LineNumber, ColumnNumber)
+
+srcSpanStartLine = srcLocLine . srcSpanStart
+
+lookupTickTreeLine :: LineNumber -> TickTree -> Maybe TickLoc 
+lookupTickTreeLine line (Root children) = lookupSpanTreeLine line children
+
+lookupSpanTreeLine :: LineNumber -> [SpanTree] -> Maybe TickLoc 
+lookupSpanTreeLine line [] = Nothing 
+lookupSpanTreeLine line (node:nodes)
+   | startLine == line && endLine == line 
+        = Just (spanTreeTick node, spanTreeLoc node) 
+   | startLine > line  
+        = lookupSpanTreeLine line nodes
+   | otherwise = 
+        case lookupSpanTreeLine line (spanTreeChildren node) of
+                Nothing    -> lookupSpanTreeLine line nodes
+                x@(Just _) -> x
+   where
+   startLine = srcSpanStartLine (spanTreeLoc node) 
+   endLine = srcSpanEndLine (spanTreeLoc node) 
+
+lookupTickTreeCoord :: Coord -> TickTree -> Maybe TickLoc 
+lookupTickTreeCoord coord (Root children) = lookupSpanTreeCoord coord children Nothing
+
+lookupSpanTreeCoord :: Coord -> [SpanTree] -> Maybe TickLoc -> Maybe TickLoc 
+lookupSpanTreeCoord coord [] acc = acc 
+lookupSpanTreeCoord coord (kid:siblings) acc
+   | spanTreeLoc kid `spans` coord 
+        = lookupSpanTreeCoord coord (spanTreeChildren kid) 
+                              (Just (spanTreeTick kid, spanTreeLoc kid))
+   | otherwise 
+        = lookupSpanTreeCoord coord siblings acc
+   where
+   spans :: SrcSpan -> Coord -> Bool
+   spans span (l,c) = srcSpanStart span <= loc && loc <= srcSpanEnd span
+        where loc = mkSrcLoc (srcSpanFile span) l c
diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index b6f1f484f2..b82685bee7 100644
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -50,7 +50,6 @@ import Maybes
 import SrcLoc
 import Util
 import DynFlags
-import Breakpoints
 import Control.Monad
 
 import Data.List
@@ -211,7 +210,7 @@ typecheckIface iface
 			      , md_fam_insts = fam_insts
 			      , md_rules     = rules
 			      , md_exports   = exports
-                              , md_dbg_sites = noDbgSites
+                              , md_modBreaks = emptyModBreaks
 			      }
     }
 \end{code}
diff --git a/compiler/main/BreakArray.hs b/compiler/main/BreakArray.hs
new file mode 100644
index 0000000000..788adf200c
--- /dev/null
+++ b/compiler/main/BreakArray.hs
@@ -0,0 +1,96 @@
+--
+-- Break Arrays in the IO monad
+-- Entries in the array are Word sized 
+--
+
+module BreakArray
+  ( BreakArray (BA)
+  , newBreakArray
+  , getBreak 
+  , setBreakOn 
+  , setBreakOff
+  , showBreakArray
+  ) where
+
+import GHC.Exts
+import GHC.IOBase
+import GHC.Prim
+import GHC.Word
+import Constants
+
+data BreakArray = BA (MutableByteArray# RealWorld)
+
+breakOff, breakOn :: Word
+breakOn  = fromIntegral 1
+breakOff = fromIntegral 0
+
+-- XXX crude
+showBreakArray :: BreakArray -> IO ()
+showBreakArray array = do
+   let loop count sz
+          | count == sz = return ()
+          | otherwise = do
+               val <- readBreakArray array count 
+               putStr $ " " ++ show val
+               loop (count + 1) sz
+   loop 0 (size array) 
+   putStr "\n"
+
+setBreakOn :: BreakArray -> Int -> IO Bool 
+setBreakOn array index
+   | safeIndex array index = do 
+        writeBreakArray array index breakOn 
+        return True
+   | otherwise = return False 
+
+setBreakOff :: BreakArray -> Int -> IO Bool 
+setBreakOff array index
+   | safeIndex array index = do
+        writeBreakArray array index breakOff
+        return True
+   | otherwise = return False 
+
+getBreak :: BreakArray -> Int -> IO (Maybe Word)
+getBreak array index 
+   | safeIndex array index = do
+        val <- readBreakArray array index 
+        return $ Just val 
+   | otherwise = return Nothing
+
+safeIndex :: BreakArray -> Int -> Bool
+safeIndex array index = index < size array && index >= 0
+
+size :: BreakArray -> Int
+size (BA array) = (I# (sizeofMutableByteArray# array)) `div` wORD_SIZE
+
+allocBA :: Int -> IO BreakArray 
+allocBA (I# sz) = IO $ \s1 ->
+  case newByteArray# sz s1 of { (# s2, array #) -> (# s2, BA array #) }
+
+-- create a new break array and initialise elements to zero
+newBreakArray :: Int -> IO BreakArray
+newBreakArray entries@(I# sz) = do
+   BA array <- allocBA (entries * wORD_SIZE) 
+   case breakOff of 
+      W# off -> do    -- Todo: there must be a better way to write zero as a Word!
+         let loop n
+                | n ==# sz = return ()
+                | otherwise = do
+                     writeBA# array n off 
+                     loop (n +# 1#)
+         loop 0#
+   return $ BA array
+
+writeBA# :: MutableByteArray# RealWorld -> Int# -> Word# -> IO ()
+writeBA# array i word = IO $ \s ->
+  case writeWordArray# array i word s of { s -> (# s, () #) }
+
+writeBreakArray :: BreakArray -> Int -> Word -> IO ()
+writeBreakArray (BA array) (I# i) (W# word) = writeBA# array i word 
+
+readBA# :: MutableByteArray# RealWorld -> Int# -> IO Word 
+readBA# array i = IO $ \s -> 
+   case readWordArray# array i s of { (# s, c #) -> (# s, W# c #) }
+
+readBreakArray :: BreakArray -> Int -> IO Word 
+readBreakArray (BA array) (I# i) = readBA# array i
diff --git a/compiler/main/Breakpoints.hs b/compiler/main/Breakpoints.hs
deleted file mode 100644
index c4318ca448..0000000000
--- a/compiler/main/Breakpoints.hs
+++ /dev/null
@@ -1,56 +0,0 @@
------------------------------------------------------------------------------

---

--- GHC API breakpoints. This module includes the main API (BkptHandler) and

--- utility code for implementing a client to this API used in GHCi 

---

--- Pepe Iborra (supported by Google SoC) 2006

---

------------------------------------------------------------------------------

-

-module Breakpoints where

-

-#ifdef GHCI

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

-#endif

-

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

-import Name

-import Var                       ( Id )

-import PrelNames

-

-import GHC.Exts

-

-#ifdef GHCI

-data BkptHandler a = BkptHandler {

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

-   , isAutoBkptEnabled :: Session -> BkptLocation a -> IO Bool

-   }

-

-nullBkptHandler = BkptHandler {

-    isAutoBkptEnabled = \ _ _     -> return False,

-    handleBreakpoint  = \_ _ _ _ b -> putStrLn "null Bkpt Handler" >> return b

-                              }

-#endif

-

-type BkptLocation a = (a, SiteNumber)

-type SiteNumber   = Int

-

-type SiteMap      = [(SiteNumber, Coord)]

-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 */

-

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index f10d2f9ea5..fa5ae4b196 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -85,10 +85,6 @@ import Util		( split )
 import Data.Char	( isUpper )
 import System.IO        ( hPutStrLn, stderr )
 
-#ifdef GHCI
-import Breakpoints      ( BkptHandler )
-import Module           ( ModuleName )
-#endif
 -- -----------------------------------------------------------------------------
 -- DynFlags
 
@@ -208,9 +204,6 @@ data DynFlag
    | Opt_SplitObjs
    | Opt_StgStats
    | Opt_HideAllPackages
-#if defined(GHCI) && defined(DEBUGGER)
-   | Opt_Debugging
-#endif
    | Opt_PrintBindResult
    | Opt_Haddock
    | Opt_Hpc_No_Auto
@@ -321,11 +314,6 @@ data DynFlags = DynFlags {
   
   -- message output
   log_action            :: Severity -> SrcSpan -> PprStyle -> Message -> IO ()
-
-#ifdef GHCI
-  -- breakpoint handling
- ,bkptHandler           :: Maybe (BkptHandler Module)
-#endif
  }
 
 data HscTarget
@@ -446,9 +434,6 @@ defaultDynFlags =
 	packageFlags		= [],
         pkgDatabase             = Nothing,
         pkgState                = panic "no package state yet: call GHC.setSessionDynFlags",
-#ifdef GHCI
-        bkptHandler             = Nothing,
-#endif
 	flags = [ 
     	    Opt_ReadUserPackageConf,
     
@@ -1079,9 +1064,6 @@ fFlags = [
   ( "excess-precision",			Opt_ExcessPrecision ),
   ( "asm-mangling",			Opt_DoAsmMangling ),
   ( "print-bind-result",		Opt_PrintBindResult ),
-#if defined(GHCI) && defined(DEBUGGER)
-  ( "debugging",                        Opt_Debugging),
-#endif
   ( "force-recomp",			Opt_ForceRecomp ),
   ( "hpc-no-auto",			Opt_Hpc_No_Auto )
   ]
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index eb2ca8e3dd..5f78c3e9d5 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -60,9 +60,6 @@ module GHC (
 	modInfoInstances,
 	modInfoIsExportedName,
 	modInfoLookupName,
-#if defined(GHCI)
-        modInfoBkptSites,
-#endif
 	lookupGlobalName,
 
 	-- * Printing
@@ -86,9 +83,8 @@ module GHC (
         isModuleInterpreted,
 	compileExpr, HValue, dynCompileExpr,
 	lookupName,
-
-        getBreakpointHandler, setBreakpointHandler, 
         obtainTerm, obtainTerm1,
+        modInfoModBreaks, 
 #endif
 
 	-- * Abstract syntax elements
@@ -194,24 +190,16 @@ import Name		( nameOccName )
 import Type		( tidyType )
 import Var		( varName )
 import VarEnv		( emptyTidyEnv )
-import GHC.Exts         ( unsafeCoerce# )
-
--- For breakpoints
-import Breakpoints      ( SiteNumber, Coord, nullBkptHandler, 
-                          BkptHandler(..), BkptLocation, noDbgSites )
-import Linker           ( initDynLinker )
-import PrelNames        ( breakpointJumpName, breakpointCondJumpName, 
-                          breakpointAutoJumpName )
-
-import GHC.Exts         ( Int(..), Ptr(..), int2Addr#, indexArray# )
-import GHC.Base         ( Opaque(..) )
-import Foreign.StablePtr( deRefStablePtr, castPtrToStablePtr )
-import Foreign          ( unsafePerformIO )
+import GHC.Exts         ( unsafeCoerce#, Ptr )
+import Foreign.StablePtr( deRefStablePtr, castPtrToStablePtr, StablePtr, newStablePtr, freeStablePtr )
+import Foreign          ( poke )
 import Data.Maybe       ( fromMaybe)
 import qualified Linker
 
 import Data.Dynamic     ( Dynamic )
 import Linker		( HValue, getHValue, extendLinkEnv )
+
+import ByteCodeInstr    (BreakInfo)
 #endif
 
 import Packages		( initPackages )
@@ -854,7 +842,7 @@ checkModule session@(Session ref) mod = do
 				minf_rdr_env   = Just rdr_env,
 				minf_instances = md_insts details
 #ifdef GHCI
-                               ,minf_dbg_sites = noDbgSites
+                               ,minf_modBreaks = emptyModBreaks 
 #endif
 			      }
 		   return (Just (CheckedModule {
@@ -1799,7 +1787,7 @@ data ModuleInfo = ModuleInfo {
 	minf_rdr_env   :: Maybe GlobalRdrEnv,	-- Nothing for a compiled/package mod
 	minf_instances :: [Instance]
 #ifdef GHCI
-        ,minf_dbg_sites :: [(SiteNumber,Coord)] 
+        ,minf_modBreaks :: ModBreaks 
 #endif
 	-- ToDo: this should really contain the ModIface too
   }
@@ -1840,7 +1828,7 @@ getPackageModuleInfo hsc_env mdl = do
 			minf_exports   = names,
 			minf_rdr_env   = Just $! nameSetToGlobalRdrEnv names (moduleName mdl),
 			minf_instances = error "getModuleInfo: instances for package module unimplemented",
-                        minf_dbg_sites = noDbgSites
+                        minf_modBreaks = emptyModBreaks  
 		}))
 #else
   -- bogusly different for non-GHCI (ToDo)
@@ -1858,7 +1846,7 @@ getHomeModuleInfo hsc_env mdl =
 			minf_rdr_env   = mi_globals $! hm_iface hmi,
 			minf_instances = md_insts details
 #ifdef GHCI
-                       ,minf_dbg_sites = md_dbg_sites details
+                       ,minf_modBreaks = md_modBreaks details  
 #endif
 			}))
 
@@ -1894,7 +1882,7 @@ modInfoLookupName s minf name = withSession s $ \hsc_env -> do
 			    (hsc_HPT hsc_env) (eps_PTE eps) name
 
 #ifdef GHCI
-modInfoBkptSites = minf_dbg_sites
+modInfoModBreaks = minf_modBreaks  
 #endif
 
 isDictonaryId :: Id -> Bool
@@ -1993,7 +1981,6 @@ setContext sess@(Session ref) toplev_mods export_mods = do
   writeIORef ref hsc_env{ hsc_IC = old_ic { ic_toplev_scope = toplev_mods,
 					    ic_exports      = export_mods,
 					    ic_rn_gbl_env   = all_env }}
-  reinstallBreakpointHandlers sess
 
 -- Make a GlobalRdrEnv based on the exports of the modules only.
 mkExportEnv :: HscEnv -> [Module] -> IO GlobalRdrEnv
@@ -2164,14 +2151,22 @@ data RunResult
   = RunOk [Name] 		-- ^ names bound by this evaluation
   | RunFailed	 		-- ^ statement failed compilation
   | RunException Exception	-- ^ statement raised an exception
+  | forall a . RunBreak a ThreadId BreakInfo (IO RunResult)
+
+data Status a
+   = Break RunResult               -- ^ the computation hit a breakpoint
+   | Complete (Either Exception a) -- ^ the computation completed with either an exception or a value
 
--- | Run a statement in the current interactive context.  Statemenet
+-- | Run a statement in the current interactive context.  Statement
 -- may bind multple values.
 runStmt :: Session -> String -> IO RunResult
 runStmt (Session ref) expr
    = do 
 	hsc_env <- readIORef ref
 
+        breakMVar  <- newEmptyMVar  -- wait on this when we hit a breakpoint
+        statusMVar <- newEmptyMVar  -- wait on this when a computation is running 
+
 	-- Turn off -fwarn-unused-bindings when running a statement, to hide
 	-- warnings about the implicit bindings we introduce.
 	let dflags'  = dopt_unset (hsc_dflags hsc_env) Opt_WarnUnusedBinds
@@ -2183,36 +2178,58 @@ runStmt (Session ref) expr
 	   Nothing -> return RunFailed
 	   Just (new_hsc_env, names, hval) -> do
 
-		let thing_to_run = unsafeCoerce# hval :: IO [HValue]
-		either_hvals <- sandboxIO thing_to_run
-
+              -- resume says what to do when we continue execution from a breakpoint
+              -- onBreakAction says what to do when we hit a breakpoint
+              -- they are mutually recursive, hence the strange use tuple let-binding 
+              let (resume, onBreakAction)
+                     = ( do stablePtr <- newStablePtr onBreakAction 
+                            poke breakPointIOAction stablePtr
+                            putMVar breakMVar ()
+                            status <- takeMVar statusMVar
+                            switchOnStatus ref new_hsc_env names status
+                       , \ids apStack -> do 
+                            tid <- myThreadId
+                            putMVar statusMVar (Break (RunBreak apStack tid ids resume))
+                            takeMVar breakMVar 
+                       )
+
+              -- set the onBreakAction to be performed when we hit a breakpoint
+              -- this is visible in the Byte Code Interpreter, thus it is a global
+              -- variable, implemented with stable pointers
+              stablePtr <- newStablePtr onBreakAction
+              poke breakPointIOAction stablePtr
+
+              let thing_to_run = unsafeCoerce# hval :: IO [HValue]
+              status <- sandboxIO statusMVar thing_to_run
+              freeStablePtr stablePtr -- be careful not to leak stable pointers!
+              switchOnStatus ref new_hsc_env names status
+   where
+   switchOnStatus ref hs_env names status = 
+      case status of  
+         -- did we hit a breakpoint or did we complete?
+         (Break result) -> return result 
+         (Complete either_hvals) ->
 		case either_hvals of
-		    Left e -> do
-			-- on error, keep the *old* interactive context,
-			-- so that 'it' is not bound to something
-			-- that doesn't exist.
-		        return (RunException e)
-
+		    Left e -> return (RunException e)
 		    Right hvals -> do
-			-- Get the newly bound things, and bind them.  
-			-- Don't need to delete any shadowed bindings;
-			-- the new ones override the old ones. 
 			extendLinkEnv (zip names hvals)
-	     		
-			writeIORef ref new_hsc_env
+			writeIORef ref hs_env 
 			return (RunOk names)
+           
+-- this points to the IO action that is executed when a breakpoint is hit
+foreign import ccall "&breakPointIOAction" 
+        breakPointIOAction :: Ptr (StablePtr (a -> BreakInfo -> IO ())) 
 
 -- When running a computation, we redirect ^C exceptions to the running
 -- thread.  ToDo: we might want a way to continue even if the target
 -- thread doesn't die when it receives the exception... "this thread
 -- is not responding".
-sandboxIO :: IO a -> IO (Either Exception a)
-sandboxIO thing = do
-  m <- newEmptyMVar
+sandboxIO :: MVar (Status a) -> IO a -> IO (Status a) 
+sandboxIO statusMVar thing = do
   ts <- takeMVar interruptTargetThread
-  child <- forkIO (do res <- Exception.try thing; putMVar m res)
+  child <- forkIO (do res <- Exception.try thing; putMVar statusMVar (Complete res))
   putMVar interruptTargetThread (child:ts)
-  takeMVar m `finally` modifyMVar_ interruptTargetThread (return.tail)
+  takeMVar statusMVar `finally` modifyMVar_ interruptTargetThread (return.tail)
 
 {-
 -- This version of sandboxIO runs the expression in a completely new
@@ -2261,75 +2278,6 @@ isModuleInterpreted s mod_summary = withSession s $ \hsc_env ->
 		      where
 			 obj_linkable = isObjectLinkable (expectJust "showModule" (hm_linkable mod_info))
 
------------------------------------------------------------------------------
--- Breakpoint handlers
-
-getBreakpointHandler :: Session -> IO (Maybe (BkptHandler Module))
-getBreakpointHandler session = getSessionDynFlags session >>= return . bkptHandler
- 
-setBreakpointHandler :: Session -> BkptHandler Module -> IO ()
-setBreakpointHandler session handler = do
-  dflags <- getSessionDynFlags session
-  setSessionDynFlags session dflags{ bkptHandler = Just handler }
-  let linkEnv =   [ ( breakpointJumpName
-                    , unsafeCoerce# (jumpFunction session handler))
-                  , ( breakpointCondJumpName
-                    , unsafeCoerce# (jumpCondFunction session handler))
-                  , ( breakpointAutoJumpName 
-                    , unsafeCoerce# (jumpAutoFunction session handler))
-                  ]
-  writeIORef v_bkptLinkEnv linkEnv
-  dflags <- getSessionDynFlags session
-  reinstallBreakpointHandlers session
-
-reinstallBreakpointHandlers :: Session -> IO ()
-reinstallBreakpointHandlers session = do
-  dflags <- getSessionDynFlags session
-  let mode = ghcMode dflags
-  when (ghcLink dflags == LinkInMemory) $ do
-    linkEnv <- readIORef v_bkptLinkEnv
-    initDynLinker dflags 
-    extendLinkEnv linkEnv
-
------------------------------------------------------------------------
--- Jump functions
-
-type SiteInfo = (String, SiteNumber)
-jumpFunction, jumpAutoFunction  :: Session -> BkptHandler Module -> SiteInfo -> (Int, [Opaque], String) -> b -> b
-jumpCondFunction  :: Session -> BkptHandler Module -> SiteInfo -> (Int, [Opaque], String) -> Bool -> b -> b
-jumpFunctionM :: Session -> BkptHandler a ->  BkptLocation a -> (Int, [Opaque], String) -> b -> IO b
-
-jumpCondFunction _ _ _ _ False b = b
-jumpCondFunction session handler site args True b
-    = jumpFunction session handler site args b
-
-jumpFunction session handler siteInfo args b 
-    | site <- mkSite siteInfo
-    = unsafePerformIO $ jumpFunctionM session handler site args b
-
-jumpFunctionM session handler site (I# idsPtr, wrapped_hValues, locmsg) b = 
-      do 
-         ids <- deRefStablePtr (castPtrToStablePtr (Ptr (int2Addr# idsPtr)))
-         let hValues = unsafeCoerce# b : [unsafeCoerce# hv | O hv <- wrapped_hValues]
-         handleBreakpoint handler session (zip ids hValues) site locmsg b
-
-jumpAutoFunction session handler siteInfo args b 
-    | site <- mkSite siteInfo
-    = unsafePerformIO $ do
-         break <- isAutoBkptEnabled handler session site 
-         if break 
-            then jumpFunctionM session handler site args b
-            else return b
-
-jumpStepByStepFunction session handler siteInfo args b 
-    | site <- mkSite siteInfo
-    = unsafePerformIO $ do
-          jumpFunctionM session handler site args b
-
-mkSite :: SiteInfo -> BkptLocation Module
-mkSite ( modName, sitenum) =
-  (mkModule mainPackageId (mkModuleName modName), sitenum)
-
 obtainTerm1 :: Session -> Bool -> Maybe Type -> a -> IO Term
 obtainTerm1 sess force mb_ty x = withSession sess $ \hsc_env -> cvObtainTerm hsc_env force mb_ty (unsafeCoerce# x)
 
diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs
index 06279250f3..4413c52ec2 100644
--- a/compiler/main/HscMain.lhs
+++ b/compiler/main/HscMain.lhs
@@ -76,7 +76,6 @@ import CodeGen		( codeGen )
 import CmmParse		( parseCmmFile )
 import CodeOutput	( codeOutput )
 import NameEnv          ( emptyNameEnv )
-import Breakpoints      ( noDbgSites )
 
 import DynFlags
 import ErrUtils
@@ -636,7 +635,7 @@ hscInteractive (iface, details, cgguts)
          prepd_binds <- {-# SCC "CorePrep" #-}
                         corePrepPgm dflags core_binds data_tycons ;
          -----------------  Generate byte code ------------------
-         comp_bc <- byteCodeGen dflags prepd_binds data_tycons
+         comp_bc <- byteCodeGen dflags prepd_binds data_tycons (md_modBreaks details)
          ------------------ Create f-x-dynamic C-side stuff ---
          (istub_h_exists, istub_c_exists) 
              <- outputForeignStubs dflags this_mod location foreign_stubs
@@ -682,7 +681,7 @@ hscFileCheck hsc_env mod_summary = do {
 				md_exports   = tcg_exports   tc_result,
 				md_insts     = tcg_insts     tc_result,
 				md_fam_insts = tcg_fam_insts tc_result,
-                                md_dbg_sites = noDbgSites,
+                                md_modBreaks = emptyModBreaks,      
 				md_rules     = [panic "no rules"] }
 				   -- Rules are CoreRules, not the
 				   -- RuleDecls we get out of the typechecker
diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index 92b7228dd5..c7926e3c23 100644
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -59,12 +59,14 @@ module HscTypes (
 	Linkable(..), isObjectLinkable,
 	Unlinked(..), CompiledByteCode,
 	isObject, nameOfObject, isInterpretable, byteCodeOfObject,
-        HpcInfo, noHpcInfo
+        HpcInfo, noHpcInfo,
+
+        -- Breakpoints
+        ModBreaks (..), emptyModBreaks
     ) where
 
 #include "HsVersions.h"
 
-import Breakpoints      ( SiteNumber, Coord, noDbgSites )
 #ifdef GHCI
 import ByteCodeAsm	( CompiledByteCode )
 #endif
@@ -100,6 +102,7 @@ import FiniteMap	( FiniteMap )
 import CoreSyn		( CoreRule )
 import Maybes		( orElse, expectJust, catMaybes, seqMaybe )
 import Outputable
+import BreakArray
 import SrcLoc		( SrcSpan, Located )
 import UniqFM		( lookupUFM, eltsUFM, emptyUFM )
 import UniqSupply	( UniqSupply )
@@ -109,6 +112,7 @@ import StringBuffer	( StringBuffer )
 
 import System.Time	( ClockTime )
 import Data.IORef	( IORef, readIORef )
+import Data.Array       ( Array, array )
 \end{code}
 
 
@@ -456,7 +460,7 @@ data ModDetails
         md_insts     :: ![Instance],	-- Dfun-ids for the instances in this module
         md_fam_insts :: ![FamInst],
         md_rules     :: ![CoreRule],	-- Domain may include Ids from other modules
-        md_dbg_sites     :: ![(SiteNumber, Coord)]     -- Breakpoint sites inserted by the renamer
+        md_modBreaks :: !ModBreaks  -- breakpoint information for this module 
      }
 
 emptyModDetails = ModDetails { md_types = emptyTypeEnv,
@@ -464,7 +468,7 @@ emptyModDetails = ModDetails { md_types = emptyTypeEnv,
 			       md_insts     = [],
 			       md_rules     = [],
 			       md_fam_insts = [],
-                               md_dbg_sites = noDbgSites}
+                               md_modBreaks = emptyModBreaks } 
 
 -- A ModGuts is carried through the compiler, accumulating stuff as it goes
 -- There is only one ModGuts at any time, the one for the module
@@ -498,7 +502,7 @@ data ModGuts
 	mg_foreign   :: !ForeignStubs,
 	mg_deprecs   :: !Deprecations,	 -- Deprecations declared in the module
 	mg_hpc_info  :: !HpcInfo,        -- info about coverage tick boxes
-        mg_dbg_sites :: ![(SiteNumber, Coord)]     -- Bkpts inserted by the renamer
+        mg_modBreaks :: !ModBreaks
     }
 
 -- The ModGuts takes on several slightly different forms:
@@ -1140,11 +1144,6 @@ showModMsg target recomp mod_summary
   = showSDoc (hsep [text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' '),
 	            char '(', text (msHsFilePath mod_summary) <> comma,
 		    case target of
-#if defined(GHCI) && defined(DEBUGGER)
-                      HscInterpreted | recomp && 
-                                       Opt_Debugging `elem` modflags
-                                 -> text "interpreted(debugging)"
-#endif
                       HscInterpreted | recomp 
                                  -> text "interpreted"
                       HscNothing -> text "nothing"
@@ -1153,7 +1152,6 @@ showModMsg target recomp mod_summary
  where 
     mod     = moduleName (ms_mod mod_summary)
     mod_str = showSDoc (ppr mod) ++ hscSourceString (ms_hsc_src mod_summary)
-    modflags= flags(ms_hspp_opts mod_summary)
 \end{code}
 
 
@@ -1238,5 +1236,25 @@ byteCodeOfObject (BCOs bc) = bc
 byteCodeOfObject other     = pprPanic "byteCodeOfObject" (ppr other)
 \end{code}
 
+%************************************************************************
+%*                                                                      *
+\subsection{Breakpoint Support}
+%*                                                                      *
+%************************************************************************
 
+\begin{code}
+-- all the information about the breakpoints for a given module
+data ModBreaks
+   = ModBreaks
+   { modBreaks_array :: BreakArray
+            -- the array of breakpoint flags indexed by tick number
+   , modBreaks_ticks :: !(Array Int SrcSpan)
+   }
 
+emptyModBreaks :: ModBreaks
+emptyModBreaks = ModBreaks
+   { modBreaks_array = error "ModBreaks.modBreaks_array not initialised"
+         -- Todo: can we avoid this? 
+   , modBreaks_ticks = array (0,-1) []
+   }
+\end{code}
diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs
index 6f44bca63a..b001e1d3b3 100644
--- a/compiler/main/TidyPgm.lhs
+++ b/compiler/main/TidyPgm.lhs
@@ -124,8 +124,9 @@ mkBootModDetails hsc_env (ModGuts { mg_module    = mod
 				  , mg_exports   = exports
 				  , mg_types     = type_env
 				  , mg_insts     = insts
-				  , mg_fam_insts = fam_insts,
-                                    mg_dbg_sites = sites })
+				  , mg_fam_insts = fam_insts
+                                  , mg_modBreaks = modBreaks   
+                                  })
   = do	{ let dflags = hsc_dflags hsc_env 
 	; showPass dflags "Tidy [hoot] type env"
 
@@ -140,7 +141,8 @@ mkBootModDetails hsc_env (ModGuts { mg_module    = mod
 			     , md_fam_insts = fam_insts
 			     , md_rules     = []
 			     , md_exports   = exports
-                             , md_dbg_sites = sites})
+                             , md_modBreaks = modBreaks 
+                             })
 	}
   where
 
@@ -244,7 +246,7 @@ tidyProgram hsc_env
 				mg_dir_imps = dir_imps, mg_deps = deps, 
 				mg_foreign = foreign_stubs,
 			        mg_hpc_info = hpc_info,
-                                mg_dbg_sites = sites })
+                                mg_modBreaks = modBreaks })
 
   = do	{ let dflags = hsc_dflags hsc_env
 	; showPass dflags "Tidy Core"
@@ -303,7 +305,8 @@ tidyProgram hsc_env
 				md_insts     = tidy_insts,
 				md_fam_insts = fam_insts,
 				md_exports   = exports,
-                                md_dbg_sites = sites })
+                                md_modBreaks = modBreaks })
+
 	}
 
 lookup_dfun type_env dfun_id
diff --git a/compiler/package.conf.in b/compiler/package.conf.in
index f0ecc35be4..d001c282d1 100644
--- a/compiler/package.conf.in
+++ b/compiler/package.conf.in
@@ -77,7 +77,6 @@ exposed-modules:
 	DriverPipeline
 	DsArrows
 	DsBinds
-	DsBreakpoint
 	DsCCall
 	DsExpr
 	DsForeign
diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp
index 16149d9eff..1d46095d4d 100644
--- a/compiler/prelude/primops.txt.pp
+++ b/compiler/prelude/primops.txt.pp
@@ -1738,13 +1738,8 @@ primop  NewBCOOp "newBCO#" GenPrimOp
    has_side_effects = True
    out_of_line      = True
 
-primop  InfoPtrOp "infoPtr#" GenPrimOp
-   a -> Addr#
-   with
-   out_of_line = True
-
-primop  ClosurePayloadOp "closurePayload#" GenPrimOp
-   a -> (# Array# b, ByteArr# #)
+primop  UnpackClosureOp "unpackClosure#" GenPrimOp
+   a -> (# Addr#, Array# b, ByteArr# #)
    with
    out_of_line = True
 
diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index e26c50b584..259596332b 100644
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -72,7 +72,6 @@ import SrcLoc
 import HscTypes
 import ListSetOps
 import Outputable
-import Breakpoints
 
 #ifdef GHCI
 import Linker
@@ -97,6 +96,9 @@ import Util
 import Bag
 
 import Control.Monad    ( unless )
+import Data.Maybe	( isJust )
+import Foreign.Ptr      ( Ptr )
+
 \end{code}
 
 
@@ -318,7 +320,7 @@ tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds)
 				mg_deprecs   = NoDeprecs,
 				mg_foreign   = NoStubs,
 				mg_hpc_info  = noHpcInfo,
-                                mg_dbg_sites = noDbgSites
+                                mg_modBreaks = emptyModBreaks  
 		    } } ;
 
    tcCoreDump mod_guts ;
@@ -1193,11 +1195,11 @@ lookup_rdr_name rdr_name = do {
     return good_names
  }
 
-tcRnRecoverDataCon :: HscEnv -> a -> IO (Maybe DataCon) 
-tcRnRecoverDataCon hsc_env a
+tcRnRecoverDataCon :: HscEnv -> Ptr () -> IO (Maybe DataCon) 
+tcRnRecoverDataCon hsc_env ptr
   = initTcPrintErrors hsc_env iNTERACTIVE $ 
-    setInteractiveContext hsc_env (hsc_IC hsc_env) $
-     do name    <- recoverDataCon a
+    setInteractiveContext hsc_env (hsc_IC hsc_env) $ do
+        name <- dataConInfoPtrToName ptr
         tcLookupDataCon name
 
 tcRnLookupName :: HscEnv -> Name -> IO (Maybe TyThing)
diff --git a/compiler/typecheck/TcRnDriver.lhs-boot b/compiler/typecheck/TcRnDriver.lhs-boot
index 0de156bcfa..b4208516e6 100644
--- a/compiler/typecheck/TcRnDriver.lhs-boot
+++ b/compiler/typecheck/TcRnDriver.lhs-boot
@@ -1,5 +1,6 @@
 >module TcRnDriver where
 >import HscTypes
 >import DataCon
+>import Foreign.Ptr
 >
->tcRnRecoverDataCon :: HscEnv -> a -> IO (Maybe DataCon) 
\ No newline at end of file
+>tcRnRecoverDataCon :: HscEnv -> Ptr () -> IO (Maybe DataCon) 
diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs
index 4e2ae695d9..b675cf9033 100644
--- a/compiler/typecheck/TcSplice.lhs
+++ b/compiler/typecheck/TcSplice.lhs
@@ -376,11 +376,7 @@ runMeta :: (SrcSpan -> th_syn -> Either Message hs_syn)
 	-> TcM hs_syn		-- Of type t
 runMeta convert expr
   = do	{ 	-- Desugar
-#if defined(GHCI) && defined(DEBUGGER)
-	  ds_expr <- unsetOptM Opt_Debugging $ initDsTc (dsLExpr expr)
-#else 
 	  ds_expr <- initDsTc (dsLExpr expr)
-#endif
 	-- Compile and link it; might fail if linking fails
 	; hsc_env <- getTopEnv
 	; src_span <- getSrcSpanM
diff --git a/includes/Bytecodes.h b/includes/Bytecodes.h
index 4a75b00c11..3df7ddd073 100644
--- a/includes/Bytecodes.h
+++ b/includes/Bytecodes.h
@@ -75,6 +75,7 @@
 #define bci_RETURN_D 			50
 #define bci_RETURN_L 			51
 #define bci_RETURN_V 			52
+#define bci_BRK_FUN			53
 /* If you need to go past 255 then you will run into the flags */
 
 /* If you need to go below 0x0100 then you will run into the instructions */
diff --git a/includes/Constants.h b/includes/Constants.h
index cc1987d5f3..66b8fe79d8 100644
--- a/includes/Constants.h
+++ b/includes/Constants.h
@@ -246,9 +246,12 @@
  *
  * TSO_INTERRUPTIBLE: the TSO can be interrupted if it blocks
  * interruptibly (eg. with BlockedOnMVar).
+ *
+ * TSO_STOPPED_ON_BREAKPOINT: the thread is currently stopped in a breakpoint
  */
 #define TSO_BLOCKEX       4
 #define TSO_INTERRUPTIBLE 8
+#define TSO_STOPPED_ON_BREAKPOINT 16 
 
 /* -----------------------------------------------------------------------------
    RET_DYN stack frames
diff --git a/includes/StgMiscClosures.h b/includes/StgMiscClosures.h
index 82671287de..3c6482799b 100644
--- a/includes/StgMiscClosures.h
+++ b/includes/StgMiscClosures.h
@@ -589,8 +589,8 @@ RTS_FUN(readTVarzh_fast);
 RTS_FUN(writeTVarzh_fast);
 RTS_FUN(checkzh_fast);
 
-RTS_FUN(infoPtrzh_fast);
-RTS_FUN(closurePayloadzh_fast);
+RTS_FUN(unpackClosurezh_fast);
+RTS_FUN(getApStackValzh_fast);
 
 RTS_FUN(noDuplicatezh_fast);
 
diff --git a/mk/config.mk.in b/mk/config.mk.in
index a47a2153a5..cda113a634 100644
--- a/mk/config.mk.in
+++ b/mk/config.mk.in
@@ -316,9 +316,6 @@ BuildingGranSim=$(subst mg,YES,$(filter mg,$(WAYS)))
 
 HscIfaceFileVersion=6
 
-# Building with debugger?
-GhciWithDebugger=YES
-
 #------------------------------------------------------------------------------
 # Options for Libraries
 
diff --git a/rts/Disassembler.c b/rts/Disassembler.c
index 4407c77f3b..0620e99967 100644
--- a/rts/Disassembler.c
+++ b/rts/Disassembler.c
@@ -43,6 +43,11 @@ disInstr ( StgBCO *bco, int pc )
 
    instr = instrs[pc++];
    switch (instr) {
+      case bci_BRK_FUN:
+         debugBelch ("BRK_FUN  " );  printPtr( ptrs[instrs[pc]] ); 
+         debugBelch (" %d ", instrs[pc+1]); printPtr( ptrs[instrs[pc+2]] ); debugBelch("\n" );
+         pc += 3;
+         break;
       case bci_SWIZZLE:
          debugBelch("SWIZZLE stkoff %d by %d\n",
                          instrs[pc], (signed int)instrs[pc+1]);
diff --git a/rts/Interpreter.c b/rts/Interpreter.c
index 62fd2c2ef2..188693ccb6 100644
--- a/rts/Interpreter.c
+++ b/rts/Interpreter.c
@@ -83,6 +83,7 @@ allocate_NONUPD (int n_words)
     return allocate(stg_max(sizeofW(StgHeader)+MIN_PAYLOAD_SIZE, n_words));
 }
 
+rtsBool stop_next_breakpoint = rtsFalse;
 
 #ifdef INTERP_STATS
 
@@ -103,6 +104,7 @@ int it_ofreq[27];
 int it_oofreq[27][27];
 int it_lastopc;
 
+
 #define INTERP_TICK(n) (n)++
 
 void interp_startup ( void )
@@ -175,6 +177,9 @@ static StgWord app_ptrs_itbl[] = {
     (W_)&stg_ap_pppppp_info,
 };
 
+HsStablePtr breakPointIOAction; // points to the IO action which is executed on a breakpoint
+                                // it is set in main/GHC.hs:runStmt
+
 Capability *
 interpretBCO (Capability* cap)
 {
@@ -198,8 +203,8 @@ interpretBCO (Capability* cap)
     //      	+---------------+
     //       
     if (Sp[0] == (W_)&stg_enter_info) {
-	Sp++;
-	goto eval;
+       Sp++;
+       goto eval;
     }
 
     // ------------------------------------------------------------------------
@@ -284,8 +289,10 @@ eval_obj:
 	break;
 	
     case BCO:
+    {
 	ASSERT(((StgBCO *)obj)->arity > 0);
 	break;
+    }
 
     case AP:	/* Copied from stg_AP_entry. */
     {
@@ -672,6 +679,7 @@ do_apply:
     // Sadly we have three different kinds of stack/heap/cswitch check
     // to do:
 
+
 run_BCO_return:
     // Heap check
     if (doYouWantToGC()) {
@@ -680,6 +688,7 @@ run_BCO_return:
     }
     // Stack checks aren't necessary at return points, the stack use
     // is aggregated into the enclosing function entry point.
+
     goto run_BCO;
     
 run_BCO_return_unboxed:
@@ -689,6 +698,7 @@ run_BCO_return_unboxed:
     }
     // Stack checks aren't necessary at return points, the stack use
     // is aggregated into the enclosing function entry point.
+
     goto run_BCO;
     
 run_BCO_fun:
@@ -715,6 +725,7 @@ run_BCO_fun:
 	Sp[0] = (W_)&stg_apply_interp_info; // placeholder, really
 	RETURN_TO_SCHEDULER(ThreadInterpret, StackOverflow);
     }
+
     goto run_BCO;
     
     // Now, actually interpret the BCO... (no returning to the
@@ -723,7 +734,7 @@ run_BCO:
     INTERP_TICK(it_BCO_entries);
     {
 	register int       bciPtr     = 1; /* instruction pointer */
-    register StgWord16 bci;
+        register StgWord16 bci;
 	register StgBCO*   bco        = (StgBCO*)obj;
 	register StgWord16* instrs    = (StgWord16*)(bco->instrs->payload);
 	register StgWord*  literals   = (StgWord*)(&bco->literals->payload[0]);
@@ -753,6 +764,7 @@ run_BCO:
 		 //if (do_print_stack) checkStack(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size,iSu);
 	    );
 
+
 	INTERP_TICK(it_insns);
 
 #ifdef INTERP_STATS
@@ -769,6 +781,88 @@ run_BCO:
 
     switch (bci & 0xFF) {
 
+        /* check for a breakpoint on the beginning of a let binding */
+        case bci_BRK_FUN: 
+        {
+            int arg1_brk_array, arg2_array_index, arg3_freeVars;
+            StgArrWords *breakPoints;
+            int returning_from_break;     /* are we resuming execution from a breakpoint?
+                                          **   if yes, then don't break this time around */
+            StgClosure *ioAction;         // the io action to run at a breakpoint
+
+            StgAP_STACK *new_aps;         // a closure to save the top stack frame on the heap
+            int i;
+            int size_words;
+
+            arg1_brk_array      = BCO_NEXT;  /* first argument of break instruction */
+            arg2_array_index    = BCO_NEXT;  /* second dargument of break instruction */
+            arg3_freeVars       = BCO_NEXT;  /* third argument of break instruction */
+
+            // check if we are returning from a breakpoint - this info is stored in
+            // the flags field of the current TSO
+            returning_from_break = cap->r.rCurrentTSO->flags & TSO_STOPPED_ON_BREAKPOINT; 
+
+            // if we are returning from a break then skip this section and continue executing
+            if (!returning_from_break)
+            {
+               breakPoints = (StgArrWords *) BCO_PTR(arg1_brk_array);
+
+               // stop the current thread if either the "stop_next_breakpoint" flag is true
+               // OR if the breakpoint flag for this particular expression is true
+               if (stop_next_breakpoint == rtsTrue || breakPoints->payload[arg2_array_index] == rtsTrue)
+               {
+                  stop_next_breakpoint = rtsFalse; // make sure we don't automatically stop at the next breakpoint
+
+                  // allocate memory for a new AP_STACK, enough to store the top stack frame
+                  // plus an stg_apply_interp_info pointer and a pointer to the BCO
+                  size_words = BCO_BITMAP_SIZE(obj) + 2;
+                  new_aps = (StgAP_STACK *) allocate (AP_STACK_sizeW(size_words));
+                  SET_HDR(new_aps,&stg_AP_STACK_info,CCS_SYSTEM); 
+                  new_aps->size = size_words;
+                  // we should never enter new_aps->fun, so it is assigned to a dummy value
+                  // ToDo: fixme to something that explodes with an error if you enter it 
+                  new_aps->fun = &stg_dummy_ret_closure; 
+
+                  // fill in the payload of the AP_STACK 
+                  new_aps->payload[0] = (W_)&stg_apply_interp_info;
+                  new_aps->payload[1] = (W_)obj;
+
+                  // copy the contents of the top stack frame into the AP_STACK
+                  for (i = 2; i < size_words; i++)
+                  {
+                     new_aps->payload[i] = (W_)Sp[i-2];
+                  }
+
+                  // prepare the stack so that we can call the breakPointIOAction
+                  // and ensure that the stack is in a reasonable state for the GC
+                  // and so that execution of this BCO can continue when we resume
+                  ioAction = (StgClosure *) deRefStablePtr (breakPointIOAction);
+                  Sp -= 7;
+                  Sp[6] = (W_)obj;   
+                  Sp[5] = (W_)&stg_apply_interp_info;
+                  Sp[4] = (W_)new_aps;                 /* the AP_STACK */
+                  Sp[3] = (W_)BCO_PTR(arg3_freeVars);  /* the info about local vars of the breakpoint */
+                  Sp[2] = (W_)&stg_ap_ppv_info;
+                  Sp[1] = (W_)ioAction;                /* apply the IO action to its two arguments above */
+                  Sp[0] = (W_)&stg_enter_info;         /* get ready to run the IO action */
+
+                  // set the flag in the TSO to say that we are now stopping at a breakpoint
+                  // so that when we resume we don't stop on the same breakpoint that we already
+                  // stopped at just now 
+                  cap->r.rCurrentTSO->flags |= TSO_STOPPED_ON_BREAKPOINT;
+
+                  // stop this thread and return to the scheduler - eventually we will come back
+                  // and the IO action on the top of the stack will be executed
+                  RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
+               }
+            }
+            // record that this thread is not stopped at a breakpoint anymore
+            cap->r.rCurrentTSO->flags &= ~TSO_STOPPED_ON_BREAKPOINT;
+
+            // continue normal execution of the byte code instructions
+	    goto nextInsn;
+        }
+
 	case bci_STKCHECK: {
 	    // Explicit stack check at the beginning of a function
 	    // *only* (stack checks in case alternatives are
@@ -1256,7 +1350,7 @@ run_BCO:
 	    bciPtr     = nextpc;
 	    goto nextInsn;
 	}
-
+ 
 	case bci_CASEFAIL:
 	    barf("interpretBCO: hit a CASEFAIL");
 	    
@@ -1271,3 +1365,32 @@ run_BCO:
 
     barf("interpretBCO: fell off end of the interpreter");
 }
+
+/* temporary code for peeking inside a AP_STACK and pulling out values
+   based on their stack offset - used in the debugger for inspecting
+   the local values of a breakpoint
+*/
+HsStablePtr rts_getApStackVal (HsStablePtr, int);
+HsStablePtr rts_getApStackVal (HsStablePtr apStackSptr, int offset)
+{
+   HsStablePtr resultSptr;
+   StgAP_STACK *apStack;
+   StgClosure **payload;
+   StgClosure *val;
+
+   apStack = (StgAP_STACK *) deRefStablePtr (apStackSptr);
+   payload = apStack->payload;
+   val = (StgClosure *) payload[offset+2];
+   resultSptr = getStablePtr (val); 
+   return resultSptr;
+}
+
+/* set the single step flag for the debugger to True -
+   it gets set back to false in the interpreter everytime
+   we hit a breakpoint
+*/
+void rts_setStepFlag (void);
+void rts_setStepFlag (void)
+{
+   stop_next_breakpoint = rtsTrue;
+}
diff --git a/rts/Linker.c b/rts/Linker.c
index 4ab84eddcd..58ee9392c6 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -525,8 +525,8 @@ typedef struct _RtsSymbolVal {
       SymX(hs_free_stable_ptr)			\
       SymX(hs_free_fun_ptr)			\
       SymX(initLinker)				\
-      SymX(infoPtrzh_fast)                      \
-      SymX(closurePayloadzh_fast)               \
+      SymX(unpackClosurezh_fast)                \
+      SymX(getApStackValzh_fast)                \
       SymX(int2Integerzh_fast)			\
       SymX(integer2Intzh_fast)			\
       SymX(integer2Wordzh_fast)			\
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index 31f58d1f12..bb9faddef5 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -1823,6 +1823,7 @@ newBCOzh_fast
     W_ bco, bitmap_arr, bytes, words;
     
     bitmap_arr = R5;
+
     words = BYTES_TO_WDS(SIZEOF_StgBCO) + StgArrWords_words(bitmap_arr);
     bytes = WDS(words);
 
@@ -1876,34 +1877,48 @@ mkApUpd0zh_fast
     RET_P(ap);
 }
 
-infoPtrzh_fast
-{
-/* args: R1 = closure to analyze */
-   
-  MAYBE_GC(R1_PTR, infoPtrzh_fast);
-
-  W_ info;
-  info = %GET_STD_INFO(R1);
-  RET_N(info);
-}
-
-closurePayloadzh_fast
+unpackClosurezh_fast
 {
 /* args: R1 = closure to analyze */
 // TODO: Consider the absence of ptrs or nonptrs as a special case ?
 
-    MAYBE_GC(R1_PTR, closurePayloadzh_fast);
-
     W_ info, ptrs, nptrs, p, ptrs_arr, nptrs_arr;
     info  = %GET_STD_INFO(R1);
     ptrs  = TO_W_(%INFO_PTRS(info)); 
     nptrs = TO_W_(%INFO_NPTRS(info));
-    p = 0;
 
-    ALLOC_PRIM (SIZEOF_StgMutArrPtrs + WDS(ptrs), R1_PTR, closurePayloadzh_fast);
-    ptrs_arr = Hp - SIZEOF_StgMutArrPtrs - WDS(ptrs) + WDS(1);
+    // Some closures have non-standard layout, so we omit those here.
+    W_ type;
+    type = TO_W_(%INFO_TYPE(info));
+    switch [0 .. N_CLOSURE_TYPES] type {
+    case THUNK_SELECTOR : {
+        ptrs = 1;
+        nptrs = 0;
+        goto out;
+    }
+    case THUNK, THUNK_1_0, THUNK_0_1, THUNK_2_0, THUNK_1_1, 
+         THUNK_0_2, THUNK_STATIC, AP, PAP, AP_STACK, BCO : {
+        ptrs = 0;
+        nptrs = 0;
+        goto out;
+    }
+    default: {
+        goto out;
+    }}
+out:
+
+    W_ ptrs_arr_sz, nptrs_arr_sz;
+    nptrs_arr_sz = SIZEOF_StgArrWords   + WDS(nptrs);
+    ptrs_arr_sz  = SIZEOF_StgMutArrPtrs + WDS(ptrs);
+
+    ALLOC_PRIM (ptrs_arr_sz + nptrs_arr_sz, R1_PTR, unpackClosurezh_fast);
+
+    ptrs_arr  = Hp - nptrs_arr_sz - ptrs_arr_sz + WDS(1);
+    nptrs_arr = Hp - nptrs_arr_sz + WDS(1);
+
     SET_HDR(ptrs_arr, stg_MUT_ARR_PTRS_FROZEN_info, W_[CCCS]);
     StgMutArrPtrs_ptrs(ptrs_arr) = ptrs;
+    p = 0;
 for:
     if(p < ptrs) {
     	 W_[ptrs_arr + SIZEOF_StgMutArrPtrs + WDS(p)] = StgClosure_payload(R1,p);
@@ -1911,8 +1926,6 @@ for:
 	 goto for;
     }
     
-    ALLOC_PRIM (SIZEOF_StgArrWords + WDS(nptrs), R1_PTR, closurePayloadzh_fast);
-    nptrs_arr = Hp - SIZEOF_StgArrWords - WDS(nptrs) + WDS(1);
     SET_HDR(nptrs_arr, stg_ARR_WORDS_info, W_[CCCS]);
     StgArrWords_words(nptrs_arr) = nptrs;
     p = 0;
@@ -1922,7 +1935,7 @@ for2:
     	 p = p + 1;
 	 goto for2;
     }
-    RET_PP(ptrs_arr, nptrs_arr);
+    RET_NPP(info, ptrs_arr, nptrs_arr);
 }
 
 /* -----------------------------------------------------------------------------
@@ -2149,3 +2162,16 @@ noDuplicatezh_fast
         jump %ENTRY_CODE(Sp(0));
     }
 }
+
+getApStackValzh_fast
+{
+   W_ ap_stack, offset, val;
+
+   /* args: R1 = tso, R2 = offset */
+   ap_stack = R1;
+   offset   = R2;
+
+   val = StgClosure_payload(ap_stack,offset); 
+
+   RET_P(val);
+}
diff --git a/rts/Printer.c b/rts/Printer.c
index 6da32fc6f8..28cdd0d4ab 100644
--- a/rts/Printer.c
+++ b/rts/Printer.c
@@ -136,6 +136,7 @@ printClosure( StgClosure *obj )
     case CONSTR_NOCAF_STATIC:
         {
             StgWord i, j;
+
 #ifdef PROFILING
 	    debugBelch("%s(", info->prof.closure_desc);
 	    debugBelch("%s", obj->header.prof.ccs->cc->label);
@@ -1105,6 +1106,88 @@ findPtr(P_ p, int follow)
   }
 }
 
+/* prettyPrintClosure() is for printing out a closure using the data constructor
+   names found in the info tables. Closures are printed in a fashion that resembles
+   their Haskell representation. Useful during debugging.
+
+   Todo: support for more closure types, and support for non pointer fields in the
+   payload.
+*/ 
+
+void prettyPrintClosure_ (StgClosure *);
+
+void prettyPrintClosure (StgClosure *obj)
+{
+   prettyPrintClosure_ (obj);
+   debugBelch ("\n");
+}
+
+void prettyPrintClosure_ (StgClosure *obj)
+{
+    StgInfoTable *info;
+    StgConInfoTable *con_info;
+
+    /* collapse any indirections */
+    unsigned int type;
+    type = get_itbl(obj)->type;
+           
+    while (type == IND ||
+           type == IND_STATIC ||
+           type == IND_OLDGEN ||
+           type == IND_PERM ||
+           type == IND_OLDGEN_PERM) 
+    {
+      obj = ((StgInd *)obj)->indirectee;
+      type = get_itbl(obj)->type;
+    }
+
+    /* find the info table for this object */
+    info = get_itbl(obj);
+
+    /* determine what kind of object we have */
+    switch (info->type) 
+    {
+        /* full applications of data constructors */
+        case CONSTR:
+        case CONSTR_1_0: 
+        case CONSTR_0_1:
+        case CONSTR_1_1: 
+        case CONSTR_0_2: 
+        case CONSTR_2_0:
+        case CONSTR_STATIC:
+        case CONSTR_NOCAF_STATIC: 
+        {
+           int i; 
+           char *descriptor;
+
+           /* find the con_info for the constructor */
+           con_info = get_con_itbl (obj);
+
+           /* obtain the name of the constructor */
+           descriptor = con_info->con_desc;
+
+           debugBelch ("(%s", descriptor);
+
+           /* process the payload of the closure */
+           /* we don't handle non pointers at the moment */
+           for (i = 0; i < info->layout.payload.ptrs; i++)
+           {
+              debugBelch (" ");
+              prettyPrintClosure_ ((StgClosure *) obj->payload[i]);
+           }
+           debugBelch (")");
+           break;
+        }
+
+        /* if it isn't a constructor then just print the closure type */
+        default:
+        {
+           debugBelch ("<%s>", info_type(obj));
+           break;
+        }
+    }
+}
+
 #else /* DEBUG */
 void printPtr( StgPtr p )
 {
@@ -1115,4 +1198,6 @@ void printObj( StgClosure *obj )
 {
     debugBelch("obj 0x%p (enable -DDEBUG for more info) " , obj );
 }
+
+
 #endif /* DEBUG */
diff --git a/rts/Printer.h b/rts/Printer.h
index 54bf611250..689c2f8d4a 100644
--- a/rts/Printer.h
+++ b/rts/Printer.h
@@ -13,6 +13,7 @@ extern void   	   printPtr        ( StgPtr p );
 extern void   	   printObj        ( StgClosure *obj );
 
 #ifdef DEBUG
+extern void        prettyPrintClosure (StgClosure *obj);
 extern void   	   printClosure    ( StgClosure *obj );
 extern StgStackPtr printStackObj   ( StgStackPtr sp );
 extern void        printStackChunk ( StgStackPtr sp, StgStackPtr spLim );