Straightened out implicit coercions for indexed types

[ghc-hetmet.git] / compiler / iface / MkIface.lhs

diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index 4cb2b53..3bc9257 100644 (file)
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -191,11 +191,11 @@ import TyCon              ( TyCon, AlgTyConRhs(..), SynTyConRhs(..),
                          isTupleTyCon, tupleTyConBoxity, tyConStupidTheta,
                          tyConHasGenerics, synTyConRhs, isGadtSyntaxTyCon,
                          tyConArity, tyConTyVars, algTyConRhs, tyConExtName,
-                         tyConFamily_maybe )
+                         tyConFamInst_maybe, tyConFamInstIndex )
 import DataCon         ( dataConName, dataConFieldLabels, dataConStrictMarks,
                          dataConTyCon, dataConIsInfix, dataConUnivTyVars,
                          dataConExTyVars, dataConEqSpec, dataConTheta,
-                         dataConOrigArgTys, dataConInstTys ) 
+                         dataConOrigArgTys ) 
 import Type            ( TyThing(..), splitForAllTys, funResultTy )
 import TcType          ( deNoteType )
 import TysPrim         ( alphaTyVars )
@@ -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,
-               ifFamily  = fmap (toIfaceTyCon ext) $ tyConFamily_maybe tycon }
+               ifFamInst = famInstToIface (tyConFamInst_maybe tycon)
+                                          (tyConFamInstIndex tycon) }
 
   | isForeignTyCon tycon
   = IfaceForeign { ifName    = getOccName tycon,
@@ -1051,7 +1052,7 @@ tyThingToIfaceDecl ext (ATyCon tycon)
                ifGadtSyntax = False,
                ifGeneric = False,
                ifRec     = NonRecursive,
-               ifFamily  = Nothing }
+               ifFamInst = Nothing }
 
   | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
   where
@@ -1083,12 +1084,14 @@ tyThingToIfaceDecl ext (ATyCon tycon)
                                       (dataConOrigArgTys data_con),
                    ifConFields  = map getOccName 
                                       (dataConFieldLabels data_con),
-                   ifConStricts = dataConStrictMarks data_con,
-                   ifConInstTys = fmap (map (toIfaceType ext)) 
-                                       (dataConInstTys data_con) }
+                   ifConStricts = dataConStrictMarks data_con }
 
     to_eq_spec spec = [(getOccName tv, toIfaceType ext ty) | (tv,ty) <- spec]
 
+    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