-matchLiterals all_vars@(var:vars)
- eqns_info@(EqnInfo n ctx ((NPat literal lit_ty eq_chk):ps1) _ : eqns)
- = let
- (shifted_eqns_for_this_lit, eqns_not_for_this_lit)
- = partitionEqnsByLit Nothing literal eqns_info
- in
- dsExpr (HsApp eq_chk (HsVar var)) `thenDs` \ pred_expr ->
- match vars shifted_eqns_for_this_lit `thenDs` \ inner_match_result ->
- let
- match_result1 = mkGuardedMatchResult pred_expr inner_match_result
- in
- if (null eqns_not_for_this_lit)
- then
- returnDs match_result1
- else
- matchLiterals all_vars eqns_not_for_this_lit `thenDs` \ match_result2 ->
- returnDs (combineMatchResults match_result1 match_result2)
+matchLiterals :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult
+-- All the EquationInfos have LitPats at the front
+
+matchLiterals (var:vars) ty eqns
+ = do { -- GROUP BY LITERAL
+ let groups :: [[(Literal, EquationInfo)]]
+ groups = equivClasses cmpTaggedEqn (tagLitEqns eqns)
+
+ -- DO THE MATCHING FOR EACH GROUP
+ ; alts <- mapM match_group groups
+
+ -- MAKE THE PRIMITIVE CASE
+ ; return (mkCoPrimCaseMatchResult var ty alts) }
+ where
+ match_group :: [(Literal, EquationInfo)] -> DsM (Literal, MatchResult)
+ match_group group
+ = do { let (lits, eqns) = unzip group
+ ; match_result <- match vars ty (shiftEqns eqns)
+ ; return (head lits, match_result) }
+\end{code}
+
+%************************************************************************
+%* *
+ Pattern matching on NPat
+%* *
+%************************************************************************
+
+\begin{code}
+matchNPats :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult
+-- All the EquationInfos have NPatOut at the front
+
+matchNPats (var:vars) ty eqns
+ = do { let groups :: [[(Literal, EquationInfo)]]
+ groups = equivClasses cmpTaggedEqn (tagLitEqns eqns)
+
+ ; match_results <- mapM (match_group . map snd) groups
+
+ ; ASSERT( not (null match_results) )
+ return (foldr1 combineMatchResults match_results) }
+ where
+ match_group :: [EquationInfo] -> DsM MatchResult
+ match_group (eqn1:eqns)
+ = do { pred_expr <- dsExpr (HsApp (noLoc eq_chk) (nlHsVar var))
+ ; match_result <- match vars ty (eqn1' : shiftEqns eqns)
+ ; return (adjustMatchResult (eqn_wrap eqn1) $
+ -- Bring the eqn1 wrapper stuff into scope because
+ -- it may be used in pred_expr
+ mkGuardedMatchResult pred_expr match_result) }
+ where
+ NPatOut _ _ eq_chk : pats1 = eqn_pats eqn1
+ eqn1' = eqn1 { eqn_wrap = idWrapper, eqn_pats = pats1 }