Straightened out implicit coercions for indexed types
authorManuel M T Chakravarty <chak@cse.unsw.edu.au>
Wed, 20 Sep 2006 18:44:04 +0000 (18:44 +0000)
committerManuel M T Chakravarty <chak@cse.unsw.edu.au>
Wed, 20 Sep 2006 18:44:04 +0000 (18:44 +0000)
Mon Sep 18 19:35:24 EDT 2006  Manuel M T Chakravarty <chak@cse.unsw.edu.au>
  * Straightened out implicit coercions for indexed types
  Mon Sep  4 23:46:14 EDT 2006  Manuel M T Chakravarty <chak@cse.unsw.edu.au>
    * Straightened out implicit coercions for indexed types
    - HscTypes.implicitTyThings and LoadIface.ifaceDeclSubBndrs now
      include the coercion of indexed data/newtypes.
    - Name generation for the internal names of indexed data/newtypes now uses
      the same counter that generates the dfun unique indexes (ie, class and type
      instances are counted with the one counter).  We could make this two
      separate counters if that's what's preferred.
    - The unique index of a data/newtype instances needs to go into the iface, so
      that we can generate the same names on slurping in the iface as when the
      original module was generated.  This is a bit yucky, but I don't see a way
      to avoid that (other than putting the full blown internal tycon name and
      coercion name into the iface, which IMHO would be worse).
    - The predicate for when a datacon has a wrapper didn't take GADT
      equations nor whether it comes froma  family instance into account.

    *** WARNING!  This patch changed the interface file format. ***
    ***           Please recompile from scratch.                ***

12 files changed:
compiler/basicTypes/MkId.lhs
compiler/basicTypes/OccName.lhs
compiler/iface/BuildTyCl.lhs
compiler/iface/IfaceSyn.lhs
compiler/iface/LoadIface.lhs
compiler/iface/MkIface.lhs
compiler/iface/TcIface.lhs
compiler/main/HscTypes.lhs
compiler/typecheck/TcInstDcls.lhs
compiler/typecheck/TcTyClsDecls.lhs
compiler/types/Coercion.lhs
compiler/types/TyCon.lhs

index fda6763..54bbae9 100644 (file)
@@ -64,7 +64,7 @@ import TyCon          ( TyCon, isNewTyCon, tyConDataCons, FieldLabel,
                           tyConStupidTheta, isProductTyCon, isDataTyCon,
                           isRecursiveTyCon, isFamInstTyCon,
                           tyConFamInst_maybe, tyConFamilyCoercion_maybe,
-                          newTyConCo )
+                          newTyConCo_maybe )
 import Class           ( Class, classTyCon, classSelIds )
 import Var             ( Id, TyVar, Var, setIdType )
 import VarSet          ( isEmptyVarSet, subVarSet, varSetElems )
@@ -220,14 +220,14 @@ This coercion is conditionally applied by wrapFamInstBody.
 mkDataConIds :: Name -> Name -> DataCon -> DataConIds
 mkDataConIds wrap_name wkr_name data_con
   | isNewTyCon tycon
-  = DCIds Nothing nt_work_id                    -- Newtype, only has a worker
+  = DCIds Nothing nt_work_id                 -- Newtype, only has a worker
 
-  | any isMarkedStrict all_strict_marks                -- Algebraic, needs wrapper
-    || not (null eq_spec)
-    || isFamInstTyCon tycon
+  | any isMarkedStrict all_strict_marks             -- Algebraic, needs wrapper
+    || not (null eq_spec)                   -- NB: LoadIface.ifaceDeclSubBndrs
+    || isFamInstTyCon tycon                 --     depends on this test
   = DCIds (Just alg_wrap_id) wrk_id
 
-  | otherwise                                  -- Algebraic, no wrapper
+  | otherwise                               -- Algebraic, no wrapper
   = DCIds Nothing wrk_id
   where
     (univ_tvs, ex_tvs, eq_spec, 
@@ -860,7 +860,7 @@ wrapNewTypeBody tycon args result_expr
   = wrapFamInstBody tycon args inner
   where
     inner
-      | Just co_con <- newTyConCo tycon
+      | Just co_con <- newTyConCo_maybe tycon
       = mkCoerce (mkSymCoercion (mkTyConApp co_con args)) result_expr
       | otherwise
       = result_expr
@@ -872,7 +872,7 @@ wrapNewTypeBody tycon args result_expr
 --
 unwrapNewTypeBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr
 unwrapNewTypeBody tycon args result_expr
-  | Just co_con <- newTyConCo tycon
+  | Just co_con <- newTyConCo_maybe tycon
   = mkCoerce (mkTyConApp co_con args) result_expr
   | otherwise
   = result_expr
index 3465f55..9319c67 100644 (file)
@@ -483,20 +483,19 @@ mkLocalOcc uniq occ
 -- Derive a name for the representation type constructor of a data/newtype
 -- instance.
 --
-mkInstTyTcOcc :: Unique                -- Unique
+mkInstTyTcOcc :: Int                   -- Index
              -> OccName                -- Local name (e.g. "Map")
              -> OccName                -- Nice unique version (":R23Map")
-mkInstTyTcOcc uniq occ
-   = mk_deriv varName (":R" ++ show uniq) (occNameString occ)
+mkInstTyTcOcc index occ
+   = mk_deriv varName (":R" ++ show index) (occNameString occ)
 
 -- Derive a name for the coercion of a data/newtype instance.
 --
-mkInstTyCoOcc :: Unique                -- Unique
+mkInstTyCoOcc :: Int                   -- Index
              -> OccName                -- Local name (e.g. "Map")
-             -> OccName                -- Nice unique version ("Co23Map")
-mkInstTyCoOcc uniq occ
-   = mk_deriv varName ("Co" ++ show uniq) (occNameString occ)
-
+             -> OccName                -- Nice unique version (":Co23Map")
+mkInstTyCoOcc index occ
+   = mk_deriv varName (":Co" ++ show index) (occNameString occ)
 \end{code}
 
 \begin{code}
index 5f23fd5..8093c08 100644 (file)
@@ -69,7 +69,8 @@ buildAlgTyCon :: Name -> [TyVar]
              -> RecFlag
              -> Bool                   -- True <=> want generics functions
              -> Bool                   -- True <=> was declared in GADT syntax
-             -> Maybe (TyCon, [Type])  -- Just (family, tys) 
+             -> Maybe (TyCon, [Type], 
+                       Int)            -- Just (family, tys, index) 
                                        -- <=> instance of `family' at `tys'
              -> TcRnIf m n TyCon
 
@@ -102,20 +103,19 @@ buildAlgTyCon tc_name tvs stupid_theta rhs is_rec want_generics gadt_syn
     -- (3) Produce a `AlgTyConParent' value containing the parent and coercion
     --     information.
     --
-    maybeComputeFamilyInfo Nothing                  rep_tycon = 
+    maybeComputeFamilyInfo Nothing                         rep_tycon = 
       return (tc_name, NoParentTyCon)
-    maybeComputeFamilyInfo (Just (family, instTys)) rep_tycon =
+    maybeComputeFamilyInfo (Just (family, instTys, index)) rep_tycon =
       do { -- (1) New, derived name for the instance tycon
-        ; uniq <- newUnique
-        ; final_name <- newImplicitBinder tc_name (mkInstTyTcOcc uniq)
+        ; final_name <- newImplicitBinder tc_name (mkInstTyTcOcc index)
 
           -- (2) Create the coercion.
-        ; co_tycon_name <- newImplicitBinder tc_name (mkInstTyCoOcc uniq)
+        ; co_tycon_name <- newImplicitBinder tc_name (mkInstTyCoOcc index)
         ; let co_tycon = mkDataInstCoercion co_tycon_name tvs
                                             family instTys rep_tycon
 
           -- (3) Produce parent information.
-        ; return (final_name, FamilyTyCon family instTys co_tycon)
+        ; return (final_name, FamilyTyCon family instTys co_tycon index)
         }
     
 
index bf62095..5f9c1d8 100644 (file)
@@ -87,7 +87,8 @@ data IfaceDecl
                                                -- current compilation unit 
                 ifFamInst    :: Maybe           -- Just _ <=> instance of fam
                                  (IfaceTyCon,  --   Family tycon
-                                  [IfaceType]) --   Instance types
+                                  [IfaceType], --   Instance types
+                                  Int    )     --   Unique index for naming
     }
 
   | IfaceSyn  {        ifName    :: OccName,           -- Type constructor
@@ -283,9 +284,10 @@ pprRec isrec = ptext SLIT("RecFlag") <+> ppr isrec
 pprGen True  = ptext SLIT("Generics: yes")
 pprGen False = ptext SLIT("Generics: no")
 
-pprFamily Nothing           = ptext SLIT("FamilyInstance: none")
-pprFamily (Just (fam, tys)) = ptext SLIT("FamilyInstance:") <+> 
-                             ppr fam <+> hsep (map ppr tys)
+pprFamily Nothing                  = ptext SLIT("FamilyInstance: none")
+pprFamily (Just (fam, tys, index)) = ptext SLIT("FamilyInstance:") <+> 
+                                    ppr fam <+> hsep (map ppr tys) <+>
+                                    brackets (ppr index)
 
 instance Outputable IfaceClassOp where
    ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
@@ -554,10 +556,10 @@ eqIfDecl d1@(IfaceData {}) d2@(IfaceData {})
        -- over the constructors (any more), but they do scope
        -- over the stupid context in the IfaceConDecls
   where
-    Nothing             `eqIfTc_fam` Nothing             = Equal
-    (Just (fam1, tys1)) `eqIfTc_fam` (Just (fam2, tys2)) = 
-      fam1 `eqIfTc` fam2 &&& eqListBy eqIfType tys1 tys2
-    _                  `eqIfTc_fam` _                   = NotEqual
+    Nothing                  `eqIfTc_fam` Nothing                  = Equal
+    (Just (fam1, tys1, co1)) `eqIfTc_fam` (Just (fam2, tys2, co2)) = 
+      fam1 `eqIfTc` fam2 &&& eqListBy eqIfType tys1 tys2 &&& bool (co1 == co2)
+    _                       `eqIfTc_fam` _                        = NotEqual
 
 eqIfDecl d1@(IfaceSyn {}) d2@(IfaceSyn {})
   = bool (ifName d1 == ifName d2) &&&
index d3dbd0d..c91aa63 100644 (file)
@@ -49,9 +49,9 @@ import NameEnv
 import MkId            ( seqId )
 import Module
 import OccName         ( OccName, mkOccEnv, lookupOccEnv, mkClassTyConOcc,
-                          mkClassDataConOcc, mkSuperDictSelOcc,
-                          mkDataConWrapperOcc, mkDataConWorkerOcc,
-                          mkNewTyCoOcc )
+                         mkClassDataConOcc, mkSuperDictSelOcc,
+                         mkDataConWrapperOcc, mkDataConWorkerOcc,
+                         mkNewTyCoOcc, mkInstTyTcOcc, mkInstTyCoOcc ) 
 import SrcLoc          ( importedSrcLoc )
 import Maybes          ( MaybeErr(..) )
 import ErrUtils         ( Message )
@@ -64,6 +64,7 @@ import BinIface               ( readBinIface, v_IgnoreHiWay )
 import Binary          ( getBinFileWithDict )
 import Panic           ( ghcError, tryMost, showException, GhcException(..) )
 import List            ( nub )
+import Maybe            ( isJust )
 import DATA_IOREF      ( writeIORef )
 \end{code}
 
@@ -300,7 +301,7 @@ loadDecl ignore_prags mod (_version, decl)
          main_name      <- mk_new_bndr mod Nothing (ifName decl)
        ; implicit_names <- mapM (mk_new_bndr mod (Just main_name)) 
                                 (ifaceDeclSubBndrs decl)
-        ; at_names       <- mapM (mk_new_bndr mod Nothing) (atNames decl)
+        ; at_names       <- mapM (mk_new_bndr mod  (Just main_name)) (atNames decl)
 
        -- Typecheck the thing, lazily
        -- NB. firstly, the laziness is there in case we never need the
@@ -387,12 +388,18 @@ ifaceDeclSubBndrs IfaceData {ifCons = IfAbstractTyCon}
 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
                              ifCons = IfNewTyCon (
                                         IfCon { ifConOcc = con_occ, 
-                                                ifConFields = fields})})
-  = fields ++ [con_occ, mkDataConWrapperOcc con_occ, mkNewTyCoOcc tc_occ]
+                                                          ifConFields = fields
+                                                        }),
+                             ifFamInst = famInst}) 
+  = fields ++ [con_occ, mkDataConWorkerOcc con_occ, mkNewTyCoOcc tc_occ]
+    ++ famInstCo famInst tc_occ
 
-ifaceDeclSubBndrs (IfaceData {ifCons = IfDataTyCon cons})
+ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
+                             ifCons = IfDataTyCon cons, 
+                             ifFamInst = famInst})
   = nub (concatMap ifConFields cons)   -- Eliminate duplicate fields
     ++ concatMap dc_occs cons
+    ++ famInstCo famInst tc_occ
   where
     dc_occs con_decl
        | has_wrapper = [con_occ, work_occ, wrap_occ]
@@ -403,9 +410,16 @@ ifaceDeclSubBndrs (IfaceData {ifCons = IfDataTyCon cons})
          wrap_occ = mkDataConWrapperOcc con_occ
          work_occ = mkDataConWorkerOcc con_occ
          has_wrapper = any isMarkedStrict strs -- See MkId.mkDataConIds (sigh)
+                       || not (null . ifConEqSpec $ con_decl)
+                       || isJust famInst
                -- ToDo: may miss strictness in existential dicts
 
 ifaceDeclSubBndrs _other = []
+
+-- coercion for data/newtype family instances
+famInstCo Nothing              baseOcc = []
+famInstCo (Just (_, _, index)) baseOcc = [mkInstTyTcOcc index baseOcc,
+                                         mkInstTyCoOcc index baseOcc]
 \end{code}
 
 
index d399967..3bc9257 100644 (file)
@@ -191,7 +191,7 @@ import TyCon                ( TyCon, AlgTyConRhs(..), SynTyConRhs(..),
                          isTupleTyCon, tupleTyConBoxity, tyConStupidTheta,
                          tyConHasGenerics, synTyConRhs, isGadtSyntaxTyCon,
                          tyConArity, tyConTyVars, algTyConRhs, tyConExtName,
-                         tyConFamInst_maybe )
+                         tyConFamInst_maybe, tyConFamInstIndex )
 import DataCon         ( dataConName, dataConFieldLabels, dataConStrictMarks,
                          dataConTyCon, dataConIsInfix, dataConUnivTyVars,
                          dataConExTyVars, dataConEqSpec, dataConTheta,
@@ -379,17 +379,17 @@ mkExtNameFn hsc_env eps this_mod
        occ      = nameOccName name
        par_occ  = nameOccName (nameParent name)
                -- The version of the *parent* is the one want
-       vers     = lookupVersion mod par_occ
+       vers     = lookupVersion mod par_occ occ
              
-    lookupVersion :: Module -> OccName -> Version
+    lookupVersion :: Module -> OccName -> OccName -> Version
        -- Even though we're looking up a home-package thing, in
        -- one-shot mode the imported interfaces may be in the PIT
-    lookupVersion mod occ
-      = mi_ver_fn iface occ `orElse` 
-        pprPanic "lookupVers1" (ppr mod <+> ppr occ)
+    lookupVersion mod par_occ occ
+      = mi_ver_fn iface par_occ `orElse` 
+        pprPanic "lookupVers1" (ppr mod <+> ppr par_occ <+> ppr occ)
       where
         iface = lookupIfaceByModule (hsc_dflags hsc_env) hpt pit mod `orElse` 
-               pprPanic "lookupVers2" (ppr mod <+> ppr occ)
+               pprPanic "lookupVers2" (ppr mod <+> ppr par_occ <+> ppr occ)
 
 
 ---------------------
@@ -1036,7 +1036,8 @@ tyThingToIfaceDecl ext (ATyCon tycon)
                ifRec     = boolToRecFlag (isRecursiveTyCon tycon),
                ifGadtSyntax = isGadtSyntaxTyCon tycon,
                ifGeneric = tyConHasGenerics tycon,
-               ifFamInst = famInstToIface $ tyConFamInst_maybe tycon }
+               ifFamInst = famInstToIface (tyConFamInst_maybe tycon)
+                                          (tyConFamInstIndex tycon) }
 
   | isForeignTyCon tycon
   = IfaceForeign { ifName    = getOccName tycon,
@@ -1087,9 +1088,9 @@ tyThingToIfaceDecl ext (ATyCon tycon)
 
     to_eq_spec spec = [(getOccName tv, toIfaceType ext ty) | (tv,ty) <- spec]
 
-    famInstToIface Nothing                    = Nothing
-    famInstToIface (Just (famTyCon, instTys)) = 
-      Just (toIfaceTyCon ext famTyCon, map (toIfaceType ext) instTys)
+    famInstToIface Nothing                    _     = Nothing
+    famInstToIface (Just (famTyCon, instTys)) index 
+      Just (toIfaceTyCon ext famTyCon, map (toIfaceType ext) instTys, index)
 
 tyThingToIfaceDecl ext (ADataCon dc)
  = pprPanic "toIfaceDecl" (ppr dc)     -- Should be trimmed out earlier
index 6c197cc..68abd23 100644 (file)
@@ -371,11 +371,11 @@ tcIfaceDecl (IfaceData {ifName = occ_name,
            { stupid_theta <- tcIfaceCtxt ctxt
            ; famInst <- 
                case mb_family of
-                 Nothing         -> return Nothing
-                 Just (fam, tys) -> 
+                 Nothing                -> return Nothing
+                 Just (fam, tys, index) -> 
                    do { famTyCon <- tcIfaceTyCon fam
                       ; insttys <- mapM tcIfaceType tys
-                      ; return $ Just (famTyCon, insttys)
+                      ; return $ Just (famTyCon, insttys, index)
                       }
            ; cons <- tcIfaceDataCons tc_name tycon tyvars rdr_cons
            ; buildAlgTyCon tc_name tyvars stupid_theta
index 2c8780c..b142d19 100644 (file)
@@ -83,7 +83,8 @@ import Id             ( Id )
 import Type            ( TyThing(..) )
 
 import Class           ( Class, classSelIds, classTyCon )
-import TyCon           ( TyCon, tyConSelIds, tyConDataCons, isNewTyCon, newTyConCo )
+import TyCon           ( TyCon, tyConSelIds, tyConDataCons, isNewTyCon,
+                         newTyConCo_maybe, tyConFamilyCoercion_maybe )
 import DataCon         ( dataConImplicitIds )
 import PrelNames       ( gHC_PRIM )
 import Packages                ( PackageId )
@@ -105,6 +106,7 @@ import FastString   ( FastString )
 
 import DATA_IOREF      ( IORef, readIORef )
 import StringBuffer    ( StringBuffer )
+import Maybe            ( catMaybes )
 import Time            ( ClockTime )
 \end{code}
 
@@ -626,9 +628,10 @@ implicitTyThings (AnId id)   = []
        -- and the selectors and generic-programming Ids too
        --
        -- Newtypes don't have a worker Id, so don't generate that?
-implicitTyThings (ATyCon tc) = implicitNewCoTyCon tc ++
+implicitTyThings (ATyCon tc) = implicitCoTyCon tc ++
                               map AnId (tyConSelIds tc) ++ 
-                              concatMap (extras_plus . ADataCon) (tyConDataCons tc)
+                              concatMap (extras_plus . ADataCon) 
+                                        (tyConDataCons tc)
                     
        -- For classes, add the class TyCon too (and its extras)
        -- and the class selector Ids
@@ -639,10 +642,10 @@ implicitTyThings (AClass cl) = map AnId (classSelIds cl) ++
        -- For data cons add the worker and wrapper (if any)
 implicitTyThings (ADataCon dc) = map AnId (dataConImplicitIds dc)
 
-       -- For newtypes, add the implicit coercion tycon
-implicitNewCoTyCon tc 
-  | isNewTyCon tc, Just co_con <- newTyConCo tc = [ATyCon co_con]
-  | otherwise = []
+       -- For newtypes and indexed data types, add the implicit coercion tycon
+implicitCoTyCon tc 
+  = map ATyCon . catMaybes $ [newTyConCo_maybe tc, 
+                             tyConFamilyCoercion_maybe tc]
 
 extras_plus thing = thing : implicitTyThings thing
 
index 1d8310c..e186b36 100644 (file)
@@ -33,7 +33,7 @@ import Type           ( zipOpenTvSubst, substTheta, mkTyConApp, mkTyVarTy,
                           splitFunTys, TyThing(ATyCon), isTyVarTy, tcEqType,
                           substTys, emptyTvSubst, extendTvSubst )
 import Coercion         ( mkSymCoercion )
-import TyCon            ( TyCon, tyConName, newTyConCo, tyConTyVars,
+import TyCon            ( TyCon, tyConName, newTyConCo_maybe, tyConTyVars,
                          isTyConAssoc, tyConFamInst_maybe,
                          assocTyConArgPoss_maybe )
 import DataCon         ( classDataCon, dataConTyCon, dataConInstArgTys )
@@ -550,7 +550,7 @@ tcInstDecl2 (InstInfo { iSpec = ispec,
   where
        -- For newtype T a = MkT <ty>
        -- The returned coercion has kind :: C (T a):=:C <ty>
-    co_fn tvs cls_tycon cls_inst_tys | Just co_con <- newTyConCo tycon
+    co_fn tvs cls_tycon cls_inst_tys | Just co_con <- newTyConCo_maybe tycon
           = ExprCoFn (mkTyConApp cls_tycon (drop_tail 1 cls_inst_tys ++
                       [mkSymCoercion (mkTyConApp co_con (map mkTyVarTy tvs))]))
           | otherwise
index 95e172c..9065d28 100644 (file)
@@ -319,6 +319,7 @@ tcIdxTyInstDecl1 (decl@TyData {tcdND = new_or_data, tcdLName = L loc tc_name,
        ; t_typats     <- mappM tcHsKindedType k_typats
        ; stupid_theta <- tcHsKindedContext k_ctxt
 
+       ; index <- nextDFunIndex                   -- to generate unique names
        ; tycon <- fixM (\ tycon -> do 
             { data_cons <- mappM (addLocM (tcConDecl unbox_strict new_or_data 
                                              tycon t_tvs))
@@ -330,7 +331,7 @@ tcIdxTyInstDecl1 (decl@TyData {tcdND = new_or_data, tcdLName = L loc tc_name,
                            ASSERT( isSingleton data_cons )
                            mkNewTyConRhs tc_name tycon (head data_cons)
             ; buildAlgTyCon tc_name t_tvs stupid_theta tc_rhs Recursive
-                            False h98_syntax (Just (family, t_typats))
+                            False h98_syntax (Just (family, t_typats, index))
                  -- We always assume that indexed types are recursive.  Why?
                  -- (1) Due to their open nature, we can never be sure that a
                  -- further instance might not introduce a new recursive
index ff49a6e..1dbd7f3 100644 (file)
@@ -41,7 +41,7 @@ import Type     ( Type, Kind, PredType, substTyWith, mkAppTy, mkForAllTy,
                     tyVarsOfType, mkTyVarTys
                   )
 import TyCon      ( TyCon, tyConArity, mkCoercionTyCon, isClosedNewTyCon,
-                    newTyConRhs, newTyConCo, 
+                    newTyConRhs, newTyConCo_maybe
                     isCoercionTyCon, isCoercionTyCon_maybe )
 import Var       ( Var, TyVar, isTyVar, tyVarKind )
 import VarSet     ( elemVarSet )
@@ -459,6 +459,6 @@ splitNewTypeRepCo_maybe (TyConApp tc tys)
               ASSERT( length tvs == length tys )
              Just (substTyWith tvs tys rep_ty, mkTyConApp co_con tys)
   where
-    co_con = maybe (pprPanic "splitNewTypeRepCo_maybe" (ppr tc)) id (newTyConCo tc)
+    co_con = maybe (pprPanic "splitNewTypeRepCo_maybe" (ppr tc)) id (newTyConCo_maybe tc)
 splitNewTypeRepCo_maybe other = Nothing
 \end{code}
index 1464fab..723a790 100644 (file)
@@ -19,7 +19,7 @@ module TyCon(
        isEnumerationTyCon, isGadtSyntaxTyCon, isOpenTyCon,
        assocTyConArgPoss_maybe, isTyConAssoc, setTyConArgPoss,
        isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, tupleTyConBoxity,
-       isRecursiveTyCon, newTyConRep, newTyConRhs, newTyConCo,
+       isRecursiveTyCon, newTyConRep, newTyConRhs, newTyConCo_maybe,
        isHiBootTyCon, isSuperKindTyCon,
         isCoercionTyCon_maybe, isCoercionTyCon,
 
@@ -50,6 +50,7 @@ module TyCon(
        tyConArity,
        isClassTyCon, tyConClass_maybe,
        isFamInstTyCon, tyConFamInst_maybe, tyConFamilyCoercion_maybe,
+       tyConFamInstIndex,
        synTyConDefn, synTyConRhs, synTyConType, synTyConResKind,
        tyConExtName,           -- External name for foreign types
 
@@ -274,6 +275,9 @@ data AlgTyConParent = -- An ordinary type constructor has no parent.
                                    TyCon       -- a *coercion* identifying
                                                -- the representation type
                                                -- with the type instance
+                                    Int         -- index to generate unique
+                                               -- name (needed here to put
+                                               -- into iface)
 
 data SynTyConRhs
   = OpenSynTyCon Kind  -- Type family: *result* kind given
@@ -756,12 +760,9 @@ newTyConRep :: TyCon -> ([TyVar], Type)
 newTyConRep (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_rep = rep }}) = (tvs, rep)
 newTyConRep tycon = pprPanic "newTyConRep" (ppr tycon)
 
-newTyConCo :: TyCon -> Maybe TyCon
-newTyConCo (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_co = co }})
-  = co
-newTyConCo (AlgTyCon {tyConTyVars = tvs, algTcRhs = OpenNewTyCon})
-  = Nothing
-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
@@ -816,20 +817,25 @@ tyConClass_maybe (AlgTyCon {algTcParent = ClassTyCon clas}) = Just clas
 tyConClass_maybe ther_tycon                                = Nothing
 
 isFamInstTyCon :: TyCon -> Bool
-isFamInstTyCon (AlgTyCon {algTcParent = FamilyTyCon _ _ _}) = True
-isFamInstTyCon other_tycon                                 = False
+isFamInstTyCon (AlgTyCon {algTcParent = FamilyTyCon _ _ _ _}) = True
+isFamInstTyCon other_tycon                                   = False
 
 tyConFamInst_maybe :: TyCon -> Maybe (TyCon, [Type])
-tyConFamInst_maybe (AlgTyCon {algTcParent = FamilyTyCon fam instTys _}) = 
+tyConFamInst_maybe (AlgTyCon {algTcParent = FamilyTyCon fam instTys _ _}) = 
   Just (fam, instTys)
-tyConFamInst_maybe ther_tycon                                          = 
+tyConFamInst_maybe ther_tycon                                            
   Nothing
 
 tyConFamilyCoercion_maybe :: TyCon -> Maybe TyCon
-tyConFamilyCoercion_maybe (AlgTyCon {algTcParent = FamilyTyCon _ _ coe}) = 
+tyConFamilyCoercion_maybe (AlgTyCon {algTcParent = FamilyTyCon _ _ coe _}) = 
   Just coe
-tyConFamilyCoercion_maybe ther_tycon                                    = 
+tyConFamilyCoercion_maybe ther_tycon                                      
   Nothing
+
+tyConFamInstIndex :: TyCon -> Int
+tyConFamInstIndex (AlgTyCon {algTcParent = FamilyTyCon _ _ _ index}) = index
+tyConFamInstIndex _                                                 = 
+  panic "tyConFamInstIndex"
 \end{code}