From 310c00498677181c35c632678711a5c82f151674 Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Wed, 6 Oct 2010 15:50:33 +0000 Subject: [PATCH] Make warning-free --- compiler/deSugar/Match.lhs | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/compiler/deSugar/Match.lhs b/compiler/deSugar/Match.lhs index 0544d9b..aa2e9fe 100644 --- a/compiler/deSugar/Match.lhs +++ b/compiler/deSugar/Match.lhs @@ -331,7 +331,8 @@ matchVariables [] _ _ = panic "matchVariables" matchBangs :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult matchBangs (var:vars) ty eqns - = do { match_result <- match (var:vars) ty (map decomposeFirst_Bang eqns) + = do { match_result <- match (var:vars) ty $ + map (decomposeFirstPat getBangPat) eqns ; return (mkEvalMatchResult var ty match_result) } matchBangs [] _ _ = panic "matchBangs" @@ -340,7 +341,8 @@ matchCoercion :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult matchCoercion (var:vars) ty (eqns@(eqn1:_)) = do { let CoPat co pat _ = firstPat eqn1 ; var' <- newUniqueId var (hsPatType pat) - ; match_result <- match (var':vars) ty (map decomposeFirst_Coercion eqns) + ; match_result <- match (var':vars) ty $ + map (decomposeFirstPat getCoPat) eqns ; co' <- dsHsWrapper co ; let rhs' = co' (Var var) ; return (mkCoLetMatchResult (NonRec var' rhs') match_result) } @@ -355,7 +357,8 @@ matchView (var:vars) ty (eqns@(eqn1:_)) let ViewPat viewExpr (L _ pat) _ = firstPat eqn1 -- do the rest of the compilation ; var' <- newUniqueId var (hsPatType pat) - ; match_result <- match (var':vars) ty (map decomposeFirst_View eqns) + ; match_result <- match (var':vars) ty $ + map (decomposeFirstPat getViewPat) eqns -- compile the view expressions ; viewExpr' <- dsLExpr viewExpr ; return (mkViewMatchResult var' viewExpr' var match_result) } @@ -367,12 +370,13 @@ decomposeFirstPat extractpat (eqn@(EqnInfo { eqn_pats = pat : pats })) = eqn { eqn_pats = extractpat pat : pats} decomposeFirstPat _ _ = panic "decomposeFirstPat" -decomposeFirst_Coercion, decomposeFirst_Bang, decomposeFirst_View :: EquationInfo -> EquationInfo - -decomposeFirst_Coercion = decomposeFirstPat (\ (CoPat _ pat _) -> pat) -decomposeFirst_Bang = decomposeFirstPat (\ (BangPat pat ) -> unLoc pat) -decomposeFirst_View = decomposeFirstPat (\ (ViewPat _ pat _) -> unLoc pat) - +getCoPat, getBangPat, getViewPat :: Pat Id -> Pat Id +getCoPat (CoPat _ pat _) = pat +getCoPat _ = panic "getCoPat" +getBangPat (BangPat pat ) = unLoc pat +getBangPat _ = panic "getBangPat" +getViewPat (ViewPat _ pat _) = unLoc pat +getViewPat _ = panic "getBangPat" \end{code} %************************************************************************ -- 1.7.10.4