diff options
| author | Manuel M T Chakravarty <chak@cse.unsw.edu.au> | 2009-07-02 08:48:26 +0000 |
|---|---|---|
| committer | Manuel M T Chakravarty <chak@cse.unsw.edu.au> | 2009-07-02 08:48:26 +0000 |
| commit | 1a77fd719aef44c2f91a25ddf312c70651bce1f1 (patch) | |
| tree | 845e738d2e34e7e28eea91e2ba1a3f04b59ea467 | |
| parent | 432b9c9322181a3644083e3c19b7e240d90659e7 (diff) | |
| download | haskell-1a77fd719aef44c2f91a25ddf312c70651bce1f1.tar.gz | |
Type synonym families may be nullary
| -rw-r--r-- | compiler/rename/RnSource.lhs | 10 | ||||
| -rw-r--r-- | compiler/typecheck/TcTyClsDecls.lhs | 11 |
2 files changed, 1 insertions, 20 deletions
diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs index 3c9f77fff0..052b7e03d6 100644 --- a/compiler/rename/RnSource.lhs +++ b/compiler/rename/RnSource.lhs @@ -926,25 +926,17 @@ rnFamily :: TyClDecl RdrName rnFamily (tydecl@TyFamily {tcdFlavour = flavour, tcdLName = tycon, tcdTyVars = tyvars}) bindIdxVars = - do { checkM (isDataFlavour flavour -- for synonyms, - || not (null tyvars)) $ addErr needOneIdx -- no. of indexes >= 1 - ; bindIdxVars (family_doc tycon) tyvars $ \tyvars' -> do { + do { bindIdxVars (family_doc tycon) tyvars $ \tyvars' -> do { ; tycon' <- lookupLocatedTopBndrRn tycon ; return (TyFamily {tcdFlavour = flavour, tcdLName = tycon', tcdTyVars = tyvars', tcdKind = tcdKind tydecl}, emptyFVs) } } - where - isDataFlavour DataFamily = True - isDataFlavour _ = False rnFamily d _ = pprPanic "rnFamily" (ppr d) family_doc :: Located RdrName -> SDoc family_doc tycon = text "In the family declaration for" <+> quotes (ppr tycon) -needOneIdx :: SDoc -needOneIdx = text "Type family declarations requires at least one type index" - -- Rename associated type declarations (in classes) -- -- * This can be family declarations and (default) type instances diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs index 633dc52812..f854b137b5 100644 --- a/compiler/typecheck/TcTyClsDecls.lhs +++ b/compiler/typecheck/TcTyClsDecls.lhs @@ -693,9 +693,6 @@ tcTyClDecl1 _calc_isrec ; idx_tys <- doptM Opt_TypeFamilies ; checkTc idx_tys $ badFamInstDecl tc_name - -- Check for no type indices - ; checkTc (not (null tvs)) (noIndexTypes tc_name) - ; tycon <- buildSynTyCon tc_name tvs' (OpenSynTyCon kind Nothing) kind Nothing ; return [ATyCon tycon] } @@ -714,9 +711,6 @@ tcTyClDecl1 _calc_isrec ; idx_tys <- doptM Opt_TypeFamilies ; checkTc idx_tys $ badFamInstDecl tc_name - -- Check for no type indices - ; checkTc (not (null tvs)) (noIndexTypes tc_name) - ; tycon <- buildAlgTyCon tc_name final_tvs [] mkOpenDataTyConRhs Recursive False True Nothing ; return [ATyCon tycon] @@ -1500,11 +1494,6 @@ badSigTyDecl tc_name quotes (ppr tc_name) , nest 2 (parens $ ptext (sLit "Use -XKindSignatures to allow kind signatures")) ] -noIndexTypes :: Name -> SDoc -noIndexTypes tc_name - = ptext (sLit "Type family constructor") <+> quotes (ppr tc_name) - <+> ptext (sLit "must have at least one type index parameter") - badFamInstDecl :: Outputable a => a -> SDoc badFamInstDecl tc_name = vcat [ ptext (sLit "Illegal family instance for") <+> |