+This function is a wrapper of @match@, it must be called from all the parts where
+it was called match, but only substitutes the firs call, ....
+if the associated flags are declared, warnings will be issued.
+It can not be called matchWrapper because this name already exists :-(
+
+JJCQ 30-Nov-1997
+
+\begin{code}
+matchExport :: [Id] -- Vars rep'ing the exprs we're matching with
+ -> [EquationInfo] -- Info about patterns, etc. (type synonym below)
+ -> DsM MatchResult -- Desugared result!
+
+matchExport vars qs@((EqnInfo _ ctx _ (MatchResult _ _ _)) : _)
+ | incomplete && shadow =
+ dsShadowWarn ctx eqns_shadow `thenDs` \ () ->
+ dsIncompleteWarn ctx pats `thenDs` \ () ->
+ match vars qs
+ | incomplete =
+ dsIncompleteWarn ctx pats `thenDs` \ () ->
+ match vars qs
+ | shadow =
+ dsShadowWarn ctx eqns_shadow `thenDs` \ () ->
+ match vars qs
+ | otherwise =
+ match vars qs
+ where (pats,indexs) = check qs
+ incomplete = opt_WarnIncompletePatterns && (length pats /= 0)
+ shadow = opt_WarnOverlappedPatterns && sizeUniqSet indexs < no_eqns
+ no_eqns = length qs
+ unused_eqns = uniqSetToList (mkUniqSet [1..no_eqns] `minusUniqSet` indexs)
+ eqns_shadow = map (\n -> qs!!(n - 1)) unused_eqns
+\end{code}
+
+This variable shows the maximun number of lines of output generated for warnings.
+It will limit the number of patterns/equations displayed to maximum_output.
+
+\begin{code}
+maximum_output = 4
+\end{code}
+
+The next two functions creates the warning message.
+
+\begin{code}
+dsShadowWarn :: DsMatchContext -> [EquationInfo] -> DsM ()
+dsShadowWarn ctx@(DsMatchContext kind _ _) qs = dsWarn warn
+ where
+ warn sty | length qs > maximum_output =
+ hang (pp_context sty ctx (ptext SLIT("are overlapped")))
+ 12 ((vcat $ map (ppr_eqn kind sty) (take maximum_output qs))
+ $$ ptext SLIT("..."))
+ warn sty =
+ hang (pp_context sty ctx (ptext SLIT("are overlapped")))
+ 12 (vcat $ map (ppr_eqn kind sty) qs)
+
+dsIncompleteWarn :: DsMatchContext -> [ExhaustivePat] -> DsM ()
+dsIncompleteWarn ctx@(DsMatchContext kind _ _) pats = dsWarn warn
+ where
+ warn sty | length pats > maximum_output =
+ hang (pp_context sty ctx (ptext SLIT("are non-exhaustive")))
+ 12 (hang (ptext SLIT("Patterns not recognized:"))
+ 4 ((vcat $ map (ppr_incomplete_pats kind sty) (take maximum_output pats))
+ $$ ptext SLIT("...")))
+ warn sty =
+ hang (pp_context sty ctx (ptext SLIT("are non-exhaustive")))
+ 12 (hang (ptext SLIT("Patterns not recognized:"))
+ 4 (vcat $ map (ppr_incomplete_pats kind sty) pats))
+
+pp_context sty NoMatchContext msg = ptext SLIT("Warning: Some match(es)") <+> msg
+
+pp_context sty (DsMatchContext kind pats loc) msg
+ = hang (hcat [ppr (PprForUser opt_PprUserLength) loc, ptext SLIT(": ")])
+ 4 (hang message
+ 4 (pp_match kind pats))
+ where
+ message = ptext SLIT("Warning: Pattern match(es)") <+> msg
+
+ pp_match (FunMatch fun) pats
+ = hsep [ptext SLIT("in the definition of function"), ppr sty fun]
+
+ pp_match CaseMatch pats
+ = hang (ptext SLIT("in a group of case alternatives beginning:"))
+ 4 (ppr_pats sty pats)
+
+ pp_match PatBindMatch pats
+ = hang (ptext SLIT("in a pattern binding:"))
+ 4 (ppr_pats sty pats)
+
+ pp_match LambdaMatch pats
+ = hang (ptext SLIT("in a lambda abstraction:"))
+ 4 (ppr_pats sty pats)
+
+ pp_match DoBindMatch pats
+ = hang (ptext SLIT("in a `do' pattern binding:"))
+ 4 (ppr_pats sty pats)
+
+ pp_match ListCompMatch pats
+ = hang (ptext SLIT("in a `list comprension' pattern binding:"))
+ 4 (ppr_pats sty pats)
+
+ pp_match LetMatch pats
+ = hang (ptext SLIT("in a `let' pattern binding:"))
+ 4 (ppr_pats sty pats)
+
+ppr_pats sty pats = pprQuote sty $ \ sty -> sep (map (ppr sty) pats)
+
+separator (FunMatch _) = SLIT("=")
+separator (CaseMatch) = SLIT("->")
+separator (LambdaMatch) = SLIT("->")
+separator (PatBindMatch) = panic "When is this used?"
+separator (DoBindMatch) = SLIT("<-")
+separator (ListCompMatch) = SLIT("<-")
+separator (LetMatch) = SLIT("=")
+
+ppr_shadow_pats kind sty pats = pprQuote sty $ \ sty ->
+ sep [sep (map (ppr sty) pats), ptext (separator kind), ptext SLIT("...")]
+
+ppr_incomplete_pats kind sty (pats,[]) = pprQuote sty $ \ sty ->
+ sep [sep (map (ppr sty) pats)]
+ppr_incomplete_pats kind sty (pats,constraints) = pprQuote sty $ \ sty ->
+ sep [sep (map (ppr sty) pats), ptext SLIT("with"),
+ sep (map (ppr_constraint sty) constraints)]
+
+
+ppr_constraint sty (var,pats) = sep [ppr sty var, ptext SLIT("`not_elem`"),ppr sty pats]
+
+ppr_eqn kind sty (EqnInfo _ _ pats _) = ppr_shadow_pats kind sty pats
+
+\end{code}
+
+