+
+%************************************************************************
+%* *
+ Pattern classification
+%* *
+%************************************************************************
+
+\begin{code}
+data PatGroup
+ = PgAny -- Immediate match: variables, wildcards,
+ -- lazy patterns
+ | PgCon DataCon -- Constructor patterns (incl list, tuple)
+ | PgLit Literal -- Literal patterns
+ | PgN Literal -- Overloaded literals
+ | PgNpK Literal -- n+k patterns
+ | PgBang -- Bang patterns
+ | PgCo Type -- Coercion patterns; the type is the type
+ -- of the pattern *inside*
+
+
+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
+ same_gp :: (PatGroup,EquationInfo) -> (PatGroup,EquationInfo) -> Bool
+ (pg1,_) `same_gp` (pg2,_) = pg1 `sameGroup` pg2
+
+subGroups :: [(PatGroup, EquationInfo)] -> [[EquationInfo]]
+-- Input is a particular group. The result sub-groups the
+-- equations by with particular constructor, literal etc they match.
+-- The order may be swizzled, so the matching should be order-independent
+subGroups groups = map (map snd) (equivClasses cmp groups)
+ where
+ (pg1, _) `cmp` (pg2, _) = pg1 `cmp_pg` pg2
+ (PgCon c1) `cmp_pg` (PgCon c2) = c1 `compare` c2
+ (PgLit l1) `cmp_pg` (PgLit l2) = l1 `compare` l2
+ (PgN l1) `cmp_pg` (PgN l2) = l1 `compare` l2
+ -- These are the only cases that are every sub-grouped
+
+sameGroup :: PatGroup -> PatGroup -> Bool
+-- Same group means that a single case expression
+-- or test will suffice to match both, *and* the order
+-- of testing within the group is insignificant.
+sameGroup PgAny PgAny = True
+sameGroup PgBang PgBang = True
+sameGroup (PgCon _) (PgCon _) = True -- One case expression
+sameGroup (PgLit _) (PgLit _) = True -- One case expression
+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
+patGroup (WildPat {}) = PgAny
+patGroup (BangPat {}) = PgBang
+patGroup (ConPatOut { pat_con = dc }) = PgCon (unLoc dc)
+patGroup (LitPat lit) = PgLit (hsLitKey lit)
+patGroup (NPat olit mb_neg _ _) = PgN (hsOverLitKey olit (isJust mb_neg))
+patGroup (NPlusKPat _ olit _ _) = PgNpK (hsOverLitKey olit False)
+patGroup (CoPat _ p _) = PgCo (hsPatType p) -- Type of inner pattern
+patGroup pat = pprPanic "patGroup" (ppr pat)
+\end{code}
+
+Note [Order of n+k]
+~~~~~~~~~~~~~~~~~~~
+WATCH OUT! Consider
+
+ f (n+1) = ...
+ f (n+2) = ...
+ f (n+1) = ...
+
+We can't group the first and third together, because the second may match
+the same thing as the first. Contrast
+ f 1 = ...
+ f 2 = ...
+ f 1 = ...
+where we can group the first and third. Hence we don't regard (n+1) and
+(n+2) as part of the same group.