diff options
Diffstat (limited to 'compiler/deSugar/Check.lhs')
| -rw-r--r-- | compiler/deSugar/Check.lhs | 36 |
1 files changed, 18 insertions, 18 deletions
diff --git a/compiler/deSugar/Check.lhs b/compiler/deSugar/Check.lhs index c0fe9c03e3..e07a70fc65 100644 --- a/compiler/deSugar/Check.lhs +++ b/compiler/deSugar/Check.lhs @@ -5,6 +5,8 @@ % Author: Juan J. Quintela <quintela@krilin.dc.fi.udc.es> \begin{code} +{-# LANGUAGE CPP #-} + module Check ( check , ExhaustivePat ) where #include "HsVersions.h" @@ -21,7 +23,6 @@ import Name import TysWiredIn import PrelNames import TyCon -import Type import SrcLoc import UniqSet import Util @@ -123,7 +124,7 @@ untidy_message :: (Name, [HsLit]) -> (Name, [HsLit]) untidy_message (string, lits) = (string, map untidy_lit lits) \end{code} -The function @untidy@ does the reverse work of the @tidy_pat@ funcion. +The function @untidy@ does the reverse work of the @tidy_pat@ function. \begin{code} @@ -144,7 +145,7 @@ untidy b (L loc p) = L loc (untidy' b p) untidy' _ p@(ConPatIn _ (PrefixCon [])) = p untidy' b (ConPatIn name ps) = pars b (L loc (ConPatIn name (untidy_con ps))) untidy' _ (ListPat pats ty Nothing) = ListPat (map untidy_no_pars pats) ty Nothing - untidy' _ (TuplePat pats box ty) = TuplePat (map untidy_no_pars pats) box ty + untidy' _ (TuplePat pats box tys) = TuplePat (map untidy_no_pars pats) box tys untidy' _ (ListPat _ _ (Just _)) = panic "Check.untidy: Overloaded ListPat" untidy' _ (PArrPat _ _) = panic "Check.untidy: Shouldn't get a parallel array here!" untidy' _ (SigPatIn _ _) = panic "Check.untidy: SigPat" @@ -468,8 +469,8 @@ get_unused_cons used_cons = ASSERT( not (null used_cons) ) unused_cons where used_set :: UniqSet DataCon used_set = mkUniqSet [d | ConPatOut{ pat_con = L _ (RealDataCon d) } <- used_cons] - (ConPatOut { pat_ty = ty }) = head used_cons - Just (ty_con, inst_tys) = splitTyConApp_maybe ty + (ConPatOut { pat_con = L _ (RealDataCon con1), pat_arg_tys = inst_tys }) = head used_cons + ty_con = dataConTyCon con1 unused_cons = filterOut is_used (tyConDataCons ty_con) is_used con = con `elementOfUniqSet` used_set || dataConCannotMatch inst_tys con @@ -593,9 +594,9 @@ make_con (ConPatOut{ pat_con = L _ (RealDataCon id) }) (lp:lq:ps, constraints) | isInfixCon id = (nlInfixConPat (getName id) lp lq : ps, constraints) where q = unLoc lq -make_con (ConPatOut{ pat_con = L _ (RealDataCon id), pat_args = PrefixCon pats, pat_ty = ty }) (ps, constraints) - | isTupleTyCon tc = (noLoc (TuplePat pats_con (tupleTyConBoxity tc) ty) : rest_pats, constraints) - | isPArrFakeCon id = (noLoc (PArrPat pats_con placeHolderType) : rest_pats, constraints) +make_con (ConPatOut{ pat_con = L _ (RealDataCon id), pat_args = PrefixCon pats, pat_arg_tys = tys }) (ps, constraints) + | isTupleTyCon tc = (noLoc (TuplePat pats_con (tupleTyConBoxity tc) tys) : rest_pats, constraints) + | isPArrFakeCon id = (noLoc (PArrPat pats_con placeHolderType) : rest_pats, constraints) | otherwise = (nlConPat name pats_con : rest_pats, constraints) where name = getName id @@ -696,17 +697,16 @@ tidy_pat (CoPat _ pat _) = tidy_pat pat tidy_pat (NPlusKPat id _ _ _) = WildPat (idType (unLoc id)) tidy_pat (ViewPat _ _ ty) = WildPat ty tidy_pat (ListPat _ _ (Just (ty,_))) = WildPat ty -tidy_pat (ConPatOut { pat_con = L _ PatSynCon{}, pat_ty = ty }) - = WildPat ty +tidy_pat (ConPatOut { pat_con = L _ (PatSynCon syn), pat_arg_tys = tys }) + = WildPat (patSynInstResTy syn tys) tidy_pat pat@(ConPatOut { pat_con = L _ con, pat_args = ps }) = pat { pat_args = tidy_con con ps } tidy_pat (ListPat ps ty Nothing) - = unLoc $ foldr (\ x y -> mkPrefixConPat consDataCon [x,y] list_ty) - (mkNilPat list_ty) + = unLoc $ foldr (\ x y -> mkPrefixConPat consDataCon [x,y] [ty]) + (mkNilPat ty) (map tidy_lpat ps) - where list_ty = mkListTy ty -- introduce fake parallel array constructors to be able to handle parallel -- arrays with the existing machinery for constructor pattern @@ -714,11 +714,11 @@ tidy_pat (ListPat ps ty Nothing) tidy_pat (PArrPat ps ty) = unLoc $ mkPrefixConPat (parrFakeCon (length ps)) (map tidy_lpat ps) - (mkPArrTy ty) + [ty] -tidy_pat (TuplePat ps boxity ty) +tidy_pat (TuplePat ps boxity tys) = unLoc $ mkPrefixConPat (tupleCon (boxityNormalTupleSort boxity) arity) - (map tidy_lpat ps) ty + (map tidy_lpat ps) tys where arity = length ps @@ -735,8 +735,8 @@ tidy_lit_pat :: HsLit -> Pat Id -- overlap with each other, or even explicit lists of Chars. tidy_lit_pat lit | HsString s <- lit - = unLoc $ foldr (\c pat -> mkPrefixConPat consDataCon [mkCharLitPat c, pat] stringTy) - (mkPrefixConPat nilDataCon [] stringTy) (unpackFS s) + = unLoc $ foldr (\c pat -> mkPrefixConPat consDataCon [mkCharLitPat c, pat] [charTy]) + (mkPrefixConPat nilDataCon [] [charTy]) (unpackFS s) | otherwise = tidyLitPat lit |