X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FDsGRHSs.lhs;h=e0bb5f2dbb2154b3e53a317b69b78b7a45ec913e;hb=ad94d40948668032189ad22a0ad741ac1f645f50;hp=93f4ead8f89890c7b1602bb6b736d83477293c45;hpb=49c98d143c382a1341e1046f5ca00819a25691ba;p=ghc-hetmet.git

diff --git a/compiler/deSugar/DsGRHSs.lhs b/compiler/deSugar/DsGRHSs.lhs
index 93f4ead..e0bb5f2 100644
--- a/compiler/deSugar/DsGRHSs.lhs
+++ b/compiler/deSugar/DsGRHSs.lhs
@@ -6,6 +6,13 @@
 Matching guarded right-hand-sides (GRHSs)
 
 \begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/CodingStyle#Warnings
+-- for details
+
 module DsGRHSs ( dsGuarded, dsGRHSs ) where
 
 #include "HsVersions.h"
@@ -20,12 +27,12 @@ import Type
 
 import DsMonad
 import DsUtils
-import Unique
 import PrelInfo
 import TysWiredIn
 import PrelNames
 import Name
 import SrcLoc
+
 \end{code}
 
 @dsGuarded@ is used for both @case@ expressions and pattern bindings.
@@ -55,14 +62,15 @@ dsGRHSs :: HsMatchContext Name -> [Pat Id]	-- These are to build a MatchContext
 	-> GRHSs Id				-- Guarded RHSs
 	-> Type					-- Type of RHS
 	-> DsM MatchResult
-
-dsGRHSs hs_ctx pats (GRHSs grhss binds) rhs_ty
-  = mappM (dsGRHS hs_ctx pats rhs_ty) grhss	`thenDs` \ match_results ->
+dsGRHSs hs_ctx pats grhssa@(GRHSs grhss binds) rhs_ty = do
+    match_results <- mappM (dsGRHS hs_ctx pats rhs_ty) grhss
     let 
 	match_result1 = foldr1 combineMatchResults match_results
-	match_result2 = adjustMatchResultDs (dsLocalBinds binds) match_result1
+	match_result2 = adjustMatchResultDs 
+                                 (\e -> dsLocalBinds binds e) 
+                                 match_result1
 		-- NB: nested dsLet inside matchResult
-    in
+    --
     returnDs match_result2
 
 dsGRHS hs_ctx pats rhs_ty (L loc (GRHS guards rhs))