import Bag
import Outputable
import FastString
+
+import Data.Maybe
\end{code}
#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
+ 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 (HsIPVar ip) = returnDs (Var (ipNameName ip))
dsExpr (HsLit lit) = dsLit lit
dsExpr (HsOverLit lit) = dsOverLit lit
-dsExpr (HsWrap co_fn e) = dsCoercion co_fn (dsExpr e)
+dsExpr (HsWrap co_fn e) = dsCoercion co_fn (dsExpr e)
dsExpr (NegApp expr neg_expr)
= do { core_expr <- dsLExpr expr
matchWrapper CaseAlt matches `thenDs` \ ([discrim_var], matching_code) ->
returnDs (scrungleMatch discrim_var core_discrim matching_code)
+-- Pepe: The binds are in scope in the body but NOT in the binding group
+-- This is to avoid silliness in breakpoints
dsExpr (HsLet binds body)
- = dsAndThenMaybeInsertBreakpoint body `thenDs` \ body' ->
+ = (bindLocalsDs (map unLoc $ collectLocalBinders binds) $
+ dsAndThenMaybeInsertBreakpoint body) `thenDs` \ body' ->
dsLocalBinds binds body'
-- We need the `ListComp' form to use `deListComp' (rather than the "do" form)
; returnDs (mkApps then_expr2 [rhs2, rest]) }
go (LetStmt binds : stmts)
- = do { rest <- go stmts
+ = do { rest <- bindLocalsDs (map unLoc$ collectLocalBinders binds) $
+ go stmts
; dsLocalBinds binds rest }
-
+
+ -- Notice how due to the placement of bindLocals, binders in this stmt
+ -- are available in posterior stmts but Not in this one rhs.
+ -- This is to avoid silliness in breakpoints
go (BindStmt pat rhs bind_op fail_op : stmts)
- = do { body <- go stmts
+ =
+ do { body <- bindLocalsDs (collectPatBinders pat) $ go stmts
; var <- selectSimpleMatchVarL pat
; match <- matchSinglePat (Var var) (StmtCtxt DoExpr) pat
result_ty (cantFailMatchResult body)
; returnDs (mkApps (Var then_id) [Type rhs_ty, Type b_ty, rhs2, rest]) }
go (BindStmt pat rhs _ _ : stmts)
- = do { body <- go stmts
+ = do { body <- bindLocalsDs (collectPatBinders pat) $ go stmts
; var <- selectSimpleMatchVarL pat
; match <- matchSinglePat (Var var) (StmtCtxt ctxt) pat
result_ty (cantFailMatchResult body)