HsSyn clean up for indexed types

- This patch cleans up the HsSyn representation of type family declarations.
- The new representation is not only less delicate, it also simplified teh code
  a bit.
- I took the opportunity of stream lining the terminology and function names
  at the same time.
- I also updated the description on the wiki at
  <http://hackage.haskell.org/trac/ghc/wiki/TypeFunctionsSyntax>

compiler/hsSyn/HsDecls.lhs

@@ -12,6 +12,7 @@ Definitions for: @TyDecl@ and @oCnDecl@, @ClassDecl@,
 module HsDecls (
 	HsDecl(..), LHsDecl, TyClDecl(..), LTyClDecl, 
 	InstDecl(..), LInstDecl, DerivDecl(..), LDerivDecl, NewOrData(..),
+	FamilyFlavour(..),
 	RuleDecl(..), LRuleDecl, RuleBndr(..),
 	DefaultDecl(..), LDefaultDecl, SpliceDecl(..),
 	ForeignDecl(..), LForeignDecl, ForeignImport(..), ForeignExport(..),
@@ -21,8 +22,8 @@ module HsDecls (
 	DeprecDecl(..),  LDeprecDecl,
 	HsGroup(..),  emptyRdrGroup, emptyRnGroup, appendGroups,
 	tcdName, tyClDeclNames, tyClDeclTyVars,
-	isClassDecl, isTFunDecl, isSynDecl, isDataDecl, isKindSigDecl,
-	isIdxTyDecl,
+	isClassDecl, isSynDecl, isDataDecl, isTypeDecl, isFamilyDecl,
+	isFamInstDecl, 
 	countTyClDecls,
 	conDetailsTys,
 	instDeclATs,
@@ -346,13 +347,9 @@ Interface file code:
 \begin{code}
 -- Representation of indexed types
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--- Kind signatures of indexed types come in two flavours:
---
--- * kind signatures for type functions: variant `TyFunction' and
---
--- * kind signatures for indexed data types and newtypes : variant `TyData'
---   iff a kind is present in `tcdKindSig' and there are no constructors in
---   `tcdCons'.
+-- Family kind signatures are represented by the variant `TyFamily'.  It
+-- covers "type family", "newtype family", and "data family" declarations,
+-- distinguished by the value of the field `tcdFlavour'.
 --
 -- Indexed types are represented by 'TyData' and 'TySynonym' using the field
 -- 'tcdTyPats::Maybe [LHsType name]', with the following meaning:
@@ -361,7 +358,7 @@ Interface file code:
 --     synonym declaration and 'tcdVars' contains the type parameters of the
 --     type constructor.
 --
---   * If it is 'Just pats', we have the definition of an indexed type Then,
+--   * If it is 'Just pats', we have the definition of an indexed type.  Then,
 --     'pats' are type patterns for the type-indexes of the type constructor
 --     and 'tcdVars' are the variables in those patterns.  Hence, the arity of
 --     the indexed type (ie, the number of indexes) is 'length tcdTyPats' and
@@ -376,7 +373,13 @@ data TyClDecl name
 		tcdLName    :: Located name,
 		tcdExtName  :: Maybe FastString,
 		tcdFoType   :: FoType
-  }
+    }
+
+  | TyFamily {  tcdFlavour:: FamilyFlavour,	        -- type, new, or data
+		tcdLName  :: Located name,	        -- type constructor
+		tcdTyVars :: [LHsTyVarBndr name],	-- type variables
+		tcdKind   :: Maybe Kind			-- result kind
+    }
 
   | TyData {	tcdND     :: NewOrData,
 		tcdCtxt   :: LHsContext name,	 	-- Context
@@ -390,12 +393,8 @@ data TyClDecl name
 			-- Nothing for everything else
 
 		tcdKindSig:: Maybe Kind,		-- Optional kind sig 
-			-- (Just k) for a
-			--	(a) GADT-style 'data', or 'data instance' decl 
-			--		with explicit kind sig
-			--	(b) 'data family' decl, whether or not 
-			--		there is an explicit kind sig
-			--		(this is how we distinguish a data family decl)
+			-- (Just k) for a GADT-style 'data', or 'data
+			-- instance' decl with explicit kind sig
 
 		tcdCons	  :: [LConDecl name],	 	-- Data constructors
 			-- For data T a = T1 | T2 a          the LConDecls all have ResTyH98
@@ -409,18 +408,9 @@ data TyClDecl name
 			-- Typically the foralls and ty args are empty, but they
 			-- are non-empty for the newtype-deriving case
     }
-	-- data family:   tcdPats = Nothing, tcdCons = [], tcdKindSig = Just k
-	--
 	-- data instance: tcdPats = Just tys
 	--
 	-- data:	  tcdPats = Nothing, 
-	--		  tcdCons is non-empty *or* tcdKindSig = Nothing
-
-  | TyFunction {tcdLName  :: Located name,	        -- type constructor
-		tcdTyVars :: [LHsTyVarBndr name],	-- type variables
-		tcdIso    :: Bool,	                -- injective type?
-		tcdKind   :: Kind			-- result kind
-    }
 
   | TySynonym {	tcdLName  :: Located name,	        -- type constructor
 		tcdTyVars :: [LHsTyVarBndr name],	-- type variables
@@ -445,46 +435,46 @@ data TyClDecl name
     }
 
 data NewOrData
-  = NewType  	-- "newtype Blah ..."
-  | DataType 	-- "data Blah ..."
-  deriving( Eq )	-- Needed because Demand derives Eq
+  = NewType			-- "newtype Blah ..."
+  | DataType			-- "data Blah ..."
+  deriving( Eq )		-- Needed because Demand derives Eq
+
+data FamilyFlavour
+  = TypeFamily			-- "type family ..."
+  | DataFamily NewOrData	-- "newtype family ..." or "data family ..."
 \end{code}
 
 Simple classifiers
 
 \begin{code}
-isTFunDecl, isDataDecl, isSynDecl, isClassDecl, isKindSigDecl, isIdxTyDecl ::
+isDataDecl, isTypeDecl, isSynDecl, isClassDecl, isFamilyDecl, isFamInstDecl :: 
   TyClDecl name -> Bool
 
--- type function kind signature
-isTFunDecl (TyFunction {}) = True
-isTFunDecl other	   = False
-
--- vanilla Haskell type synonym
-isSynDecl (TySynonym {tcdTyPats = Nothing}) = True
-isSynDecl other		                    = False
+-- data/newtype or data/newtype instance declaration
+isDataDecl (TyData {}) = True
+isDataDecl _other      = False
 
--- type equation (of a type function)
-isTEqnDecl (TySynonym {tcdTyPats = Just _}) = True
-isTEqnDecl other		            = False
+-- type or type instance declaration
+isTypeDecl (TySynonym {}) = True
+isTypeDecl _other	  = False
 
-isDataDecl (TyData {}) = True
-isDataDecl other       = False
+-- vanilla Haskell type synonym (ie, not a type instance)
+isSynDecl (TySynonym {tcdTyPats = Nothing}) = True
+isSynDecl _other	                    = False
 
+-- type class
 isClassDecl (ClassDecl {}) = True
 isClassDecl other	   = False
 
--- kind signature (for an indexed type)
-isKindSigDecl (TyFunction {}                   ) = True
-isKindSigDecl (TyData     {tcdKindSig = Just _,
-			   tcdCons    = []    }) = True
-isKindSigDecl other                              = False
-
--- definition of an instance of an indexed type
-isIdxTyDecl tydecl
-   | isTEqnDecl tydecl = True
-   | isDataDecl tydecl = isJust (tcdTyPats tydecl)
-   | otherwise	       = False
+-- type family declaration
+isFamilyDecl (TyFamily {}) = True
+isFamilyDecl _other        = False
+
+-- family instance (types, newtypes, and data types)
+isFamInstDecl tydecl
+   | isTypeDecl tydecl
+     || isDataDecl tydecl = isJust (tcdTyPats tydecl)
+   | otherwise	          = False
 \end{code}
 
 Dealing with names
@@ -499,7 +489,7 @@ tyClDeclNames :: Eq name => TyClDecl name -> [Located name]
 -- For record fields, the first one counts as the SrcLoc
 -- We use the equality to filter out duplicate field names
 
-tyClDeclNames (TyFunction  {tcdLName = name})    = [name]
+tyClDeclNames (TyFamily    {tcdLName = name})    = [name]
 tyClDeclNames (TySynonym   {tcdLName = name})    = [name]
 tyClDeclNames (ForeignType {tcdLName = name})    = [name]
 
@@ -510,7 +500,7 @@ tyClDeclNames (ClassDecl {tcdLName = cls_name, tcdSigs = sigs, tcdATs = ats})
 tyClDeclNames (TyData {tcdLName = tc_name, tcdCons = cons})
   = tc_name : conDeclsNames (map unLoc cons)
 
-tyClDeclTyVars (TyFunction  {tcdTyVars = tvs}) = tvs
+tyClDeclTyVars (TyFamily    {tcdTyVars = tvs}) = tvs
 tyClDeclTyVars (TySynonym   {tcdTyVars = tvs}) = tvs
 tyClDeclTyVars (TyData      {tcdTyVars = tvs}) = tvs
 tyClDeclTyVars (ClassDecl   {tcdTyVars = tvs}) = tvs
@@ -519,21 +509,20 @@ tyClDeclTyVars (ForeignType {})		       = []
 
 \begin{code}
 countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int, Int, Int)
-	-- class, synonym decls, type function signatures,
-	-- type function equations, data, newtype
+	-- class, synonym decls, data, newtype, family decls, family instances
 countTyClDecls decls 
- = (count isClassDecl     decls,
-    count isSynDecl       decls,
-    count isTFunDecl      decls,
-    count isTEqnDecl      decls,
-    count isDataTy        decls,
-    count isNewTy         decls) 
+ = (count isClassDecl    decls,
+    count isSynDecl      decls,  -- excluding...
+    count isDataTy       decls,  -- ...family...
+    count isNewTy        decls,  -- ...instances
+    count isFamilyDecl   decls,
+    count isFamInstDecl  decls)
  where
-   isDataTy TyData{tcdND=DataType} = True
-   isDataTy _                      = False
+   isDataTy TyData{tcdND = DataType, tcdTyPats = Nothing} = True
+   isDataTy _                                             = False
    
-   isNewTy TyData{tcdND=NewType} = True
-   isNewTy _                     = False
+   isNewTy TyData{tcdND = NewType, tcdTyPats = Nothing} = True
+   isNewTy _                                            = False
 \end{code}
 
 \begin{code}
@@ -543,14 +532,18 @@ instance OutputableBndr name
     ppr (ForeignType {tcdLName = ltycon})
 	= hsep [ptext SLIT("foreign import type dotnet"), ppr ltycon]
 
-    ppr (TyFunction {tcdLName = ltycon, tcdTyVars = tyvars, tcdIso = iso, 
-		     tcdKind = kind})
-      = typeMaybeIso <+> pp_decl_head [] ltycon tyvars Nothing <+> 
-	dcolon <+> pprKind kind
+    ppr (TyFamily {tcdFlavour = flavour, tcdLName = ltycon, 
+		   tcdTyVars = tyvars, tcdKind = mb_kind})
+      = pp_flavour <+> pp_decl_head [] ltycon tyvars Nothing <+> pp_kind
         where
-	  typeMaybeIso = if iso 
-			 then ptext SLIT("type family iso") 
-			 else ptext SLIT("type family")
+	  pp_flavour = case flavour of
+		         TypeFamily          -> ptext SLIT("type family")
+			 DataFamily NewType  -> ptext SLIT("newtype family")
+			 DataFamily DataType -> ptext SLIT("data family")
+
+          pp_kind = case mb_kind of
+		      Nothing   -> empty
+		      Just kind -> dcolon <+> pprKind kind
 
     ppr (TySynonym {tcdLName = ltycon, tcdTyVars = tyvars, tcdTyPats = typats,
 		    tcdSynRhs = mono_ty})

compiler/main/HscStats.lhs

@@ -38,10 +38,10 @@ ppSourceStats short (L _ (HsModule _ exports imports ldecls _ _ _ _))
 		("FixityDecls      ", fixity_sigs),
 		("DefaultDecls     ", default_ds),
 	      	("TypeDecls        ", type_ds),
-	      	("TypeFunDecls     ", type_fun_ds),
-	      	("TypeEquations    ", type_equs),
 	      	("DataDecls        ", data_ds),
 	      	("NewTypeDecls     ", newt_ds),
+	      	("TypeFamilyDecls  ", type_fam_ds),
+	      	("FamilyInstDecls  ", fam_inst_ds),
 	      	("DataConstrs      ", data_constrs),
 		("DataDerivings    ", data_derivs),
 	      	("ClassDecls       ", class_ds),
@@ -77,7 +77,7 @@ ppSourceStats short (L _ (HsModule _ exports imports ldecls _ _ _ _))
 		-- in class decls.  ToDo
 
     tycl_decls  = [d | TyClD d <- decls]
-    (class_ds, type_ds, type_fun_ds, type_equs, data_ds, newt_ds) = 
+    (class_ds, type_ds, data_ds, newt_ds, type_fam_ds, fam_inst_ds) = 
       countTyClDecls tycl_decls
 
     inst_decls  = [d | InstD d <- decls]

compiler/parser/Lexer.x

@@ -422,7 +422,6 @@ data Token
   | ITccallconv
   | ITdotnet
   | ITmdo
-  | ITiso
   | ITfamily
 
 	-- Pragmas
@@ -556,7 +555,6 @@ isSpecial ITunsafe    	= True
 isSpecial ITccallconv   = True
 isSpecial ITstdcallconv = True
 isSpecial ITmdo		= True
-isSpecial ITiso		= True
 isSpecial ITfamily	= True
 isSpecial _             = False
 
@@ -649,7 +647,7 @@ reservedSymsFM = listToUFM $
        ,("∀",	ITforall,	bit glaExtsBit)
        ,("→",   ITrarrow,	bit glaExtsBit)
        ,("←",   ITlarrow,	bit glaExtsBit)
-       ,("⋯", 	ITdotdot,	bit glaExtsBit)
+       ,("?", 	ITdotdot,	bit glaExtsBit)
         -- ToDo: ideally, → and ∷ should be "specials", so that they cannot
         -- form part of a large operator.  This would let us have a better
         -- syntax for kinds: ɑ∷*→* would be a legal kind signature. (maybe).

compiler/parser/Parser.y.pp

@@ -44,13 +44,24 @@ import FastString
 import Maybes		( orElse )
 import Outputable
 
-import Control.Monad    ( when )
+import Control.Monad    ( unless )
 import GHC.Exts
 import Data.Char
 import Control.Monad    ( mplus )
 }
 
 {-
+-----------------------------------------------------------------------------
+31 December 2006
+
+Conflicts: 34 shift/reduce
+           1 reduce/reduce
+
+The reduce/reduce conflict is weird.  It's between tyconsym and consym, and I
+would think the two should never occur in the same context.
+
+  -=chak
+
 -----------------------------------------------------------------------------
 6 December 2006
 
@@ -208,7 +219,6 @@ incorrect.
  'threadsafe'	{ L _ ITthreadsafe }
  'unsafe'	{ L _ ITunsafe }
  'mdo'		{ L _ ITmdo }
- 'iso'		{ L _ ITiso }
  'family'	{ L _ ITfamily }
  'stdcall'      { L _ ITstdcallconv }
  'ccall'        { L _ ITccallconv }
@@ -547,7 +557,7 @@ ty_decl :: { LTyClDecl RdrName }
 		-- infix type constructors to be declared 
  		{% do { (tc, tvs, _) <- checkSynHdr $2 False
 		      ; return (L (comb2 $1 $4) 
-				  (TySynonym tc tvs Nothing $4)) 
+				  (TySynonym tc tvs Nothing $4))
                       } }
 
            -- type family declarations
@@ -556,11 +566,8 @@ ty_decl :: { LTyClDecl RdrName }
 		-- infix type constructors to be declared
 		--
  		{% do { (tc, tvs, _) <- checkSynHdr $3 False
-		      ; let kind = case unLoc $4 of
-				     Nothing -> liftedTypeKind
-				     Just ki -> ki
 		      ; return (L (comb3 $1 $3 $4) 
-				  (TyFunction tc tvs False kind))
+				  (TyFamily TypeFamily tc tvs (unLoc $4)))
 		      } }
 
            -- type instance declarations
@@ -598,14 +605,14 @@ ty_decl :: { LTyClDecl RdrName }
           -- data/newtype family
         | data_or_newtype 'family' tycl_hdr opt_kind_sig
 		{% do { let {(ctxt, tc, tvs, tparms) = unLoc $3}
-                      ; checkTyVars tparms    -- no type pattern
-		      ; let kind = case unLoc $4 of
-				     Nothing -> liftedTypeKind
-				     Just ki -> ki
+                      ; checkTyVars tparms            -- no type pattern
+		      ; unless (null (unLoc ctxt)) $  -- and no context
+			  parseError (getLoc ctxt) 
+			    "A family declaration cannot have a context"
 		      ; return $
 			  L (comb3 $1 $2 $4)
-			    (mkTyData (unLoc $1) (ctxt, tc, tvs, Nothing) 
-			      (Just kind) [] Nothing) } }
+			    (TyFamily (DataFamily (unLoc $1)) tc tvs 
+				      (unLoc $4)) } }
 
           -- data/newtype instance declaration
 	| data_or_newtype 'instance' tycl_hdr constrs deriving
@@ -645,11 +652,8 @@ at_decl_cls :: { LTyClDecl RdrName }
 		-- infix type constructors to be declared
 		--
  		{% do { (tc, tvs, _) <- checkSynHdr $2 False
-		      ; let kind = case unLoc $3 of
-				     Nothing -> liftedTypeKind
-				     Just ki -> ki
 		      ; return (L (comb3 $1 $2 $3) 
-				  (TyFunction tc tvs False kind))
+				  (TyFamily TypeFamily tc tvs (unLoc $3)))
 		      } }
 
            -- default type instance
@@ -665,14 +669,15 @@ at_decl_cls :: { LTyClDecl RdrName }
           -- data/newtype family declaration
         | data_or_newtype tycl_hdr opt_kind_sig
 		{% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
-                      ; checkTyVars tparms    -- no type pattern
-		      ; let kind = case unLoc $3 of
-				     Nothing -> liftedTypeKind
-				     Just ki -> ki
+                      ; checkTyVars tparms            -- no type pattern
+		      ; unless (null (unLoc ctxt)) $  -- and no context
+			  parseError (getLoc ctxt) 
+			    "A family declaration cannot have a context"
 		      ; return $
 			  L (comb3 $1 $2 $3)
-			    (mkTyData (unLoc $1) (ctxt, tc, tvs, Nothing) 
-			      (Just kind) [] Nothing) } }
+			    (TyFamily (DataFamily (unLoc $1)) tc tvs
+				      (unLoc $3)) 
+                      } }
 
 -- Associate type instances
 --
@@ -709,10 +714,6 @@ at_decl_inst :: { LTyClDecl RdrName }
 			    (mkTyData (unLoc $1) (ctxt, tc, tvs, Just tparms) 
 			     (unLoc $3) (reverse (unLoc $5)) (unLoc $6)) } }
 
-opt_iso :: { Bool }
-	:       { False }
-	| 'iso'	{ True  }
-
 data_or_newtype :: { Located NewOrData }
 	: 'data'	{ L1 DataType }
 	| 'newtype'	{ L1 NewType }
@@ -1706,7 +1707,6 @@ varid_no_unsafe :: { Located RdrName }
 	: VARID			{ L1 $! mkUnqual varName (getVARID $1) }
 	| special_id		{ L1 $! mkUnqual varName (unLoc $1) }
 	| 'forall'		{ L1 $! mkUnqual varName FSLIT("forall") }
-	| 'iso'                 { L1 $! mkUnqual varName FSLIT("iso") }
 	| 'family'              { L1 $! mkUnqual varName FSLIT("family") }
 
 qvarsym :: { Located RdrName }
@@ -1731,7 +1731,7 @@ varsym_no_minus :: { Located RdrName } -- varsym not including '-'
 
 -- These special_ids are treated as keywords in various places, 
 -- but as ordinary ids elsewhere.   'special_id' collects all these
--- except 'unsafe', 'forall', 'family', and 'iso' whose treatment differs
+-- except 'unsafe', 'forall', and 'family' whose treatment differs
 -- depending on context 
 special_id :: { Located FastString }
 special_id

compiler/parser/RdrHsSyn.lhs

@@ -311,7 +311,7 @@ add gp@(HsGroup {hs_tyclds = ts, hs_fixds = fs, hs_docs = docs})
 		addl (gp { hs_tyclds = L l d : ts, 
                            hs_fixds = fsigs ++ fs,
                            hs_docs = add_doc decl docs}) ds
-	| isIdxTyDecl d = 
+	| isFamInstDecl d = 
 	        addl (gp { hs_tyclds = L l d : ts }) ds
 	| otherwise =
 		addl (gp { hs_tyclds = L l d : ts, 
@@ -548,7 +548,7 @@ checkKindSigs :: [LTyClDecl RdrName] -> P ()
 checkKindSigs = mapM_ check
   where
     check (L l tydecl) 
-      | isKindSigDecl tydecl
+      | isFamilyDecl tydecl
         || isSynDecl tydecl  = return ()
       | otherwise	     = 
 	parseError l "Type declaration in a class must be a kind signature or synonym default"

compiler/rename/RnNames.lhs

@@ -17,7 +17,7 @@ import DynFlags		( DynFlag(..), GhcMode(..), DynFlags(..) )
 import HsSyn		( IE(..), ieName, ImportDecl(..), LImportDecl,
 			  ForeignDecl(..), HsGroup(..), HsValBinds(..),
 			  Sig(..), collectHsBindLocatedBinders, tyClDeclNames,
-			  instDeclATs, isIdxTyDecl,
+			  instDeclATs, isFamInstDecl,
 			  LIE )
 import RnEnv
 import RnHsDoc          ( rnHsDoc )
@@ -336,7 +336,7 @@ getLocalDeclBinders gbl_env (HsGroup {hs_valds = ValBindsIn val_decls val_sigs,
     for_hs_bndrs = [nm | L _ (ForeignImport nm _ _) <- foreign_decls]
 
     new_tc tc_decl 
-      | isIdxTyDecl (unLoc tc_decl)
+      | isFamInstDecl (unLoc tc_decl)
 	= do { main_name <- lookupFamInstDeclBndr mod main_rdr
 	     ; sub_names <- mappM (newTopSrcBinder mod) sub_rdrs
 	     ; return (AvailTC main_name sub_names) }

compiler/rename/RnSource.lhs

@@ -380,26 +380,16 @@ rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
 
 Renaming of the associated types in instances.  
 
-* We raise an error if we encounter a kind signature in an instance.
-
 \begin{code}
 rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
 rnATInsts atDecls = 
   mapFvRn (wrapLocFstM rnATInst) atDecls
   where
-    rnATInst tydecl@TyFunction {} = 
-      do
-        addErr noKindSig
-	rnTyClDecl tydecl
+    rnATInst tydecl@TyData     {} = rnTyClDecl tydecl
     rnATInst tydecl@TySynonym  {} = rnTyClDecl tydecl
-    rnATInst tydecl@TyData     {} = 
-      do
-        checkM (not . isKindSigDecl $ tydecl) $ addErr noKindSig
-        rnTyClDecl tydecl
-    rnATInst _                    =
-      panic "RnSource.rnATInsts: not a type declaration"
-
-noKindSig = text "Instances cannot have kind signatures"
+    rnATInst tydecl               =
+      pprPanic "RnSource.rnATInsts: invalid AT instance" 
+	       (ppr (tcdName tydecl))
 \end{code}
 
 For the method bindings in class and instance decls, we extend the 
@@ -557,17 +547,21 @@ rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_
     returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
 	     emptyFVs)
 
+-- all flavours of type family declarations ("type family", "newtype fanily",
+-- and "data family")
+rnTyClDecl (tydecl@TyFamily {}) =
+  rnFamily tydecl bindTyVarsRn
+
+-- "data", "newtype", "data instance, and "newtype instance" declarations
 rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context, 
 			   tcdLName = tycon, tcdTyVars = tyvars, 
 			   tcdTyPats = typatsMaybe, tcdCons = condecls, 
 			   tcdKindSig = sig, tcdDerivs = derivs})
-  | isKindSigDecl tydecl  -- kind signature of indexed type
-  = rnTySig tydecl bindTyVarsRn
   | is_vanilla	          -- Normal Haskell data type decl
   = ASSERT( isNothing sig )	-- In normal H98 form, kind signature on the 
 				-- data type is syntactically illegal
     bindTyVarsRn data_doc tyvars		$ \ tyvars' ->
-    do	{ tycon' <- if isIdxTyDecl tydecl
+    do	{ tycon' <- if isFamInstDecl tydecl
 		    then lookupLocatedOccRn     tycon -- may be imported family
 		    else lookupLocatedTopBndrRn tycon
 	; context' <- rnContext data_doc context
@@ -583,14 +577,14 @@ rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
 	     	   extractHsCtxtTyNames context'	`plusFV`
 	     	   plusFVs (map conDeclFVs condecls')   `plusFV`
 	     	   deriv_fvs				`plusFV`
-		   (if isIdxTyDecl tydecl
+		   (if isFamInstDecl tydecl
 		   then unitFV (unLoc tycon')	-- type instance => use
 		   else emptyFVs)) 
         }
 
   | otherwise	          -- GADT
   = ASSERT( none typatsMaybe )    -- GADTs cannot have type patterns for now
-    do	{ tycon' <- if isIdxTyDecl tydecl
+    do	{ tycon' <- if isFamInstDecl tydecl
 		    then lookupLocatedOccRn     tycon -- may be imported family
 		    else lookupLocatedTopBndrRn tycon
 	; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
@@ -608,7 +602,7 @@ rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
 			   tcdCons = condecls', tcdDerivs = derivs'}, 
 	     	   plusFVs (map conDeclFVs condecls') `plusFV` 
 		   deriv_fvs			      `plusFV`
-		   (if isIdxTyDecl tydecl
+		   (if isFamInstDecl tydecl
 		   then unitFV (unLoc tycon')	-- type instance => use
 		   else emptyFVs))
         }
@@ -631,13 +625,11 @@ rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
     rn_derivs (Just ds) = rnLHsTypes data_doc ds	`thenM` \ ds' -> 
 			  returnM (Just ds', extractHsTyNames_s ds')
 
-rnTyClDecl (tydecl@TyFunction {}) =
-  rnTySig tydecl bindTyVarsRn
-
+-- "type" and "type instance" declarations
 rnTyClDecl tydecl@(TySynonym {tcdLName = name, tcdTyVars = tyvars,
 			      tcdTyPats = typatsMaybe, tcdSynRhs = ty})
   = bindTyVarsRn syn_doc tyvars		        $ \ tyvars' ->
-    do { name' <- if isIdxTyDecl tydecl
+    do { name' <- if isFamInstDecl tydecl
 		  then lookupLocatedOccRn     name -- may be imported family
 		  else lookupLocatedTopBndrRn name
        ; typats' <- rnTyPats syn_doc typatsMaybe
@@ -646,7 +638,7 @@ rnTyClDecl tydecl@(TySynonym {tcdLName = name, tcdTyVars = tyvars,
 			     tcdTyPats = typats', tcdSynRhs = ty'},
 	          delFVs (map hsLTyVarName tyvars') $
 		  fvs			      `plusFV`
-		   (if isIdxTyDecl tydecl
+		   (if isFamInstDecl tydecl
 		   then unitFV (unLoc name')	-- type instance => use
 		   else emptyFVs))
        }
@@ -808,64 +800,45 @@ rnField doc (HsRecField name ty haddock_doc)
     rnMbLHsDoc haddock_doc      `thenM` \ new_haddock_doc ->
     returnM (HsRecField new_name new_ty new_haddock_doc) 
 
--- Rename kind signatures (signatures of indexed data types/newtypes and
--- signatures of type functions)
+-- Rename family declarations
 --
 -- * This function is parametrised by the routine handling the index
 --   variables.  On the toplevel, these are defining occurences, whereas they
 --   are usage occurences for associated types.
 --
-rnTySig :: TyClDecl RdrName 
-        -> (SDoc -> [LHsTyVarBndr RdrName] -> 
-	    ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
-	    RnM (TyClDecl Name, FreeVars))
-        -> RnM (TyClDecl Name, FreeVars)
-
-rnTySig (tydecl@TyData {tcdCtxt = context, tcdLName = tycon, 
-			tcdTyVars = tyvars, tcdTyPats = mb_typats,
-			tcdCons = condecls, tcdKindSig = sig, 
-			tcdDerivs = derivs}) 
+rnFamily :: TyClDecl RdrName 
+         -> (SDoc -> [LHsTyVarBndr RdrName] -> 
+	     ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
+	     RnM (TyClDecl Name, FreeVars))
+         -> RnM (TyClDecl Name, FreeVars)
+
+rnFamily (tydecl@TyFamily {tcdFlavour = flavour, 
+			   tcdLName = tycon, tcdTyVars = tyvars}) 
         bindIdxVars =
-      ASSERT( null condecls )	    -- won't have constructors
-      ASSERT( isNothing mb_typats ) -- won't have type patterns
-      ASSERT( isNothing derivs )    -- won't have deriving
-      ASSERT( isJust sig )          -- will have kind signature
-      do { bindIdxVars (ksig_doc tycon) tyvars $ \tyvars' -> do {
+      do { checkM (isDataFlavour flavour                      -- for synonyms,
+		   || not (null tyvars)) $ addErr needOneIdx  -- #indexes >= 1
+	 ; bindIdxVars (family_doc tycon) tyvars $ \tyvars' -> do {
 	 ; tycon' <- lookupLocatedTopBndrRn tycon
-	 ; context' <- rnContext (ksig_doc tycon) context
-	 ; returnM (TyData {tcdND = tcdND tydecl, tcdCtxt = context', 
-			    tcdLName = tycon', tcdTyVars = tyvars',
-			    tcdTyPats = Nothing, tcdKindSig = sig, 
-			    tcdCons = [], tcdDerivs = Nothing}, 
-		    delFVs (map hsLTyVarName tyvars') $
-	     	    extractHsCtxtTyNames context') 
-         } }
-      where
-
-rnTySig (tydecl@TyFunction {tcdLName = tycon, tcdTyVars = tyvars, 
-			    tcdKind = sig}) 
-        bindIdxVars =
-      do { checkM (not . null $ tyvars) $ addErr needOneIdx   -- #indexes >= 1
-	 ; bindIdxVars (ksig_doc tycon) tyvars $ \tyvars' -> do {
-	 ; tycon' <- lookupLocatedTopBndrRn tycon
-	 ; returnM (TyFunction {tcdLName = tycon', tcdTyVars = tyvars',
-			        tcdIso = tcdIso tydecl, tcdKind = sig}, 
+	 ; returnM (TyFamily {tcdFlavour = flavour, tcdLName = tycon', 
+			      tcdTyVars = tyvars', tcdKind = tcdKind tydecl}, 
 		    emptyFVs) 
          } }
+      where
+        isDataFlavour (DataFamily _) = True
+	isDataFlavour _		     = False
 
-ksig_doc tycon = text "In the kind signature for" <+> quotes (ppr tycon)
-needOneIdx = text "Kind signature requires at least one type index"
+family_doc tycon = text "In the family declaration for" <+> quotes (ppr tycon)
+needOneIdx = text "Type family declarations requires at least one type index"
 
 -- Rename associated type declarations (in classes)
 --
--- * This can be kind signatures and (default) type function equations.
+-- * This can be family declarations and (default) type instances
 --
 rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
 rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
   where
-    rn_at (tydecl@TyData     {}) = rnTySig tydecl lookupIdxVars
-    rn_at (tydecl@TyFunction {}) = rnTySig tydecl lookupIdxVars
-    rn_at (tydecl@TySynonym  {}) = 
+    rn_at (tydecl@TyFamily  {}) = rnFamily tydecl lookupIdxVars
+    rn_at (tydecl@TySynonym {}) = 
       do
         checkM (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
         rnTyClDecl tydecl

compiler/typecheck/TcClassDcl.lhs

@@ -727,15 +727,15 @@ mkGenericInstance clas (hs_ty, binds)
 tcAddDeclCtxt decl thing_inside
   = addErrCtxt ctxt thing_inside
   where
-     thing = case decl of
-	   	ClassDecl {}		  -> "class"
-		TySynonym {}		  -> "type synonym"
-		TyFunction {}		  -> "type function signature"
-		TyData {tcdND = NewType}  -> "newtype" ++ maybeSig
-		TyData {tcdND = DataType} -> "data type" ++ maybeSig
-
-     maybeSig | isKindSigDecl decl = " signature"
-	      | otherwise	   = ""
+     thing | isClassDecl decl  = "class"
+	   | isTypeDecl decl   = "type synonym" ++ maybeInst
+	   | isDataDecl decl   = if tcdND decl == NewType 
+				 then "newtype" ++ maybeInst
+				 else "data type" ++ maybeInst
+	   | isFamilyDecl decl = "family"
+
+     maybeInst | isFamInstDecl decl = " family"
+	       | otherwise          = ""
 
      ctxt = hsep [ptext SLIT("In the"), text thing, 
 		  ptext SLIT("declaration for"), quotes (ppr (tcdName decl))]