-
-% (c) The University of Glasgow, 2000
+%
+% (c) The University of Glasgow, 2006
%
\section[HscTypes]{Types for the per-module compiler}
icPrintUnqual, mkPrintUnqualified,
ModIface(..), mkIfaceDepCache, mkIfaceVerCache, mkIfaceFixCache,
- emptyIfaceDepCache,
+ emptyIfaceDepCache,
Deprecs(..), IfaceDeprecs,
FixityEnv, FixItem(..), lookupFixity, emptyFixityEnv,
- implicitTyThings,
+ implicitTyThings, isImplicitTyThing,
TyThing(..), tyThingClass, tyThingTyCon, tyThingDataCon, tyThingId,
TypeEnv, lookupType, mkTypeEnv, emptyTypeEnv,
extendTypeEnv, extendTypeEnvList, extendTypeEnvWithIds, lookupTypeEnv,
typeEnvElts, typeEnvClasses, typeEnvTyCons, typeEnvIds,
+ typeEnvDataCons,
WhetherHasOrphans, IsBootInterface, Usage(..),
Dependencies(..), noDependencies,
NameCache(..), OrigNameCache, OrigIParamCache,
- Avails, availsToNameSet, availName, availNames,
+ Avails, availsToNameSet, availsToNameEnv, availName, availNames,
GenAvailInfo(..), AvailInfo, RdrAvailInfo,
IfaceExport,
extendOccEnv )
import Module
import InstEnv ( InstEnv, Instance )
+import FamInstEnv ( FamInstEnv, FamInst )
import Rules ( RuleBase )
import CoreSyn ( CoreBind )
-import Id ( Id )
+import Id ( Id, isImplicitId )
import Type ( TyThing(..) )
import Class ( Class, classSelIds, classATs, classTyCon )
-import TyCon ( TyCon, tyConSelIds, tyConDataCons, isNewTyCon,
- newTyConCo_maybe, tyConFamilyCoercion_maybe )
-import DataCon ( dataConImplicitIds )
+import TyCon
+import DataCon ( DataCon, dataConImplicitIds )
import PrelNames ( gHC_PRIM )
import Packages ( PackageId )
import DynFlags ( DynFlags(..), isOneShot, HscTarget (..) )
import DriverPhases ( HscSource(..), isHsBoot, hscSourceString, Phase )
import BasicTypes ( Version, initialVersion, IPName,
Fixity, defaultFixity, DeprecTxt )
-
-import IfaceSyn ( IfaceInst, IfaceRule, IfaceDecl(ifName) )
-
+import IfaceSyn
import FiniteMap ( FiniteMap )
import CoreSyn ( CoreRule )
import Maybes ( orElse, expectJust )
import UniqSupply ( UniqSupply )
import FastString ( FastString )
-import DATA_IOREF ( IORef, readIORef )
import StringBuffer ( StringBuffer )
-import Maybe ( catMaybes )
-import Time ( ClockTime )
+import Maybes ( catMaybes, seqMaybe )
+
+import System.Time ( ClockTime )
+import Data.IORef ( IORef, readIORef )
\end{code}
-> 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}
mi_mod_vers :: !Version, -- Module version: changes when anything changes
mi_orphan :: !WhetherHasOrphans, -- Whether this module has orphans
+ mi_finsts :: !WhetherHasFamInst, -- Whether module has family insts
mi_boot :: !IsBootInterface, -- Read from an hi-boot file?
mi_deps :: Dependencies,
-- HomeModInfo, but that leads to more plumbing.
-- Instance declarations and rules
- mi_insts :: [IfaceInst], -- Sorted
- mi_rules :: [IfaceRule], -- Sorted
- mi_rule_vers :: !Version, -- Version number for rules and instances combined
+ mi_insts :: [IfaceInst], -- Sorted
+ mi_fam_insts :: [IfaceFamInst], -- Sorted
+ mi_rules :: [IfaceRule], -- Sorted
+ mi_rule_vers :: !Version, -- Version number for rules and
+ -- instances (for classes and families)
+ -- combined
-- Cached environments for easy lookup
-- These are computed (lazily) from other fields
-- and are not put into the interface file
mi_dep_fn :: Name -> Maybe DeprecTxt, -- Cached lookup for mi_deprecs
mi_fix_fn :: OccName -> Fixity, -- Cached lookup for mi_fixities
- mi_ver_fn :: OccName -> Maybe Version -- Cached lookup for mi_decls
+ mi_ver_fn :: OccName -> Maybe (OccName, Version)
+ -- Cached lookup for mi_decls
-- The Nothing in mi_ver_fn means that the thing
-- isn't in decls. It's useful to know that when
-- seeing if we are up to date wrt the old interface
+ -- The 'OccName' is the parent of the name, if it has one.
}
-- Should be able to construct ModDetails from mi_decls in ModIface
data ModDetails
= ModDetails {
-- The next three fields are created by the typechecker
- md_exports :: NameSet,
+ md_exports :: [AvailInfo],
md_types :: !TypeEnv,
+ md_fam_insts :: ![FamInst], -- Cached value extracted from md_types
md_insts :: ![Instance], -- Dfun-ids for the instances in this module
md_rules :: ![CoreRule] -- Domain may include Ids from other modules
}
emptyModDetails = ModDetails { md_types = emptyTypeEnv,
- md_exports = emptyNameSet,
- md_insts = [],
- md_rules = [] }
+ md_exports = [],
+ md_insts = [],
+ md_rules = [],
+ md_fam_insts = [] }
-- 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
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 :: ![AvailInfo], -- 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:
= ModIface { mi_module = mod,
mi_mod_vers = initialVersion,
mi_orphan = False,
+ mi_finsts = False,
mi_boot = False,
mi_deps = noDependencies,
mi_usages = [],
mi_exp_vers = initialVersion,
mi_fixities = [],
mi_deprecs = NoDeprecs,
- mi_insts = [],
- mi_rules = [],
- mi_decls = [],
- mi_globals = Nothing,
+ mi_insts = [],
+ mi_fam_insts = [],
+ mi_rules = [],
+ mi_decls = [],
+ mi_globals = Nothing,
mi_rule_vers = initialVersion,
mi_dep_fn = emptyIfaceDepCache,
mi_fix_fn = emptyIfaceFixCache,
-- For data cons add the worker and wrapper (if any)
implicitTyThings (ADataCon dc) = map AnId (dataConImplicitIds dc)
+-- | returns 'True' if there should be no interface-file declaration
+-- for this thing on its own: either it is built-in, or it is part
+-- of some other declaration, or it is generated implicitly by some
+-- other declaration.
+isImplicitTyThing :: TyThing -> Bool
+isImplicitTyThing (ADataCon _) = True
+isImplicitTyThing (AnId id) = isImplicitId id
+isImplicitTyThing (AClass _) = False
+isImplicitTyThing (ATyCon tc) = isImplicitTyCon tc
+
-- For newtypes and indexed data types, add the implicit coercion tycon
implicitCoTyCon tc
= map ATyCon . catMaybes $ [newTyConCo_maybe tc,
\begin{code}
type TypeEnv = NameEnv TyThing
-emptyTypeEnv :: TypeEnv
-typeEnvElts :: TypeEnv -> [TyThing]
-typeEnvClasses :: TypeEnv -> [Class]
-typeEnvTyCons :: TypeEnv -> [TyCon]
-typeEnvIds :: TypeEnv -> [Id]
-lookupTypeEnv :: TypeEnv -> Name -> Maybe TyThing
-
-emptyTypeEnv = emptyNameEnv
-typeEnvElts env = nameEnvElts env
-typeEnvClasses env = [cl | AClass cl <- typeEnvElts env]
-typeEnvTyCons env = [tc | ATyCon tc <- typeEnvElts env]
-typeEnvIds env = [id | AnId id <- typeEnvElts env]
+emptyTypeEnv :: TypeEnv
+typeEnvElts :: TypeEnv -> [TyThing]
+typeEnvClasses :: TypeEnv -> [Class]
+typeEnvTyCons :: TypeEnv -> [TyCon]
+typeEnvIds :: TypeEnv -> [Id]
+typeEnvDataCons :: TypeEnv -> [DataCon]
+lookupTypeEnv :: TypeEnv -> Name -> Maybe TyThing
+
+emptyTypeEnv = emptyNameEnv
+typeEnvElts env = nameEnvElts env
+typeEnvClasses env = [cl | AClass cl <- typeEnvElts env]
+typeEnvTyCons env = [tc | ATyCon tc <- typeEnvElts env]
+typeEnvIds env = [id | AnId id <- typeEnvElts env]
+typeEnvDataCons env = [dc | ADataCon dc <- typeEnvElts env]
mkTypeEnv :: [TyThing] -> TypeEnv
mkTypeEnv things = extendTypeEnvList emptyTypeEnv things
this_pkg = thisPackage dflags
\end{code}
-
\begin{code}
tyThingTyCon (ATyCon tc) = tc
tyThingTyCon other = pprPanic "tyThingTyCon" (ppr other)
but they are mostly elaborated elsewhere
\begin{code}
-mkIfaceVerCache :: [(Version,IfaceDecl)] -> OccName -> Maybe Version
+mkIfaceVerCache :: [(Version,IfaceDecl)]
+ -> (OccName -> Maybe (OccName, Version))
mkIfaceVerCache pairs
= \occ -> lookupOccEnv env occ
where
- env = foldl add emptyOccEnv pairs
- add env (v,d) = extendOccEnv env (ifName d) v
+ env = foldr add_decl emptyOccEnv pairs
+ add_decl (v,d) env0 = foldr add_imp env1 (ifaceDeclSubBndrs d)
+ where
+ decl_name = ifName d
+ env1 = extendOccEnv env0 decl_name (decl_name, v)
+ add_imp bndr env = extendOccEnv env bndr (decl_name, v)
-emptyIfaceVerCache :: OccName -> Maybe Version
+emptyIfaceVerCache :: OccName -> Maybe (OccName, Version)
emptyIfaceVerCache occ = Nothing
------------------ Deprecations -------------------------
type IfaceExport = (Module, [GenAvailInfo OccName])
availsToNameSet :: [AvailInfo] -> NameSet
-availsToNameSet avails = foldl add emptyNameSet avails
- where
- add set avail = addListToNameSet set (availNames avail)
+availsToNameSet avails = foldr add emptyNameSet avails
+ where add avail set = addListToNameSet set (availNames avail)
+
+availsToNameEnv :: [AvailInfo] -> NameEnv AvailInfo
+availsToNameEnv avails = foldr add emptyNameEnv avails
+ where add avail env = extendNameEnvList env
+ (zip (availNames avail) (repeat avail))
availName :: GenAvailInfo name -> name
availName (Avail n) = n
ppr = pprAvail
pprAvail :: Outputable n => GenAvailInfo n -> SDoc
-pprAvail (AvailTC n ns) = ppr n <> case {- filter (/= n) -} ns of
- [] -> empty
- ns' -> braces (hsep (punctuate comma (map ppr ns')))
-
-pprAvail (Avail n) = ppr n
+pprAvail (Avail n) = ppr n
+pprAvail (AvailTC n ns) = ppr n <> braces (hsep (punctuate comma (map ppr ns)))
\end{code}
\begin{code}
-- * a transformation rule in a module other than the one defining
-- the function in the head of the rule.
+type WhetherHasFamInst = Bool -- This module defines family instances?
+
type IsBootInterface = Bool
-- Dependency info about modules and packages below this one
-- in the import hierarchy. See TcRnTypes.ImportAvails for details.
+-- The orphan modules in `dep_orphs' do *not* include family instance orphans,
+-- as they are anyway included in `dep_finsts'.
--
-- Invariant: the dependencies of a module M never includes M
-- Invariant: the lists are unordered, with no duplicates
data Dependencies
- = Deps { dep_mods :: [(ModuleName,IsBootInterface)], -- Home-package module dependencies
- dep_pkgs :: [PackageId], -- External package dependencies
- dep_orphs :: [Module] } -- Orphan modules (whether home or external pkg)
+ = Deps { dep_mods :: [(ModuleName, -- Home-package module dependencies
+ IsBootInterface)]
+ , dep_pkgs :: [PackageId] -- External package dependencies
+ , dep_orphs :: [Module] -- Orphan modules (whether home or
+ -- external pkg)
+ , dep_finsts :: [Module] -- Modules that contain family
+ -- instances (whether home or
+ -- external pkg)
+ }
deriving( Eq )
-- Equality used only for old/new comparison in MkIface.addVersionInfo
noDependencies :: Dependencies
-noDependencies = Deps [] [] []
+noDependencies = Deps [] [] [] []
data Usage
= Usage { usg_name :: ModuleName, -- Name of the module
usg_mod :: Version, -- Module version
usg_entities :: [(OccName,Version)], -- Sorted by occurrence name
+ -- NB. usages are for parent names only, eg. tycon but not constructors.
usg_exports :: Maybe Version, -- Export-list version, if we depend on it
usg_rules :: Version -- Orphan-rules version (for non-orphan
-- modules this will always be initialVersion)
%************************************************************************
\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 {
-- 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
-- * 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
}