X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FMkIface.lhs;h=f1a0d5728cee5a7b69f71822da8ffbc98d5ed5e8;hb=17434e5beb213f1e8971d1ce8ffbf40a0848bb3a;hp=d39996775e08567aa3b5642427ddeb610f94355b;hpb=909d2dd885f5eebaf7c12cf15d5ac153d646566e;p=ghc-hetmet.git

diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index d399967..f1a0d57 100644
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -202,10 +202,11 @@ import TysPrim		( alphaTyVars )
 import InstEnv		( Instance(..) )
 import TcRnMonad
 import HscTypes		( ModIface(..), ModDetails(..), 
-			  ModGuts(..), HscEnv(..), hscEPS, Dependencies(..), FixItem(..),
+			  ModGuts(..), HscEnv(..), hscEPS, Dependencies(..),
+			  FixItem(..), 
 			  ModSummary(..), msHiFilePath, 
 			  mkIfaceDepCache, mkIfaceFixCache, mkIfaceVerCache,
-			  typeEnvElts, 
+			  typeEnvElts, mkIfaceFamInstsCache,
 			  GenAvailInfo(..), availName, 
 			  ExternalPackageState(..),
 			  Usage(..), IsBootInterface,
@@ -266,17 +267,18 @@ mkIface :: HscEnv
 				--	    is identical, so no need to write it
 
 mkIface hsc_env maybe_old_iface 
-	(ModGuts{     mg_module  = this_mod,
-		      mg_boot    = is_boot,
-		      mg_usages  = usages,
-		      mg_deps    = deps,
-		      mg_rdr_env = rdr_env,
-		      mg_fix_env = fix_env,
-		      mg_deprecs = src_deprecs })
-	(ModDetails{  md_insts 	 = insts, 
-		      md_rules 	 = rules,
-		      md_types 	 = type_env,
-		      md_exports = exports })
+	(ModGuts{     mg_module   = this_mod,
+		      mg_boot     = is_boot,
+		      mg_usages   = usages,
+		      mg_deps     = deps,
+		      mg_rdr_env  = rdr_env,
+		      mg_fix_env  = fix_env,
+		      mg_deprecs  = src_deprecs })
+	(ModDetails{  md_insts 	  = insts, 
+		      md_fam_insts= _fam_inst,  -- we use the type_env instead
+		      md_rules 	  = rules,
+		      md_types 	  = type_env,
+		      md_exports  = exports })
 	
 -- NB:	notice that mkIface does not look at the bindings
 --	only at the TypeEnv.  The previous Tidy phase has
@@ -294,10 +296,13 @@ mkIface hsc_env maybe_old_iface
 		    	-- Don't put implicit Ids and class tycons in the interface file
 			-- Nor wired-in things; the compiler knows about them anyhow
 
-		; fixities    = [(occ,fix) | FixItem occ fix _ <- nameEnvElts fix_env]
-		; deprecs     = mkIfaceDeprec src_deprecs
-		; iface_rules = map (coreRuleToIfaceRule ext_nm_lhs ext_nm_rhs) rules
-		; iface_insts = map (instanceToIfaceInst ext_nm_lhs) insts
+		; fixities        = [ (occ,fix) 
+				    | FixItem occ fix _ <- nameEnvElts fix_env]
+		; deprecs         = mkIfaceDeprec src_deprecs
+		; iface_rules     = map (coreRuleToIfaceRule 
+					   ext_nm_lhs ext_nm_rhs) rules
+		; iface_insts     = map (instanceToIfaceInst ext_nm_lhs) insts
+		; iface_fam_insts = extractIfFamInsts decls
 
 	        ; intermediate_iface = ModIface { 
 			mi_module   = this_mod,
@@ -306,6 +311,7 @@ mkIface hsc_env maybe_old_iface
 			mi_usages   = usages,
 			mi_exports  = mkIfaceExports exports,
 			mi_insts    = sortLe le_inst iface_insts,
+			mi_fam_insts= mkIfaceFamInstsCache decls,
 			mi_rules    = sortLe le_rule iface_rules,
 			mi_fixities = fixities,
 			mi_deprecs  = deprecs,
@@ -339,8 +345,8 @@ mkIface hsc_env maybe_old_iface
 
 	; return (new_iface, no_change_at_all) }
   where
-     r1 `le_rule` r2 = ifRuleName r1 <= ifRuleName r2
-     i1 `le_inst` i2 = ifDFun     i1 <= ifDFun     i2
+     r1      `le_rule`     r2      = ifRuleName r1 <= ifRuleName r2
+     i1      `le_inst`     i2      = ifDFun     i1 <= ifDFun     i2
 
      dflags = hsc_dflags hsc_env
      deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
@@ -379,17 +385,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 +1042,7 @@ tyThingToIfaceDecl ext (ATyCon tycon)
 	  	ifRec     = boolToRecFlag (isRecursiveTyCon tycon),
 		ifGadtSyntax = isGadtSyntaxTyCon tycon,
 		ifGeneric = tyConHasGenerics tycon,
-		ifFamInst = famInstToIface $ tyConFamInst_maybe tycon }
+		ifFamInst = famInstToIface (tyConFamInst_maybe tycon)}
 
   | isForeignTyCon tycon
   = IfaceForeign { ifName    = getOccName tycon,
@@ -1089,7 +1095,9 @@ tyThingToIfaceDecl ext (ATyCon tycon)
 
     famInstToIface Nothing                    = Nothing
     famInstToIface (Just (famTyCon, instTys)) = 
-      Just (toIfaceTyCon ext famTyCon, map (toIfaceType ext) instTys)
+      Just $ IfaceFamInst { ifFamInstTyCon = toIfaceTyCon ext famTyCon
+			  , ifFamInstTys   = map (toIfaceType ext) instTys
+			  }
 
 tyThingToIfaceDecl ext (ADataCon dc)
  = pprPanic "toIfaceDecl" (ppr dc)	-- Should be trimmed out earlier