Rough matches for family instances
[ghc-hetmet.git] / compiler / main / HscTypes.lhs
index 2c0fa6c..6bc1197 100644 (file)
@@ -30,7 +30,7 @@ module HscTypes (
        icPrintUnqual, mkPrintUnqualified,
 
        ModIface(..), mkIfaceDepCache, mkIfaceVerCache, mkIfaceFixCache,
-       emptyIfaceDepCache, mkIfaceFamInstsCache, mkDetailsFamInstCache,
+       emptyIfaceDepCache,
 
        Deprecs(..), IfaceDeprecs,
 
@@ -78,14 +78,14 @@ import OccName              ( OccName, OccEnv, lookupOccEnv, mkOccEnv, emptyOccEnv,
                          extendOccEnv )
 import Module
 import InstEnv         ( InstEnv, Instance )
-import FamInstEnv      ( FamInst, extractFamInsts )
+import FamInstEnv      ( FamInstEnv, FamInst )
 import Rules           ( RuleBase )
 import CoreSyn         ( CoreBind )
 import Id              ( Id )
 import Type            ( TyThing(..) )
 
 import Class           ( Class, classSelIds, classATs, classTyCon )
-import TyCon           ( TyCon, tyConSelIds, tyConDataCons, isNewTyCon,
+import TyCon           ( TyCon, tyConSelIds, tyConDataCons, 
                          newTyConCo_maybe, tyConFamilyCoercion_maybe )
 import DataCon         ( DataCon, dataConImplicitIds )
 import PrelNames       ( gHC_PRIM )
@@ -96,7 +96,7 @@ import BasicTypes     ( Version, initialVersion, IPName,
                          Fixity, defaultFixity, DeprecTxt )
 
 import IfaceSyn                ( IfaceInst, IfaceFamInst, IfaceRule, 
-                         IfaceDecl(ifName), extractIfFamInsts )
+                         IfaceDecl(ifName) )
 
 import FiniteMap       ( FiniteMap )
 import CoreSyn         ( CoreRule )
@@ -109,7 +109,7 @@ import FastString   ( FastString )
 
 import DATA_IOREF      ( IORef, readIORef )
 import StringBuffer    ( StringBuffer )
-import Maybe            ( catMaybes )
+import Maybes           ( catMaybes, seqMaybe )
 import Time            ( ClockTime )
 \end{code}
 
@@ -247,12 +247,21 @@ lookupIfaceByModule
        -> Module
        -> Maybe ModIface
 lookupIfaceByModule dflags hpt pit mod
-  -- in one-shot, we don't use the HPT
-  | not (isOneShot (ghcMode dflags)) && modulePackageId mod == this_pkg 
-  = fmap hm_iface (lookupUFM hpt (moduleName mod))
-  | otherwise
-  = lookupModuleEnv pit mod
-  where this_pkg = thisPackage dflags
+  | modulePackageId mod == thisPackage dflags
+  =    -- The module comes from the home package, so look first
+       -- in the HPT.  If it's not from the home package it's wrong to look
+       -- in the HPT, because the HPT is indexed by *ModuleName* not Module
+    fmap hm_iface (lookupUFM hpt (moduleName mod)) 
+    `seqMaybe` lookupModuleEnv pit mod
+
+  | otherwise = lookupModuleEnv pit mod                -- Look in PIT only 
+
+-- If the module does come from the home package, why do we look in the PIT as well?
+-- (a) In OneShot mode, even home-package modules accumulate in the PIT
+-- (b) Even in Batch (--make) mode, there is *one* case where a home-package
+--     module is in the PIT, namely GHC.Prim when compiling the base package.
+-- We could eliminate (b) if we wanted, by making GHC.Prim belong to a packake
+-- of its own, but it doesn't seem worth the bother.
 \end{code}
 
 
@@ -411,8 +420,7 @@ data ModIface
 
                -- Instance declarations and rules
        mi_insts     :: [IfaceInst],                    -- Sorted
-       mi_fam_insts :: [(IfaceFamInst, IfaceDecl)],     -- Cached value
-                                       -- ...from mi_decls (not in iface file)
+       mi_fam_insts :: [IfaceFamInst],                 -- Sorted
        mi_rules     :: [IfaceRule],                    -- Sorted
        mi_rule_vers :: !Version,       -- Version number for rules and 
                                        -- instances combined
@@ -428,10 +436,6 @@ data ModIface
                        -- seeing if we are up to date wrt the old interface
      }
 
--- Pre-compute the set of type instances from the declaration list.
-mkIfaceFamInstsCache :: [IfaceDecl] -> [(IfaceFamInst, IfaceDecl)]
-mkIfaceFamInstsCache = extractIfFamInsts
-
 -- Should be able to construct ModDetails from mi_decls in ModIface
 data ModDetails
    = ModDetails {
@@ -453,10 +457,6 @@ emptyModDetails = ModDetails { md_types = emptyTypeEnv,
                               md_rules     = [],
                               md_fam_insts = [] }
 
--- Pre-compute the set of type instances from the type environment.
-mkDetailsFamInstCache :: TypeEnv -> [FamInst]
-mkDetailsFamInstCache = extractFamInsts . typeEnvElts
-
 -- A ModGuts is carried through the compiler, accumulating stuff as it goes
 -- There is only one ModGuts at any time, the one for the module
 -- being compiled right now.  Once it is compiled, a ModIface and 
@@ -464,23 +464,26 @@ mkDetailsFamInstCache = extractFamInsts . typeEnvElts
 
 data ModGuts
   = ModGuts {
-        mg_module   :: !Module,
-       mg_boot     :: IsBootInterface, -- Whether it's an hs-boot module
-       mg_exports  :: !NameSet,        -- What it exports
-       mg_deps     :: !Dependencies,   -- What is below it, directly or otherwise
-       mg_dir_imps :: ![Module],       -- Directly-imported modules; used to
-                                       --      generate initialisation code
-       mg_usages   :: ![Usage],        -- Version info for what it needed
-
-        mg_rdr_env  :: !GlobalRdrEnv,  -- Top-level lexical environment
-       mg_fix_env  :: !FixityEnv,      -- Fixity env, for things declared in this module
-       mg_deprecs  :: !Deprecations,   -- Deprecations declared in the module
-
-       mg_types    :: !TypeEnv,
-       mg_insts    :: ![Instance],     -- Instances 
-        mg_rules    :: ![CoreRule],    -- Rules from this module
-       mg_binds    :: ![CoreBind],     -- Bindings for this module
-       mg_foreign  :: !ForeignStubs
+        mg_module    :: !Module,
+       mg_boot      :: IsBootInterface, -- Whether it's an hs-boot module
+       mg_exports   :: !NameSet,        -- What it exports
+       mg_deps      :: !Dependencies,   -- What is below it, directly or
+                                        --   otherwise 
+       mg_dir_imps  :: ![Module],       -- Directly-imported modules; used to
+                                        --     generate initialisation code
+       mg_usages    :: ![Usage],        -- Version info for what it needed
+
+        mg_rdr_env   :: !GlobalRdrEnv,  -- Top-level lexical environment
+       mg_fix_env   :: !FixityEnv,      -- Fixity env, for things declared in
+                                        --   this module 
+       mg_deprecs   :: !Deprecations,   -- Deprecations declared in the module
+
+       mg_types     :: !TypeEnv,
+       mg_insts     :: ![Instance],     -- Instances 
+       mg_fam_insts :: ![FamInst],      -- Instances 
+        mg_rules     :: ![CoreRule],    -- Rules from this module
+       mg_binds     :: ![CoreBind],     -- Bindings for this module
+       mg_foreign   :: !ForeignStubs
     }
 
 -- The ModGuts takes on several slightly different forms:
@@ -939,9 +942,10 @@ data Usage
 %************************************************************************
 
 \begin{code}
-type PackageTypeEnv  = TypeEnv
-type PackageRuleBase = RuleBase
-type PackageInstEnv  = InstEnv
+type PackageTypeEnv    = TypeEnv
+type PackageRuleBase   = RuleBase
+type PackageInstEnv    = InstEnv
+type PackageFamInstEnv = FamInstEnv
 
 data ExternalPackageState
   = EPS {
@@ -962,8 +966,8 @@ data ExternalPackageState
                -- The ModuleIFaces for modules in external packages
                -- whose interfaces we have opened
                -- The declarations in these interface files are held in
-               -- eps_decls, eps_inst_env, eps_rules (below), not in the 
-               -- mi_decls fields of the iPIT.  
+               -- eps_decls, eps_inst_env, eps_fam_inst_env, eps_rules
+               -- (below), not in the mi_decls fields of the iPIT.  
                -- What _is_ in the iPIT is:
                --      * The Module 
                --      * Version info
@@ -971,11 +975,13 @@ data ExternalPackageState
                --      * Fixities
                --      * Deprecations
 
-       eps_PTE :: !PackageTypeEnv,             -- Domain = external-package modules
+       eps_PTE :: !PackageTypeEnv,        -- Domain = external-package modules
 
-       eps_inst_env :: !PackageInstEnv,        -- The total InstEnv accumulated from
-                                               --   all the external-package modules
-       eps_rule_base :: !PackageRuleBase,      -- Ditto RuleEnv
+       eps_inst_env     :: !PackageInstEnv,   -- The total InstEnv accumulated
+                                              -- from all the external-package
+                                              -- modules 
+       eps_fam_inst_env :: !PackageFamInstEnv,-- Ditto FamInstEnv
+       eps_rule_base    :: !PackageRuleBase,  -- Ditto RuleEnv
 
        eps_stats :: !EpsStats
   }