% Author: Juan J. Quintela <quintela@krilin.dc.fi.udc.es>
\begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
module Check ( check , ExhaustivePat ) where
#include "HsVersions.h"
import HsSyn
import TcHsSyn
-import TcType
import DsUtils
import MatchLit
import Id
untidy_con (PrefixCon pats) = PrefixCon (map untidy_pars pats)
untidy_con (InfixCon p1 p2) = InfixCon (untidy_pars p1) (untidy_pars p2)
-untidy_con (RecCon bs) = RecCon [ HsRecField f (untidy_pars p) d | HsRecField f p d <- bs ]
+untidy_con (RecCon (HsRecFields flds dd))
+ = RecCon (HsRecFields [ fld { hsRecFieldArg = untidy_pars (hsRecFieldArg fld) }
+ | fld <- flds ] dd)
pars :: NeedPars -> WarningPat -> Pat Name
pars True p = ParPat p
hash_x = mkInternalName unboundKey {- doesn't matter much -}
(mkVarOccFS FSLIT("#x"))
- noSrcLoc
+ noSrcSpan
make_row_vars_for_constructor :: (EqnNo, EquationInfo) -> [WarningPat]
make_row_vars_for_constructor (_, EqnInfo { eqn_pats = pats})
has_nplusk_pat (PArrPat ps _) = any has_nplusk_lpat ps
has_nplusk_pat (LazyPat p) = False -- Why?
has_nplusk_pat (BangPat p) = has_nplusk_lpat p -- I think
-has_nplusk_pat (ConPatOut { pat_args = ps }) = any has_nplusk_lpat (hsConArgs ps)
-has_nplusk_pat p = False -- VarPat, VarPatOut, WildPat, LitPat, NPat, TypePat, DictPat
+has_nplusk_pat (ConPatOut { pat_args = ps }) = any has_nplusk_lpat (hsConPatArgs ps)
+has_nplusk_pat p = False -- VarPat, VarPatOut, WildPat, LitPat, NPat, TypePat
simplify_lpat :: LPat Id -> LPat Id
simplify_lpat p = fmap simplify_pat p
simplify_pat (NPlusKPat id hslit hsexpr1 hsexpr2)
= WildPat (idType (unLoc id))
-simplify_pat (DictPat dicts methods)
- = case num_of_d_and_ms of
- 0 -> simplify_pat (TuplePat [] Boxed unitTy)
- 1 -> simplify_pat (head dict_and_method_pats)
- _ -> simplify_pat (mkVanillaTuplePat (map noLoc dict_and_method_pats) Boxed)
- where
- num_of_d_and_ms = length dicts + length methods
- dict_and_method_pats = map VarPat (dicts ++ methods)
-
simplify_pat (CoPat co pat ty) = simplify_pat pat
-----------------
simplify_con con (PrefixCon ps) = PrefixCon (map simplify_lpat ps)
simplify_con con (InfixCon p1 p2) = PrefixCon [simplify_lpat p1, simplify_lpat p2]
-simplify_con con (RecCon fs)
+simplify_con con (RecCon (HsRecFields fs _))
| null fs = PrefixCon [nlWildPat | t <- dataConOrigArgTys con]
-- Special case for null patterns; maybe not a record at all
| otherwise = PrefixCon (map (simplify_lpat.snd) all_pats)