X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FMatch.lhs;h=9ff15487ec938d1796d0e7ce4cf10eafbc5c411f;hb=0b86bc9b022a5965d2b35f143ff4b919f784e676;hp=641c2cace9193b7763a35fb40f0e5163c37100be;hpb=37507b3a4342773030ef538599363a5aff8b666a;p=ghc-hetmet.git

diff --git a/compiler/deSugar/Match.lhs b/compiler/deSugar/Match.lhs
index 641c2ca..9ff1548 100644
--- a/compiler/deSugar/Match.lhs
+++ b/compiler/deSugar/Match.lhs
@@ -254,7 +254,7 @@ match :: [Id]		  -- Variables rep'ing the exprs we're matching with
       -> DsM MatchResult  -- Desugared result!
 
 match [] ty eqns
-  = ASSERT( not (null eqns) )
+  = ASSERT2( not (null eqns), ppr ty )
     returnDs (foldr1 combineMatchResults match_results)
   where
     match_results = [ ASSERT( null (eqn_pats eqn) ) 
@@ -305,7 +305,7 @@ matchCoercion :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult
 matchCoercion (var:vars) ty (eqn1:eqns)
   = do	{ let CoPat co pat _ = firstPat eqn1
 	; var' <- newUniqueId (idName var) (hsPatType pat)
-	; match_result <- match (var:vars) ty (map shift (eqn1:eqns))
+	; match_result <- match (var':vars) ty (map shift (eqn1:eqns))
 	; rhs <- dsCoercion co (return (Var var))
 	; return (mkCoLetMatchResult (NonRec var' rhs) match_result) }
   where
@@ -715,6 +715,9 @@ data PatGroup
 
 
 groupEquations :: [EquationInfo] -> [[(PatGroup, EquationInfo)]]
+-- If the result is of form [g1, g2, g3], 
+-- (a) all the (pg,eq) pairs in g1 have the same pg
+-- (b) none of the gi are empty
 groupEquations eqns
   = runs same_gp [(patGroup (firstPat eqn), eqn) | eqn <- eqns]
   where
@@ -745,6 +748,10 @@ sameGroup (PgN l1)   (PgN l2)   = True		-- Needs conditionals
 sameGroup (PgNpK l1) (PgNpK l2) = l1==l2	-- Order is significant
 						-- See Note [Order of n+k]
 sameGroup (PgCo	t1)  (PgCo t2)  = t1 `coreEqType` t2
+	-- CoPats are in the same goup only if the type of the
+	-- enclosed pattern is the same. The patterns outside the CoPat
+	-- always have the same type, so this boils down to saying that
+	-- the two coercions are identical.
 sameGroup _          _          = False
  
 patGroup :: Pat Id -> PatGroup