import Foreign.StablePtr
import GHC.Exts
+#ifdef GHCI
mkBreakpointExpr :: SrcSpan -> Id -> DsM (LHsExpr Id)
mkBreakpointExpr loc bkptFuncId = do
scope' <- getLocalBindsDs
let scope = filter (isValidType .idType ) scope'
mod_name = moduleNameFS$ moduleName mod
if null scope && instrumenting
- then return (l$ HsVar lazyId)
+ -- need to return some expresion, hence lazy is used here as a noop (hopefully)
+ then return (l$ HsVar lazyId)
else do
when (not instrumenting) $
warnDs (text "Extracted ids:" <+> (ppr scope $$
srcSpanLit :: SrcSpan -> HsExpr Id
srcSpanLit span = HsLit (HsString (mkFastString (showSDoc (ppr span))))
instrumenting = idName bkptFuncId == breakpointAutoName
+#else
+mkBreakpointExpr = undefined -- A stage1 ghc doesn't care about breakpoints
+#endif
debug_enabled :: DsM Bool
#if defined(GHCI) && defined(DEBUGGER)
debug_enabled = return False
#endif
-maybeInsertBreakpoint :: LHsExpr Id -> Type -> DsM (LHsExpr Id)
---maybeInsertBreakpoint e | pprTrace("insertBreakpoint at" (ppr e) False = undefined
-
isInstrumentationSpot (L loc e) = do
ghcmode <- getGhcModeDs
instrumenting <- debug_enabled
isRedundant HsLet {} = True
isRedundant HsDo {} = True
-isRedundant HsCase {} = True
+isRedundant HsCase {} = False
isRedundant _ = False
dynBreakpoint :: SrcSpan -> DsM (LHsExpr Id)
-- Records a breakpoint site and returns the site number
recordBkpt :: SrcLoc -> DsM (Int)
---recordBkpt | trace "recordBkpt" False = undefined
recordBkpt loc = do
sites_var <- getBkptSitesDs
sites <- ioToIOEnv$ readIORef sites_var
breakpoints_enabled :: DsM Bool
dsAndThenMaybeInsertBreakpoint :: LHsExpr Id -> DsM CoreExpr
+-- | Takes an expression and its type
+maybeInsertBreakpoint :: LHsExpr Id -> Type -> DsM (LHsExpr Id)
#ifdef GHCI
maybeInsertBreakpoint lhsexpr@(L loc _) ty = do
instrumenting <- isInstrumentationSpot lhsexpr
if instrumenting
then do L _ dynBkpt <- dynBreakpoint loc
--- return (l (HsApp (l$ TyApp dynBkpt [ty]) lhsexpr))
return$ l(HsApp (l$ HsWrap (WpTyApp ty) dynBkpt) lhsexpr)
else return lhsexpr
where l = L loc