X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FDsExpr.lhs;h=4163559959ba85d351f14e8a6f5a61009b05fb23;hb=f1915bd7bdb2d228c595d64713365c1394bfbd13;hp=d09196d33b21f8fe3bed050a534d632da6f1442f;hpb=cdce647711c0f46f5799b24de087622cb77e647f;p=ghc-hetmet.git diff --git a/compiler/deSugar/DsExpr.lhs b/compiler/deSugar/DsExpr.lhs index d09196d..4163559 100644 --- 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)