%
+% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-\section[Main_match]{The @match@ function}
+
+The @match@ function
\begin{code}
module Match ( match, matchEquations, matchWrapper, matchSimply, matchSinglePat ) where
#include "HsVersions.h"
-import DynFlags ( DynFlag(..), dopt )
+import DynFlags
import HsSyn
-import TcHsSyn ( mkVanillaTuplePat, hsPatType )
-import Check ( check, ExhaustivePat )
+import TcHsSyn
+import Check
import CoreSyn
-import Literal ( Literal )
-import CoreUtils ( bindNonRec, exprType )
+import Literal
+import CoreUtils
import DsMonad
-import DsBinds ( dsLHsBinds, dsCoercion )
-import DsGRHSs ( dsGRHSs )
+import DsBinds
+import DsGRHSs
import DsUtils
-import Id ( idName, idType, Id )
-import DataCon ( DataCon )
-import MatchCon ( matchConFamily )
-import MatchLit ( matchLiterals, matchNPlusKPats, matchNPats,
- tidyLitPat, tidyNPat, hsLitKey, hsOverLitKey )
-import PrelInfo ( pAT_ERROR_ID )
-import TcType ( Type )
-import Type ( splitFunTysN, coreEqType )
-import TysWiredIn ( consDataCon, mkListTy, unitTy,
- tupleCon, parrFakeCon, mkPArrTy )
-import BasicTypes ( Boxity(..) )
-import ListSetOps ( equivClasses, runs )
-import SrcLoc ( unLoc, Located(..) )
-import Maybes ( isJust )
-import Util ( lengthExceeds, notNull )
-import Name ( Name )
+import Id
+import DataCon
+import MatchCon
+import MatchLit
+import PrelInfo
+import TcType
+import Type
+import TysWiredIn
+import BasicTypes
+import ListSetOps
+import SrcLoc
+import Maybes
+import Util
+import Name
import Outputable
\end{code}
-> 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) )
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
tidy1 v (ParPat pat) = tidy1 v (unLoc pat)
tidy1 v (SigPatOut pat _) = tidy1 v (unLoc pat)
-tidy1 v (WildPat ty) = returnDs (idWrapper, WildPat ty)
+tidy1 v (WildPat ty) = returnDs (idDsWrapper, WildPat ty)
-- case v of { x -> mr[] }
-- = case v of { _ -> let x=v in mr[] }
; returnDs (mkDsLets sel_binds, WildPat (idType v)) }
tidy1 v (ListPat pats ty)
- = returnDs (idWrapper, unLoc list_ConPat)
+ = returnDs (idDsWrapper, unLoc list_ConPat)
where
list_ty = mkListTy ty
list_ConPat = foldr (\ x y -> mkPrefixConPat consDataCon [x, y] list_ty)
-- Introduce fake parallel array constructors to be able to handle parallel
-- arrays with the existing machinery for constructor pattern
tidy1 v (PArrPat pats ty)
- = returnDs (idWrapper, unLoc parrConPat)
+ = returnDs (idDsWrapper, unLoc parrConPat)
where
arity = length pats
parrConPat = mkPrefixConPat (parrFakeCon arity) pats (mkPArrTy ty)
tidy1 v (TuplePat pats boxity ty)
- = returnDs (idWrapper, unLoc tuple_ConPat)
+ = returnDs (idDsWrapper, unLoc tuple_ConPat)
where
arity = length pats
tuple_ConPat = mkPrefixConPat (tupleCon boxity arity) pats ty
-- LitPats: we *might* be able to replace these w/ a simpler form
tidy1 v (LitPat lit)
- = returnDs (idWrapper, tidyLitPat lit)
+ = returnDs (idDsWrapper, tidyLitPat lit)
-- NPats: we *might* be able to replace these w/ a simpler form
tidy1 v (NPat lit mb_neg eq lit_ty)
- = returnDs (idWrapper, tidyNPat lit mb_neg eq lit_ty)
+ = returnDs (idDsWrapper, tidyNPat lit mb_neg eq lit_ty)
-- Everything else goes through unchanged...
tidy1 v non_interesting_pat
- = returnDs (idWrapper, non_interesting_pat)
+ = returnDs (idDsWrapper, non_interesting_pat)
\end{code}
\noindent
\begin{code}
matchWrapper ctxt (MatchGroup matches match_ty)
- = do { eqns_info <- mapM mk_eqn_info matches
+ = ASSERT( notNull matches )
+ do { eqns_info <- mapM mk_eqn_info matches
; new_vars <- selectMatchVars arg_pats
; result_expr <- matchEquations ctxt new_vars eqns_info rhs_ty
; return (new_vars, result_expr) }
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
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