Big tidy-up of deriving code

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

diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs
index c80e3a7..9595759 100644 (file)
--- a/compiler/types/TyCon.lhs
+++ b/compiler/types/TyCon.lhs
@@ -1,26 +1,33 @@
 %
 %

+% (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(

-       TyCon, ArgVrcs, FieldLabel,
+       TyCon, FieldLabel,

 
        PrimRep(..),
        tyConPrimRep,
 
 
        PrimRep(..),
        tyConPrimRep,
 

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

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

-       isAlgTyCon, isDataTyCon, isSynTyCon, isNewTyCon, isPrimTyCon,
-       isEnumerationTyCon, isGadtSyntaxTyCon,
+       isAlgTyCon, isDataTyCon, isSynTyCon, isNewTyCon, isClosedNewTyCon,
+       isPrimTyCon, 
+       isEnumerationTyCon, isGadtSyntaxTyCon, isOpenTyCon,
+       assocTyConArgPoss_maybe, isTyConAssoc, setTyConArgPoss,

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

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

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

+        isImplicitTyCon,

 
 

-       tcExpandTyCon_maybe, coreExpandTyCon_maybe, stgExpandTyCon_maybe,
+       tcExpandTyCon_maybe, coreExpandTyCon_maybe,

 
        makeTyConAbstract, isAbstractTyCon,
 
 
        makeTyConAbstract, isAbstractTyCon,
 

@@ -41,13 +48,13 @@ module TyCon(
        tyConKind,
        tyConUnique,
        tyConTyVars,
        tyConKind,
        tyConUnique,
        tyConTyVars,

-       tyConArgVrcs,

        algTyConRhs, tyConDataCons, tyConDataCons_maybe, tyConFamilySize,
        tyConSelIds,
        tyConStupidTheta,
        tyConArity,
        isClassTyCon, tyConClass_maybe,
        algTyConRhs, tyConDataCons, tyConDataCons_maybe, tyConFamilySize,
        tyConSelIds,
        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,

@@ -58,15 +65,15 @@ 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
 \end{code}
 import Outputable
 import FastString
 \end{code}

@@ -93,13 +100,24 @@ 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

-       argVrcs     :: ArgVrcs,

 
 

-       algTcSelIds :: [Id],            -- Its record selectors (empty if none): 
+        tyConArgPoss :: Maybe [Int],    -- for associated families: for each
+                                       -- tyvar 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.
+                                       -- NB: Just _ <=> associated (not
+                                       --                toplevel) family
+       
+       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"

@@ -110,14 +128,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 :: AlgTyConParent   -- Gives the class or family tycon for
+                                       -- derived tycons representing classes
+                                       -- or family instances, respectively.

     }
 
   | TupleTyCon {
     }
 
   | TupleTyCon {

@@ -132,16 +151,21 @@ data TyCon
     }
 
   | SynTyCon {
     }
 
   | SynTyCon {

-       tyConUnique :: Unique,
-       tyConName   :: Name,
-       tyConKind   :: Kind,
-       tyConArity  :: Arity,
-
-       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.
-       argVrcs :: ArgVrcs
+       tyConUnique  :: Unique,
+       tyConName    :: Name,
+       tyConKind    :: Kind,
+       tyConArity   :: Arity,
+
+       tyConTyVars  :: [TyVar],        -- Bound tyvars
+
+        tyConArgPoss :: Maybe [Int],    -- for associated families: for each
+                                       -- tyvar 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.
+       
+       synTcRhs     :: SynTyConRhs     -- Expanded type in here

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

@@ -150,8 +174,8 @@ data TyCon
        tyConUnique   :: Unique,
        tyConName     :: Name,
        tyConKind     :: Kind,
        tyConUnique   :: Unique,
        tyConName     :: Name,
        tyConKind     :: Kind,

-       tyConArity    :: Arity,
-       argVrcs       :: ArgVrcs,
+       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

@@ -167,8 +191,10 @@ data TyCon
        tyConUnique :: Unique,
         tyConName   :: Name,
        tyConArity  :: Arity,
        tyConUnique :: Unique,
         tyConName   :: Name,
        tyConArity  :: Arity,

-       coKindFun   :: [Type] -> Kind
-    }
+       coKindFun   :: [Type] -> (Type,Type)
+    }          -- INVARAINT: 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

@@ -176,21 +202,17 @@ data TyCon
         tyConName   :: Name
     }
 
         tyConName   :: Name
     }
 

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

 type FieldLabel = Name
 
 type FieldLabel = Name
 

-type ArgVrcs = [(Bool,Bool)]  -- Tyvar variance info: [(occPos,occNeg)]
-       -- [] means "no information, assume the worst"
-

 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
 
 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
 

+  | OpenDataTyCon       -- data family        (further instances can appear
+  | OpenNewTyCon        -- newtype family      at any time)
+

   | DataTyCon {
        data_cons :: [DataCon],
                        -- The constructors; can be empty if the user declares
   | DataTyCon {
        data_cons :: [DataCon],
                        -- The constructors; can be empty if the user declares

@@ -207,8 +229,9 @@ 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 :: TyCon,                -- The coercion used to create the newtype
+        nt_co :: Maybe TyCon,   -- The coercion used to create the newtype

                                 -- from the representation
                                 -- from the representation

+                                -- optional for non-recursive newtypes

                                -- See Note [Newtype coercions]
 
        nt_etad_rhs :: ([TyVar], Type) ,
                                -- See Note [Newtype coercions]
 
        nt_etad_rhs :: ([TyVar], Type) ,

@@ -234,8 +257,35 @@ data AlgTyConRhs
 
 visibleDataCons :: AlgTyConRhs -> [DataCon]
 visibleDataCons AbstractTyCon                = []
 
 visibleDataCons :: AlgTyConRhs -> [DataCon]
 visibleDataCons AbstractTyCon                = []

+visibleDataCons OpenDataTyCon                = []
+visibleDataCons OpenNewTyCon                 = []

 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 data/newtype 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.
+--
+data AlgTyConParent = -- An ordinary type constructor has no parent.
+                     NoParentTyCon
+
+                     -- Type constructors representing a class dictionary.
+                   | ClassTyCon    Class       
+
+                     -- Type constructors representing an instances of a type
+                     -- family.
+                   | FamilyTyCon   TyCon       -- the type family
+                                   [Type]      -- instance types
+                                   TyCon       -- a *coercion* identifying
+                                               -- the representation type
+                                               -- with the type instance
+
+data SynTyConRhs
+  = OpenSynTyCon Kind  -- Type family: *result* kind given
+  | 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]

@@ -245,15 +295,23 @@ 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,
 
 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.
-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.
+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]
+
+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])

@@ -261,10 +319,10 @@ which encodes as (TyConApp instCoercionTyCon [TyConApp CoT [], s])
 But in GHC we instead make CoT into a new piece of type syntax
 (like instCoercionTyCon, symCoercionTyCon etc), which must always
 be saturated, but which encodes as
 But in GHC we instead make CoT into a new piece of type syntax
 (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]
 ~~~~~~~~~~~~~~~~~~

@@ -359,40 +417,25 @@ 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 argvrcs stupid rhs sel_ids is_rec gen_info gadt_syn
+mkAlgTyCon name kind tyvars stupid rhs sel_ids parent is_rec gen_info gadt_syn

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

-       argVrcs          = argvrcs,
+       tyConArgPoss     = Nothing,

        algTcStupidTheta = stupid,
        algTcRhs         = rhs,
        algTcSelIds      = sel_ids,
        algTcStupidTheta = stupid,
        algTcRhs         = rhs,
        algTcSelIds      = sel_ids,

-       algTcClass       = Nothing,
+       algTcParent      = parent,

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

-mkClassTyCon name kind tyvars argvrcs rhs clas is_rec
-  = AlgTyCon { 
-       tyConName        = name,
-       tyConUnique      = nameUnique name,
-       tyConKind        = kind,
-       tyConArity       = length tyvars,
-       tyConTyVars      = tyvars,
-       argVrcs          = argvrcs,
-       algTcStupidTheta = [],
-       algTcRhs         = rhs,
-       algTcSelIds      = [],
-       algTcClass       = Just clas,
-       algTcRec         = is_rec,
-       algTcGadtSyntax  = False,       -- Doesn't really matter
-       hasGenerics = False
-    }
-
+mkClassTyCon name kind tyvars rhs clas is_rec =
+  mkAlgTyCon name kind tyvars [] rhs [] (ClassTyCon clas) is_rec False False

 
 mkTupleTyCon name kind arity tyvars con boxed gen_info
   = TupleTyCon {
 
 mkTupleTyCon name kind arity tyvars con boxed gen_info
   = TupleTyCon {

@@ -410,13 +453,12 @@ 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 ext_name kind arity arg_vrcs
+mkForeignTyCon name ext_name kind arity

   = PrimTyCon {
        tyConName    = name,
        tyConUnique  = nameUnique name,
        tyConKind    = kind,
        tyConArity   = arity,
   = PrimTyCon {
        tyConName    = name,
        tyConUnique  = nameUnique name,
        tyConKind    = kind,
        tyConArity   = arity,

-        argVrcs      = arg_vrcs,

        primTyConRep = PtrRep, -- they all do
        isUnLifted   = False,
        tyConExtName = ext_name
        primTyConRep = PtrRep, -- they all do
        isUnLifted   = False,
        tyConExtName = ext_name

@@ -424,37 +466,36 @@ mkForeignTyCon name ext_name kind arity arg_vrcs
 
 
 -- most Prim tycons are lifted
 
 
 -- most Prim tycons are lifted

-mkPrimTyCon name kind arity arg_vrcs rep
-  = mkPrimTyCon' name kind arity arg_vrcs rep True  
+mkPrimTyCon name kind arity rep
+  = mkPrimTyCon' name kind arity rep True  

 
 

-mkVoidPrimTyCon name kind arity arg_vrcs 
-  = mkPrimTyCon' name kind arity arg_vrcs VoidRep True  
+mkVoidPrimTyCon name kind arity 
+  = mkPrimTyCon' name kind arity VoidRep True  

 
 -- but RealWorld is lifted
 
 -- but RealWorld is lifted

-mkLiftedPrimTyCon name kind arity arg_vrcs rep
-  = mkPrimTyCon' name kind arity arg_vrcs rep False
+mkLiftedPrimTyCon name kind arity rep
+  = mkPrimTyCon' name kind arity rep False

 
 

-mkPrimTyCon' name kind arity arg_vrcs rep is_unlifted
+mkPrimTyCon' name kind arity rep is_unlifted

   = PrimTyCon {
        tyConName    = name,
        tyConUnique  = nameUnique name,
        tyConKind    = kind,
        tyConArity   = arity,
   = PrimTyCon {
        tyConName    = name,
        tyConUnique  = nameUnique name,
        tyConKind    = kind,
        tyConArity   = arity,

-        argVrcs      = arg_vrcs,

        primTyConRep = rep,
        isUnLifted   = is_unlifted,
        tyConExtName = Nothing
     }
 
        primTyConRep = rep,
        isUnLifted   = is_unlifted,
        tyConExtName = Nothing
     }
 

-mkSynTyCon name kind tyvars rhs argvrcs
+mkSynTyCon name kind tyvars rhs

   = 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,
-       argVrcs      = argvrcs
+       tyConArgPoss = Nothing,
+       synTcRhs = rhs

     }
 
 mkCoercionTyCon name arity kindRule
     }
 
 mkCoercionTyCon name arity kindRule

@@ -502,8 +543,8 @@ isAlgTyCon (TupleTyCon {}) = True
 isAlgTyCon other          = False
 
 isDataTyCon :: TyCon -> Bool
 isAlgTyCon other          = False
 
 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
 -- These are srcutinised by Core-level @case@ expressions, and they
 -- get info tables allocated for them.
 --     True for all @data@ types

@@ -511,25 +552,38 @@ isDataTyCon :: TyCon -> Bool
 --               unboxed tuples
 isDataTyCon tc@(AlgTyCon {algTcRhs = rhs})  
   = case rhs of
 --               unboxed tuples
 isDataTyCon tc@(AlgTyCon {algTcRhs = rhs})  
   = case rhs of

+        OpenDataTyCon -> True

        DataTyCon {}  -> True
        DataTyCon {}  -> True

+       OpenNewTyCon  -> False

        NewTyCon {}   -> False
        NewTyCon {}   -> False

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

 isDataTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
 isDataTyCon other = False
 
 isNewTyCon :: TyCon -> Bool
 isDataTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
 isDataTyCon other = False
 
 isNewTyCon :: TyCon -> Bool

-isNewTyCon (AlgTyCon {algTcRhs = NewTyCon {}}) = True 
-isNewTyCon other                              = False
+isNewTyCon (AlgTyCon {algTcRhs = rhs}) = case rhs of
+                                          OpenNewTyCon -> True
+                                          NewTyCon {}  -> True
+                                          _            -> False
+isNewTyCon other                       = False
+
+-- This is an important refinement as typical newtype optimisations do *not*
+-- hold for newtype families.  Why?  Given a type `T a', if T is a newtype
+-- family, there is no unique right hand side by which `T a' can be replaced
+-- by a cast.
+--
+isClosedNewTyCon :: TyCon -> Bool
+isClosedNewTyCon tycon = isNewTyCon tycon && not (isOpenTyCon tycon)

 
 isProductTyCon :: TyCon -> Bool
 -- A "product" tycon
 --     has *one* constructor, 
 --     is *not* existential
 -- but
 
 isProductTyCon :: TyCon -> Bool
 -- A "product" tycon
 --     has *one* constructor, 
 --     is *not* existential
 -- but

---     may be  DataType or NewType, 
+--     may be  DataType, NewType

 --     may be  unboxed or not, 
 --     may be  recursive or not
 --     may be  unboxed or not, 
 --     may be  recursive or not

+-- 

 isProductTyCon tc@(AlgTyCon {}) = case algTcRhs tc of
                                    DataTyCon{ data_cons = [data_con] } 
                                                -> isVanillaDataCon data_con
 isProductTyCon tc@(AlgTyCon {}) = case algTcRhs tc of
                                    DataTyCon{ data_cons = [data_con] } 
                                                -> isVanillaDataCon data_con

@@ -550,6 +604,25 @@ isEnumerationTyCon :: TyCon -> Bool
 isEnumerationTyCon (AlgTyCon {algTcRhs = DataTyCon { is_enum = res }}) = res
 isEnumerationTyCon other                                              = False
 
 isEnumerationTyCon (AlgTyCon {algTcRhs = DataTyCon { is_enum = res }}) = res
 isEnumerationTyCon other                                              = False
 

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

 isTupleTyCon :: TyCon -> Bool
 -- The unit tycon didn't used to be classed as a tuple tycon
 -- but I thought that was silly so I've undone it
 isTupleTyCon :: TyCon -> Bool
 -- The unit tycon didn't used to be classed as a tuple tycon
 -- but I thought that was silly so I've undone it

@@ -590,13 +663,34 @@ isSuperKindTyCon :: TyCon -> Bool
 isSuperKindTyCon (SuperKindTyCon {}) = True
 isSuperKindTyCon other               = False
 
 isSuperKindTyCon (SuperKindTyCon {}) = True
 isSuperKindTyCon other               = 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 other = Nothing
 
 isCoercionTyCon_maybe (CoercionTyCon {tyConArity = ar, coKindFun = rule}) 
   = Just (ar, rule)
 isCoercionTyCon_maybe other = Nothing
 

+isCoercionTyCon :: TyCon -> Bool

 isCoercionTyCon (CoercionTyCon {}) = True
 isCoercionTyCon other              = False
 isCoercionTyCon (CoercionTyCon {}) = True
 isCoercionTyCon other              = 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}
 
 

@@ -613,30 +707,22 @@ tcExpandTyCon_maybe, coreExpandTyCon_maybe
                  [Type])               -- Leftover args
 
 -- For the *typechecker* view, we expand synonyms only
                  [Type])               -- Leftover args
 
 -- For the *typechecker* view, we expand synonyms only

-tcExpandTyCon_maybe (SynTyCon {tyConTyVars = tvs, synTcRhs = rhs }) tys
+tcExpandTyCon_maybe (SynTyCon {tyConTyVars = tvs, 
+                              synTcRhs = SynonymTyCon rhs }) tys

    = expand tvs rhs tys
 tcExpandTyCon_maybe other_tycon tys = Nothing
 
 ---------------
 -- For the *Core* view, we expand synonyms only as well
    = expand tvs rhs tys
 tcExpandTyCon_maybe other_tycon tys = Nothing
 
 ---------------
 -- For the *Core* view, we expand synonyms only as well

-{-
+

 coreExpandTyCon_maybe (AlgTyCon {algTcRec = NonRecursive,      -- Not recursive
 coreExpandTyCon_maybe (AlgTyCon {algTcRec = NonRecursive,      -- Not recursive

-         algTcRhs = NewTyCon { nt_etad_rhs = etad_rhs }}) tys
+         algTcRhs = NewTyCon { nt_etad_rhs = etad_rhs, nt_co = Nothing }}) tys

    = case etad_rhs of  -- Don't do this in the pattern match, lest we accidentally
                        -- match the etad_rhs of a *recursive* newtype
        (tvs,rhs) -> expand tvs rhs tys
    = case etad_rhs of  -- Don't do this in the pattern match, lest we accidentally
                        -- match the etad_rhs of a *recursive* newtype
        (tvs,rhs) -> expand tvs rhs tys

--}
-coreExpandTyCon_maybe tycon tys = tcExpandTyCon_maybe tycon tys

 
 

----------------
--- For the *STG* view, we expand synonyms *and* non-recursive newtypes
-stgExpandTyCon_maybe (AlgTyCon {algTcRec = NonRecursive,       -- Not recursive
-         algTcRhs = NewTyCon { nt_etad_rhs = etad_rhs }}) tys
-   = case etad_rhs of  -- Don't do this in the pattern match, lest we accidentally
-                       -- match the etad_rhs of a *recursive* newtype
-       (tvs,rhs) -> expand tvs rhs tys
+coreExpandTyCon_maybe tycon tys = tcExpandTyCon_maybe tycon tys

 
 

-stgExpandTyCon_maybe tycon tys = coreExpandTyCon_maybe tycon tys

 
 ----------------
 expand :: [TyVar] -> Type                      -- Template
 
 ----------------
 expand :: [TyVar] -> Type                      -- Template

@@ -669,9 +755,11 @@ tyConDataCons_maybe (TupleTyCon {dataCon = con})                      = Just [con]
 tyConDataCons_maybe other                                                 = Nothing
 
 tyConFamilySize  :: TyCon -> Int
 tyConDataCons_maybe other                                                 = Nothing
 
 tyConFamilySize  :: TyCon -> Int

-tyConFamilySize (AlgTyCon {algTcRhs = DataTyCon { data_cons = cons }}) = length cons
-tyConFamilySize (AlgTyCon {algTcRhs = NewTyCon {}}) = 1
-tyConFamilySize (TupleTyCon {})                            = 1
+tyConFamilySize (AlgTyCon   {algTcRhs = DataTyCon {data_cons = cons}}) = 
+  length cons
+tyConFamilySize (AlgTyCon   {algTcRhs = NewTyCon {}})                  = 1
+tyConFamilySize (AlgTyCon   {algTcRhs = OpenDataTyCon})                = 0
+tyConFamilySize (TupleTyCon {})                                               = 1

 #ifdef DEBUG
 tyConFamilySize other = pprPanic "tyConFamilySize:" (ppr other)
 #endif
 #ifdef DEBUG
 tyConFamilySize other = pprPanic "tyConFamilySize:" (ppr other)
 #endif

@@ -695,9 +783,9 @@ newTyConRep :: TyCon -> ([TyVar], Type)
 newTyConRep (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_rep = rep }}) = (tvs, rep)
 newTyConRep tycon = pprPanic "newTyConRep" (ppr tycon)
 
 newTyConRep (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_rep = rep }}) = (tvs, rep)
 newTyConRep tycon = pprPanic "newTyConRep" (ppr tycon)
 

-newTyConCo :: TyCon -> 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

@@ -711,26 +799,24 @@ tyConStupidTheta (TupleTyCon {})                  = []
 tyConStupidTheta tycon = pprPanic "tyConStupidTheta" (ppr tycon)
 \end{code}
 
 tyConStupidTheta tycon = pprPanic "tyConStupidTheta" (ppr tycon)
 \end{code}
 

-@tyConArgVrcs_maybe@ gives a list of (occPos,occNeg) flags, one for
-each tyvar, if available.  See @calcAlgTyConArgVrcs@ for how this is
-actually computed (in another file).
-
-\begin{code}
-tyConArgVrcs :: TyCon -> ArgVrcs
-tyConArgVrcs (FunTyCon   {})                  = [(False,True),(True,False)]
-tyConArgVrcs (AlgTyCon   {argVrcs = oi})       = oi
-tyConArgVrcs (PrimTyCon  {argVrcs = oi})       = oi
-tyConArgVrcs (TupleTyCon {tyConArity = arity}) = (replicate arity (True,False))
-tyConArgVrcs (SynTyCon   {argVrcs = oi})       = oi
-\end{code}
-

 \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}

@@ -746,12 +832,28 @@ 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 other_tycon                            = 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 other_tycon                               = Nothing
+
+isFamInstTyCon :: TyCon -> Bool
+isFamInstTyCon (AlgTyCon {algTcParent = FamilyTyCon _ _ _ }) = True
+isFamInstTyCon other_tycon                                  = False
+
+tyConFamInst_maybe :: TyCon -> Maybe (TyCon, [Type])
+tyConFamInst_maybe (AlgTyCon {algTcParent = FamilyTyCon fam instTys _}) = 
+  Just (fam, instTys)
+tyConFamInst_maybe other_tycon                                         = 
+  Nothing
+
+tyConFamilyCoercion_maybe :: TyCon -> Maybe TyCon
+tyConFamilyCoercion_maybe (AlgTyCon {algTcParent = FamilyTyCon _ _ coe}) = 
+  Just coe
+tyConFamilyCoercion_maybe other_tycon                                   = 
+  Nothing

 \end{code}
 
 
 \end{code}