projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Breakpoints: get the names of the free variables right
[ghc-hetmet.git]
/
compiler
/
deSugar
/
DsExpr.lhs
diff --git
a/compiler/deSugar/DsExpr.lhs
b/compiler/deSugar/DsExpr.lhs
index
d09196d
..
4163559
100644
(file)
--- a/
compiler/deSugar/DsExpr.lhs
+++ b/
compiler/deSugar/DsExpr.lhs
@@
-279,8
+279,7
@@
dsExpr (HsCase discrim matches)
-- 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)
-- 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)
- = (bindLocalsDs (map unLoc $ collectLocalBinders binds) $
- dsLExpr body) `thenDs` \ body' ->
+ = dsLExpr body `thenDs` \ body' ->
dsLocalBinds binds body'
-- We need the `ListComp' form to use `deListComp' (rather than the "do" form)
dsLocalBinds binds body'
-- We need the `ListComp' form to use `deListComp' (rather than the "do" form)
@@
-540,9
+539,9
@@
dsExpr (HsProc pat cmd) = dsProcExpr pat cmd
Hpc Support
\begin{code}
Hpc Support
\begin{code}
-dsExpr (HsTick ix e) = do
+dsExpr (HsTick ix vars e) = do
e' <- dsLExpr e
e' <- dsLExpr e
- mkTickBox ix e'
+ mkTickBox ix vars e'
-- There is a problem here. The then and else branches
-- have no free variables, so they are open to lifting.
-- There is a problem here. The then and else branches
-- have no free variables, so they are open to lifting.
@@
-591,16
+590,12
@@
dsDo stmts body result_ty
; returnDs (mkApps then_expr2 [rhs2, rest]) }
go (LetStmt binds : stmts)
; returnDs (mkApps then_expr2 [rhs2, rest]) }
go (LetStmt binds : stmts)
- = do { rest <- bindLocalsDs (map unLoc$ collectLocalBinders binds) $
- go stmts
+ = do { rest <- go stmts
; dsLocalBinds binds rest }
; 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)
=
go (BindStmt pat rhs bind_op fail_op : stmts)
=
- do { body <- bindLocalsDs (collectPatBinders pat) $ go stmts
+ do { body <- go stmts
; var <- selectSimpleMatchVarL pat
; match <- matchSinglePat (Var var) (StmtCtxt DoExpr) pat
result_ty (cantFailMatchResult body)
; var <- selectSimpleMatchVarL pat
; match <- matchSinglePat (Var var) (StmtCtxt DoExpr) pat
result_ty (cantFailMatchResult body)
@@
-660,7
+655,7
@@
dsMDo tbl stmts body result_ty
; returnDs (mkApps (Var then_id) [Type rhs_ty, Type b_ty, rhs2, rest]) }
go (BindStmt pat rhs _ _ : stmts)
; returnDs (mkApps (Var then_id) [Type rhs_ty, Type b_ty, rhs2, rest]) }
go (BindStmt pat rhs _ _ : stmts)
- = do { body <- bindLocalsDs (collectPatBinders pat) $ go stmts
+ = do { body <- go stmts
; var <- selectSimpleMatchVarL pat
; match <- matchSinglePat (Var var) (StmtCtxt ctxt) pat
result_ty (cantFailMatchResult body)
; var <- selectSimpleMatchVarL pat
; match <- matchSinglePat (Var var) (StmtCtxt ctxt) pat
result_ty (cantFailMatchResult body)