Split SynTyCon to SynonymTyCon and FamilyTyCon
authorJan Stolarek <jan.stolarek@p.lodz.pl>
Wed, 19 Nov 2014 21:03:05 +0000 (22:03 +0100)
committerJan Stolarek <jan.stolarek@p.lodz.pl>
Thu, 20 Nov 2014 17:56:36 +0000 (18:56 +0100)
This patch refactors internal representation of type synonyms and type families by splitting them into two separate data constructors of TyCon data type. The main motivation is is that some fields make sense only for type synonyms and some make sense only for type families. This will be even more true with the upcoming injective type families.

There is also some refactoring of names to keep the naming constistent. And thus tc_kind field has become tyConKind and tc_roles has become tcRoles. Both changes are not visible from the outside of TyCon module.

Updates haddock submodule

Reviewers: simonpj

Differential Revision: https://phabricator.haskell.org/D508

GHC Trac Issues: #9812

29 files changed:
compiler/coreSyn/CoreLint.lhs
compiler/iface/BuildTyCl.lhs
compiler/iface/IfaceSyn.lhs
compiler/iface/MkIface.lhs
compiler/iface/TcIface.lhs
compiler/main/GHC.hs
compiler/prelude/TysPrim.lhs
compiler/stgSyn/StgLint.lhs
compiler/typecheck/TcCanonical.lhs
compiler/typecheck/TcDeriv.lhs
compiler/typecheck/TcErrors.lhs
compiler/typecheck/TcFlatten.lhs
compiler/typecheck/TcInstDcls.lhs
compiler/typecheck/TcInteract.lhs
compiler/typecheck/TcRnDriver.lhs
compiler/typecheck/TcRnTypes.lhs
compiler/typecheck/TcSMonad.lhs
compiler/typecheck/TcSimplify.lhs
compiler/typecheck/TcSplice.lhs
compiler/typecheck/TcTyClsDecls.lhs
compiler/typecheck/TcTyDecls.lhs
compiler/typecheck/TcType.lhs
compiler/typecheck/TcTypeNats.hs
compiler/typecheck/TcUnify.lhs
compiler/typecheck/TcValidity.lhs
compiler/types/FamInstEnv.lhs
compiler/types/TyCon.lhs
compiler/vectorise/Vectorise/Type/Env.hs
utils/haddock

index f6bb1a2..7a050a8 100644 (file)
@@ -729,9 +729,8 @@ lintType ty@(TyConApp tc tys)
   | Just ty' <- coreView ty
   = lintType ty'   -- Expand type synonyms, so that we do not bogusly complain
                    --  about un-saturated type synonyms
-                   -- 
 
-  | isUnLiftedTyCon tc || isSynTyCon tc
+  | isUnLiftedTyCon tc || isTypeSynonymTyCon tc || isTypeFamilyTyCon tc
        -- See Note [The kind invariant] in TypeRep
        -- Also type synonyms and type families
   , length tys < tyConArity tc
index 106a15f..094ae3e 100644 (file)
@@ -7,7 +7,8 @@
 {-# LANGUAGE CPP #-}
 
 module BuildTyCl (
-        buildSynTyCon,
+        buildSynonymTyCon,
+        buildFamilyTyCon,
         buildAlgTyCon,
         buildDataCon,
         buildPatSyn,
@@ -45,13 +46,22 @@ import Outputable
 
 \begin{code}
 ------------------------------------------------------
-buildSynTyCon :: Name -> [TyVar] -> [Role]
-              -> SynTyConRhs
-              -> Kind                   -- ^ Kind of the RHS
-              -> TyConParent
-              -> TcRnIf m n TyCon
-buildSynTyCon tc_name tvs roles rhs rhs_kind parent
-  = return (mkSynTyCon tc_name kind tvs roles rhs parent)
+buildSynonymTyCon :: Name -> [TyVar] -> [Role]
+                  -> Type
+                  -> Kind                   -- ^ Kind of the RHS
+                  -> TcRnIf m n TyCon
+buildSynonymTyCon tc_name tvs roles rhs rhs_kind
+  = return (mkSynonymTyCon tc_name kind tvs roles rhs)
+  where kind = mkPiKinds tvs rhs_kind
+
+
+buildFamilyTyCon :: Name -> [TyVar]
+                 -> FamTyConFlav
+                 -> Kind                   -- ^ Kind of the RHS
+                 -> TyConParent
+                 -> TcRnIf m n TyCon
+buildFamilyTyCon tc_name tvs rhs rhs_kind parent
+  = return (mkFamilyTyCon tc_name kind tvs rhs parent)
   where kind = mkPiKinds tvs rhs_kind
 
 
index 49d645d..4241f07 100644 (file)
@@ -9,7 +9,7 @@
 module IfaceSyn (
         module IfaceType,
 
-        IfaceDecl(..), IfaceSynTyConRhs(..), IfaceClassOp(..), IfaceAT(..),
+        IfaceDecl(..), IfaceFamTyConFlav(..), IfaceClassOp(..), IfaceAT(..),
         IfaceConDecl(..), IfaceConDecls(..), IfaceEqSpec,
         IfaceExpr(..), IfaceAlt, IfaceLetBndr(..),
         IfaceBinding(..), IfaceConAlt(..),
@@ -101,11 +101,18 @@ data IfaceDecl
                                                  -- or data/newtype family instance
     }
 
-  | IfaceSyn  { ifName    :: IfaceTopBndr,           -- Type constructor
-                ifTyVars  :: [IfaceTvBndr],     -- Type variables
-                ifRoles   :: [Role],            -- Roles
-                ifSynKind :: IfaceKind,         -- Kind of the *rhs* (not of the tycon)
-                ifSynRhs  :: IfaceSynTyConRhs }
+  | IfaceSynonym { ifName    :: IfaceTopBndr,      -- Type constructor
+                   ifTyVars  :: [IfaceTvBndr],     -- Type variables
+                   ifRoles   :: [Role],            -- Roles
+                   ifSynKind :: IfaceKind,         -- Kind of the *rhs* (not of
+                                                   -- the tycon)
+                   ifSynRhs  :: IfaceType }
+
+  | IfaceFamily  { ifName    :: IfaceTopBndr,      -- Type constructor
+                   ifTyVars  :: [IfaceTvBndr],     -- Type variables
+                   ifFamKind :: IfaceKind,         -- Kind of the *rhs* (not of
+                                                   -- the tycon)
+                   ifFamFlav :: IfaceFamTyConFlav }
 
   | IfaceClass { ifCtxt    :: IfaceContext,             -- Context...
                  ifName    :: IfaceTopBndr,             -- Name of the class TyCon
@@ -145,12 +152,11 @@ data IfaceTyConParent
                    IfaceTyCon
                    IfaceTcArgs
 
-data IfaceSynTyConRhs
+data IfaceFamTyConFlav
   = IfaceOpenSynFamilyTyCon
   | IfaceClosedSynFamilyTyCon IfExtName       -- name of associated axiom
                               [IfaceAxBranch] -- for pretty printing purposes only
   | IfaceAbstractClosedSynFamilyTyCon
-  | IfaceSynonymTyCon IfaceType
   | IfaceBuiltInSynFamTyCon -- for pretty printing purposes only
 
 data IfaceClassOp = IfaceClassOp IfaceTopBndr DefMethSpec IfaceType
@@ -734,16 +740,16 @@ pprIfaceDecl ss (IfaceClass { ifATs = ats, ifSigs = sigs, ifRec = isrec
         | showSub ss sg = Just $  pprIfaceClassOp ss sg
         | otherwise     = Nothing
 
-pprIfaceDecl ss (IfaceSyn { ifName   = tc
-                          , ifTyVars = tv
-                          , ifSynRhs = IfaceSynonymTyCon mono_ty })
+pprIfaceDecl ss (IfaceSynonym { ifName   = tc
+                              , ifTyVars = tv
+                              , ifSynRhs = mono_ty })
   = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] ss tc tv <+> equals)
        2 (sep [pprIfaceForAll tvs, pprIfaceContextArr theta, ppr tau])
   where
     (tvs, theta, tau) = splitIfaceSigmaTy mono_ty
 
-pprIfaceDecl ss (IfaceSyn { ifName = tycon, ifTyVars = tyvars
-                          , ifSynRhs = rhs, ifSynKind = kind })
+pprIfaceDecl ss (IfaceFamily { ifName = tycon, ifTyVars = tyvars
+                             , ifFamFlav = rhs, ifFamKind = kind })
   = vcat [ hang (text "type family" <+> pprIfaceDeclHead [] ss tycon tyvars <+> dcolon)
               2 (ppr kind <+> ppShowRhs ss (pp_rhs rhs))
          , ppShowRhs ss (nest 2 (pp_branches rhs)) ]
@@ -1111,11 +1117,16 @@ freeNamesIfDecl d@IfaceData{} =
   freeNamesIfaceTyConParent (ifParent d) &&&
   freeNamesIfContext (ifCtxt d) &&&
   freeNamesIfConDecls (ifCons d)
-freeNamesIfDecl d@IfaceSyn{} =
+freeNamesIfDecl d@IfaceSynonym{} =
   freeNamesIfTvBndrs (ifTyVars d) &&&
-  freeNamesIfSynRhs (ifSynRhs d) &&&
+  freeNamesIfType (ifSynRhs d) &&&
   freeNamesIfKind (ifSynKind d) -- IA0_NOTE: because of promotion, we
                                 -- return names in the kind signature
+freeNamesIfDecl d@IfaceFamily{} =
+  freeNamesIfTvBndrs (ifTyVars d) &&&
+  freeNamesIfFamFlav (ifFamFlav d) &&&
+  freeNamesIfKind (ifFamKind d) -- IA0_NOTE: because of promotion, we
+                                -- return names in the kind signature
 freeNamesIfDecl d@IfaceClass{} =
   freeNamesIfTvBndrs (ifTyVars d) &&&
   freeNamesIfContext (ifCtxt d) &&&
@@ -1147,13 +1158,12 @@ freeNamesIfIdDetails (IfRecSelId tc _) = freeNamesIfTc tc
 freeNamesIfIdDetails _                 = emptyNameSet
 
 -- All other changes are handled via the version info on the tycon
-freeNamesIfSynRhs :: IfaceSynTyConRhs -> NameSet
-freeNamesIfSynRhs (IfaceSynonymTyCon ty)            = freeNamesIfType ty
-freeNamesIfSynRhs IfaceOpenSynFamilyTyCon           = emptyNameSet
-freeNamesIfSynRhs (IfaceClosedSynFamilyTyCon ax br)
+freeNamesIfFamFlav :: IfaceFamTyConFlav -> NameSet
+freeNamesIfFamFlav IfaceOpenSynFamilyTyCon           = emptyNameSet
+freeNamesIfFamFlav (IfaceClosedSynFamilyTyCon ax br)
   = unitNameSet ax &&& fnList freeNamesIfAxBranch br
-freeNamesIfSynRhs IfaceAbstractClosedSynFamilyTyCon = emptyNameSet
-freeNamesIfSynRhs IfaceBuiltInSynFamTyCon = emptyNameSet
+freeNamesIfFamFlav IfaceAbstractClosedSynFamilyTyCon = emptyNameSet
+freeNamesIfFamFlav IfaceBuiltInSynFamTyCon = emptyNameSet
 
 freeNamesIfContext :: IfaceContext -> NameSet
 freeNamesIfContext = fnList freeNamesIfType
@@ -1385,7 +1395,7 @@ instance Binary IfaceDecl where
         put_ bh a9
         put_ bh a10
 
-    put_ bh (IfaceSyn a1 a2 a3 a4 a5) = do
+    put_ bh (IfaceSynonym a1 a2 a3 a4 a5) = do
         putByte bh 3
         put_ bh (occNameFS a1)
         put_ bh a2
@@ -1393,8 +1403,15 @@ instance Binary IfaceDecl where
         put_ bh a4
         put_ bh a5
 
-    put_ bh (IfaceClass a1 a2 a3 a4 a5 a6 a7 a8 a9) = do
+    put_ bh (IfaceFamily a1 a2 a3 a4) = do
         putByte bh 4
+        put_ bh (occNameFS a1)
+        put_ bh a2
+        put_ bh a3
+        put_ bh a4
+
+    put_ bh (IfaceClass a1 a2 a3 a4 a5 a6 a7 a8 a9) = do
+        putByte bh 5
         put_ bh a1
         put_ bh (occNameFS a2)
         put_ bh a3
@@ -1406,14 +1423,14 @@ instance Binary IfaceDecl where
         put_ bh a9
 
     put_ bh (IfaceAxiom a1 a2 a3 a4) = do
-        putByte bh 5
+        putByte bh 6
         put_ bh (occNameFS a1)
         put_ bh a2
         put_ bh a3
         put_ bh a4
 
     put_ bh (IfacePatSyn name a2 a3 a4 a5 a6 a7 a8 a9 a10) = do
-        putByte bh 6
+        putByte bh 7
         put_ bh (occNameFS name)
         put_ bh a2
         put_ bh a3
@@ -1453,11 +1470,17 @@ instance Binary IfaceDecl where
                     a4 <- get bh
                     a5 <- get bh
                     occ <- return $! mkTcOccFS a1
-                    return (IfaceSyn occ a2 a3 a4 a5)
+                    return (IfaceSynonym occ a2 a3 a4 a5)
             4 -> do a1 <- get bh
                     a2 <- get bh
                     a3 <- get bh
                     a4 <- get bh
+                    occ <- return $! mkTcOccFS a1
+                    return (IfaceFamily occ a2 a3 a4)
+            5 -> do a1 <- get bh
+                    a2 <- get bh
+                    a3 <- get bh
+                    a4 <- get bh
                     a5 <- get bh
                     a6 <- get bh
                     a7 <- get bh
@@ -1465,13 +1488,13 @@ instance Binary IfaceDecl where
                     a9 <- get bh
                     occ <- return $! mkClsOccFS a2
                     return (IfaceClass a1 occ a3 a4 a5 a6 a7 a8 a9)
-            5 -> do a1 <- get bh
+            6 -> do a1 <- get bh
                     a2 <- get bh
                     a3 <- get bh
                     a4 <- get bh
                     occ <- return $! mkTcOccFS a1
                     return (IfaceAxiom occ a2 a3 a4)
-            6 -> do a1 <- get bh
+            7 -> do a1 <- get bh
                     a2 <- get bh
                     a3 <- get bh
                     a4 <- get bh
@@ -1485,12 +1508,11 @@ instance Binary IfaceDecl where
                     return (IfacePatSyn occ a2 a3 a4 a5 a6 a7 a8 a9 a10)
             _ -> panic (unwords ["Unknown IfaceDecl tag:", show h])
 
-instance Binary IfaceSynTyConRhs where
+instance Binary IfaceFamTyConFlav where
     put_ bh IfaceOpenSynFamilyTyCon           = putByte bh 0
     put_ bh (IfaceClosedSynFamilyTyCon ax br) = putByte bh 1 >> put_ bh ax
                                                              >> put_ bh br
     put_ bh IfaceAbstractClosedSynFamilyTyCon = putByte bh 2
-    put_ bh (IfaceSynonymTyCon ty)            = putByte bh 3 >> put_ bh ty
     put_ _ IfaceBuiltInSynFamTyCon
         = pprPanic "Cannot serialize IfaceBuiltInSynFamTyCon, used for pretty-printing only" Outputable.empty
 
@@ -1500,9 +1522,7 @@ instance Binary IfaceSynTyConRhs where
                     1 -> do { ax <- get bh
                             ; br <- get bh
                             ; return (IfaceClosedSynFamilyTyCon ax br) }
-                    2 -> return IfaceAbstractClosedSynFamilyTyCon
-                    _ -> do { ty <- get bh
-                            ; return (IfaceSynonymTyCon ty) } }
+                    _ -> return IfaceAbstractClosedSynFamilyTyCon }
 
 instance Binary IfaceClassOp where
     put_ bh (IfaceClassOp n def ty) = do
index 95fe479..ece0644 100644 (file)
@@ -756,7 +756,9 @@ data IfaceDeclExtras
        [AnnPayload]             -- Annotations of the type itself
        [IfaceIdExtras]          -- For each class method: fixity, RULES and annotations
 
-  | IfaceSynExtras   Fixity [IfaceInstABI] [AnnPayload]
+  | IfaceSynonymExtras Fixity [AnnPayload]
+
+  | IfaceFamilyExtras   Fixity [IfaceInstABI] [AnnPayload]
 
   | IfaceOtherDeclExtras
 
@@ -790,7 +792,9 @@ freeNamesDeclExtras (IfaceDataExtras  _ insts _ subs)
   = unionManyNameSets (mkNameSet insts : map freeNamesIdExtras subs)
 freeNamesDeclExtras (IfaceClassExtras _ insts _ subs)
   = unionManyNameSets (mkNameSet insts : map freeNamesIdExtras subs)
-freeNamesDeclExtras (IfaceSynExtras _ insts _)
+freeNamesDeclExtras (IfaceSynonymExtras _ _)
+  = emptyNameSet
+freeNamesDeclExtras (IfaceFamilyExtras _ insts _)
   = mkNameSet insts
 freeNamesDeclExtras IfaceOtherDeclExtras
   = emptyNameSet
@@ -801,7 +805,8 @@ freeNamesIdExtras (IdExtras _ rules _) = unionManyNameSets (map freeNamesIfRule
 instance Outputable IfaceDeclExtras where
   ppr IfaceOtherDeclExtras       = Outputable.empty
   ppr (IfaceIdExtras  extras)    = ppr_id_extras extras
-  ppr (IfaceSynExtras fix finsts anns) = vcat [ppr fix, ppr finsts, ppr anns]
+  ppr (IfaceSynonymExtras fix anns) = vcat [ppr fix, ppr anns]
+  ppr (IfaceFamilyExtras fix finsts anns) = vcat [ppr fix, ppr finsts, ppr anns]
   ppr (IfaceDataExtras fix insts anns stuff) = vcat [ppr fix, ppr_insts insts, ppr anns,
                                                 ppr_id_extras_s stuff]
   ppr (IfaceClassExtras fix insts anns stuff) = vcat [ppr fix, ppr_insts insts, ppr anns,
@@ -825,9 +830,11 @@ instance Binary IfaceDeclExtras where
    putByte bh 2; put_ bh fix; put_ bh insts; put_ bh anns; put_ bh cons
   put_ bh (IfaceClassExtras fix insts anns methods) = do
    putByte bh 3; put_ bh fix; put_ bh insts; put_ bh anns; put_ bh methods
-  put_ bh (IfaceSynExtras fix finsts anns) = do
-   putByte bh 4; put_ bh fix; put_ bh finsts; put_ bh anns
-  put_ bh IfaceOtherDeclExtras = putByte bh 5
+  put_ bh (IfaceSynonymExtras fix anns) = do
+   putByte bh 4; put_ bh fix; put_ bh anns
+  put_ bh (IfaceFamilyExtras fix finsts anns) = do
+   putByte bh 5; put_ bh fix; put_ bh finsts; put_ bh anns
+  put_ bh IfaceOtherDeclExtras = putByte bh 6
 
 instance Binary IfaceIdExtras where
   get _bh = panic "no get for IfaceIdExtras"
@@ -858,7 +865,9 @@ declExtras fix_fn ann_fn rule_env inst_env fi_env decl
                            -- as well as instances of the class (Trac #5147)
                         (ann_fn n)
                         [id_extras op | IfaceClassOp op _ _ <- sigs]
-      IfaceSyn{} -> IfaceSynExtras (fix_fn n)
+      IfaceSynonym{} -> IfaceSynonymExtras (fix_fn n)
+                                           (ann_fn n)
+      IfaceFamily{} -> IfaceFamilyExtras (fix_fn n)
                         (map ifFamInstAxiom (lookupOccEnvL fi_env n))
                         (ann_fn n)
       _other -> IfaceOtherDeclExtras
@@ -1605,11 +1614,20 @@ tyConToIfaceDecl env tycon
 
   | Just syn_rhs <- synTyConRhs_maybe tycon
   = ( tc_env1
-    , IfaceSyn {  ifName    = getOccName tycon,
-                  ifTyVars  = if_tc_tyvars,
-                  ifRoles   = tyConRoles tycon,
-                  ifSynRhs  = to_ifsyn_rhs syn_rhs,
-                  ifSynKind = tidyToIfaceType tc_env1 (synTyConResKind tycon) })
+    , IfaceSynonym { ifName    = getOccName tycon,
+                     ifTyVars  = if_tc_tyvars,
+                     ifRoles   = tyConRoles tycon,
+                     ifSynRhs  = if_syn_type syn_rhs,
+                     ifSynKind = tidyToIfaceType tc_env1 (synTyConResKind tycon)
+                   })
+
+  | Just fam_flav <- famTyConFlav_maybe tycon
+  = ( tc_env1
+    , IfaceFamily { ifName    = getOccName tycon,
+                    ifTyVars  = if_tc_tyvars,
+                    ifFamFlav = to_if_fam_flav fam_flav,
+                    ifFamKind = tidyToIfaceType tc_env1 (synTyConResKind tycon)
+                  })
 
   | isAlgTyCon tycon
   = ( tc_env1
@@ -1640,6 +1658,7 @@ tyConToIfaceDecl env tycon
   where
     (tc_env1, tc_tyvars) = tidyTyClTyVarBndrs env (tyConTyVars tycon)
     if_tc_tyvars = toIfaceTvBndrs tc_tyvars
+    if_syn_type ty = tidyToIfaceType tc_env1 ty
 
     funAndPrimTyVars = toIfaceTvBndrs $ take (tyConArity tycon) alphaTyVars
 
@@ -1649,18 +1668,15 @@ tyConToIfaceDecl env tycon
                                                    (tidyToIfaceTcArgs tc_env1 tc ty)
                Nothing           -> IfNoParent
 
-    to_ifsyn_rhs OpenSynFamilyTyCon        = IfaceOpenSynFamilyTyCon
-    to_ifsyn_rhs (ClosedSynFamilyTyCon ax) = IfaceClosedSynFamilyTyCon axn ibr
+    to_if_fam_flav OpenSynFamilyTyCon        = IfaceOpenSynFamilyTyCon
+    to_if_fam_flav (ClosedSynFamilyTyCon ax) = IfaceClosedSynFamilyTyCon axn ibr
       where defs = fromBranchList $ coAxiomBranches ax
             ibr  = map (coAxBranchToIfaceBranch' tycon) defs
             axn  = coAxiomName ax
-    to_ifsyn_rhs AbstractClosedSynFamilyTyCon
+    to_if_fam_flav AbstractClosedSynFamilyTyCon
       = IfaceAbstractClosedSynFamilyTyCon
 
-    to_ifsyn_rhs (SynonymTyCon ty)
-      = IfaceSynonymTyCon (tidyToIfaceType tc_env1 ty)
-
-    to_ifsyn_rhs (BuiltInSynFamTyCon {})
+    to_if_fam_flav (BuiltInSynFamTyCon {})
       = IfaceBuiltInSynFamTyCon
 
 
index 85ea0f9..4950f5e 100644 (file)
@@ -487,28 +487,41 @@ tc_iface_decl parent _ (IfaceData {ifName = occ_name,
            ; lhs_tys <- tcIfaceTcArgs arg_tys
            ; return (FamInstTyCon ax_unbr fam_tc lhs_tys) }
 
-tc_iface_decl parent _ (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs,
-                                  ifRoles = roles,
-                                  ifSynRhs = mb_rhs_ty,
-                                  ifSynKind = kind })
+tc_iface_decl _ _ (IfaceSynonym {ifName = occ_name, ifTyVars = tv_bndrs,
+                                      ifRoles = roles,
+                                      ifSynRhs = rhs_ty,
+                                      ifSynKind = kind })
    = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
      { tc_name  <- lookupIfaceTop occ_name
      ; rhs_kind <- tcIfaceKind kind     -- Note [Synonym kind loop]
      ; rhs      <- forkM (mk_doc tc_name) $
-                   tc_syn_rhs mb_rhs_ty
-     ; tycon    <- buildSynTyCon tc_name tyvars roles rhs rhs_kind parent
+                   tcIfaceType rhs_ty
+     ; tycon    <- buildSynonymTyCon tc_name tyvars roles rhs rhs_kind
      ; return (ATyCon tycon) }
    where
-     mk_doc n = ptext (sLit "Type syonym") <+> ppr n
-     tc_syn_rhs IfaceOpenSynFamilyTyCon   = return OpenSynFamilyTyCon
-     tc_syn_rhs (IfaceClosedSynFamilyTyCon ax_name _)
+     mk_doc n = ptext (sLit "Type synonym") <+> ppr n
+
+tc_iface_decl parent _ (IfaceFamily {ifName = occ_name, ifTyVars = tv_bndrs,
+                                     ifFamFlav = fam_flav,
+                                     ifFamKind = kind })
+   = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
+     { tc_name  <- lookupIfaceTop occ_name
+     ; rhs_kind <- tcIfaceKind kind     -- Note [Synonym kind loop]
+     ; rhs      <- forkM (mk_doc tc_name) $
+                   tc_fam_flav fam_flav
+     ; tycon    <- buildFamilyTyCon tc_name tyvars rhs rhs_kind parent
+     ; return (ATyCon tycon) }
+   where
+     mk_doc n = ptext (sLit "Type synonym") <+> ppr n
+     tc_fam_flav IfaceOpenSynFamilyTyCon   = return OpenSynFamilyTyCon
+     tc_fam_flav (IfaceClosedSynFamilyTyCon ax_name _)
        = do { ax <- tcIfaceCoAxiom ax_name
             ; return (ClosedSynFamilyTyCon ax) }
-     tc_syn_rhs IfaceAbstractClosedSynFamilyTyCon = return AbstractClosedSynFamilyTyCon
-     tc_syn_rhs (IfaceSynonymTyCon ty)    = do { rhs_ty <- tcIfaceType ty
-                                               ; return (SynonymTyCon rhs_ty) }
-     tc_syn_rhs IfaceBuiltInSynFamTyCon   = pprPanic "tc_iface_decl"
-                                               (ptext (sLit "IfaceBuiltInSynFamTyCon in interface file"))
+     tc_fam_flav IfaceAbstractClosedSynFamilyTyCon
+         = return AbstractClosedSynFamilyTyCon
+     tc_fam_flav IfaceBuiltInSynFamTyCon
+         = pprPanic "tc_iface_decl"
+                    (text "IfaceBuiltInSynFamTyCon in interface file")
 
 tc_iface_decl _parent ignore_prags
             (IfaceClass {ifCtxt = rdr_ctxt, ifName = tc_occ,
index 9ab52eb..41066a5 100644 (file)
@@ -156,10 +156,12 @@ module GHC (
         recordSelectorFieldLabel,
 
         -- ** Type constructors
-        TyCon, 
+        TyCon,
         tyConTyVars, tyConDataCons, tyConArity,
-        isClassTyCon, isSynTyCon, isNewTyCon, isPrimTyCon, isFunTyCon,
-        isFamilyTyCon, isOpenFamilyTyCon, tyConClass_maybe,
+        isClassTyCon, isTypeSynonymTyCon, isTypeFamilyTyCon, isNewTyCon,
+        isPrimTyCon, isFunTyCon,
+        isFamilyTyCon, isOpenFamilyTyCon, isOpenTypeFamilyTyCon,
+        tyConClass_maybe,
         synTyConRhs_maybe, synTyConDefn_maybe, synTyConResKind,
 
         -- ** Type variables
index e2d081a..e130fe5 100644 (file)
@@ -772,12 +772,11 @@ anyTy :: Type
 anyTy = mkTyConTy anyTyCon
 
 anyTyCon :: TyCon
-anyTyCon = mkSynTyCon anyTyConName kind [kKiVar] [Nominal]
-                      syn_rhs
-                      NoParentTyCon
+anyTyCon = mkFamilyTyCon anyTyConName kind [kKiVar]
+                         AbstractClosedSynFamilyTyCon
+                         NoParentTyCon
   where
     kind = ForAllTy kKiVar (mkTyVarTy kKiVar)
-    syn_rhs = AbstractClosedSynFamilyTyCon
 
 anyTypeOfKind :: Kind -> Type
 anyTypeOfKind kind = TyConApp anyTyCon [kind]
index 93fc9cd..a0fdf78 100644 (file)
@@ -427,7 +427,7 @@ checkFunApp fun_ty arg_tys msg
         else cfa False (newTyConInstRhs tc tc_args) arg_tys
 
       | Just tc <- tyConAppTyCon_maybe fun_ty
-      , not (isSynFamilyTyCon tc)       -- Definite error
+      , not (isTypeFamilyTyCon tc)      -- Definite error
       = (Nothing, Just msg)             -- Too many args
 
       | otherwise
index 2b5efc3..9b93815 100644 (file)
@@ -399,9 +399,9 @@ can_eq_nc' ev ty1 ps_ty1 ty2 ps_ty2
 -- so that  tv ~ F ty gets flattened
 -- Otherwise  F a ~ F a  might not get solved!
 can_eq_nc' ev (TyConApp fn1 tys1) _ ty2 ps_ty2
-  | isSynFamilyTyCon fn1 = can_eq_fam_nc ev NotSwapped fn1 tys1 ty2 ps_ty2
+  | isTypeFamilyTyCon fn1 = can_eq_fam_nc ev NotSwapped fn1 tys1 ty2 ps_ty2
 can_eq_nc' ev ty1 ps_ty1 (TyConApp fn2 tys2) _
-  | isSynFamilyTyCon fn2 = can_eq_fam_nc ev IsSwapped fn2 tys2 ty1 ps_ty1
+  | isTypeFamilyTyCon fn2 = can_eq_fam_nc ev IsSwapped fn2 tys2 ty1 ps_ty1
 
 -- Type variable on LHS or RHS are next
 can_eq_nc' ev (TyVarTy tv1) _ ty2 ps_ty2
index 6b81c29..c662b18 100644 (file)
@@ -561,7 +561,8 @@ deriveAutoTypeable auto_typeable done_specs tycl_decls
 
     do_one cls (L _ decl)
       = do { tc <- tcLookupTyCon (tcdName decl)
-           ; if (isSynTyCon tc || tyConName tc `elemNameSet` done_tcs)
+           ; if (isTypeSynonymTyCon tc || isTypeFamilyTyCon tc
+                                       || tyConName tc `elemNameSet` done_tcs)
                  -- Do not derive Typeable for type synonyms or type families
              then return []
              else mkPolyKindedTypeableEqn cls tc }
index 0ce397a..f9168ac 100644 (file)
@@ -287,7 +287,7 @@ isRigidOrSkol ty
 
 isTyFun_maybe :: Type -> Maybe TyCon
 isTyFun_maybe ty = case tcSplitTyConApp_maybe ty of
-                      Just (tc,_) | isSynFamilyTyCon tc -> Just tc
+                      Just (tc,_) | isTypeFamilyTyCon tc -> Just tc
                       _ -> Nothing
 
 
@@ -1274,7 +1274,7 @@ quickFlattenTy (FunTy ty1 ty2) = do { fy1 <- quickFlattenTy ty1
                                     ; fy2 <- quickFlattenTy ty2
                                     ; return (FunTy fy1 fy2) }
 quickFlattenTy (TyConApp tc tys)
-    | not (isSynFamilyTyCon tc)
+    | not (isTypeFamilyTyCon tc)
     = do { fys <- mapM quickFlattenTy tys
          ; return (TyConApp tc fys) }
     | otherwise
index 2d41ff8..fbb4729 100644 (file)
@@ -654,7 +654,7 @@ flatten fmode (TyConApp tc tys)
   | Just (tenv, rhs, tys') <- tcExpandTyCon_maybe tc tys
   , let expanded_ty = mkAppTys (substTy (mkTopTvSubst tenv) rhs) tys'
   = case fe_mode fmode of
-      FM_FlattenAll | anyNameEnv isSynFamilyTyCon (tyConsOfType rhs)
+      FM_FlattenAll | anyNameEnv isTypeFamilyTyCon (tyConsOfType rhs)
                    -> flatten fmode expanded_ty
                     | otherwise
                    -> flattenTyConApp fmode tc tys
@@ -663,7 +663,7 @@ flatten fmode (TyConApp tc tys)
   -- Otherwise, it's a type function application, and we have to
   -- flatten it away as well, and generate a new given equality constraint
   -- between the application and a newly generated flattening skolem variable.
-  | isSynFamilyTyCon tc
+  | isTypeFamilyTyCon tc
   = flattenFamApp fmode tc tys
 
   -- For * a normal data type application
index b6c0da1..3a6cca0 100644 (file)
@@ -649,8 +649,8 @@ tcTyFamInstDecl mb_clsinfo (L loc decl@(TyFamInstDecl { tfid_eqn = eqn }))
 
          -- (0) Check it's an open type family
        ; checkTc (isFamilyTyCon fam_tc)        (notFamily fam_tc)
-       ; checkTc (isSynFamilyTyCon fam_tc)     (wrongKindOfFamily fam_tc)
-       ; checkTc (isOpenSynFamilyTyCon fam_tc) (notOpenFamily fam_tc)
+       ; checkTc (isTypeFamilyTyCon fam_tc)    (wrongKindOfFamily fam_tc)
+       ; checkTc (isOpenTypeFamilyTyCon fam_tc) (notOpenFamily fam_tc)
 
          -- (1) do the work of verifying the synonym group
        ; co_ax_branch <- tcTyFamInstEqn (famTyConShape fam_tc) eqn
index 1cb3c45..0febaf3 100644 (file)
@@ -1571,8 +1571,8 @@ doTopReactDict _ w = pprPanic "doTopReactDict" (ppr w)
 doTopReactFunEq :: Ct -> TcS (StopOrContinue Ct)
 doTopReactFunEq work_item@(CFunEqCan { cc_ev = old_ev, cc_fun = fam_tc
                                      , cc_tyargs = args , cc_fsk = fsk })
-  = ASSERT(isSynFamilyTyCon fam_tc) -- No associated data families
-                                    -- have reached this far
+  = ASSERT(isTypeFamilyTyCon fam_tc) -- No associated data families
+                                     -- have reached this far
     ASSERT( not (isDerived old_ev) )   -- CFunEqCan is never Derived
     -- Look up in top-level instances, or built-in axiom
     do { match_res <- matchFam fam_tc args   -- See Note [MATCHING-SYNONYMS]
@@ -1583,7 +1583,7 @@ doTopReactFunEq work_item@(CFunEqCan { cc_ev = old_ev, cc_fun = fam_tc
     -- Found a top-level instance
 
     | Just (tc, tc_args) <- tcSplitTyConApp_maybe rhs_ty
-    , isSynFamilyTyCon tc
+    , isTypeFamilyTyCon tc
     , tc_args `lengthIs` tyConArity tc    -- Short-cut
     -> shortCutReduction old_ev fsk ax_co tc tc_args
          -- Try shortcut; see Note [Short cut for top-level reaction]
index 0b1601b..ca6df13 100644 (file)
@@ -934,18 +934,22 @@ checkBootTyCon tc1 tc2
   , Just syn_rhs2 <- synTyConRhs_maybe tc2
   , Just env <- eqTyVarBndrs emptyRnEnv2 (tyConTyVars tc1) (tyConTyVars tc2)
   = ASSERT(tc1 == tc2)
-    let eqSynRhs OpenSynFamilyTyCon OpenSynFamilyTyCon = True
-        eqSynRhs AbstractClosedSynFamilyTyCon (ClosedSynFamilyTyCon {}) = True
-        eqSynRhs (ClosedSynFamilyTyCon {}) AbstractClosedSynFamilyTyCon = True
-        eqSynRhs (ClosedSynFamilyTyCon ax1) (ClosedSynFamilyTyCon ax2)
+    check (roles1 == roles2) roles_msg `andThenCheck`
+    check (eqTypeX env syn_rhs1 syn_rhs2) empty   -- nothing interesting to say
+
+  | Just fam_flav1 <- famTyConFlav_maybe tc1
+  , Just fam_flav2 <- famTyConFlav_maybe tc2
+  = ASSERT(tc1 == tc2)
+    let eqFamFlav OpenSynFamilyTyCon OpenSynFamilyTyCon = True
+        eqFamFlav AbstractClosedSynFamilyTyCon (ClosedSynFamilyTyCon {}) = True
+        eqFamFlav (ClosedSynFamilyTyCon {}) AbstractClosedSynFamilyTyCon = True
+        eqFamFlav (ClosedSynFamilyTyCon ax1) (ClosedSynFamilyTyCon ax2)
             = eqClosedFamilyAx ax1 ax2
-        eqSynRhs (SynonymTyCon t1) (SynonymTyCon t2)
-            = eqTypeX env t1 t2
-        eqSynRhs (BuiltInSynFamTyCon _) (BuiltInSynFamTyCon _) = tc1 == tc2
-        eqSynRhs _ _ = False
+        eqFamFlav (BuiltInSynFamTyCon _) (BuiltInSynFamTyCon _) = tc1 == tc2
+        eqFamFlav _ _ = False
     in
     check (roles1 == roles2) roles_msg `andThenCheck`
-    check (eqSynRhs syn_rhs1 syn_rhs2) empty   -- nothing interesting to say
+    check (eqFamFlav fam_flav1 fam_flav2) empty   -- nothing interesting to say
 
   | isAlgTyCon tc1 && isAlgTyCon tc2
   , Just env <- eqTyVarBndrs emptyRnEnv2 (tyConTyVars tc1) (tyConTyVars tc2)
index 15be2a6..6f00b86 100644 (file)
@@ -1042,7 +1042,7 @@ data Ct
 
   | CFunEqCan {  -- F xis ~ fsk
        -- Invariants:
-       --   * isSynFamilyTyCon cc_fun
+       --   * isTypeFamilyTyCon cc_fun
        --   * typeKind (F xis) = tyVarKind fsk
        --   * always Nominal role
        --   * always Given or Wanted, never Derived
index decbb4f..b756fbc 100644 (file)
@@ -256,7 +256,7 @@ extendWorkListCt ct wl
  = case classifyPredType (ctPred ct) of
      EqPred ty1 _
        | Just (tc,_) <- tcSplitTyConApp_maybe ty1
-       , isSynFamilyTyCon tc
+       , isTypeFamilyTyCon tc
        -> extendWorkListFunEq ct wl
        | otherwise
        -> extendWorkListEq ct wl
@@ -1939,7 +1939,7 @@ maybeSym NotSwapped co = co
 matchFam :: TyCon -> [Type] -> TcS (Maybe (TcCoercion, TcType))
 -- Given (F tys) return (ty, co), where co :: F tys ~ ty
 matchFam tycon args
-  | isOpenSynFamilyTyCon tycon
+  | isOpenTypeFamilyTyCon tycon
   = do { fam_envs <- getFamInstEnvs
        ; let mb_match = tcLookupFamInst fam_envs tycon args
        ; traceTcS "lookupFamInst" $
index b13fded..8ec3591 100644 (file)
@@ -22,7 +22,7 @@ import TcInteract
 import Kind     ( isKind, isSubKind, defaultKind_maybe )
 import Inst
 import Type     ( classifyPredType, isIPClass, PredTree(..), getClassPredTys_maybe )
-import TyCon    ( isSynFamilyTyCon )
+import TyCon    ( isTypeFamilyTyCon )
 import Class    ( Class )
 import Id       ( idType )
 import Var
@@ -456,7 +456,7 @@ quantifyPred qtvs pred
     -- over (Eq Int); the instance should kick in right here
     quant_fun ty
       = case tcSplitTyConApp_maybe ty of
-          Just (tc, tys) | isSynFamilyTyCon tc
+          Just (tc, tys) | isTypeFamilyTyCon tc
                          -> tyVarsOfTypes tys `intersectsVarSet` qtvs
           _ -> False
 
index f2efb2a..3302d02 100644 (file)
@@ -1481,7 +1481,7 @@ reifyFunDep (xs, ys) = TH.FunDep (map reifyName xs) (map reifyName ys)
 
 reifyFamFlavour :: TyCon -> TcM (Either TH.FamFlavour [TH.TySynEqn])
 reifyFamFlavour tc
-  | isOpenSynFamilyTyCon tc = return $ Left TH.TypeFam
+  | isOpenTypeFamilyTyCon tc = return $ Left TH.TypeFam
   | isDataFamilyTyCon    tc = return $ Left TH.DataFam
 
     -- this doesn't really handle abstract closed families, but let's not worry
index e08f269..d5bc8b1 100644 (file)
@@ -672,8 +672,7 @@ tcFamDecl1 parent
   = tcTyClTyVars tc_name tvs $ \ tvs' kind -> do
   { traceTc "open type family:" (ppr tc_name)
   ; checkFamFlag tc_name
-  ; let roles = map (const Nominal) tvs'
-  ; tycon <- buildSynTyCon tc_name tvs' roles OpenSynFamilyTyCon kind parent
+  ; tycon <- buildFamilyTyCon tc_name tvs' OpenSynFamilyTyCon kind parent
   ; return [ATyCon tycon] }
 
 tcFamDecl1 parent
@@ -717,8 +716,7 @@ tcFamDecl1 parent
        ; let syn_rhs = if null eqns
                        then AbstractClosedSynFamilyTyCon
                        else ClosedSynFamilyTyCon co_ax
-             roles   = map (const Nominal) tvs'
-       ; tycon <- buildSynTyCon tc_name tvs' roles syn_rhs kind parent
+       ; tycon <- buildFamilyTyCon tc_name tvs' syn_rhs kind parent
 
        ; let result = if null eqns
                       then [ATyCon tycon]
@@ -752,8 +750,7 @@ tcTySynRhs rec_info tc_name tvs kind hs_ty
        ; rhs_ty <- tcCheckLHsType hs_ty kind
        ; rhs_ty <- zonkTcTypeToType emptyZonkEnv rhs_ty
        ; let roles = rti_roles rec_info tc_name
-       ; tycon <- buildSynTyCon tc_name tvs roles (SynonymTyCon rhs_ty)
-                                kind NoParentTyCon
+       ; tycon <- buildSynonymTyCon tc_name tvs roles rhs_ty kind
        ; return [ATyCon tycon] }
 
 tcDataDefn :: RecTyInfo -> Name
@@ -873,7 +870,7 @@ tcDefaultAssocDecl fam_tc [L loc (TyFamEqn { tfe_tycon = L _ tc_name
     tcAddFamInstCtxt (ptext (sLit "default type instance")) tc_name $
     tcTyClTyVars tc_name hs_tvs $ \ tvs rhs_kind ->
     do { traceTc "tcDefaultAssocDecl" (ppr tc_name)
-       ; checkTc (isSynFamilyTyCon fam_tc) (wrongKindOfFamily fam_tc)
+       ; checkTc (isTypeFamilyTyCon fam_tc) (wrongKindOfFamily fam_tc)
        ; let (fam_name, fam_pat_arity, _) = famTyConShape fam_tc
        ; ASSERT( fam_name == tc_name )
          checkTc (length (hsQTvBndrs hs_tvs) == fam_pat_arity)
@@ -1394,7 +1391,10 @@ checkValidTyCon tc
   = checkValidClass cl
 
   | Just syn_rhs <- synTyConRhs_maybe tc
-  = case syn_rhs of
+  = checkValidType syn_ctxt syn_rhs
+
+  | Just fam_flav <- famTyConFlav_maybe tc
+  = case fam_flav of
     { ClosedSynFamilyTyCon ax      -> checkValidClosedCoAxiom ax
     ; AbstractClosedSynFamilyTyCon ->
       do { hsBoot <- tcIsHsBootOrSig
@@ -1402,7 +1402,6 @@ checkValidTyCon tc
            ptext (sLit "You may omit the equations in a closed type family") $$
            ptext (sLit "only in a .hs-boot file") }
     ; OpenSynFamilyTyCon           -> return ()
-    ; SynonymTyCon ty              -> checkValidType syn_ctxt ty
     ; BuiltInSynFamTyCon _         -> return () }
 
   | otherwise
@@ -1763,7 +1762,7 @@ checkValidRoles tc
   | isAlgTyCon tc
     -- tyConDataCons returns an empty list for data families
   = mapM_ check_dc_roles (tyConDataCons tc)
-  | Just (SynonymTyCon rhs) <- synTyConRhs_maybe tc
+  | Just rhs <- synTyConRhs_maybe tc
   = check_ty_roles (zipVarEnv (tyConTyVars tc) (tyConRoles tc)) Representational rhs
   | otherwise
   = return ()
@@ -2175,8 +2174,8 @@ wrongKindOfFamily family
   = ptext (sLit "Wrong category of family instance; declaration was for a")
     <+> kindOfFamily
   where
-    kindOfFamily | isSynTyCon family = ptext (sLit "type synonym")
-                 | isAlgTyCon family = ptext (sLit "data type")
+    kindOfFamily | isTypeSynonymTyCon family = text "type synonym"
+                 | isAlgTyCon         family = text "data type"
                  | otherwise = pprPanic "wrongKindOfFamily" (ppr family)
 
 wrongNumberOfParmsErr :: Arity -> SDoc
@@ -2234,7 +2233,7 @@ addTyThingCtxt thing
     flav = case thing of
              ATyCon tc
                 | isClassTyCon tc       -> ptext (sLit "class")
-                | isSynFamilyTyCon tc   -> ptext (sLit "type family")
+                | isTypeFamilyTyCon tc  -> ptext (sLit "type family")
                 | isDataFamilyTyCon tc  -> ptext (sLit "data family")
                 | isTypeSynonymTyCon tc -> ptext (sLit "type")
                 | isNewTyCon tc         -> ptext (sLit "newtype")
index f2c2395..3812013 100644 (file)
@@ -709,7 +709,7 @@ irTyCon tc
          mapM_ (irType emptyVarSet) (tyConStupidTheta tc)  -- See #8958
        ; mapM_ (irDataCon tc_name) (visibleDataCons $ algTyConRhs tc) }}
 
-  | Just (SynonymTyCon ty) <- synTyConRhs_maybe tc
+  | Just ty <- synTyConRhs_maybe tc
   = addRoleInferenceInfo tc_name (tyConTyVars tc) $
     irType emptyVarSet ty
 
index dba1be8..74406c0 100644 (file)
@@ -67,7 +67,6 @@ module TcType (
   isDoubleTy, isFloatTy, isIntTy, isWordTy, isStringTy,
   isIntegerTy, isBoolTy, isUnitTy, isCharTy,
   isTauTy, isTauTyCon, tcIsTyVarTy, tcIsForAllTy,
-  isSynFamilyTyConApp,
   isPredTy, isTyVarClassPred,
 
   ---------------------------------
@@ -554,7 +553,7 @@ tcTyFamInsts ty
   | Just exp_ty <- tcView ty    = tcTyFamInsts exp_ty
 tcTyFamInsts (TyVarTy _)        = []
 tcTyFamInsts (TyConApp tc tys)
-  | isSynFamilyTyCon tc         = [(tc, tys)]
+  | isTypeFamilyTyCon tc        = [(tc, tys)]
   | otherwise                   = concat (map tcTyFamInsts tys)
 tcTyFamInsts (LitTy {})         = []
 tcTyFamInsts (FunTy ty1 ty2)    = tcTyFamInsts ty1 ++ tcTyFamInsts ty2
@@ -1357,17 +1356,6 @@ is_tc uniq ty = case tcSplitTyConApp_maybe ty of
                         Nothing      -> False
 \end{code}
 
-\begin{code}
--- NB: Currently used in places where we have already expanded type synonyms;
---     hence no 'coreView'.  This could, however, be changed without breaking
---     any code.
-isSynFamilyTyConApp :: TcTauType -> Bool
-isSynFamilyTyConApp (TyConApp tc tys) = isSynFamilyTyCon tc &&
-                                      length tys == tyConArity tc
-isSynFamilyTyConApp _other            = False
-\end{code}
-
-
 %************************************************************************
 %*                                                                      *
 \subsection{Misc}
index 8f02c9a..9815958 100644 (file)
@@ -15,7 +15,7 @@ module TcTypeNats
 import Type
 import Pair
 import TcType     ( TcType, tcEqType )
-import TyCon      ( TyCon, SynTyConRhs(..), mkSynTyCon, TyConParent(..)  )
+import TyCon      ( TyCon, FamTyConFlav(..), mkFamilyTyCon, TyConParent(..)  )
 import Coercion   ( Role(..) )
 import TcRnTypes  ( Xi )
 import CoAxiom    ( CoAxiomRule(..), BuiltInSynFamily(..) )
@@ -104,10 +104,9 @@ typeNatExpTyCon = mkTypeNatFunTyCon2 name
 
 typeNatLeqTyCon :: TyCon
 typeNatLeqTyCon =
-  mkSynTyCon name
+  mkFamilyTyCon name
     (mkArrowKinds [ typeNatKind, typeNatKind ] boolKind)
     (take 2 $ tyVarList typeNatKind)
-    [Nominal,Nominal]
     (BuiltInSynFamTyCon ops)
     NoParentTyCon
 
@@ -122,10 +121,9 @@ typeNatLeqTyCon =
 
 typeNatCmpTyCon :: TyCon
 typeNatCmpTyCon =
-  mkSynTyCon name
+  mkFamilyTyCon name
     (mkArrowKinds [ typeNatKind, typeNatKind ] orderingKind)
     (take 2 $ tyVarList typeNatKind)
-    [Nominal,Nominal]
     (BuiltInSynFamTyCon ops)
     NoParentTyCon
 
@@ -140,10 +138,9 @@ typeNatCmpTyCon =
 
 typeSymbolCmpTyCon :: TyCon
 typeSymbolCmpTyCon =
-  mkSynTyCon name
+  mkFamilyTyCon name
     (mkArrowKinds [ typeSymbolKind, typeSymbolKind ] orderingKind)
     (take 2 $ tyVarList typeSymbolKind)
-    [Nominal,Nominal]
     (BuiltInSynFamTyCon ops)
     NoParentTyCon
 
@@ -163,10 +160,9 @@ typeSymbolCmpTyCon =
 -- Make a binary built-in constructor of kind: Nat -> Nat -> Nat
 mkTypeNatFunTyCon2 :: Name -> BuiltInSynFamily -> TyCon
 mkTypeNatFunTyCon2 op tcb =
-  mkSynTyCon op
+  mkFamilyTyCon op
     (mkArrowKinds [ typeNatKind, typeNatKind ] typeNatKind)
     (take 2 $ tyVarList typeNatKind)
-    [Nominal,Nominal]
     (BuiltInSynFamTyCon tcb)
     NoParentTyCon
 
index 421d076..f103fd7 100644 (file)
@@ -612,9 +612,9 @@ uType origin orig_ty1 orig_ty2
         -- Always defer if a type synonym family (type function)
         -- is involved.  (Data families behave rigidly.)
     go ty1@(TyConApp tc1 _) ty2
-      | isSynFamilyTyCon tc1 = uType_defer origin ty1 ty2
+      | isTypeFamilyTyCon tc1 = uType_defer origin ty1 ty2
     go ty1 ty2@(TyConApp tc2 _)
-      | isSynFamilyTyCon tc2 = uType_defer origin ty1 ty2
+      | isTypeFamilyTyCon tc2 = uType_defer origin ty1 ty2
 
     go (TyConApp tc1 tys1) (TyConApp tc2 tys2)
       -- See Note [Mismatched type lists and application decomposition]
@@ -908,7 +908,7 @@ checkTauTvUpdate dflags tv ty
     -- See Note [Conservative unification check]
     defer_me (LitTy {})        = False
     defer_me (TyVarTy tv')     = tv == tv'
-    defer_me (TyConApp tc tys) = isSynFamilyTyCon tc || any defer_me tys
+    defer_me (TyConApp tc tys) = isTypeFamilyTyCon tc || any defer_me tys
     defer_me (FunTy arg res)   = defer_me arg || defer_me res
     defer_me (AppTy fun arg)   = defer_me fun || defer_me arg
     defer_me (ForAllTy _ ty)   = not impredicative || defer_me ty
index 8381533..97d62d1 100644 (file)
@@ -294,7 +294,8 @@ check_type ctxt rank (AppTy ty1 ty2)
         ; check_arg_type ctxt rank ty2 }
 
 check_type ctxt rank ty@(TyConApp tc tys)
-  | isSynTyCon tc          = check_syn_tc_app ctxt rank ty tc tys
+  | isTypeSynonymTyCon tc || isTypeFamilyTyCon tc
+  = check_syn_tc_app ctxt rank ty tc tys
   | isUnboxedTupleTyCon tc = check_ubx_tuple  ctxt      ty    tys
   | otherwise              = mapM_ (check_arg_type ctxt rank) tys
 
@@ -303,7 +304,7 @@ check_type _ _ (LitTy {}) = return ()
 check_type _ _ ty = pprPanic "check_type" (ppr ty)
 
 ----------------------------------------
-check_syn_tc_app :: UserTypeCtxt -> Rank -> KindOrType 
+check_syn_tc_app :: UserTypeCtxt -> Rank -> KindOrType
                  -> TyCon -> [KindOrType] -> TcM ()
 -- Used for type synonyms and type synonym families,
 -- which must be saturated, 
@@ -318,7 +319,7 @@ check_syn_tc_app ctxt rank ty tc tys
        --      f :: Foo a b -> ...
   = do  { -- See Note [Liberal type synonyms]
         ; liberal <- xoptM Opt_LiberalTypeSynonyms
-        ; if not liberal || isSynFamilyTyCon tc then
+        ; if not liberal || isTypeFamilyTyCon tc then
                 -- For H98 and synonym families, do check the type args
                 mapM_ check_arg tys
 
@@ -334,12 +335,12 @@ check_syn_tc_app ctxt rank ty tc tys
   | otherwise
   = failWithTc (arityErr flavour (tyConName tc) tc_arity n_args)
   where
-    flavour | isSynFamilyTyCon tc = "Type family" 
-            | otherwise           = "Type synonym"
+    flavour | isTypeFamilyTyCon tc = "Type family"
+            | otherwise            = "Type synonym"
     n_args = length tys
     tc_arity  = tyConArity tc
-    check_arg | isSynFamilyTyCon tc = check_arg_type  ctxt rank
-              | otherwise           = check_mono_type ctxt synArgMonoType
+    check_arg | isTypeFamilyTyCon tc = check_arg_type  ctxt rank
+              | otherwise            = check_mono_type ctxt synArgMonoType
          
 ----------------------------------------
 check_ubx_tuple :: UserTypeCtxt -> KindOrType 
index bc21e2e..feef835 100644 (file)
@@ -709,7 +709,7 @@ lookup_fam_inst_env' match_fun ie fam match_tys
     -- Deal with over-saturation
     -- See Note [Over-saturated matches]
     split_tys tpl_tys
-      | isSynFamilyTyCon fam
+      | isTypeFamilyTyCon fam
       = pre_rough_split_tys
 
       | otherwise
@@ -812,7 +812,7 @@ reduceTyFamApp_maybe envs role tc tys
 
   | case role of
        Representational -> isOpenFamilyTyCon    tc
-       _                -> isOpenSynFamilyTyCon tc
+       _                -> isOpenTypeFamilyTyCon tc
        -- If we seek a representational coercion
        -- (e.g. the call in topNormaliseType_maybe) then we can
        -- unwrap data families as well as type-synonym families;
index 39543b3..4e399db 100644 (file)
@@ -14,7 +14,7 @@ module TyCon(
 
         AlgTyConRhs(..), visibleDataCons,
         TyConParent(..), isNoParent,
-        SynTyConRhs(..), Role(..),
+        FamTyConFlav(..), Role(..),
 
         -- ** Constructing TyCons
         mkAlgTyCon,
@@ -24,7 +24,8 @@ module TyCon(
         mkKindTyCon,
         mkLiftedPrimTyCon,
         mkTupleTyCon,
-        mkSynTyCon,
+        mkSynonymTyCon,
+        mkFamilyTyCon,
         mkPromotedDataCon,
         mkPromotedTyCon,
 
@@ -34,7 +35,7 @@ module TyCon(
         isFunTyCon,
         isPrimTyCon,
         isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon,
-        isSynTyCon, isTypeSynonymTyCon,
+        isTypeSynonymTyCon,
         isDecomposableTyCon,
         isPromotedDataCon, isPromotedTyCon,
         isPromotedDataCon_maybe, isPromotedTyCon_maybe,
@@ -44,8 +45,8 @@ module TyCon(
         isEnumerationTyCon,
         isNewTyCon, isAbstractTyCon,
         isFamilyTyCon, isOpenFamilyTyCon,
-        isSynFamilyTyCon, isDataFamilyTyCon,
-        isOpenSynFamilyTyCon, isClosedSynFamilyTyCon_maybe,
+        isTypeFamilyTyCon, isDataFamilyTyCon,
+        isOpenTypeFamilyTyCon, isClosedSynFamilyTyCon_maybe,
         isBuiltInSynFamTyCon_maybe,
         isUnLiftedTyCon,
         isGadtSyntaxTyCon, isDistinctTyCon, isDistinctAlgRhs,
@@ -68,7 +69,7 @@ module TyCon(
         tyConParent,
         tyConTuple_maybe, tyConClass_maybe,
         tyConFamInst_maybe, tyConFamInstSig_maybe, tyConFamilyCoercion_maybe,
-        synTyConDefn_maybe, synTyConRhs_maybe, 
+        synTyConDefn_maybe, synTyConRhs_maybe, famTyConFlav_maybe,
         algTyConRhs,
         newTyConRhs, newTyConEtadArity, newTyConEtadRhs, 
         unwrapNewTyCon_maybe, unwrapNewTyConEtad_maybe,
@@ -125,7 +126,7 @@ Note [Type synonym families]
         type instance F Int = Bool
         ..etc...
 
-* Reply "yes" to isSynFamilyTyCon, and isFamilyTyCon
+* Reply "yes" to isTypeFamilyTyCon, and isFamilyTyCon
 
 * From the user's point of view (F Int) and Bool are simply
   equivalent types.
@@ -322,10 +323,18 @@ N.
 data TyCon
   = -- | The function type constructor, @(->)@
     FunTyCon {
-        tyConUnique :: Unique,
-        tyConName   :: Name,
-        tc_kind   :: Kind,
-        tyConArity  :: Arity
+        tyConUnique :: Unique,   -- ^ A Unique of this TyCon. Invariant:
+                                 -- identical to Unique of Name stored in
+                                 -- tyConName field.
+
+        tyConName   :: Name,     -- ^ Name of the constructor
+
+        tyConKind   :: Kind,     -- ^ Kind of this TyCon (full kind, not just
+                                 -- the return kind)
+
+        tyConArity  :: Arity     -- ^ Number of arguments this TyCon must
+                                 -- receive to be considered saturated
+                                 -- (including implicit kind variables)
     }
 
   -- | Algebraic type constructors, which are defined to be those
@@ -333,82 +342,156 @@ data TyCon
   -- constructors are lifted and boxed. See 'AlgTyConRhs' for more
   -- information.
   | AlgTyCon {
-        tyConUnique :: Unique,
-        tyConName   :: Name,
-        tc_kind     :: Kind,
-        tyConArity  :: Arity,
-
-        tyConTyVars :: [TyVar],   -- ^ The kind and type variables used in the type constructor.
-                                  -- Invariant: length tyvars = arity
-                                  -- Precisely, this list scopes over:
-                                  --
-                                  -- 1. The 'algTcStupidTheta'
-                                  -- 2. The cached types in 'algTyConRhs.NewTyCon'
-                                  -- 3. The family instance types if present
-                                  --
-                                  -- Note that it does /not/ scope over the data constructors.
-        tc_roles     :: [Role],   -- ^ The role for each type variable
-                                  -- This list has the same length as tyConTyVars
-                                  -- See also Note [TyCon Role signatures]
-        
-        tyConCType   :: Maybe CType, -- The C type that should be used
-                                     -- for this type when using the FFI
-                                     -- and CAPI
-
-        algTcGadtSyntax  :: Bool,       -- ^ Was the data type declared with GADT syntax?
-                                        -- If so, that doesn't mean it's a true GADT;
-                                        -- only that the "where" form was used.
-                                        -- This field is used only to guide pretty-printing
-
-        algTcStupidTheta :: [PredType], -- ^ The \"stupid theta\" for the data type
-                                        -- (always empty for GADTs).
-                                        -- A \"stupid theta\" is the context to the left
-                                        -- of an algebraic type declaration,
-                                        -- e.g. @Eq a@ in the declaration
-                                        --    @data Eq a => T a ...@.
-
-        algTcRhs :: AlgTyConRhs,  -- ^ Contains information about the
-                                  -- data constructors of the algebraic type
-
-        algTcRec :: RecFlag,      -- ^ Tells us whether the data type is part
-                                  -- of a mutually-recursive group or not
-
-        algTcParent :: TyConParent,     -- ^ Gives the class or family declaration 'TyCon'
-                                        -- for derived 'TyCon's representing class
-                                        -- or family instances, respectively.
-                                        -- See also 'synTcParent'
-        
-        tcPromoted :: Maybe TyCon    -- ^ Promoted TyCon, if any
+        tyConUnique  :: Unique,  -- ^ A Unique of this TyCon. Invariant:
+                                 -- identical to Unique of Name stored in
+                                 -- tyConName field.
+
+        tyConName    :: Name,    -- ^ Name of the constructor
+
+        tyConKind    :: Kind,    -- ^ Kind of this TyCon (full kind, not just
+                                 -- the return kind)
+
+        tyConArity   :: Arity,   -- ^ Number of arguments this TyCon must
+                                 -- receive to be considered saturated
+                                 -- (including implicit kind variables)
+
+        tyConTyVars  :: [TyVar], -- ^ The kind and type variables used in the
+                                 -- type constructor.
+                                 -- Invariant: length tyvars = arity
+                                 -- Precisely, this list scopes over:
+                                 --
+                                 -- 1. The 'algTcStupidTheta'
+                                 -- 2. The cached types in algTyConRhs.NewTyCon
+                                 -- 3. The family instance types if present
+                                 --
+                                 -- Note that it does /not/ scope over the data
+                                 -- constructors.
+
+        tcRoles      :: [Role],  -- ^ The role for each type variable
+                                 -- This list has the same length as tyConTyVars
+                                 -- See also Note [TyCon Role signatures]
+
+        tyConCType   :: Maybe CType,-- ^ The C type that should be used
+                                    -- for this type when using the FFI
+                                    -- and CAPI
+
+        algTcGadtSyntax  :: Bool,   -- ^ Was the data type declared with GADT
+                                    -- syntax?  If so, that doesn't mean it's a
+                                    -- true GADT; only that the "where" form
+                                    -- was used.  This field is used only to
+                                    -- guide pretty-printing
+
+        algTcStupidTheta :: [PredType], -- ^ The \"stupid theta\" for the data
+                                        -- type (always empty for GADTs).  A
+                                        -- \"stupid theta\" is the context to
+                                        -- the left of an algebraic type
+                                        -- declaration, e.g. @Eq a@ in the
+                                        -- declaration @data Eq a => T a ...@.
+
+        algTcRhs    :: AlgTyConRhs, -- ^ Contains information about the
+                                    -- data constructors of the algebraic type
+
+        algTcRec    :: RecFlag,     -- ^ Tells us whether the data type is part
+                                    -- of a mutually-recursive group or not
+
+        algTcParent :: TyConParent, -- ^ Gives the class or family declaration
+                                    -- 'TyCon' for derived 'TyCon's representing
+                                    -- class or family instances, respectively.
+                                    -- See also 'synTcParent'
+
+        tcPromoted  :: Maybe TyCon  -- ^ Promoted TyCon, if any
     }
 
   -- | Represents the infinite family of tuple type constructors,
   --   @()@, @(a,b)@, @(# a, b #)@ etc.
   | TupleTyCon {
-        tyConUnique    :: Unique,
-        tyConName      :: Name,
-        tc_kind        :: Kind,
-        tyConArity     :: Arity,
-        tyConTupleSort :: TupleSort,
-        tyConTyVars    :: [TyVar],
-        dataCon        :: DataCon, -- ^ Corresponding tuple data constructor
-        tcPromoted     :: Maybe TyCon    -- Nothing for unboxed tuples
+        tyConUnique    :: Unique,   -- ^ A Unique of this TyCon. Invariant:
+                                    -- identical to Unique of Name stored in
+                                    -- tyConName field.
+
+        tyConName      :: Name,     -- ^ Name of the constructor
+
+        tyConKind      :: Kind,     -- ^ Kind of this TyCon (full kind, not just
+                                    -- the return kind)
+
+        tyConArity     :: Arity,    -- ^ Number of arguments this TyCon must
+                                    -- receive to be considered saturated
+                                    -- (including implicit kind variables)
+
+        tyConTupleSort :: TupleSort,-- ^ Is this a boxed, unboxed or constraint
+                                    -- tuple?
+
+        tyConTyVars    :: [TyVar],  -- ^ List of type and kind variables in this
+                                    -- TyCon. Includes implicit kind variables.
+                                    -- Invariant:
+                                    -- length tyConTyVars = tyConArity
+
+        dataCon        :: DataCon,  -- ^ Corresponding tuple data constructor
+
+        tcPromoted     :: Maybe TyCon
+                                    -- ^ Nothing for unboxed tuples
     }
 
   -- | Represents type synonyms
-  | SynTyCon {
-        tyConUnique  :: Unique,
-        tyConName    :: Name,
-        tc_kind    :: Kind,
-        tyConArity   :: Arity,
+  | SynonymTyCon {
+        tyConUnique  :: Unique,  -- ^ A Unique of this TyCon. Invariant:
+                                 -- identical to Unique of Name stored in
+                                 -- tyConName field.
+
+        tyConName    :: Name,    -- ^ Name of the constructor
+
+        tyConKind    :: Kind,    -- ^ Kind of this TyCon (full kind, not just
+                                 -- the return kind)
+
+        tyConArity   :: Arity,   -- ^ Number of arguments this TyCon must
+                                 -- receive to be considered saturated
+                                 -- (including implicit kind variables)
+
+        tyConTyVars  :: [TyVar], -- ^ List of type and kind variables in this
+                                 -- TyCon. Includes implicit kind variables.
+                                 -- Invariant: length tyConTyVars = tyConArity
+
+        tcRoles      :: [Role],  -- ^ The role for each type variable
+                                 -- This list has the same length as tyConTyVars
+                                 -- See also Note [TyCon Role signatures]
+
+        synTcRhs     :: Type     -- ^ Contains information about the expansion
+                                 -- of the synonym
+    }
 
-        tyConTyVars  :: [TyVar],        -- Bound tyvars
-        tc_roles     :: [Role],
+  -- | Represents type families
+  | FamilyTyCon {
+        tyConUnique  :: Unique,  -- ^ A Unique of this TyCon. Invariant:
+                                 -- identical to Unique of Name stored in
+                                 -- tyConName field.
 
-        synTcRhs     :: SynTyConRhs,       -- ^ Contains information about the
-                                           -- expansion of the synonym
+        tyConName    :: Name,    -- ^ Name of the constructor
 
-        synTcParent  :: TyConParent     -- ^ Gives the family declaration 'TyCon'
-                                        -- of 'TyCon's representing family instances
+        tyConKind    :: Kind,    -- ^ Kind of this TyCon (full kind, not just
+                                 -- the return kind)
+
+        tyConArity   :: Arity,   -- ^ Number of arguments this TyCon must
+                                 -- receive to be considered saturated
+                                 -- (including implicit kind variables)
+
+        tyConTyVars  :: [TyVar], -- ^ The kind and type variables used in the
+                                 -- type constructor.
+                                 -- Invariant: length tyvars = arity
+                                 -- Precisely, this list scopes over:
+                                 --
+                                 -- 1. The 'algTcStupidTheta'
+                                 -- 2. The cached types in 'algTyConRhs.NewTyCon'
+                                 -- 3. The family instance types if present
+                                 --
+                                 -- Note that it does /not/ scope over the data
+                                 -- constructors.
+
+        famTcFlav    :: FamTyConFlav, -- ^ Type family flavour: open, closed,
+                                      -- abstract, built-in. See comments for
+                                      -- FamTyConFlav
+
+        famTcParent  :: TyConParent   -- ^ TyCon of enclosing class for
+                                      -- associated type families
 
     }
 
@@ -416,30 +499,40 @@ data TyCon
   -- the usual suspects (such as @Int#@) as well as foreign-imported
   -- types and kinds
   | PrimTyCon {
-        tyConUnique   :: Unique,
-        tyConName     :: Name,
-        tc_kind       :: Kind,
-        tyConArity    :: Arity,         
-        tc_roles      :: [Role],
-
-        primTyConRep  :: PrimRep,       -- ^ Many primitive tycons are unboxed, but some are
-                                        --   boxed (represented by pointers). This 'PrimRep'
-                                        --   holds that information.
-                                        -- Only relevant if tc_kind = *
-
-        isUnLifted   :: Bool            -- ^ Most primitive tycons are unlifted
-                                        --   (may not contain bottom)
-                                        --   but other are lifted,
-                                        --   e.g. @RealWorld@
+        tyConUnique   :: Unique, -- ^ A Unique of this TyCon. Invariant:
+                                 -- identical to Unique of Name stored in
+                                 -- tyConName field.
+
+        tyConName     :: Name,   -- ^ Name of the constructor
+
+        tyConKind     :: Kind,   -- ^ Kind of this TyCon (full kind, not just
+                                 -- the return kind)
+
+        tyConArity    :: Arity,  -- ^ Number of arguments this TyCon must
+                                 -- receive to be considered saturated
+                                 -- (including implicit kind variables)
+
+        tcRoles       :: [Role], -- ^ The role for each type variable
+                                 -- This list has the same length as tyConTyVars
+                                 -- See also Note [TyCon Role signatures]
+
+        primTyConRep  :: PrimRep,-- ^ Many primitive tycons are unboxed, but
+                                 -- some are boxed (represented by
+                                 -- pointers). This 'PrimRep' holds that
+                                 -- information.  Only relevant if tyConKind = *
+
+        isUnLifted   :: Bool     -- ^ Most primitive tycons are unlifted (may
+                                 -- not contain bottom) but other are lifted,
+                                 -- e.g. @RealWorld@
     }
 
   -- | Represents promoted data constructor.
-  | PromotedDataCon {         -- See Note [Promoted data constructors]
+  | PromotedDataCon {          -- See Note [Promoted data constructors]
         tyConUnique :: Unique, -- ^ Same Unique as the data constructor
         tyConName   :: Name,   -- ^ Same Name as the data constructor
         tyConArity  :: Arity,
-        tc_roles    :: [Role], -- ^ Roles: N for kind vars, R for type vars
-        tc_kind     :: Kind,   -- ^ Translated type of the data constructor
+        tyConKind   :: Kind,   -- ^ Translated type of the data constructor
+        tcRoles     :: [Role], -- ^ Roles: N for kind vars, R for type vars
         dataCon     :: DataCon -- ^ Corresponding data constructor
     }
 
@@ -448,7 +541,7 @@ data TyCon
         tyConUnique :: Unique, -- ^ Same Unique as the type constructor
         tyConName   :: Name,   -- ^ Same Name as the type constructor
         tyConArity  :: Arity,  -- ^ n if ty_con :: * -> ... -> *  n times
-        tc_kind     :: Kind,   -- ^ Always TysPrim.superKind
+        tyConKind   :: Kind,   -- ^ Always TysPrim.superKind
         ty_con      :: TyCon   -- ^ Corresponding type constructor
     }
 
@@ -615,15 +708,9 @@ isNoParent _             = False
 --------------------
 
 -- | Information pertaining to the expansion of a type synonym (@type@)
-data SynTyConRhs
-  = -- | An ordinary type synonyn.
-    SynonymTyCon
-       Type           -- This 'Type' is the rhs, and may mention from 'tyConTyVars'.
-                      -- It acts as a template for the expansion when the 'TyCon'
-                      -- is applied to some types.
-
-   -- | An open type synonym family  e.g. @type family F x y :: * -> *@
-   | OpenSynFamilyTyCon 
+data FamTyConFlav
+  = -- | An open type synonym family  e.g. @type family F x y :: * -> *@
+     OpenSynFamilyTyCon
 
    -- | A closed type synonym family  e.g. @type family F x where { F Int = Bool }@
    | ClosedSynFamilyTyCon
@@ -633,6 +720,7 @@ data SynTyConRhs
    -- type family F a where ..
    | AbstractClosedSynFamilyTyCon
 
+   -- | Built-in type family used by the TypeNats solver
    | BuiltInSynFamTyCon BuiltInSynFamily
 \end{code}
 
@@ -663,7 +751,7 @@ via the PromotedTyCon alternative in TyCon.
     type of DataCon           Just :: forall (a:*). a -> Maybe a
     kind of (promoted) tycon  Just :: forall (a:box). a -> Maybe a
   The kind is not identical to the type, because of the */box
-  kind signature on the forall'd variable; so the tc_kind field of
+  kind signature on the forall'd variable; so the tyConKind field of
   PromotedTyCon is not identical to the dataConUserType of the
   DataCon.  But it's the same modulo changing the variable kinds,
   done by DataCon.promoteType.
@@ -913,7 +1001,7 @@ mkFunTyCon name kind
   = FunTyCon {
         tyConUnique = nameUnique name,
         tyConName   = name,
-        tc_kind   = kind,
+        tyConKind   = kind,
         tyConArity  = 2
     }
 
@@ -939,10 +1027,10 @@ mkAlgTyCon name kind tyvars roles cType stupid rhs parent is_rec gadt_syn prom_t
   = AlgTyCon {
         tyConName        = name,
         tyConUnique      = nameUnique name,
-        tc_kind          = kind,
+        tyConKind        = kind,
         tyConArity       = length tyvars,
         tyConTyVars      = tyvars,
-        tc_roles         = roles,
+        tcRoles          = roles,
         tyConCType       = cType,
         algTcStupidTheta = stupid,
         algTcRhs         = rhs,
@@ -971,7 +1059,7 @@ mkTupleTyCon name kind arity tyvars con sort prom_tc
   = TupleTyCon {
         tyConUnique = nameUnique name,
         tyConName = name,
-        tc_kind = kind,
+        tyConKind = kind,
         tyConArity = arity,
         tyConTupleSort = sort,
         tyConTyVars = tyvars,
@@ -999,27 +1087,41 @@ mkPrimTyCon' name kind roles rep is_unlifted
   = PrimTyCon {
         tyConName    = name,
         tyConUnique  = nameUnique name,
-        tc_kind    = kind,
+        tyConKind    = kind,
         tyConArity   = length roles,
-        tc_roles     = roles,
+        tcRoles      = roles,
         primTyConRep = rep,
         isUnLifted   = is_unlifted
     }
 
 -- | Create a type synonym 'TyCon'
-mkSynTyCon :: Name -> Kind -> [TyVar] -> [Role] -> SynTyConRhs -> TyConParent -> TyCon
-mkSynTyCon name kind tyvars roles rhs parent
-  = SynTyCon {
-        tyConName = name,
+mkSynonymTyCon :: Name -> Kind -> [TyVar] -> [Role] -> Type -> TyCon
+mkSynonymTyCon name kind tyvars roles rhs
+  = SynonymTyCon {
+        tyConName   = name,
         tyConUnique = nameUnique name,
-        tc_kind = kind,
-        tyConArity = length tyvars,
+        tyConKind   = kind,
+        tyConArity  = length tyvars,
         tyConTyVars = tyvars,
-        tc_roles = roles,
-        synTcRhs = rhs,
-        synTcParent = parent
+        tcRoles     = roles,
+        synTcRhs    = rhs
     }
 
+-- | Create a type family 'TyCon'
+mkFamilyTyCon:: Name -> Kind -> [TyVar] -> FamTyConFlav -> TyConParent
+             -> TyCon
+mkFamilyTyCon name kind tyvars flav parent
+  = FamilyTyCon
+      { tyConUnique = nameUnique name
+      , tyConName   = name
+      , tyConKind   = kind
+      , tyConArity  = length tyvars
+      , tyConTyVars = tyvars
+      , famTcFlav   = flav
+      , famTcParent = parent
+      }
+
+
 -- | Create a promoted data constructor 'TyCon'
 -- Somewhat dodgily, we give it the same Name
 -- as the data constructor itself; when we pretty-print
@@ -1030,8 +1132,8 @@ mkPromotedDataCon con name unique kind roles
         tyConName   = name,
         tyConUnique = unique,
         tyConArity  = arity,
-        tc_roles    = roles,
-        tc_kind     = kind,
+        tcRoles     = roles,
+        tyConKind   = kind,
         dataCon     = con
   }
   where
@@ -1046,7 +1148,7 @@ mkPromotedTyCon tc kind
         tyConName   = getName tc,
         tyConUnique = getUnique tc,
         tyConArity  = tyConArity tc,
-        tc_kind     = kind,
+        tyConKind   = kind,
         ty_con      = tc
   }
 \end{code}
@@ -1174,13 +1276,8 @@ isDataProductTyCon_maybe _ = Nothing
 
 -- | Is this a 'TyCon' representing a regular H98 type synonym (@type@)?
 isTypeSynonymTyCon :: TyCon -> Bool
-isTypeSynonymTyCon (SynTyCon { synTcRhs = SynonymTyCon {} }) = True
-isTypeSynonymTyCon _ = False
-
--- | Is this 'TyCon' a type synonym or type family?
-isSynTyCon :: TyCon -> Bool
-isSynTyCon (SynTyCon {}) = True
-isSynTyCon _             = False
+isTypeSynonymTyCon (SynonymTyCon {}) = True
+isTypeSynonymTyCon _                 = False
 
 
 -- As for newtypes, it is in some contexts important to distinguish between
@@ -1198,8 +1295,9 @@ isDecomposableTyCon :: TyCon -> Bool
 -- It'd be unusual to call isDecomposableTyCon on a regular H98
 -- type synonym, because you should probably have expanded it first
 -- But regardless, it's not decomposable
-isDecomposableTyCon (SynTyCon {}) = False
-isDecomposableTyCon _other        = True
+isDecomposableTyCon (SynonymTyCon {}) = False
+isDecomposableTyCon (FamilyTyCon  {}) = False
+isDecomposableTyCon _other            = True
 
 -- | Is this an algebraic 'TyCon' declared with the GADT syntax?
 isGadtSyntaxTyCon :: TyCon -> Bool
@@ -1215,42 +1313,36 @@ isEnumerationTyCon _                                                   = False
 
 -- | Is this a 'TyCon', synonym or otherwise, that defines a family?
 isFamilyTyCon :: TyCon -> Bool
-isFamilyTyCon (SynTyCon {synTcRhs = OpenSynFamilyTyCon })              = True
-isFamilyTyCon (SynTyCon {synTcRhs = ClosedSynFamilyTyCon {} })         = True
-isFamilyTyCon (SynTyCon {synTcRhs = AbstractClosedSynFamilyTyCon {} }) = True
-isFamilyTyCon (SynTyCon {synTcRhs = BuiltInSynFamTyCon {} })           = True
-isFamilyTyCon (AlgTyCon {algTcRhs = DataFamilyTyCon {}})               = True
-isFamilyTyCon _ = False
-
--- | Is this a 'TyCon', synonym or otherwise, that defines an family with
+isFamilyTyCon (FamilyTyCon {})                           = True
+isFamilyTyCon (AlgTyCon {algTcRhs = DataFamilyTyCon {}}) = True
+isFamilyTyCon _                                          = False
+
+-- | Is this a 'TyCon', synonym or otherwise, that defines a family with
 -- instances?
 isOpenFamilyTyCon :: TyCon -> Bool
-isOpenFamilyTyCon (SynTyCon {synTcRhs = OpenSynFamilyTyCon }) = True
-isOpenFamilyTyCon (AlgTyCon {algTcRhs = DataFamilyTyCon })    = True
-isOpenFamilyTyCon _ = False
+isOpenFamilyTyCon (FamilyTyCon {famTcFlav = OpenSynFamilyTyCon }) = True
+isOpenFamilyTyCon (AlgTyCon    {algTcRhs  = DataFamilyTyCon    }) = True
+isOpenFamilyTyCon _                                               = False
 
 -- | Is this a synonym 'TyCon' that can have may have further instances appear?
-isSynFamilyTyCon :: TyCon -> Bool
-isSynFamilyTyCon (SynTyCon {synTcRhs = OpenSynFamilyTyCon {}})           = True
-isSynFamilyTyCon (SynTyCon {synTcRhs = ClosedSynFamilyTyCon {}})         = True
-isSynFamilyTyCon (SynTyCon {synTcRhs = AbstractClosedSynFamilyTyCon {}}) = True
-isSynFamilyTyCon (SynTyCon {synTcRhs = BuiltInSynFamTyCon {}})           = True
-isSynFamilyTyCon _ = False
+isTypeFamilyTyCon :: TyCon -> Bool
+isTypeFamilyTyCon (FamilyTyCon {}) = True
+isTypeFamilyTyCon _                = False
 
-isOpenSynFamilyTyCon :: TyCon -> Bool
-isOpenSynFamilyTyCon (SynTyCon {synTcRhs = OpenSynFamilyTyCon }) = True
-isOpenSynFamilyTyCon _ = False
+isOpenTypeFamilyTyCon :: TyCon -> Bool
+isOpenTypeFamilyTyCon (FamilyTyCon {famTcFlav = OpenSynFamilyTyCon }) = True
+isOpenTypeFamilyTyCon _                                               = False
 
 -- leave out abstract closed families here
 isClosedSynFamilyTyCon_maybe :: TyCon -> Maybe (CoAxiom Branched)
 isClosedSynFamilyTyCon_maybe
-  (SynTyCon {synTcRhs = ClosedSynFamilyTyCon ax}) = Just ax
-isClosedSynFamilyTyCon_maybe _ = Nothing
+  (FamilyTyCon {famTcFlav = ClosedSynFamilyTyCon ax}) = Just ax
+isClosedSynFamilyTyCon_maybe _                        = Nothing
 
 isBuiltInSynFamTyCon_maybe :: TyCon -> Maybe BuiltInSynFamily
 isBuiltInSynFamTyCon_maybe
-  SynTyCon {synTcRhs = BuiltInSynFamTyCon ops } = Just ops
-isBuiltInSynFamTyCon_maybe _ = Nothing
+  (FamilyTyCon {famTcFlav = BuiltInSynFamTyCon ops }) = Just ops
+isBuiltInSynFamTyCon_maybe _                          = Nothing
 
 -- | Is this a synonym 'TyCon' that can have may have further instances appear?
 isDataFamilyTyCon :: TyCon -> Bool
@@ -1357,10 +1449,11 @@ isImplicitTyCon (TupleTyCon {})      = True
 isImplicitTyCon (PrimTyCon {})       = True
 isImplicitTyCon (PromotedDataCon {}) = True
 isImplicitTyCon (PromotedTyCon {})   = True
-isImplicitTyCon (AlgTyCon { algTcParent = AssocFamilyTyCon {} }) = True
-isImplicitTyCon (AlgTyCon {})                                    = False
-isImplicitTyCon (SynTyCon { synTcParent = AssocFamilyTyCon {} }) = True
-isImplicitTyCon (SynTyCon {})                                    = False
+isImplicitTyCon (AlgTyCon { algTcParent = AssocFamilyTyCon {} })    = True
+isImplicitTyCon (AlgTyCon {})                                       = False
+isImplicitTyCon (FamilyTyCon { famTcParent = AssocFamilyTyCon {} }) = True
+isImplicitTyCon (FamilyTyCon {})                                    = False
+isImplicitTyCon (SynonymTyCon {})                                   = False
 
 tyConCType_maybe :: TyCon -> Maybe CType
 tyConCType_maybe tc@(AlgTyCon {}) = tyConCType tc
@@ -1384,8 +1477,8 @@ tcExpandTyCon_maybe, coreExpandTyCon_maybe
 
 -- ^ Used to create the view the /typechecker/ has on 'TyCon's.
 -- We expand (closed) synonyms only, cf. 'coreExpandTyCon_maybe'
-tcExpandTyCon_maybe (SynTyCon {tyConTyVars = tvs,
-                               synTcRhs = SynonymTyCon rhs }) tys
+tcExpandTyCon_maybe (SynonymTyCon { tyConTyVars = tvs
+                                  , synTcRhs    = rhs }) tys
    = expand tvs rhs tys
 tcExpandTyCon_maybe _ _ = Nothing
 
@@ -1411,9 +1504,6 @@ expand tvs rhs tys
 \end{code}
 
 \begin{code}
-tyConKind :: TyCon -> Kind
-tyConKind = tc_kind
-
 -- | As 'tyConDataCons_maybe', but returns the empty list of constructors if no constructors
 -- could be found
 tyConDataCons :: TyCon -> [DataCon]
@@ -1452,13 +1542,14 @@ tyConRoles :: TyCon -> [Role]
 -- See also Note [TyCon Role signatures]
 tyConRoles tc
   = case tc of
-    { FunTyCon {}                          -> const_role Representational
-    ; AlgTyCon { tc_roles = roles }        -> roles
-    ; TupleTyCon {}                        -> const_role Representational
-    ; SynTyCon { tc_roles = roles }        -> roles
-    ; PrimTyCon { tc_roles = roles }       -> roles
-    ; PromotedDataCon { tc_roles = roles } -> roles
-    ; PromotedTyCon {}                     -> const_role Nominal
+    { FunTyCon {}                         -> const_role Representational
+    ; AlgTyCon { tcRoles = roles }        -> roles
+    ; TupleTyCon {}                       -> const_role Representational
+    ; SynonymTyCon { tcRoles = roles }    -> roles
+    ; FamilyTyCon {}                      -> const_role Nominal
+    ; PrimTyCon { tcRoles = roles }       -> roles
+    ; PromotedDataCon { tcRoles = roles } -> roles
+    ; PromotedTyCon {}                    -> const_role Nominal
     }
   where
     const_role r = replicate (tyConArity tc) r
@@ -1512,17 +1603,24 @@ tyConStupidTheta tycon = pprPanic "tyConStupidTheta" (ppr tycon)
 \end{code}
 
 \begin{code}
--- | Extract the 'TyVar's bound by a vanilla type synonym (not familiy)
+-- | Extract the 'TyVar's bound by a vanilla type synonym
 -- and the corresponding (unsubstituted) right hand side.
 synTyConDefn_maybe :: TyCon -> Maybe ([TyVar], Type)
-synTyConDefn_maybe (SynTyCon {tyConTyVars = tyvars, synTcRhs = SynonymTyCon ty})
+synTyConDefn_maybe (SynonymTyCon {tyConTyVars = tyvars, synTcRhs = ty})
   = Just (tyvars, ty)
 synTyConDefn_maybe _ = Nothing
 
--- | Extract the information pertaining to the right hand side of a type synonym (@type@) declaration.
-synTyConRhs_maybe :: TyCon -> Maybe SynTyConRhs
-synTyConRhs_maybe (SynTyCon {synTcRhs = rhs}) = Just rhs
-synTyConRhs_maybe _                           = Nothing
+-- | Extract the information pertaining to the right hand side of a type synonym
+-- (@type@) declaration.
+synTyConRhs_maybe :: TyCon -> Maybe Type
+synTyConRhs_maybe (SynonymTyCon {synTcRhs = rhs}) = Just rhs
+synTyConRhs_maybe _                               = Nothing
+
+-- | Extract the flavour of a type family (with all the extra information that
+-- it carries)
+famTyConFlav_maybe :: TyCon -> Maybe FamTyConFlav
+famTyConFlav_maybe (FamilyTyCon {famTcFlav = flav}) = Just flav
+famTyConFlav_maybe _                                = Nothing
 \end{code}
 
 \begin{code}
@@ -1562,9 +1660,9 @@ tyConTuple_maybe _                                    = Nothing
 
 ----------------------------------------------------------------------------
 tyConParent :: TyCon -> TyConParent
-tyConParent (AlgTyCon {algTcParent = parent}) = parent
-tyConParent (SynTyCon {synTcParent = parent}) = parent
-tyConParent _                                 = NoParentTyCon
+tyConParent (AlgTyCon    {algTcParent = parent}) = parent
+tyConParent (FamilyTyCon {famTcParent = parent}) = parent
+tyConParent _                                    = NoParentTyCon
 
 ----------------------------------------------------------------------------
 -- | Is this 'TyCon' that for a data family instance?
index b73d094..4643810 100644 (file)
@@ -234,7 +234,8 @@ vectTypeEnv tycons vectTypeDecls vectClassDecls
            -- warn the user about unvectorised type constructors
        ; let explanation    = ptext (sLit "(They use unsupported language extensions") $$
                               ptext (sLit "or depend on type constructors that are not vectorised)")
-             drop_tcs_nosyn = filter (not . isSynTyCon) drop_tcs
+             drop_tcs_nosyn = filter (not . isTypeFamilyTyCon) .
+                              filter (not . isTypeSynonymTyCon) $ drop_tcs
        ; unless (null drop_tcs_nosyn) $
            emitVt "Warning: cannot vectorise these type constructors:" $ 
              pprQuotedList drop_tcs_nosyn $$ explanation
@@ -356,7 +357,7 @@ vectTypeEnv tycons vectTypeDecls vectClassDecls
         origName  = tyConName origTyCon
         vectName  = tyConName vectTyCon
 
-        mkSyn canonName ty = mkSynTyCon canonName (typeKind ty) [] [] (SynonymTyCon ty) NoParentTyCon
+        mkSyn canonName ty = mkSynonymTyCon canonName (typeKind ty) [] [] ty
         
         defDataCons
           | isAbstract = return ()
index bf80e2f..1940912 160000 (submodule)
@@ -1 +1 @@
-Subproject commit bf80e2f594777c0c32fae092454bff0c13ae6181
+Subproject commit 19409126be62383bc64d79698b265ffaf96269a5