X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FDsGRHSs.lhs;h=4f1065e38482b6b715f9942bd859f36d51da9370;hb=4ae1e17253f4417303e46d59f5a737cc1d7fd78e;hp=12e0f0b0b17f88c90e8c2ea0e5df13fa27922697;hpb=376101055fb111ebd52b5ef1fb76e00334b44304;p=ghc-hetmet.git diff --git a/compiler/deSugar/DsGRHSs.lhs b/compiler/deSugar/DsGRHSs.lhs index 12e0f0b..4f1065e 100644 --- a/compiler/deSugar/DsGRHSs.lhs +++ b/compiler/deSugar/DsGRHSs.lhs @@ -14,19 +14,20 @@ import {-# SOURCE #-} DsExpr ( dsLExpr, dsLocalBinds ) import {-# SOURCE #-} Match ( matchSinglePat ) import HsSyn +import HsUtils import CoreSyn import Var import Type import DsMonad import DsUtils -import DsBreakpoint import Unique import PrelInfo import TysWiredIn import PrelNames import Name import SrcLoc + \end{code} @dsGuarded@ is used for both @case@ expressions and pattern bindings. @@ -56,14 +57,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))