-debug_enabled :: DsM Bool
-debug_enabled = do
- debugging <- doptDs Opt_Debugging
- b_enabled <- breakpoints_enabled
- return (debugging && b_enabled)
-
-breakpoints_enabled :: DsM Bool
-breakpoints_enabled = do
- ghcMode <- getGhcModeDs
- currentModule <- getModuleDs
- ignore_breakpoints <- doptDs Opt_IgnoreBreakpoints
- return ( not ignore_breakpoints
- && ghcMode == Interactive
- && currentModule /= iNTERACTIVE )
-
-maybeInsertBreakpoint :: LHsExpr Id -> Type -> DsM (LHsExpr Id)
---maybeInsertBreakpoint e | pprTrace("insertBreakpoint at" (ppr e) False = undefined
-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
-
-dsAndThenMaybeInsertBreakpoint :: LHsExpr Id -> DsM CoreExpr
-dsAndThenMaybeInsertBreakpoint expr@(L loc _) = do
- coreExpr <- dsLExpr expr
- instrumenting <- isInstrumentationSpot expr
- if instrumenting
- then do L _ dynBkpt<- dynBreakpoint loc
- bkptCore <- dsLExpr (l$ HsWrap (WpTyApp (exprType coreExpr)) dynBkpt)
- return (bkptCore `App` coreExpr)
- else return coreExpr
- where l = L loc
-
-isInstrumentationSpot (L loc e) = do
- ghcmode <- getGhcModeDs
- instrumenting <- debug_enabled
- return$ instrumenting
- && isGoodSrcSpan loc -- Avoids 'derived' code
- && (not$ isRedundant e)
-
-isRedundant HsLet {} = True
-isRedundant HsDo {} = True
-isRedundant HsCase {} = True
-isRedundant _ = False
+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