X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FDsGRHSs.lhs;h=4e3dd2d15cb7a2170705e18bb0d5e3c7515ac423;hb=a8427a4125e9b78e88a487eeabf018f1c6e8bc08;hp=93f4ead8f89890c7b1602bb6b736d83477293c45;hpb=49c98d143c382a1341e1046f5ca00819a25691ba;p=ghc-hetmet.git diff --git a/compiler/deSugar/DsGRHSs.lhs b/compiler/deSugar/DsGRHSs.lhs index 93f4ead..4e3dd2d 100644 --- a/compiler/deSugar/DsGRHSs.lhs +++ b/compiler/deSugar/DsGRHSs.lhs @@ -20,12 +20,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 +55,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))