From: Manuel M T Chakravarty <chak@cse.unsw.edu.au>
Date: Thu, 2 Jul 2009 08:48:26 +0000 (+0000)
Subject: Type synonym families may be nullary
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=1a77fd719aef44c2f91a25ddf312c70651bce1f1

Type synonym families may be nullary
---

diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs
index 3c9f77f..052b7e0 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 633dc52..f854b13 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") <+>