X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FMatch.lhs;h=c9524466ebb5e3bb9cfb4179f3de3b5e72786a8d;hb=707ea5881703d680155aab268bdbf7edc113e3b1;hp=0544d9bb18fe89e26dc5887fc358d277a997b8ea;hpb=e6e40cc112504af5062afed162993aa9352c1d2c;p=ghc-hetmet.git

diff --git a/compiler/deSugar/Match.lhs b/compiler/deSugar/Match.lhs
index 0544d9b..c952446 100644
--- a/compiler/deSugar/Match.lhs
+++ b/compiler/deSugar/Match.lhs
@@ -280,13 +280,13 @@ match vars@(v:_) ty eqns
   = ASSERT( not (null eqns ) )
     do	{ 	-- Tidy the first pattern, generating
 		-- auxiliary bindings if necessary
-	  (aux_binds, tidy_eqns) <- mapAndUnzipM (tidyEqnInfo v) eqns
+          (aux_binds, tidy_eqns) <- mapAndUnzipM (tidyEqnInfo v) eqns
 
 		-- Group the equations and match each group in turn
-       ; let grouped = groupEquations tidy_eqns
+        ; let grouped = groupEquations tidy_eqns
 
          -- print the view patterns that are commoned up to help debug
-       ; ifDOptM Opt_D_dump_view_pattern_commoning (debug grouped)
+        ; ifDOptM Opt_D_dump_view_pattern_commoning (debug grouped)
 
 	; match_results <- mapM match_group grouped
 	; return (adjustMatchResult (foldr1 (.) aux_binds) $
@@ -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}
 
 %************************************************************************
@@ -882,7 +886,7 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2
         lexp e1 e1' && lexp e2 e2'
     exp (ExplicitTuple es1 _) (ExplicitTuple es2 _) =
         eq_list tup_arg es1 es2
-    exp (HsIf e e1 e2) (HsIf e' e1' e2') =
+    exp (HsIf _ e e1 e2) (HsIf _ e' e1' e2') =
         lexp e e' && lexp e1 e1' && lexp e2 e2'
 
     -- Enhancement: could implement equality for more expressions