Change syntax for newtypes in External Core

[ghc-hetmet.git] / compiler / types / TyCon.lhs

diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs
index 99afac9..e6366be 100644 (file)
--- a/compiler/types/TyCon.lhs
+++ b/compiler/types/TyCon.lhs
@@ -1,7 +1,9 @@
 %
 %

+% (c) The University of Glasgow 2006

 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %

-\section[TyCon]{The @TyCon@ datatype}
+
+The @TyCon@ datatype

 
 \begin{code}
 module TyCon(
 
 \begin{code}
 module TyCon(

@@ -9,16 +11,25 @@ module TyCon(
 
        PrimRep(..),
        tyConPrimRep,
 
        PrimRep(..),
        tyConPrimRep,

+        primRepSizeW,

 
 

-       AlgTyConRhs(..), visibleDataCons,
+       AlgTyConRhs(..), visibleDataCons, 
+        TyConParent(..), 
+       SynTyConRhs(..),

 
        isFunTyCon, isUnLiftedTyCon, isProductTyCon, 
 
        isFunTyCon, isUnLiftedTyCon, isProductTyCon, 

-       isAlgTyCon, isDataTyCon, isSynTyCon, isNewTyCon, isPrimTyCon,
-       isEnumerationTyCon, isGadtSyntaxTyCon,
+       isAlgTyCon, isDataTyCon, 
+       isNewTyCon, unwrapNewTyCon_maybe, 
+       isSynTyCon, isClosedSynTyCon, isOpenSynTyCon,
+       isPrimTyCon, 
+
+       isEnumerationTyCon, isGadtSyntaxTyCon, isOpenTyCon,
+       assocTyConArgPoss_maybe, isTyConAssoc, setTyConArgPoss,

        isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, tupleTyConBoxity,
        isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, tupleTyConBoxity,

-       isRecursiveTyCon, newTyConRep, newTyConRhs, newTyConCo,
+       isRecursiveTyCon, newTyConRhs, newTyConEtadRhs, newTyConCo_maybe,

        isHiBootTyCon, isSuperKindTyCon,
         isCoercionTyCon_maybe, isCoercionTyCon,
        isHiBootTyCon, isSuperKindTyCon,
         isCoercionTyCon_maybe, isCoercionTyCon,

+        isImplicitTyCon,

 
        tcExpandTyCon_maybe, coreExpandTyCon_maybe,
 
 
        tcExpandTyCon_maybe, coreExpandTyCon_maybe,
 

@@ -46,7 +57,8 @@ module TyCon(
        tyConStupidTheta,
        tyConArity,
        isClassTyCon, tyConClass_maybe,
        tyConStupidTheta,
        tyConArity,
        isClassTyCon, tyConClass_maybe,

-       synTyConDefn, synTyConRhs,
+       isFamInstTyCon, tyConFamInst_maybe, tyConFamilyCoercion_maybe,
+       synTyConDefn, synTyConRhs, synTyConType, synTyConResKind,

        tyConExtName,           -- External name for foreign types
 
         maybeTyConSingleCon,
        tyConExtName,           -- External name for foreign types
 
         maybeTyConSingleCon,

@@ -57,17 +69,18 @@ module TyCon(
 
 #include "HsVersions.h"
 
 
 #include "HsVersions.h"
 

-import {-# SOURCE #-} TypeRep ( Kind, Type, Coercion, PredType )
+import {-# SOURCE #-} TypeRep ( Kind, Type, PredType )

 import {-# SOURCE #-} DataCon ( DataCon, isVanillaDataCon )
 
 import {-# SOURCE #-} DataCon ( DataCon, isVanillaDataCon )
 

-import Var             ( TyVar, Id )
-import Class           ( Class )
-import BasicTypes      ( Arity, RecFlag(..), Boxity(..), isBoxed )
-import Name            ( Name, nameUnique, NamedThing(getName) )
-import PrelNames       ( Unique, Uniquable(..) )
-import Maybes          ( orElse )
+import Var
+import Class
+import BasicTypes
+import Name
+import PrelNames
+import Maybes

 import Outputable
 import FastString
 import Outputable
 import FastString

+import Constants

 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************

@@ -92,11 +105,15 @@ data TyCon
        tyConName   :: Name,
        tyConKind   :: Kind,
        tyConArity  :: Arity,
        tyConName   :: Name,
        tyConKind   :: Kind,
        tyConArity  :: Arity,

-       
-       tyConTyVars :: [TyVar],         -- Scopes over (a) the [PredType] in AlgTyConRhs.DataTyCon
-                                       --             (b) the cached types in AlgTyConRhs.NewTyCon
+
+       tyConTyVars :: [TyVar],         -- Scopes over (a) the algTcStupidTheta
+                                       --             (b) the cached types in
+                                       --                 algTyConRhs.NewTyCon
+                                       --             (c) the family instance
+                                       --                 types if present

                                        -- But not over the data constructors
                                        -- But not over the data constructors

-       algTcSelIds :: [Id],            -- Its record selectors (empty if none): 
+
+       algTcSelIds :: [Id],            -- Its record selectors (empty if none)

 
        algTcGadtSyntax  :: Bool,       -- True <=> the data type was declared using GADT syntax
                                        -- That doesn't mean it's a true GADT; only that the "where"
 
        algTcGadtSyntax  :: Bool,       -- True <=> the data type was declared using GADT syntax
                                        -- That doesn't mean it's a true GADT; only that the "where"

@@ -107,14 +124,15 @@ data TyCon
 
        algTcRhs :: AlgTyConRhs,        -- Data constructors in here
 
 
        algTcRhs :: AlgTyConRhs,        -- Data constructors in here
 

-       algTcRec :: RecFlag,            -- Tells whether the data type is part of 
-                                       -- a mutually-recursive group or not
+       algTcRec :: RecFlag,            -- Tells whether the data type is part
+                                       -- of a mutually-recursive group or not

 
        hasGenerics :: Bool,            -- True <=> generic to/from functions are available
                                        -- (in the exports of the data type's source module)
 
 
        hasGenerics :: Bool,            -- True <=> generic to/from functions are available
                                        -- (in the exports of the data type's source module)
 

-       algTcClass :: Maybe Class
-               -- Just cl if this tycon came from a class declaration
+       algTcParent :: TyConParent      -- Gives the class or family tycon for
+                                       -- derived tycons representing classes
+                                       -- or family instances, respectively.

     }
 
   | TupleTyCon {
     }
 
   | TupleTyCon {

@@ -129,15 +147,19 @@ data TyCon
     }
 
   | SynTyCon {
     }
 
   | SynTyCon {

-       tyConUnique :: Unique,
-       tyConName   :: Name,
-       tyConKind   :: Kind,
-       tyConArity  :: Arity,
+       tyConUnique  :: Unique,
+       tyConName    :: Name,
+       tyConKind    :: Kind,
+       tyConArity   :: Arity,
+
+       tyConTyVars  :: [TyVar],        -- Bound tyvars
+
+       synTcRhs     :: SynTyConRhs,    -- Expanded type in here
+
+        synTcParent  :: TyConParent     -- Gives the family tycon of
+                                        -- representation tycons of family
+                                        -- instances

 
 

-       tyConTyVars :: [TyVar],         -- Bound tyvars
-       synTcRhs    :: Type             -- Right-hand side, mentioning these type vars.
-                                       -- Acts as a template for the expansion when
-                                       -- the tycon is applied to some types.

     }
 
   | PrimTyCon {                        -- Primitive types; cannot be defined in Haskell
     }
 
   | PrimTyCon {                        -- Primitive types; cannot be defined in Haskell

@@ -146,7 +168,8 @@ data TyCon
        tyConUnique   :: Unique,
        tyConName     :: Name,
        tyConKind     :: Kind,
        tyConUnique   :: Unique,
        tyConName     :: Name,
        tyConKind     :: Kind,

-       tyConArity    :: Arity,
+       tyConArity    :: Arity,         -- SLPJ Oct06: I'm not sure what the significance
+                                       --             of the arity of a primtycon is!

 
        primTyConRep  :: PrimRep,
                        -- Many primitive tycons are unboxed, but some are
 
        primTyConRep  :: PrimRep,
                        -- Many primitive tycons are unboxed, but some are

@@ -162,8 +185,10 @@ data TyCon
        tyConUnique :: Unique,
         tyConName   :: Name,
        tyConArity  :: Arity,
        tyConUnique :: Unique,
         tyConName   :: Name,
        tyConArity  :: Arity,

-       coKindFun   :: [Type] -> Kind
-    }
+       coKindFun   :: [Type] -> (Type,Type)
+    }          -- INVARIANT: coKindFun is always applied to exactly 'arity' args
+               -- E.g. for trans (c1 :: ta=tb) (c2 :: tb=tc), the coKindFun returns 
+               --      the kind as a pair of types: (ta,tc)

        
   | SuperKindTyCon {    -- Super Kinds, TY (box) and CO (diamond).
                        -- They have no kind; and arity zero
        
   | SuperKindTyCon {    -- Super Kinds, TY (box) and CO (diamond).
                        -- They have no kind; and arity zero

@@ -171,24 +196,43 @@ data TyCon
         tyConName   :: Name
     }
 
         tyConName   :: Name
     }
 

-type KindCon = TyCon
-
-type SuperKindCon = TyCon
-

 type FieldLabel = Name
 
 type FieldLabel = Name
 

+-- Right hand sides of type constructors for algebraic types
+--

 data AlgTyConRhs
 data AlgTyConRhs

-  = AbstractTyCon      -- We know nothing about this data type, except 
-                       -- that it's represented by a pointer
-                       -- Used when we export a data type abstractly into
-                       -- an hi file
+
+  -- We know nothing about this data type, except that it's represented by a
+  -- pointer.  Used when we export a data type abstractly into an hi file.
+  --
+  = AbstractTyCon
+
+  -- The constructor represents an open family without a fixed right hand
+  -- side.  Additional instances can appear at any time.
+  -- 
+  -- These are introduced by either a top level decl:
+  --   data T a :: *
+  -- or an assoicated data type decl, in a class decl:
+  --    class C a b where
+  --     data T b :: *
+
+  | OpenTyCon {
+
+      otArgPoss   :: Maybe [Int]
+       -- Nothing <=> top-level indexed type family
+       -- Just ns <=> associated (not toplevel) family
+       --   In the latter case, for each tyvar in the AT decl, 'ns' gives the
+       --   position of that tyvar in the class argument list (starting from 0).
+       --   NB: Length is less than tyConArity iff higher kind signature.
+       
+    }

 
   | DataTyCon {
        data_cons :: [DataCon],
                        -- The constructors; can be empty if the user declares
                        --   the type to have no constructors
                        -- INVARIANT: Kept in order of increasing tag
 
   | DataTyCon {
        data_cons :: [DataCon],
                        -- The constructors; can be empty if the user declares
                        --   the type to have no constructors
                        -- INVARIANT: Kept in order of increasing tag

-                       --            (see the tag assignment in DataCon.mkDataCon)
+                       --        (see the tag assignment in DataCon.mkDataCon)

        is_enum :: Bool         -- Cached: True <=> an enumeration type
     }                  --         Includes data types with no constructors.
 
        is_enum :: Bool         -- Cached: True <=> an enumeration type
     }                  --         Includes data types with no constructors.
 

@@ -199,65 +243,110 @@ data AlgTyConRhs
                                --  = the representation type of the tycon
                                -- The free tyvars of this type are the tyConTyVars
       
                                --  = the representation type of the tycon
                                -- The free tyvars of this type are the tyConTyVars
       

-        nt_co :: Maybe TyCon,   -- The coercion used to create the newtype
+        nt_co :: Maybe TyCon,   -- A CoercionTyCon used to create the newtype

                                 -- from the representation
                                 -- from the representation

-                                -- optional for non-recursive newtypes
+                                -- Optional for non-recursive newtypes

                                -- See Note [Newtype coercions]
                                -- See Note [Newtype coercions]

+                               -- Invariant: arity = #tvs in nt_etad_rhs;
+                               --      See Note [Newtype eta]
+                               -- Watch out!  If any newtypes become transparent
+                               -- again check Trac #1072.

 
 

-       nt_etad_rhs :: ([TyVar], Type) ,
+       nt_etad_rhs :: ([TyVar], Type)

                        -- The same again, but this time eta-reduced
                        -- hence the [TyVar] which may be shorter than the declared 
                        -- arity of the TyCon.  See Note [Newtype eta]
                        -- The same again, but this time eta-reduced
                        -- hence the [TyVar] which may be shorter than the declared 
                        -- arity of the TyCon.  See Note [Newtype eta]

-
-       nt_rep :: Type  -- Cached: the *ultimate* representation type
-                       -- By 'ultimate' I mean that the top-level constructor
-                       -- of the rep type is not itself a newtype or type synonym.
-                       -- The rep type isn't entirely simple:
-                       --  for a recursive newtype we pick () as the rep type
-                       --      newtype T = MkT T
-                       -- 
-                       -- This one does not need to be eta reduced; hence its
-                       -- free type variables are conveniently tyConTyVars
-                       -- Thus:
-                       --      newtype T a = MkT [(a,Int)]
-                       -- The rep type is [(a,Int)]
-                       -- NB: the rep type isn't necessarily the original RHS of the
-                       --     newtype decl, because the rep type looks through other
-    }                  --     newtypes.
+    }

 
 visibleDataCons :: AlgTyConRhs -> [DataCon]
 visibleDataCons AbstractTyCon                = []
 
 visibleDataCons :: AlgTyConRhs -> [DataCon]
 visibleDataCons AbstractTyCon                = []

+visibleDataCons OpenTyCon {}                 = []

 visibleDataCons (DataTyCon{ data_cons = cs }) = cs
 visibleDataCons (NewTyCon{ data_con = c })    = [c]
 visibleDataCons (DataTyCon{ data_cons = cs }) = cs
 visibleDataCons (NewTyCon{ data_con = c })    = [c]

+
+-- Both type classes as well as family instances imply implicit
+-- type constructors.  These implicit type constructors refer to their parent
+-- structure (ie, the class or family from which they derive) using a type of
+-- the following form.  We use `TyConParent' for both algebraic and synonym 
+-- types, but the variant `ClassTyCon' will only be used by algebraic tycons.
+
+data TyConParent 
+  = NoParentTyCon      -- An ordinary type constructor has no parent.
+
+  | ClassTyCon         -- Type constructors representing a class dictionary.
+       Class           -- INVARIANT: the classTyCon of this Class is the current tycon
+
+  | FamilyTyCon                -- Type constructors representing an instance of a type
+       TyCon           --   The type family
+       [Type]          --   Instance types; free variables are the tyConTyVars
+                       --      of the current TyCon (not the family one)
+                       --      INVARIANT: the number of types matches the arity 
+                       --                 of the family tycon
+       TyCon           --   A CoercionTyCon identifying the representation 
+                       --     type with the type instance family.  
+                       --      c.f. Note [Newtype coercions]
+
+       --
+       -- E.g.  data intance T [a] = ...
+       -- gives a representation tycon:
+       --      data :R7T a = ...
+       --      axiom co a :: T [a] ~ :R7T a
+       -- with :R7T's algTcParent = FamilyTyCon T [a] co
+
+okParent :: Name -> TyConParent -> Bool        -- Checks invariants
+okParent _       NoParentTyCon                   = True
+okParent tc_name (ClassTyCon cls)                = tyConName (classTyCon cls) == tc_name
+okParent _       (FamilyTyCon fam_tc tys _co_tc) = tyConArity fam_tc == length tys
+
+--------------------
+data SynTyConRhs
+  = OpenSynTyCon Kind          -- Type family: *result* kind given
+                (Maybe [Int])  -- for associated families: for each tyvars in
+                               -- the AT decl, gives the position of that
+                               -- tyvar in the class argument list (starting
+                               -- from 0). 
+                               -- NB: Length is less than tyConArity
+                               --     if higher kind signature.
+
+  | SynonymTyCon Type   -- Mentioning head type vars.  Acts as a template for
+                       --  the expansion when the tycon is applied to some
+                       --  types.

 \end{code}
 
 Note [Newtype coercions]
 ~~~~~~~~~~~~~~~~~~~~~~~~
 \end{code}
 
 Note [Newtype coercions]
 ~~~~~~~~~~~~~~~~~~~~~~~~

-

 The NewTyCon field nt_co is a a TyCon (a coercion constructor in fact)
 which is used for coercing from the representation type of the
 newtype, to the newtype itself. For example,
 
 The NewTyCon field nt_co is a a TyCon (a coercion constructor in fact)
 which is used for coercing from the representation type of the
 newtype, to the newtype itself. For example,
 

-   newtype T a = MkT [a]
+   newtype T a = MkT (a -> a)
+
+the NewTyCon for T will contain nt_co = CoT where CoT t : T t :=: t ->
+t.  This TyCon is a CoercionTyCon, so it does not have a kind on its
+own; it basically has its own typing rule for the fully-applied
+version.  If the newtype T has k type variables then CoT has arity at
+most k.  In the case that the right hand side is a type application
+ending with the same type variables as the left hand side, we
+"eta-contract" the coercion.  So if we had
+
+   newtype S a = MkT [a]

 
 

-the NewTyCon for T will contain nt_co = CoT where CoT t : [t] :=: T t.
-This TyCon is a CoercionTyCon, so it does not have a kind on its own;
-it basically has its own typing rule for the fully-applied version.
-If the newtype T has k type variables then CoT has arity k.
+then we would generate the arity 0 coercion CoS : S :=: [].  The
+primary reason we do this is to make newtype deriving cleaner.

 
 In the paper we'd write
 
 In the paper we'd write

-       axiom CoT : (forall t. [t]) :=: (forall t. T t)
+       axiom CoT : (forall t. T t) :=: (forall t. [t])

 and then when we used CoT at a particular type, s, we'd say
        CoT @ s
 which encodes as (TyConApp instCoercionTyCon [TyConApp CoT [], s])
 
 and then when we used CoT at a particular type, s, we'd say
        CoT @ s
 which encodes as (TyConApp instCoercionTyCon [TyConApp CoT [], s])
 

-But in GHC we instead make CoT into a new piece of type syntax
+But in GHC we instead make CoT into a new piece of type syntax, CoercionTyCon,

 (like instCoercionTyCon, symCoercionTyCon etc), which must always
 be saturated, but which encodes as
 (like instCoercionTyCon, symCoercionTyCon etc), which must always
 be saturated, but which encodes as

-       TyConAp CoT [s]
+       TyConApp CoT [s]

 In the vocabulary of the paper it's as if we had axiom declarations
 like
 In the vocabulary of the paper it's as if we had axiom declarations
 like

-       axiom CoT t : ([t] :=: T t)
+       axiom CoT t :  T t :=: [t]

 
 Note [Newtype eta]
 ~~~~~~~~~~~~~~~~~~
 
 Note [Newtype eta]
 ~~~~~~~~~~~~~~~~~~

@@ -283,12 +372,53 @@ Source code:
        w2 :: Foo T
        w2 = MkFoo (\(MkT x) -> case w1 of MkFoo f -> f x)
 
        w2 :: Foo T
        w2 = MkFoo (\(MkT x) -> case w1 of MkFoo f -> f x)
 

-After desugaring, and discading the data constructors for the newtypes,
+After desugaring, and discarding the data constructors for the newtypes,

 we get:
        w2 :: Foo T
        w2 = w1
 And now Lint complains unless Foo T == Foo [], and that requires T==[]
 
 we get:
        w2 :: Foo T
        w2 = w1
 And now Lint complains unless Foo T == Foo [], and that requires T==[]
 

+This point carries over to the newtype coercion, because we need to
+say 
+       w2 = w1 `cast` Foo CoT
+
+so the coercion tycon CoT must have 
+       kind:    T ~ []
+ and   arity:   0
+
+
+Note [Indexed data types] (aka data type families)
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   See also Note [Wrappers for data instance tycons] in MkId.lhs
+
+Consider
+       data family T a
+
+       data instance T (b,c) where
+         T1 :: b -> c -> T (b,c)
+
+Then
+  * T is the "family TyCon"
+
+  * We make "representation TyCon" :R1T, thus:
+       data :R1T b c where
+         T1 :: forall b c. b -> c -> :R1T b c
+
+  * It has a top-level coercion connecting it to the family TyCon
+
+       axiom :Co:R1T b c : T (b,c) ~ :R1T b c
+
+  * The data contructor T1 has a wrapper (which is what the source-level
+    "T1" invokes):
+
+       $WT1 :: forall b c. b -> c -> T (b,c)
+       $WT1 b c (x::b) (y::c) = T1 b c x y `cast` sym (:Co:R1T b c)
+
+  * The representation TyCon :R1T has an AlgTyConParent of
+
+       FamilyTyCon T [(b,c)] :Co:R1T
+
+

 
 %************************************************************************
 %*                                                                     *
 
 %************************************************************************
 %*                                                                     *

@@ -325,6 +455,22 @@ data PrimRep
   | AddrRep            -- a pointer, but not to a Haskell value
   | FloatRep
   | DoubleRep
   | AddrRep            -- a pointer, but not to a Haskell value
   | FloatRep
   | DoubleRep

+  deriving( Eq, Show )
+
+instance Outputable PrimRep where
+  ppr r = text (show r)
+
+-- Size of a PrimRep, in words
+primRepSizeW :: PrimRep -> Int
+primRepSizeW IntRep   = 1
+primRepSizeW WordRep  = 1
+primRepSizeW Int64Rep = wORD64_SIZE `quot` wORD_SIZE
+primRepSizeW Word64Rep= wORD64_SIZE `quot` wORD_SIZE
+primRepSizeW FloatRep = 1    -- NB. might not take a full word
+primRepSizeW DoubleRep= dOUBLE_SIZE `quot` wORD_SIZE
+primRepSizeW AddrRep  = 1
+primRepSizeW PtrRep   = 1
+primRepSizeW VoidRep  = 0

 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************

@@ -352,7 +498,18 @@ mkFunTyCon name kind
 -- This is the making of a TyCon. Just the same as the old mkAlgTyCon,
 -- but now you also have to pass in the generic information about the type
 -- constructor - you can get hold of it easily (see Generics module)
 -- This is the making of a TyCon. Just the same as the old mkAlgTyCon,
 -- but now you also have to pass in the generic information about the type
 -- constructor - you can get hold of it easily (see Generics module)

-mkAlgTyCon name kind tyvars stupid rhs sel_ids is_rec gen_info gadt_syn
+mkAlgTyCon :: Name
+           -> Kind
+           -> [TyVar]
+           -> [PredType]
+           -> AlgTyConRhs
+           -> [Id]
+           -> TyConParent
+           -> RecFlag
+           -> Bool
+           -> Bool
+           -> TyCon
+mkAlgTyCon name kind tyvars stupid rhs sel_ids parent is_rec gen_info gadt_syn

   = AlgTyCon { 
        tyConName        = name,
        tyConUnique      = nameUnique name,
   = AlgTyCon { 
        tyConName        = name,
        tyConUnique      = nameUnique name,

@@ -362,29 +519,17 @@ mkAlgTyCon name kind tyvars stupid rhs sel_ids is_rec gen_info gadt_syn
        algTcStupidTheta = stupid,
        algTcRhs         = rhs,
        algTcSelIds      = sel_ids,
        algTcStupidTheta = stupid,
        algTcRhs         = rhs,
        algTcSelIds      = sel_ids,

-       algTcClass       = Nothing,
+       algTcParent      = ASSERT( okParent name parent ) parent,

        algTcRec         = is_rec,
        algTcGadtSyntax  = gadt_syn,
        hasGenerics = gen_info
     }
 
        algTcRec         = is_rec,
        algTcGadtSyntax  = gadt_syn,
        hasGenerics = gen_info
     }
 

-mkClassTyCon name kind tyvars rhs clas is_rec
-  = AlgTyCon { 
-       tyConName        = name,
-       tyConUnique      = nameUnique name,
-       tyConKind        = kind,
-       tyConArity       = length tyvars,
-       tyConTyVars      = tyvars,
-       algTcStupidTheta = [],
-       algTcRhs         = rhs,
-       algTcSelIds      = [],
-       algTcClass       = Just clas,
-       algTcRec         = is_rec,
-       algTcGadtSyntax  = False,       -- Doesn't really matter
-       hasGenerics = False
-    }
-
+mkClassTyCon :: Name -> Kind -> [TyVar] -> AlgTyConRhs -> Class -> RecFlag -> TyCon
+mkClassTyCon name kind tyvars rhs clas is_rec =
+  mkAlgTyCon name kind tyvars [] rhs [] (ClassTyCon clas) is_rec False False

 
 

+mkTupleTyCon :: Name -> Kind -> Arity -> [TyVar] -> DataCon -> Boxity -> Bool -> TyCon

 mkTupleTyCon name kind arity tyvars con boxed gen_info
   = TupleTyCon {
        tyConUnique = nameUnique name,
 mkTupleTyCon name kind arity tyvars con boxed gen_info
   = TupleTyCon {
        tyConUnique = nameUnique name,

@@ -401,6 +546,7 @@ mkTupleTyCon name kind arity tyvars con boxed gen_info
 -- as primitive, but *lifted*, TyCons for now. They are lifted
 -- because the Haskell type T representing the (foreign) .NET
 -- type T is actually implemented (in ILX) as a thunk<T>
 -- as primitive, but *lifted*, TyCons for now. They are lifted
 -- because the Haskell type T representing the (foreign) .NET
 -- type T is actually implemented (in ILX) as a thunk<T>

+mkForeignTyCon :: Name -> Maybe FastString -> Kind -> Arity -> TyCon

 mkForeignTyCon name ext_name kind arity
   = PrimTyCon {
        tyConName    = name,
 mkForeignTyCon name ext_name kind arity
   = PrimTyCon {
        tyConName    = name,

@@ -414,16 +560,20 @@ mkForeignTyCon name ext_name kind arity
 
 
 -- most Prim tycons are lifted
 
 
 -- most Prim tycons are lifted

+mkPrimTyCon :: Name  -> Kind -> Arity -> PrimRep -> TyCon

 mkPrimTyCon name kind arity rep
   = mkPrimTyCon' name kind arity rep True  
 
 mkPrimTyCon name kind arity rep
   = mkPrimTyCon' name kind arity rep True  
 

+mkVoidPrimTyCon :: Name -> Kind -> Arity -> TyCon

 mkVoidPrimTyCon name kind arity 
   = mkPrimTyCon' name kind arity VoidRep True  
 
 -- but RealWorld is lifted
 mkVoidPrimTyCon name kind arity 
   = mkPrimTyCon' name kind arity VoidRep True  
 
 -- but RealWorld is lifted

+mkLiftedPrimTyCon :: Name  -> Kind -> Arity -> PrimRep -> TyCon

 mkLiftedPrimTyCon name kind arity rep
   = mkPrimTyCon' name kind arity rep False
 
 mkLiftedPrimTyCon name kind arity rep
   = mkPrimTyCon' name kind arity rep False
 

+mkPrimTyCon' :: Name  -> Kind -> Arity -> PrimRep -> Bool -> TyCon

 mkPrimTyCon' name kind arity rep is_unlifted
   = PrimTyCon {
        tyConName    = name,
 mkPrimTyCon' name kind arity rep is_unlifted
   = PrimTyCon {
        tyConName    = name,

@@ -435,16 +585,19 @@ mkPrimTyCon' name kind arity rep is_unlifted
        tyConExtName = Nothing
     }
 
        tyConExtName = Nothing
     }
 

-mkSynTyCon name kind tyvars rhs
+mkSynTyCon :: Name -> Kind -> [TyVar] -> SynTyConRhs -> TyConParent -> TyCon
+mkSynTyCon name kind tyvars rhs parent

   = SynTyCon { 
        tyConName = name,
        tyConUnique = nameUnique name,
        tyConKind = kind,
        tyConArity = length tyvars,
        tyConTyVars = tyvars,
   = SynTyCon { 
        tyConName = name,
        tyConUnique = nameUnique name,
        tyConKind = kind,
        tyConArity = length tyvars,
        tyConTyVars = tyvars,

-       synTcRhs = rhs
+       synTcRhs = rhs,
+        synTcParent = parent

     }
 
     }
 

+mkCoercionTyCon :: Name -> Arity -> ([Type] -> (Type,Type)) -> TyCon

 mkCoercionTyCon name arity kindRule
   = CoercionTyCon {
         tyConName = name,
 mkCoercionTyCon name arity kindRule
   = CoercionTyCon {
         tyConName = name,

@@ -454,6 +607,7 @@ mkCoercionTyCon name arity kindRule
     }
 
 -- Super kinds always have arity zero
     }
 
 -- Super kinds always have arity zero

+mkSuperKindTyCon :: Name -> TyCon

 mkSuperKindTyCon name
   = SuperKindTyCon {
         tyConName = name,
 mkSuperKindTyCon name
   = SuperKindTyCon {
         tyConName = name,

@@ -487,28 +641,40 @@ isUnLiftedTyCon _                                         = False
 isAlgTyCon :: TyCon -> Bool
 isAlgTyCon (AlgTyCon {})   = True
 isAlgTyCon (TupleTyCon {}) = True
 isAlgTyCon :: TyCon -> Bool
 isAlgTyCon (AlgTyCon {})   = True
 isAlgTyCon (TupleTyCon {}) = True

-isAlgTyCon other          = False
+isAlgTyCon _               = False

 
 isDataTyCon :: TyCon -> Bool
 
 isDataTyCon :: TyCon -> Bool

--- isDataTyCon returns True for data types that are represented by
--- heap-allocated constructors.
+-- isDataTyCon returns True for data types that are definitely
+-- represented by heap-allocated constructors.

 -- These are srcutinised by Core-level @case@ expressions, and they
 -- get info tables allocated for them.
 --     True for all @data@ types
 --     False for newtypes
 --               unboxed tuples
 -- These are srcutinised by Core-level @case@ expressions, and they
 -- get info tables allocated for them.
 --     True for all @data@ types
 --     False for newtypes
 --               unboxed tuples

-isDataTyCon tc@(AlgTyCon {algTcRhs = rhs})  
+--               type families
+-- 
+-- NB: for a data type family, T, only the *instance* tycons are
+--     get an info table etc.  The family tycon does not.
+--     Hence False for OpenTyCon
+isDataTyCon (AlgTyCon {algTcRhs = rhs})

   = case rhs of
   = case rhs of

+        OpenTyCon {}  -> False

        DataTyCon {}  -> True
        NewTyCon {}   -> False
        DataTyCon {}  -> True
        NewTyCon {}   -> False

-       AbstractTyCon -> pprPanic "isDataTyCon" (ppr tc)
-
+       AbstractTyCon -> False   -- We don't know, so return False

 isDataTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
 isDataTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity

-isDataTyCon other = False
+isDataTyCon _ = False

 
 isNewTyCon :: TyCon -> Bool
 
 isNewTyCon :: TyCon -> Bool

-isNewTyCon (AlgTyCon {algTcRhs = NewTyCon {}}) = True 
-isNewTyCon other                              = False
+isNewTyCon (AlgTyCon {algTcRhs = NewTyCon {}}) = True
+isNewTyCon _                                   = False
+
+unwrapNewTyCon_maybe :: TyCon -> Maybe ([TyVar], Type, Maybe TyCon)
+unwrapNewTyCon_maybe (AlgTyCon { tyConTyVars = tvs, 
+                                algTcRhs = NewTyCon { nt_co = mb_co, 
+                                                      nt_rhs = rhs }})
+                          = Just (tvs, rhs, mb_co)
+unwrapNewTyCon_maybe _     = Nothing

 
 isProductTyCon :: TyCon -> Bool
 -- A "product" tycon
 
 isProductTyCon :: TyCon -> Bool
 -- A "product" tycon

@@ -523,21 +689,52 @@ isProductTyCon tc@(AlgTyCon {}) = case algTcRhs tc of
                                    DataTyCon{ data_cons = [data_con] } 
                                                -> isVanillaDataCon data_con
                                    NewTyCon {} -> True
                                    DataTyCon{ data_cons = [data_con] } 
                                                -> isVanillaDataCon data_con
                                    NewTyCon {} -> True

-                                   other       -> False
+                                   _           -> False

 isProductTyCon (TupleTyCon {})  = True   
 isProductTyCon (TupleTyCon {})  = True   

-isProductTyCon other           = False
+isProductTyCon _                = False

 
 isSynTyCon :: TyCon -> Bool
 isSynTyCon (SynTyCon {}) = True
 isSynTyCon _            = False
 
 
 isSynTyCon :: TyCon -> Bool
 isSynTyCon (SynTyCon {}) = True
 isSynTyCon _            = False
 

+-- As for newtypes, it is in some contexts important to distinguish between
+-- closed synonyms and synonym families, as synonym families have no unique
+-- right hand side to which a synonym family application can expand.
+--
+isClosedSynTyCon :: TyCon -> Bool
+isClosedSynTyCon tycon = isSynTyCon tycon && not (isOpenTyCon tycon)
+
+isOpenSynTyCon :: TyCon -> Bool
+isOpenSynTyCon tycon = isSynTyCon tycon && isOpenTyCon tycon
+

 isGadtSyntaxTyCon :: TyCon -> Bool
 isGadtSyntaxTyCon (AlgTyCon { algTcGadtSyntax = res }) = res
 isGadtSyntaxTyCon :: TyCon -> Bool
 isGadtSyntaxTyCon (AlgTyCon { algTcGadtSyntax = res }) = res

-isGadtSyntaxTyCon other                                       = False
+isGadtSyntaxTyCon _                                    = False

 
 isEnumerationTyCon :: TyCon -> Bool
 isEnumerationTyCon (AlgTyCon {algTcRhs = DataTyCon { is_enum = res }}) = res
 
 isEnumerationTyCon :: TyCon -> Bool
 isEnumerationTyCon (AlgTyCon {algTcRhs = DataTyCon { is_enum = res }}) = res

-isEnumerationTyCon other                                              = False
+isEnumerationTyCon _                                                   = False
+
+isOpenTyCon :: TyCon -> Bool
+isOpenTyCon (SynTyCon {synTcRhs = OpenSynTyCon _ _}) = True
+isOpenTyCon (AlgTyCon {algTcRhs = OpenTyCon {}    }) = True
+isOpenTyCon _                                       = False
+
+assocTyConArgPoss_maybe :: TyCon -> Maybe [Int]
+assocTyConArgPoss_maybe (AlgTyCon { 
+                          algTcRhs = OpenTyCon {otArgPoss = poss}})  = poss
+assocTyConArgPoss_maybe (SynTyCon { synTcRhs = OpenSynTyCon _ poss }) = poss
+assocTyConArgPoss_maybe _ = Nothing
+
+isTyConAssoc :: TyCon -> Bool
+isTyConAssoc = isJust . assocTyConArgPoss_maybe
+
+setTyConArgPoss :: TyCon -> [Int] -> TyCon
+setTyConArgPoss tc@(AlgTyCon { algTcRhs = rhs })               poss = 
+  tc { algTcRhs = rhs {otArgPoss = Just poss} }
+setTyConArgPoss tc@(SynTyCon { synTcRhs = OpenSynTyCon ki _ }) poss = 
+  tc { synTcRhs = OpenSynTyCon ki (Just poss) }
+setTyConArgPoss tc _ = pprPanic "setTyConArgPoss" (ppr tc)

 
 isTupleTyCon :: TyCon -> Bool
 -- The unit tycon didn't used to be classed as a tuple tycon
 
 isTupleTyCon :: TyCon -> Bool
 -- The unit tycon didn't used to be classed as a tuple tycon

@@ -549,43 +746,65 @@ isTupleTyCon :: TyCon -> Bool
 -- get spat into the interface file as tuple tycons, so I don't think
 -- it matters.
 isTupleTyCon (TupleTyCon {}) = True
 -- get spat into the interface file as tuple tycons, so I don't think
 -- it matters.
 isTupleTyCon (TupleTyCon {}) = True

-isTupleTyCon other          = False
+isTupleTyCon _               = False

 
 isUnboxedTupleTyCon :: TyCon -> Bool
 isUnboxedTupleTyCon (TupleTyCon {tyConBoxed = boxity}) = not (isBoxed boxity)
 
 isUnboxedTupleTyCon :: TyCon -> Bool
 isUnboxedTupleTyCon (TupleTyCon {tyConBoxed = boxity}) = not (isBoxed boxity)

-isUnboxedTupleTyCon other = False
+isUnboxedTupleTyCon _                                  = False

 
 isBoxedTupleTyCon :: TyCon -> Bool
 isBoxedTupleTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
 
 isBoxedTupleTyCon :: TyCon -> Bool
 isBoxedTupleTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity

-isBoxedTupleTyCon other = False
+isBoxedTupleTyCon _                                  = False

 
 

+tupleTyConBoxity :: TyCon -> Boxity

 tupleTyConBoxity tc = tyConBoxed tc
 
 isRecursiveTyCon :: TyCon -> Bool
 isRecursiveTyCon (AlgTyCon {algTcRec = Recursive}) = True
 tupleTyConBoxity tc = tyConBoxed tc
 
 isRecursiveTyCon :: TyCon -> Bool
 isRecursiveTyCon (AlgTyCon {algTcRec = Recursive}) = True

-isRecursiveTyCon other                               = False
+isRecursiveTyCon _                                 = False

 
 isHiBootTyCon :: TyCon -> Bool
 -- Used for knot-tying in hi-boot files
 isHiBootTyCon (AlgTyCon {algTcRhs = AbstractTyCon}) = True
 
 isHiBootTyCon :: TyCon -> Bool
 -- Used for knot-tying in hi-boot files
 isHiBootTyCon (AlgTyCon {algTcRhs = AbstractTyCon}) = True

-isHiBootTyCon other                                = False
+isHiBootTyCon _                                     = False

 
 isForeignTyCon :: TyCon -> Bool
 -- isForeignTyCon identifies foreign-imported type constructors
 isForeignTyCon (PrimTyCon {tyConExtName = Just _}) = True
 
 isForeignTyCon :: TyCon -> Bool
 -- isForeignTyCon identifies foreign-imported type constructors
 isForeignTyCon (PrimTyCon {tyConExtName = Just _}) = True

-isForeignTyCon other                              = False
+isForeignTyCon _                                   = False

 
 isSuperKindTyCon :: TyCon -> Bool
 isSuperKindTyCon (SuperKindTyCon {}) = True
 
 isSuperKindTyCon :: TyCon -> Bool
 isSuperKindTyCon (SuperKindTyCon {}) = True

-isSuperKindTyCon other               = False
+isSuperKindTyCon _                   = False

 
 

-isCoercionTyCon_maybe :: TyCon -> Maybe (Arity, [Type] -> Kind)
+isCoercionTyCon_maybe :: TyCon -> Maybe (Arity, [Type] -> (Type,Type))

 isCoercionTyCon_maybe (CoercionTyCon {tyConArity = ar, coKindFun = rule}) 
   = Just (ar, rule)
 isCoercionTyCon_maybe (CoercionTyCon {tyConArity = ar, coKindFun = rule}) 
   = Just (ar, rule)

-isCoercionTyCon_maybe other = Nothing
+isCoercionTyCon_maybe _ = Nothing

 
 

+isCoercionTyCon :: TyCon -> Bool

 isCoercionTyCon (CoercionTyCon {}) = True
 isCoercionTyCon (CoercionTyCon {}) = True

-isCoercionTyCon other              = False
+isCoercionTyCon _                  = False
+
+-- Identifies implicit tycons that, in particular, do not go into interface
+-- files (because they are implicitly reconstructed when the interface is
+-- read).
+--
+-- Note that 
+--
+-- * associated families are implicit, as they are re-constructed from
+--   the class declaration in which they reside, and 
+-- * family instances are *not* implicit as they represent the instance body
+--   (similar to a dfun does that for a class instance).
+--
+isImplicitTyCon :: TyCon -> Bool
+isImplicitTyCon tycon | isTyConAssoc tycon           = True
+                     | isSynTyCon tycon             = False
+                     | isAlgTyCon tycon             = isClassTyCon tycon ||
+                                                      isTupleTyCon tycon
+isImplicitTyCon _other                               = True
+        -- catches: FunTyCon, PrimTyCon, 
+        -- CoercionTyCon, SuperKindTyCon

 \end{code}
 
 
 \end{code}
 
 

@@ -601,10 +820,11 @@ tcExpandTyCon_maybe, coreExpandTyCon_maybe
                  Type,                 -- Body type (not yet substituted)
                  [Type])               -- Leftover args
 
                  Type,                 -- Body type (not yet substituted)
                  [Type])               -- Leftover args
 

--- For the *typechecker* view, we expand synonyms only
-tcExpandTyCon_maybe (SynTyCon {tyConTyVars = tvs, synTcRhs = rhs }) tys
+-- For the *typechecker* view, we expand (closed) synonyms only
+tcExpandTyCon_maybe (SynTyCon {tyConTyVars = tvs, 
+                              synTcRhs = SynonymTyCon rhs }) tys

    = expand tvs rhs tys
    = expand tvs rhs tys

-tcExpandTyCon_maybe other_tycon tys = Nothing
+tcExpandTyCon_maybe _ _ = Nothing

 
 ---------------
 -- For the *Core* view, we expand synonyms only as well
 
 ---------------
 -- For the *Core* view, we expand synonyms only as well

@@ -635,7 +855,7 @@ expand tvs rhs tys
 tyConHasGenerics :: TyCon -> Bool
 tyConHasGenerics (AlgTyCon {hasGenerics = hg})   = hg
 tyConHasGenerics (TupleTyCon {hasGenerics = hg}) = hg
 tyConHasGenerics :: TyCon -> Bool
 tyConHasGenerics (AlgTyCon {hasGenerics = hg})   = hg
 tyConHasGenerics (TupleTyCon {hasGenerics = hg}) = hg

-tyConHasGenerics other                          = False        -- Synonyms
+tyConHasGenerics _                               = False        -- Synonyms

 
 tyConDataCons :: TyCon -> [DataCon]
 -- It's convenient for tyConDataCons to return the
 
 tyConDataCons :: TyCon -> [DataCon]
 -- It's convenient for tyConDataCons to return the

@@ -646,19 +866,19 @@ tyConDataCons_maybe :: TyCon -> Maybe [DataCon]
 tyConDataCons_maybe (AlgTyCon {algTcRhs = DataTyCon { data_cons = cons }}) = Just cons
 tyConDataCons_maybe (AlgTyCon {algTcRhs = NewTyCon { data_con = con }})    = Just [con]
 tyConDataCons_maybe (TupleTyCon {dataCon = con})                          = Just [con]
 tyConDataCons_maybe (AlgTyCon {algTcRhs = DataTyCon { data_cons = cons }}) = Just cons
 tyConDataCons_maybe (AlgTyCon {algTcRhs = NewTyCon { data_con = con }})    = Just [con]
 tyConDataCons_maybe (TupleTyCon {dataCon = con})                          = Just [con]

-tyConDataCons_maybe other                                                 = Nothing
+tyConDataCons_maybe _                                                      = Nothing

 
 tyConFamilySize  :: TyCon -> Int
 
 tyConFamilySize  :: TyCon -> Int

-tyConFamilySize (AlgTyCon {algTcRhs = DataTyCon { data_cons = cons }}) = length cons
-tyConFamilySize (AlgTyCon {algTcRhs = NewTyCon {}}) = 1
-tyConFamilySize (TupleTyCon {})                            = 1
-#ifdef DEBUG
+tyConFamilySize (AlgTyCon   {algTcRhs = DataTyCon {data_cons = cons}}) = 
+  length cons
+tyConFamilySize (AlgTyCon   {algTcRhs = NewTyCon {}})                  = 1
+tyConFamilySize (AlgTyCon   {algTcRhs = OpenTyCon {}})                 = 0
+tyConFamilySize (TupleTyCon {})                                               = 1

 tyConFamilySize other = pprPanic "tyConFamilySize:" (ppr other)
 tyConFamilySize other = pprPanic "tyConFamilySize:" (ppr other)

-#endif

 
 tyConSelIds :: TyCon -> [Id]
 tyConSelIds (AlgTyCon {algTcSelIds = fs}) = fs
 
 tyConSelIds :: TyCon -> [Id]
 tyConSelIds (AlgTyCon {algTcSelIds = fs}) = fs

-tyConSelIds other_tycon                          = []
+tyConSelIds _                             = []

 
 algTyConRhs :: TyCon -> AlgTyConRhs
 algTyConRhs (AlgTyCon {algTcRhs = rhs})  = rhs
 
 algTyConRhs :: TyCon -> AlgTyConRhs
 algTyConRhs (AlgTyCon {algTcRhs = rhs})  = rhs

@@ -671,13 +891,13 @@ newTyConRhs :: TyCon -> ([TyVar], Type)
 newTyConRhs (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_rhs = rhs }}) = (tvs, rhs)
 newTyConRhs tycon = pprPanic "newTyConRhs" (ppr tycon)
 
 newTyConRhs (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_rhs = rhs }}) = (tvs, rhs)
 newTyConRhs tycon = pprPanic "newTyConRhs" (ppr tycon)
 

-newTyConRep :: TyCon -> ([TyVar], Type)
-newTyConRep (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_rep = rep }}) = (tvs, rep)
-newTyConRep tycon = pprPanic "newTyConRep" (ppr tycon)
+newTyConEtadRhs :: TyCon -> ([TyVar], Type)
+newTyConEtadRhs (AlgTyCon {algTcRhs = NewTyCon { nt_etad_rhs = tvs_rhs }}) = tvs_rhs
+newTyConEtadRhs tycon = pprPanic "newTyConEtadRhs" (ppr tycon)

 
 

-newTyConCo :: TyCon -> Maybe TyCon
-newTyConCo (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_co = co }}) = co
-newTyConCo tycon = pprPanic "newTyConCo" (ppr tycon)
+newTyConCo_maybe :: TyCon -> Maybe TyCon
+newTyConCo_maybe (AlgTyCon {algTcRhs = NewTyCon { nt_co = co }}) = co
+newTyConCo_maybe _                                              = Nothing

 
 tyConPrimRep :: TyCon -> PrimRep
 tyConPrimRep (PrimTyCon {primTyConRep = rep}) = rep
 
 tyConPrimRep :: TyCon -> PrimRep
 tyConPrimRep (PrimTyCon {primTyConRep = rep}) = rep

@@ -693,11 +913,22 @@ tyConStupidTheta tycon = pprPanic "tyConStupidTheta" (ppr tycon)
 
 \begin{code}
 synTyConDefn :: TyCon -> ([TyVar], Type)
 
 \begin{code}
 synTyConDefn :: TyCon -> ([TyVar], Type)

-synTyConDefn (SynTyCon {tyConTyVars = tyvars, synTcRhs = ty}) = (tyvars,ty)
+synTyConDefn (SynTyCon {tyConTyVars = tyvars, synTcRhs = SynonymTyCon ty}) 
+  = (tyvars, ty)

 synTyConDefn tycon = pprPanic "getSynTyConDefn" (ppr tycon)
 
 synTyConDefn tycon = pprPanic "getSynTyConDefn" (ppr tycon)
 

-synTyConRhs :: TyCon -> Type
-synTyConRhs tc = synTcRhs tc
+synTyConRhs :: TyCon -> SynTyConRhs
+synTyConRhs (SynTyCon {synTcRhs = rhs}) = rhs
+synTyConRhs tc                         = pprPanic "synTyConRhs" (ppr tc)
+
+synTyConType :: TyCon -> Type
+synTyConType tc = case synTcRhs tc of
+                   SynonymTyCon t -> t
+                   _              -> pprPanic "synTyConType" (ppr tc)
+
+synTyConResKind :: TyCon -> Kind
+synTyConResKind (SynTyCon {synTcRhs = OpenSynTyCon kind _}) = kind
+synTyConResKind tycon  = pprPanic "synTyConResKind" (ppr tycon)

 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}

@@ -713,12 +944,33 @@ maybeTyConSingleCon tc = pprPanic "maybeTyConSingleCon: unexpected tycon " $ ppr
 
 \begin{code}
 isClassTyCon :: TyCon -> Bool
 
 \begin{code}
 isClassTyCon :: TyCon -> Bool

-isClassTyCon (AlgTyCon {algTcClass = Just _}) = True
-isClassTyCon other_tycon                        = False
+isClassTyCon (AlgTyCon {algTcParent = ClassTyCon _}) = True
+isClassTyCon _                                       = False

 
 tyConClass_maybe :: TyCon -> Maybe Class
 
 tyConClass_maybe :: TyCon -> Maybe Class

-tyConClass_maybe (AlgTyCon {algTcClass = maybe_clas}) = maybe_clas
-tyConClass_maybe ther_tycon                             = Nothing
+tyConClass_maybe (AlgTyCon {algTcParent = ClassTyCon clas}) = Just clas
+tyConClass_maybe _                                          = Nothing
+
+isFamInstTyCon :: TyCon -> Bool
+isFamInstTyCon (AlgTyCon {algTcParent = FamilyTyCon _ _ _ }) = True
+isFamInstTyCon (SynTyCon {synTcParent = FamilyTyCon _ _ _ }) = True
+isFamInstTyCon _                                             = False
+
+tyConFamInst_maybe :: TyCon -> Maybe (TyCon, [Type])
+tyConFamInst_maybe (AlgTyCon {algTcParent = FamilyTyCon fam instTys _}) = 
+  Just (fam, instTys)
+tyConFamInst_maybe (SynTyCon {synTcParent = FamilyTyCon fam instTys _}) = 
+  Just (fam, instTys)
+tyConFamInst_maybe _                                                    = 
+  Nothing
+
+tyConFamilyCoercion_maybe :: TyCon -> Maybe TyCon
+tyConFamilyCoercion_maybe (AlgTyCon {algTcParent = FamilyTyCon _ _ coe}) = 
+  Just coe
+tyConFamilyCoercion_maybe (SynTyCon {synTcParent = FamilyTyCon _ _ coe}) = 
+  Just coe
+tyConFamilyCoercion_maybe _                                              =
+  Nothing

 \end{code}
 
 
 \end{code}