X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FDsGRHSs.lhs;h=a7260e2af86aa24483b5be85016805881a219448;hb=a0f6d307b097bd788e181434a4d9b7fdd56a6c6b;hp=83ceeca17bed2fcf544683a84750d3e77f0d0e84;hpb=30c122df62ec75f9ed7f392f24c2925675bf1d06;p=ghc-hetmet.git diff --git a/compiler/deSugar/DsGRHSs.lhs b/compiler/deSugar/DsGRHSs.lhs index 83ceeca..a7260e2 100644 --- a/compiler/deSugar/DsGRHSs.lhs +++ b/compiler/deSugar/DsGRHSs.lhs @@ -21,18 +21,18 @@ import {-# SOURCE #-} DsExpr ( dsLExpr, dsLocalBinds ) import {-# SOURCE #-} Match ( matchSinglePat ) import HsSyn +import MkCore import CoreSyn import Var import Type import DsMonad import DsUtils -import PrelInfo import TysWiredIn import PrelNames import Name import SrcLoc - +import Outputable \end{code} @dsGuarded@ is used for both @case@ expressions and pattern bindings. @@ -51,7 +51,7 @@ dsGuarded :: GRHSs Id -> Type -> DsM CoreExpr dsGuarded grhss rhs_ty = do match_result <- dsGRHSs PatBindRhs [] grhss rhs_ty - error_expr <- mkErrorAppDs nON_EXHAUSTIVE_GUARDS_ERROR_ID rhs_ty "" + error_expr <- mkErrorAppDs nON_EXHAUSTIVE_GUARDS_ERROR_ID rhs_ty empty extractMatchResult match_result error_expr \end{code} @@ -75,7 +75,7 @@ dsGRHSs hs_ctx pats (GRHSs grhss binds) rhs_ty = do dsGRHS :: HsMatchContext Name -> [Pat Id] -> Type -> LGRHS Id -> DsM MatchResult dsGRHS hs_ctx _ rhs_ty (L _ (GRHS guards rhs)) - = matchGuards (map unLoc guards) hs_ctx rhs rhs_ty + = matchGuards (map unLoc guards) (PatGuard hs_ctx) rhs rhs_ty \end{code} @@ -87,7 +87,7 @@ dsGRHS hs_ctx _ rhs_ty (L _ (GRHS guards rhs)) \begin{code} matchGuards :: [Stmt Id] -- Guard - -> HsMatchContext Name -- Context + -> HsStmtContext Name -- Context -> LHsExpr Id -- RHS -> Type -- Type of RHS of guard -> DsM MatchResult @@ -126,7 +126,7 @@ matchGuards (LetStmt binds : stmts) ctx rhs rhs_ty = do matchGuards (BindStmt pat bind_rhs _ _ : stmts) ctx rhs rhs_ty = do match_result <- matchGuards stmts ctx rhs rhs_ty core_rhs <- dsLExpr bind_rhs - matchSinglePat core_rhs ctx pat rhs_ty match_result + matchSinglePat core_rhs (StmtCtxt ctx) pat rhs_ty match_result isTrueLHsExpr :: LHsExpr Id -> Maybe (CoreExpr -> DsM CoreExpr)