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)
-  = (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)
@@ -540,9 +539,9 @@ dsExpr (HsProc pat cmd) = dsProcExpr pat cmd
 Hpc Support 
 
 \begin{code}
-dsExpr (HsTick ix e) = do
+dsExpr (HsTick ix vars e) = do
   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.
@@ -591,16 +590,12 @@ dsDo stmts body result_ty
           ; 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 }
 
-    -- 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  <- bindLocalsDs (collectPatBinders pat) $ go stmts
+       do { body  <- go stmts
           ; 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)
-      = 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)