-
-% (c) The University of Glasgow, 2000
+%
+% (c) The University of Glasgow, 2006
%
\section[HscTypes]{Types for the per-module compiler}
\begin{code}
module HscTypes (
-- * Sessions and compilation state
- Session(..), HscEnv(..), hscEPS,
- FinderCache, FinderCacheEntry,
+ Session(..), withSession, modifySession,
+ HscEnv(..), hscEPS,
+ FinderCache, FindResult(..), ModLocationCache,
Target(..), TargetId(..), pprTarget, pprTargetId,
ModuleGraph, emptyMG,
ModDetails(..), emptyModDetails,
ModGuts(..), CgGuts(..), ModImports(..), ForeignStubs(..),
- ModSummary(..), showModMsg, isBootSummary,
+ ModSummary(..), ms_mod_name, showModMsg, isBootSummary,
msHsFilePath, msHiFilePath, msObjFilePath,
HscSource(..), isHsBoot, hscSourceString, -- Re-exported from DriverPhases
HomePackageTable, HomeModInfo(..), emptyHomePackageTable,
- hptInstances, hptRules,
+ hptInstances, hptRules, hptVectInfo,
ExternalPackageState(..), EpsStats(..), addEpsInStats,
PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable,
- lookupIface, lookupIfaceByModule, emptyModIface,
+ lookupIfaceByModule, emptyModIface,
InteractiveContext(..), emptyInteractiveContext,
- icPrintUnqual, unQualInScope,
+ icPrintUnqual, mkPrintUnqualified, extendInteractiveContext,
+ substInteractiveContext,
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,
- Deprecations, DeprecTxt, lookupDeprec, plusDeprecs,
+ Deprecations, DeprecTxt, plusDeprecs,
PackageInstEnv, PackageRuleBase,
-- Linker stuff
Linkable(..), isObjectLinkable,
Unlinked(..), CompiledByteCode,
- isObject, nameOfObject, isInterpretable, byteCodeOfObject
+ isObject, nameOfObject, isInterpretable, byteCodeOfObject,
+ HpcInfo(..), emptyHpcInfo, isHpcUsed, AnyHpcUsage,
+
+ -- Breakpoints
+ ModBreaks (..), BreakIndex, emptyModBreaks,
+
+ -- Vectorisation information
+ VectInfo(..), IfaceVectInfo(..), noVectInfo, plusVectInfo,
+ noIfaceVectInfo
) where
#include "HsVersions.h"
#ifdef GHCI
import ByteCodeAsm ( CompiledByteCode )
+import {-# SOURCE #-} InteractiveEval ( Resume )
#endif
-import RdrName ( GlobalRdrEnv, emptyGlobalRdrEnv,
- LocalRdrEnv, emptyLocalRdrEnv,
- GlobalRdrElt(..), mkRdrUnqual, lookupGRE_RdrName )
+import RdrName ( GlobalRdrEnv, emptyGlobalRdrEnv, GlobalRdrElt(..),
+ mkRdrUnqual, ImpDeclSpec(..), Provenance(..),
+ ImportSpec(..), lookupGlobalRdrEnv, lookupGRE_RdrName )
import Name ( Name, NamedThing, getName, nameOccName, nameModule )
import NameEnv
import NameSet
extendOccEnv )
import Module
import InstEnv ( InstEnv, Instance )
+import FamInstEnv ( FamInstEnv, FamInst )
import Rules ( RuleBase )
import CoreSyn ( CoreBind )
-import Id ( Id )
-import Type ( TyThing(..) )
-
-import Class ( Class, classSelIds, classTyCon )
-import TyCon ( TyCon, tyConSelIds, tyConDataCons )
-import DataCon ( dataConImplicitIds )
+import VarEnv
+import VarSet
+import Var hiding ( setIdType )
+import Id
+import Type
+
+import Class ( Class, classSelIds, classATs, classTyCon )
+import TyCon
+import DataCon ( DataCon, dataConImplicitIds )
import PrelNames ( gHC_PRIM )
-import Packages ( PackageIdH, PackageId, PackageConfig, HomeModules )
+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, expectJust )
+import Maybes ( orElse, expectJust, catMaybes, seqMaybe )
import Outputable
+import BreakArray
import SrcLoc ( SrcSpan, Located )
+import UniqFM ( lookupUFM, eltsUFM, emptyUFM )
import UniqSupply ( UniqSupply )
import FastString ( FastString )
-
-import DATA_IOREF ( IORef, readIORef )
import StringBuffer ( StringBuffer )
-import Time ( ClockTime )
+
+import System.Time ( ClockTime )
+import Data.IORef
+import Data.Array ( Array, array )
+import Data.List
\end{code}
-- constituting the current program or library, the context for
-- interactive evaluation, and various caches.
newtype Session = Session (IORef HscEnv)
+
+withSession :: Session -> (HscEnv -> IO a) -> IO a
+withSession (Session ref) f = do h <- readIORef ref; f h
+
+modifySession :: Session -> (HscEnv -> HscEnv) -> IO ()
+modifySession (Session ref) f = do h <- readIORef ref; writeIORef ref $! f h
\end{code}
HscEnv is like Session, except that some of the fields are immutable.
-- sucking in interface files. They cache the state of
-- external interface files, in effect.
- hsc_FC :: {-# UNPACK #-} !(IORef FinderCache)
+ hsc_FC :: {-# UNPACK #-} !(IORef FinderCache),
+ hsc_MLC :: {-# UNPACK #-} !(IORef ModLocationCache),
-- The finder's cache. This caches the location of modules,
-- so we don't have to search the filesystem multiple times.
+
+ hsc_global_rdr_env :: GlobalRdrEnv,
+ hsc_global_type_env :: TypeEnv
}
hscEPS :: HscEnv -> IO ExternalPackageState
data Target = Target TargetId (Maybe (StringBuffer,ClockTime))
data TargetId
- = TargetModule Module
+ = TargetModule ModuleName
-- ^ A module name: search for the file
| TargetFile FilePath (Maybe Phase)
-- ^ A filename: preprocess & parse it to find the module name.
pprTarget :: Target -> SDoc
pprTarget (Target id _) = pprTargetId id
+instance Outputable Target where
+ ppr = pprTarget
+
pprTargetId (TargetModule m) = ppr m
pprTargetId (TargetFile f _) = text f
-type FinderCache = ModuleEnv FinderCacheEntry
-type FinderCacheEntry = (ModLocation, Maybe (PackageConfig,Bool))
- -- The finder's cache (see module Finder)
+instance Outputable TargetId where
+ ppr = pprTargetId
-type HomePackageTable = ModuleEnv HomeModInfo
+type HomePackageTable = ModuleNameEnv HomeModInfo
-- Domain = modules in the home package
+ -- "home" package name cached here for convenience
type PackageIfaceTable = ModuleEnv ModIface
-- Domain = modules in the imported packages
-emptyHomePackageTable = emptyModuleEnv
+emptyHomePackageTable = emptyUFM
emptyPackageIfaceTable = emptyModuleEnv
data HomeModInfo
-- When re-linking a module (hscNoRecomp), we construct
-- the HomModInfo by building a new ModDetails from the
-- old ModIface (only).
-\end{code}
-
-Simple lookups in the symbol table.
-\begin{code}
-lookupIface :: HomePackageTable -> PackageIfaceTable -> Module -> Maybe ModIface
--- We often have two IfaceTables, and want to do a lookup
-lookupIface hpt pit mod
- = case lookupModuleEnv hpt mod of
- Just mod_info -> Just (hm_iface mod_info)
- Nothing -> lookupModuleEnv pit mod
-
-lookupIfaceByModule :: HomePackageTable -> PackageIfaceTable -> Module -> Maybe ModIface
--- We often have two IfaceTables, and want to do a lookup
-lookupIfaceByModule hpt pit mod
- = case lookupModuleEnv hpt mod of
- Just mod_info -> Just (hm_iface mod_info)
- Nothing -> lookupModuleEnv pit mod
+-- | Find the 'ModIface' for a 'Module'
+lookupIfaceByModule
+ :: DynFlags
+ -> HomePackageTable
+ -> PackageIfaceTable
+ -> Module
+ -> Maybe ModIface
+lookupIfaceByModule dflags hpt pit mod
+ | 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}
\begin{code}
-hptInstances :: HscEnv -> (Module -> Bool) -> [Instance]
--- Find all the instance declarations that are in modules imported
--- by this one, directly or indirectly, and are in the Home Package Table
--- This ensures that we don't see instances from modules --make compiled
--- before this one, but which are not below this one
+hptInstances :: HscEnv -> (ModuleName -> Bool) -> ([Instance], [FamInst])
+-- Find all the instance declarations (of classes and families) that are in
+-- modules imported by this one, directly or indirectly, and are in the Home
+-- Package Table. This ensures that we don't see instances from modules --make
+-- compiled before this one, but which are not below this one.
hptInstances hsc_env want_this_module
- = [ ispec
- | mod_info <- moduleEnvElts (hsc_HPT hsc_env)
- , want_this_module (mi_module (hm_iface mod_info))
- , ispec <- md_insts (hm_details mod_info) ]
+ = let (insts, famInsts) = unzip
+ [ (md_insts details, md_fam_insts details)
+ | mod_info <- eltsUFM (hsc_HPT hsc_env)
+ , want_this_module (moduleName (mi_module (hm_iface mod_info)))
+ , let details = hm_details mod_info ]
+ in
+ (concat insts, concat famInsts)
-hptRules :: HscEnv -> [(Module, IsBootInterface)] -> [CoreRule]
+hptRules :: HscEnv -> [(ModuleName, IsBootInterface)] -> [CoreRule]
-- Get rules from modules "below" this one (in the dependency sense)
-- C.f Inst.hptInstances
hptRules hsc_env deps
-- be in the HPT, because we never compile it; it's in the EPT
-- instead. ToDo: clean up, and remove this slightly bogus
-- filter:
- , mod /= gHC_PRIM
+ , mod /= moduleName gHC_PRIM
-- Look it up in the HPT
- , let mod_info = case lookupModuleEnv hpt mod of
- Nothing -> pprPanic "hptRules" (ppr mod <+> ppr deps)
- Just x -> x
+ , let rules = case lookupUFM hpt mod of
+ Just info -> md_rules (hm_details info)
+ Nothing -> pprTrace "WARNING in hptRules" msg []
+ msg = vcat [ptext SLIT("missing module") <+> ppr mod,
+ ptext SLIT("Probable cause: out-of-date interface files")]
+ -- This really shouldn't happen, but see Trac #962
-- And get its dfuns
- , rule <- md_rules (hm_details mod_info) ]
+ , rule <- rules ]
+
+hptVectInfo :: HscEnv -> VectInfo
+-- Get the combined VectInfo of all modules in the home package table. In
+-- contrast to instances and rules, we don't care whether the modules are
+-- "below" or us. The VectInfo of those modules not "below" us does not
+-- affect the compilation of the current module.
+hptVectInfo hsc_env
+ = foldr plusVectInfo noVectInfo [ md_vect_info (hm_details mod_info)
+ | mod_info <- eltsUFM (hsc_HPT hsc_env)]
\end{code}
+%************************************************************************
+%* *
+\subsection{The Finder cache}
+%* *
+%************************************************************************
+
+\begin{code}
+-- | The 'FinderCache' maps home module names to the result of
+-- searching for that module. It records the results of searching for
+-- modules along the search path. On @:load@, we flush the entire
+-- contents of this cache.
+--
+-- Although the @FinderCache@ range is 'FindResult' for convenience ,
+-- in fact it will only ever contain 'Found' or 'NotFound' entries.
+--
+type FinderCache = ModuleNameEnv FindResult
+
+-- | The result of searching for an imported module.
+data FindResult
+ = Found ModLocation Module
+ -- the module was found
+ | NoPackage PackageId
+ -- the requested package was not found
+ | FoundMultiple [PackageId]
+ -- *error*: both in multiple packages
+ | PackageHidden PackageId
+ -- for an explicit source import: the package containing the module is
+ -- not exposed.
+ | ModuleHidden PackageId
+ -- for an explicit source import: the package containing the module is
+ -- exposed, but the module itself is hidden.
+ | NotFound [FilePath] (Maybe PackageId)
+ -- the module was not found, the specified places were searched
+ | NotFoundInPackage PackageId
+ -- the module was not found in this package
+
+-- | Cache that remembers where we found a particular module. Contains both
+-- home modules and package modules. On @:load@, only home modules are
+-- purged from this cache.
+type ModLocationCache = ModuleEnv ModLocation
+\end{code}
%************************************************************************
%* *
\begin{code}
data ModIface
= ModIface {
- mi_package :: !PackageIdH, -- Which package the module comes from
mi_module :: !Module,
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
+
+ -- Vectorisation information
+ mi_vect_info :: !IfaceVectInfo,
-- 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.
+ mi_hpc :: !AnyHpcUsage
+ -- True if this program uses Hpc at any point in the program.
}
-- 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_types :: !TypeEnv,
- md_insts :: ![Instance], -- Dfun-ids for the instances in this module
- md_rules :: ![CoreRule] -- Domain may include Ids from other modules
+ -- The next two fields are created by the typechecker
+ md_exports :: [AvailInfo],
+ md_types :: !TypeEnv,
+ md_insts :: ![Instance], -- Dfun-ids for the instances in this module
+ md_fam_insts :: ![FamInst],
+ md_rules :: ![CoreRule], -- Domain may include Ids from other modules
+ md_modBreaks :: !ModBreaks, -- Breakpoint information for this module
+ md_vect_info :: !VectInfo -- Vectorisation information
}
emptyModDetails = ModDetails { md_types = emptyTypeEnv,
- md_exports = emptyNameSet,
- md_insts = [],
- md_rules = [] }
+ md_exports = [],
+ md_insts = [],
+ md_rules = [],
+ md_fam_insts = [],
+ md_modBreaks = emptyModBreaks,
+ md_vect_info = noVectInfo
+ }
-- 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_home_mods :: !HomeModules, -- For calling isHomeModule etc.
- 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_inst_env :: InstEnv, -- Class instance enviroment fro
+ -- *home-package* modules (including
+ -- this one); c.f. tcg_inst_env
+ mg_fam_inst_env :: FamInstEnv, -- Type-family instance enviroment
+ -- for *home-package* modules (including
+ -- this one); c.f. tcg_fam_inst_env
+
+ 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,
+ mg_deprecs :: !Deprecations, -- Deprecations declared in the module
+ mg_hpc_info :: !HpcInfo, -- info about coverage tick boxes
+ mg_modBreaks :: !ModBreaks,
+ mg_vect_info :: !VectInfo -- Pool of vectorised declarations
}
-- The ModGuts takes on several slightly different forms:
-- initialisation code
cg_foreign :: !ForeignStubs,
- cg_home_mods :: !HomeModules, -- for calling isHomeModule etc.
- cg_dep_pkgs :: ![PackageId] -- Used to generate #includes for C code gen
+ cg_dep_pkgs :: ![PackageId], -- Used to generate #includes for C code gen
+ cg_hpc_info :: !HpcInfo -- info about coverage tick boxes
}
-----------------------------------
\end{code}
\begin{code}
-emptyModIface :: PackageIdH -> Module -> ModIface
-emptyModIface pkg mod
- = ModIface { mi_package = pkg,
- mi_module = mod,
+emptyModIface :: Module -> ModIface
+emptyModIface mod
+ = 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_vect_info = noIfaceVectInfo,
mi_dep_fn = emptyIfaceDepCache,
mi_fix_fn = emptyIfaceFixCache,
- mi_ver_fn = emptyIfaceVerCache
+ mi_ver_fn = emptyIfaceVerCache,
+ mi_hpc = False
}
\end{code}
ic_rn_gbl_env :: GlobalRdrEnv, -- The cached GlobalRdrEnv, built from
-- ic_toplev_scope and ic_exports
- ic_rn_local_env :: LocalRdrEnv, -- Lexical context for variables bound
- -- during interaction
+ ic_tmp_ids :: [Id], -- Names bound during interaction.
+ -- Later Ids shadow
+ -- earlier ones with the same OccName.
+
+ ic_tyvars :: TyVarSet -- skolem type variables free in
+ -- ic_tmp_ids. These arise at
+ -- breakpoints in a polymorphic
+ -- context, where we have only partial
+ -- type information.
- ic_type_env :: TypeEnv -- Ditto for types
+#ifdef GHCI
+ , ic_resume :: [Resume] -- the stack of breakpoint contexts
+#endif
}
+
emptyInteractiveContext
= InteractiveContext { ic_toplev_scope = [],
ic_exports = [],
ic_rn_gbl_env = emptyGlobalRdrEnv,
- ic_rn_local_env = emptyLocalRdrEnv,
- ic_type_env = emptyTypeEnv }
+ ic_tmp_ids = [],
+ ic_tyvars = emptyVarSet
+#ifdef GHCI
+ , ic_resume = []
+#endif
+ }
icPrintUnqual :: InteractiveContext -> PrintUnqualified
-icPrintUnqual ictxt = unQualInScope (ic_rn_gbl_env ictxt)
+icPrintUnqual ictxt = mkPrintUnqualified (ic_rn_gbl_env ictxt)
+
+
+extendInteractiveContext
+ :: InteractiveContext
+ -> [Id]
+ -> TyVarSet
+ -> InteractiveContext
+extendInteractiveContext ictxt ids tyvars
+ = ictxt { ic_tmp_ids = ic_tmp_ids ictxt ++ ids,
+ -- NB. must be this way around, because we want
+ -- new ids to shadow existing bindings.
+ ic_tyvars = ic_tyvars ictxt `unionVarSet` tyvars }
+
+
+substInteractiveContext :: InteractiveContext -> TvSubst -> InteractiveContext
+substInteractiveContext ictxt subst | isEmptyTvSubst subst = ictxt
+substInteractiveContext ictxt@InteractiveContext{ic_tmp_ids=ids} subst =
+ let ids' = map (\id -> id `setIdType` substTy subst (idType id)) ids
+ subst_dom= varEnvKeys$ getTvSubstEnv subst
+ subst_ran= varEnvElts$ getTvSubstEnv subst
+ new_tvs = [ tv | Just tv <- map getTyVar_maybe subst_ran]
+ ic_tyvars'= (`delVarSetListByKey` subst_dom)
+ . (`extendVarSetList` new_tvs)
+ $ ic_tyvars ictxt
+ in ictxt { ic_tmp_ids = ids'
+ , ic_tyvars = ic_tyvars' }
+
+ where delVarSetListByKey = foldl' delVarSetByKey
\end{code}
-@unQualInScope@ returns a function that takes a @Name@ and tells whether
-its unqualified name is in scope. This is put as a boolean flag in
-the @Name@'s provenance to guide whether or not to print the name qualified
-in error messages.
+%************************************************************************
+%* *
+ Building a PrintUnqualified
+%* *
+%************************************************************************
\begin{code}
-unQualInScope :: GlobalRdrEnv -> PrintUnqualified
--- True if 'f' is in scope, and has only one binding,
--- and the thing it is bound to is the name we are looking for
--- (i.e. false if A.f and B.f are both in scope as unqualified 'f')
---
--- [Out of date] Also checks for built-in syntax, which is always 'in scope'
-unQualInScope env mod occ
- = case lookupGRE_RdrName (mkRdrUnqual occ) env of
- [gre] -> nameModule (gre_name gre) == mod
- other -> False
+mkPrintUnqualified :: GlobalRdrEnv -> PrintUnqualified
+mkPrintUnqualified env = (qual_name, qual_mod)
+ where
+ qual_name mod occ -- The (mod,occ) pair is the original name of the thing
+ | [gre] <- unqual_gres, right_name gre = Nothing
+ -- If there's a unique entity that's in scope unqualified with 'occ'
+ -- AND that entity is the right one, then we can use the unqualified name
+
+ | [gre] <- qual_gres = Just (get_qual_mod (gre_prov gre))
+
+ | null qual_gres = Just (moduleName mod)
+ -- it isn't in scope at all, this probably shouldn't happen,
+ -- but we'll qualify it by the original module anyway.
+
+ | otherwise = panic "mkPrintUnqualified"
+ where
+ right_name gre = nameModule (gre_name gre) == mod
+
+ unqual_gres = lookupGRE_RdrName (mkRdrUnqual occ) env
+ qual_gres = filter right_name (lookupGlobalRdrEnv env occ)
+
+ get_qual_mod LocalDef = moduleName mod
+ get_qual_mod (Imported is) = ASSERT( not (null is) ) is_as (is_decl (head is))
+
+ qual_mod mod = Nothing -- For now, we never qualify module names with their packages
\end{code}
\begin{code}
implicitTyThings :: TyThing -> [TyThing]
+-- If you change this, make sure you change LoadIface.ifaceDeclSubBndrs in sync
+
implicitTyThings (AnId id) = []
-- For type constructors, add the data cons (and their extras),
-- and the selectors and generic-programming Ids too
--
-- Newtypes don't have a worker Id, so don't generate that?
-implicitTyThings (ATyCon tc) = map AnId (tyConSelIds tc) ++
- concatMap (extras_plus . ADataCon) (tyConDataCons tc)
+implicitTyThings (ATyCon tc) = implicitCoTyCon tc ++
+ map AnId (tyConSelIds tc) ++
+ concatMap (extras_plus . ADataCon)
+ (tyConDataCons tc)
- -- For classes, add the class TyCon too (and its extras)
- -- and the class selector Ids
-implicitTyThings (AClass cl) = map AnId (classSelIds cl) ++
- extras_plus (ATyCon (classTyCon cl))
-
+ -- For classes, add the class selector Ids, and assoicated TyCons
+ -- and the class TyCon too (and its extras)
+implicitTyThings (AClass cl)
+ = map AnId (classSelIds cl) ++
+ map ATyCon (classATs cl) ++
+ -- No extras_plus for the classATs, because they
+ -- are only the family decls; they have no implicit things
+ extras_plus (ATyCon (classTyCon cl))
-- 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,
+ tyConFamilyCoercion_maybe tc]
+
extras_plus thing = thing : implicitTyThings thing
extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv
\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
\end{code}
\begin{code}
-lookupType :: HomePackageTable -> PackageTypeEnv -> Name -> Maybe TyThing
-lookupType hpt pte name
- = case lookupModuleEnv hpt (nameModule name) of
- Just details -> lookupNameEnv (md_types (hm_details details)) name
- Nothing -> lookupNameEnv pte name
+lookupType :: DynFlags
+ -> HomePackageTable
+ -> PackageTypeEnv
+ -> Name
+ -> Maybe TyThing
+
+lookupType dflags hpt pte name
+ -- in one-shot, we don't use the HPT
+ | not (isOneShot (ghcMode dflags)) && modulePackageId mod == this_pkg
+ = do hm <- lookupUFM hpt (moduleName mod) -- Maybe monad
+ lookupNameEnv (md_types (hm_details hm)) name
+ | otherwise
+ = lookupNameEnv pte name
+ where mod = nameModule name
+ 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
-
-emptyIfaceVerCache :: OccName -> Maybe Version
+ 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 (OccName, Version)
emptyIfaceVerCache occ = Nothing
------------------ Deprecations -------------------------
emptyIfaceDepCache :: Name -> Maybe DeprecTxt
emptyIfaceDepCache n = Nothing
-lookupDeprec :: Deprecations -> Name -> Maybe DeprecTxt
-lookupDeprec NoDeprecs name = Nothing
-lookupDeprec (DeprecAll txt) name = Just txt
-lookupDeprec (DeprecSome env) name = case lookupNameEnv env name of
- Just (_, txt) -> Just txt
- Nothing -> Nothing
-
plusDeprecs :: Deprecations -> Deprecations -> Deprecations
plusDeprecs d NoDeprecs = d
plusDeprecs NoDeprecs d = d
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 :: [(Module,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 :: Module, -- Name of the module
+ = 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
+type PackageVectInfo = VectInfo
data ExternalPackageState
= EPS {
- eps_is_boot :: !(ModuleEnv (Module, IsBootInterface)),
- -- In OneShot mode (only), home-package modules accumulate in the
- -- external package state, and are sucked in lazily.
- -- For these home-pkg modules (only) we need to record which are
- -- boot modules. We set this field after loading all the
- -- explicitly-imported interfaces, but before doing anything else
+ eps_is_boot :: !(ModuleNameEnv (ModuleName, IsBootInterface)),
+ -- In OneShot mode (only), home-package modules
+ -- accumulate in the external package state, and are
+ -- sucked in lazily. For these home-pkg modules
+ -- (only) we need to record which are boot modules.
+ -- We set this field after loading all the
+ -- explicitly-imported interfaces, but before doing
+ -- anything else
--
- -- The Module part is not necessary, but it's useful for
+ -- The ModuleName part is not necessary, but it's useful for
-- debug prints, and it's convenient because this field comes
-- direct from TcRnTypes.ImportAvails.imp_dep_mods
-- 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_vect_info :: !PackageVectInfo, -- Ditto VectInfo
+ eps_mod_fam_inst_env :: !(ModuleEnv FamInstEnv), -- identifies family
+ -- instances of each mod
eps_stats :: !EpsStats
}
data ModSummary
= ModSummary {
- ms_mod :: Module, -- Name of the module
+ ms_mod :: Module, -- Identity of the module
ms_hsc_src :: HscSource, -- Source is Haskell, hs-boot, external core
ms_location :: ModLocation, -- Location
ms_hs_date :: ClockTime, -- Timestamp of source file
ms_obj_date :: Maybe ClockTime, -- Timestamp of object, maybe
- ms_srcimps :: [Located Module], -- Source imports
- ms_imps :: [Located Module], -- Non-source imports
+ ms_srcimps :: [Located ModuleName], -- Source imports
+ ms_imps :: [Located ModuleName], -- Non-source imports
ms_hspp_file :: FilePath, -- Filename of preprocessed source.
ms_hspp_opts :: DynFlags, -- Cached flags from OPTIONS, INCLUDE
-- and LANGUAGE pragmas.
ms_hspp_buf :: Maybe StringBuffer -- The actual preprocessed source, maybe.
}
+ms_mod_name :: ModSummary -> ModuleName
+ms_mod_name = moduleName . ms_mod
+
-- The ModLocation contains both the original source filename and the
-- filename of the cleaned-up source file after all preprocessing has been
-- done. The point is that the summariser will have to cpp/unlit/whatever
= showSDoc (hsep [text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' '),
char '(', text (msHsFilePath mod_summary) <> comma,
case target of
- HscInterpreted | recomp
+ HscInterpreted | recomp
-> text "interpreted"
HscNothing -> text "nothing"
_other -> text (msObjFilePath mod_summary),
char ')'])
where
- mod = ms_mod mod_summary
- mod_str = moduleString mod ++ hscSourceString (ms_hsc_src mod_summary)
+ mod = moduleName (ms_mod mod_summary)
+ mod_str = showSDoc (ppr mod) ++ hscSourceString (ms_hsc_src mod_summary)
\end{code}
%************************************************************************
%* *
+\subsection{Hpc Support}
+%* *
+%************************************************************************
+
+\begin{code}
+data HpcInfo
+ = HpcInfo
+ { hpcInfoTickCount :: Int
+ , hpcInfoHash :: Int
+ }
+ | NoHpcInfo
+ { hpcUsed :: AnyHpcUsage -- is hpc used anywhere on the module tree?
+ }
+
+-- This is used to mean there is no module-local hpc usage,
+-- but one of my imports used hpc instrumentation.
+
+type AnyHpcUsage = Bool
+
+emptyHpcInfo :: AnyHpcUsage -> HpcInfo
+emptyHpcInfo = NoHpcInfo
+
+isHpcUsed :: HpcInfo -> AnyHpcUsage
+isHpcUsed (HpcInfo {}) = True
+isHpcUsed (NoHpcInfo { hpcUsed = used }) = used
+\end{code}
+
+%************************************************************************
+%* *
+\subsection{Vectorisation Support}
+%* *
+%************************************************************************
+
+The following information is generated and consumed by the vectorisation
+subsystem. It communicates the vectorisation status of declarations from one
+module to another.
+
+Why do we need both f and f_v in the ModGuts/ModDetails/EPS version VectInfo
+below? We need to know `f' when converting to IfaceVectInfo. However, during
+vectorisation, we need to know `f_v', whose `Var' we cannot lookup based
+on just the OccName easily in a Core pass.
+
+\begin{code}
+-- ModGuts/ModDetails/EPS version
+data VectInfo
+ = VectInfo {
+ vectInfoVar :: VarEnv (Var , Var ), -- (f, f_v) keyed on f
+ vectInfoTyCon :: NameEnv (TyCon , TyCon), -- (T, T_v) keyed on T
+ vectInfoDataCon :: NameEnv (DataCon, DataCon), -- (C, C_v) keyed on C
+ vectInfoPADFun :: NameEnv (TyCon , Var), -- (T_v, paT) keyed on T_v
+ vectInfoIso :: NameEnv (TyCon , Var) -- (T, isoT) keyed on T
+ }
+ -- all of this is always tidy, even in ModGuts
+
+-- ModIface version
+data IfaceVectInfo
+ = IfaceVectInfo {
+ ifaceVectInfoVar :: [Name],
+ -- all variables in here have a vectorised variant;
+ -- the name of the vectorised variant is determined by `mkCloVect'
+ ifaceVectInfoTyCon :: [Name],
+ -- all tycons in here have a vectorised variant;
+ -- the name of the vectorised variant and those of its
+ -- data constructors are determined by `mkVectTyConOcc'
+ -- and `mkVectDataConOcc'; the names of
+ -- the isomorphisms is determined by `mkVectIsoOcc'
+ ifaceVectInfoTyConReuse :: [Name]
+ -- the vectorised form of all the tycons in here coincids with
+ -- the unconverted from; the names of the isomorphisms is determined
+ -- by `mkVectIsoOcc'
+ }
+
+noVectInfo :: VectInfo
+noVectInfo = VectInfo emptyVarEnv emptyNameEnv emptyNameEnv emptyNameEnv emptyNameEnv
+
+plusVectInfo :: VectInfo -> VectInfo -> VectInfo
+plusVectInfo vi1 vi2 =
+ VectInfo (vectInfoVar vi1 `plusVarEnv` vectInfoVar vi2)
+ (vectInfoTyCon vi1 `plusNameEnv` vectInfoTyCon vi2)
+ (vectInfoDataCon vi1 `plusNameEnv` vectInfoDataCon vi2)
+ (vectInfoPADFun vi1 `plusNameEnv` vectInfoPADFun vi2)
+ (vectInfoIso vi1 `plusNameEnv` vectInfoIso vi2)
+
+noIfaceVectInfo :: IfaceVectInfo
+noIfaceVectInfo = IfaceVectInfo [] [] []
+\end{code}
+
+%************************************************************************
+%* *
\subsection{Linkable stuff}
%* *
%************************************************************************
nameOfObject (DotO fn) = fn
nameOfObject (DotA fn) = fn
nameOfObject (DotDLL fn) = fn
+nameOfObject other = pprPanic "nameOfObject" (ppr other)
byteCodeOfObject (BCOs bc) = bc
+byteCodeOfObject other = pprPanic "byteCodeOfObject" (ppr other)
\end{code}
+%************************************************************************
+%* *
+\subsection{Breakpoint Support}
+%* *
+%************************************************************************
+\begin{code}
+type BreakIndex = Int
+
+-- | all the information about the breakpoints for a given module
+data ModBreaks
+ = ModBreaks
+ { modBreaks_flags :: BreakArray
+ -- The array of flags, one per breakpoint,
+ -- indicating which breakpoints are enabled.
+ , modBreaks_locs :: !(Array BreakIndex SrcSpan)
+ -- An array giving the source span of each breakpoint.
+ , modBreaks_vars :: !(Array BreakIndex [OccName])
+ -- An array giving the names of the free variables at each breakpoint.
+ , modBreaks_decls:: !(Array BreakIndex SrcSpan)
+ -- An array giving the span of the enclosing expression
+ }
+emptyModBreaks :: ModBreaks
+emptyModBreaks = ModBreaks
+ { modBreaks_flags = error "ModBreaks.modBreaks_array not initialised"
+ -- Todo: can we avoid this?
+ , modBreaks_locs = array (0,-1) []
+ , modBreaks_vars = array (0,-1) []
+ , modBreaks_decls= array (0,-1) []
+ }
+\end{code}