X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FDsExpr.lhs;h=adf4c3df730afe19ce9cab750982926fe20b8b77;hb=402cb6db0de6e607d874328784bd43e747376dc1;hp=8c75dc96f65fd7b694abdeaa50b5e4c8fbfc9883;hpb=376101055fb111ebd52b5ef1fb76e00334b44304;p=ghc-hetmet.git

diff --git a/compiler/deSugar/DsExpr.lhs b/compiler/deSugar/DsExpr.lhs
index 8c75dc9..adf4c3d 100644
--- a/compiler/deSugar/DsExpr.lhs
+++ b/compiler/deSugar/DsExpr.lhs
@@ -52,6 +52,8 @@ import Util
 import Bag
 import Outputable
 import FastString
+
+import Data.Maybe
 \end{code}
 
 
@@ -207,7 +209,7 @@ dsExpr (HsVar var)     	      = returnDs (Var var)
 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
@@ -290,8 +292,11 @@ dsExpr (HsCase discrim matches)
     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)
@@ -602,11 +607,16 @@ dsDo stmts body result_ty
 	   ; 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)
@@ -666,7 +676,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  <- go stmts
+      = do { body  <- bindLocalsDs (collectPatBinders pat) $ go stmts
 	   ; var   <- selectSimpleMatchVarL pat
 	   ; match <- matchSinglePat (Var var) (StmtCtxt ctxt) pat
     				  result_ty (cantFailMatchResult body)