\begin{code}
module HscTypes (
HscEnv(..), hscEPS,
- GhciMode(..),
+ GhciMode(..), isOneShot,
ModDetails(..),
ModGuts(..), ModImports(..), ForeignStubs(..),
+ ModSummary(..), showModMsg,
+ msHsFilePath, msHiFilePath, msObjFilePath,
+
+ HscSource(..), isHsBoot, hscSourceString, -- Re-exported from DriverPhases
+
HomePackageTable, HomeModInfo(..), emptyHomePackageTable,
+ hptInstances, hptRules,
- ExternalPackageState(..),
+ ExternalPackageState(..), EpsStats(..), addEpsInStats,
PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable,
- lookupIface, lookupIfaceByModName, moduleNameToModule,
- emptyModIface,
+ lookupIface, lookupIfaceByModule, emptyModIface,
InteractiveContext(..), emptyInteractiveContext,
icPrintUnqual, unQualInScope,
ModIface(..), mkIfaceDepCache, mkIfaceVerCache, mkIfaceFixCache,
- emptyIfaceDepCache,
+ emptyIfaceDepCache,
Deprecs(..), IfaceDeprecs,
FixityEnv, FixItem(..), lookupFixity, emptyFixityEnv,
- implicitTyThings, isImplicitTyThing,
+ implicitTyThings,
TyThing(..), tyThingClass, tyThingTyCon, tyThingDataCon, tyThingId,
TypeEnv, lookupType, mkTypeEnv, emptyTypeEnv,
- extendTypeEnvList, extendTypeEnvWithIds, lookupTypeEnv,
+ extendTypeEnv, extendTypeEnvList, extendTypeEnvWithIds, lookupTypeEnv,
typeEnvElts, typeEnvClasses, typeEnvTyCons, typeEnvIds,
WhetherHasOrphans, IsBootInterface, Usage(..),
Dependencies(..), noDependencies,
- Pool(..), emptyPool, DeclPool, InstPool,
- Gated,
- RulePool, addRuleToPool,
+ InstPool, Gated, addInstsToPool,
+ RulePool, addRulesToPool,
NameCache(..), OrigNameCache, OrigIParamCache,
Avails, availsToNameSet, availName, availNames,
GenAvailInfo(..), AvailInfo, RdrAvailInfo,
import RdrName ( GlobalRdrEnv, emptyGlobalRdrEnv,
LocalRdrEnv, emptyLocalRdrEnv,
- GlobalRdrElt(..), unQualOK )
+ GlobalRdrElt(..), mkRdrUnqual, lookupGRE_RdrName )
import Name ( Name, NamedThing, getName, nameOccName, nameModule )
import NameEnv
import NameSet
import OccName ( OccName, OccEnv, lookupOccEnv, mkOccEnv, emptyOccEnv,
- extendOccEnv, foldOccEnv )
+ extendOccEnv )
import Module
import InstEnv ( InstEnv, DFunId )
import Rules ( RuleBase )
import CoreSyn ( CoreBind )
-import Id ( Id, isImplicitId )
+import Id ( Id )
import Type ( TyThing(..) )
import Class ( Class, classSelIds, classTyCon )
-import TyCon ( TyCon, isClassTyCon, tyConSelIds, tyConDataCons )
+import TyCon ( TyCon, tyConSelIds, tyConDataCons )
import DataCon ( dataConImplicitIds )
-import Packages ( PackageName )
+import Packages ( PackageIdH, PackageId )
import CmdLineOpts ( DynFlags )
-
+import DriverPhases ( HscSource(..), isHsBoot, hscSourceString )
import BasicTypes ( Version, initialVersion, IPName,
Fixity, defaultFixity, DeprecTxt )
import FiniteMap ( FiniteMap )
import CoreSyn ( IdCoreRule )
-import PrelNames ( isBuiltInSyntaxName )
-import Maybes ( orElse )
+import Maybes ( orElse, fromJust, expectJust )
import Outputable
-import SrcLoc ( SrcLoc )
+import SrcLoc ( SrcSpan )
import UniqSupply ( UniqSupply )
-import Maybe ( fromJust )
import FastString ( FastString )
import DATA_IOREF ( IORef, readIORef )
+import StringBuffer ( StringBuffer )
import Time ( ClockTime )
\end{code}
-- are compiling right now.
-- (In one-shot mode the current module is the only
-- home-package module, so hsc_HPT is empty. All other
- -- modules count as "external-package" modules.)
+ -- modules count as "external-package" modules.
+ -- However, even in GHCi mode, hi-boot interfaces are
+ -- demand-loadeded into the external-package table.)
+ --
-- hsc_HPT is not mutable because we only demand-load
-- external packages; the home package is eagerly
- -- loaded by the compilation manager.
+ -- loaded, module by module, by the compilation manager.
+ --
+ -- The HPT may contain modules compiled earlier by --make
+ -- but not actually below the current module in the dependency
+ -- graph. (This changes a previous invariant: changed Jan 05.)
-- The next two are side-effected by compiling
-- to reflect sucking in interface files
The GhciMode is self-explanatory:
\begin{code}
-data GhciMode = Batch | Interactive | OneShot
+data GhciMode = Batch -- ghc --make Main
+ | Interactive -- ghc --interactive
+ | OneShot -- ghc Foo.hs
+ | IDE -- Visual Studio etc
deriving Eq
+
+isOneShot :: GhciMode -> Bool
+isOneShot OneShot = True
+isOneShot _other = False
\end{code}
\begin{code}
data HomeModInfo
= HomeModInfo { hm_iface :: ModIface,
- hm_globals :: Maybe GlobalRdrEnv, -- Its top level environment
- -- Nothing <-> compiled module
hm_details :: ModDetails,
hm_linkable :: Linkable }
\end{code}
Just mod_info -> Just (hm_iface mod_info)
Nothing -> lookupModuleEnv pit mod
-lookupIfaceByModName :: HomePackageTable -> PackageIfaceTable -> ModuleName -> Maybe ModIface
+lookupIfaceByModule :: HomePackageTable -> PackageIfaceTable -> Module -> Maybe ModIface
-- We often have two IfaceTables, and want to do a lookup
-lookupIfaceByModName hpt pit mod
- = case lookupModuleEnvByName hpt mod of
+lookupIfaceByModule hpt pit mod
+ = case lookupModuleEnv hpt mod of
Just mod_info -> Just (hm_iface mod_info)
- Nothing -> lookupModuleEnvByName pit mod
+ Nothing -> lookupModuleEnv pit mod
\end{code}
+
\begin{code}
--- Use instead of Finder.findModule if possible: this way doesn't
--- require filesystem operations, and it is guaranteed not to fail
--- when the IfaceTables are properly populated (i.e. after the renamer).
-moduleNameToModule :: HomePackageTable -> PackageIfaceTable -> ModuleName -> Module
-moduleNameToModule hpt pit mod
- = mi_module (fromJust (lookupIfaceByModName hpt pit mod))
+hptInstances :: HscEnv -> (Module -> Bool) -> [DFunId]
+-- 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 hsc_env want_this_module
+ = [ dfun
+ | mod_info <- moduleEnvElts (hsc_HPT hsc_env)
+ , want_this_module (mi_module (hm_iface mod_info))
+ , dfun <- md_insts (hm_details mod_info) ]
+
+hptRules :: HscEnv -> [(Module, IsBootInterface)] -> [IdCoreRule]
+-- Get rules from modules "below" this one (in the dependency sense)
+-- C.f Inst.hptInstances
+hptRules hsc_env deps
+ | isOneShot (hsc_mode hsc_env) = []
+ | otherwise
+ = let
+ hpt = hsc_HPT hsc_env
+ in
+ [ rule
+ | -- Find each non-hi-boot module below me
+ (mod, False) <- deps
+
+ -- Look it up in the HPT
+ , let mod_info = ASSERT( mod `elemModuleEnv` hpt )
+ fromJust (lookupModuleEnv hpt mod)
+
+ -- And get its dfuns
+ , rule <- md_rules (hm_details mod_info) ]
\end{code}
\begin{code}
data ModIface
= ModIface {
- mi_package :: !PackageName, -- Which package the module comes from
+ mi_package :: !PackageIdH, -- Which package the module comes from
mi_module :: !Module,
mi_mod_vers :: !Version, -- Module version: changes when anything changes
-- NOT STRICT! we read this field lazily from the interface file
-- Deprecations
- mi_deprecs :: Deprecs [(OccName,DeprecTxt)],
+ mi_deprecs :: IfaceDeprecs,
-- NOT STRICT! we read this field lazily from the interface file
-- Type, class and variable declarations
-- the version of the parent class/tycon changes
mi_decls :: [(Version,IfaceDecl)], -- Sorted
+ mi_globals :: !(Maybe GlobalRdrEnv),
+ -- Its top level environment or Nothing if we read this
+ -- interface from an interface file. (We need the source
+ -- file to figure out the top-level environment.)
+
-- Instance declarations and rules
mi_insts :: [IfaceInst], -- Sorted
mi_rules :: [IfaceRule], -- Sorted
data ModGuts
= ModGuts {
mg_module :: !Module,
- mg_exports :: !Avails, -- What it exports
+ 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
\end{code}
\begin{code}
-emptyModIface :: PackageName -> ModuleName -> ModIface
+emptyModIface :: PackageIdH -> Module -> ModIface
emptyModIface pkg mod
= ModIface { mi_package = pkg,
- mi_module = mkModule pkg mod,
+ mi_module = mod,
mi_mod_vers = initialVersion,
mi_orphan = False,
mi_boot = False,
mi_insts = [],
mi_rules = [],
mi_decls = [],
+ mi_globals = Nothing,
mi_rule_vers = initialVersion,
mi_dep_fn = emptyIfaceDepCache,
mi_fix_fn = emptyIfaceFixCache,
in error messages.
\begin{code}
-unQualInScope :: GlobalRdrEnv -> Name -> Bool
+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')
--
--- Also checks for built-in syntax, which is always 'in scope'
---
--- This fn is only efficient if the shared
--- partial application is used a lot.
-unQualInScope env
- = \n -> n `elemNameSet` unqual_names || isBuiltInSyntaxName n
- where
- unqual_names :: NameSet
- unqual_names = foldOccEnv add emptyNameSet env
- add [gre] unquals | unQualOK gre = addOneToNameSet unquals (gre_name gre)
- add _ unquals = unquals
+-- [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
\end{code}
%************************************************************************
\begin{code}
-isImplicitTyThing :: TyThing -> Bool
-isImplicitTyThing (ADataCon dc) = True
-isImplicitTyThing (AnId id) = isImplicitId id
-isImplicitTyThing (ATyCon tc) = isClassTyCon tc
-isImplicitTyThing other = False
-
implicitTyThings :: TyThing -> [TyThing]
implicitTyThings (AnId id) = []
lookupTypeEnv = lookupNameEnv
-extendTypeEnvList :: TypeEnv -> [TyThing] -> TypeEnv
-- Extend the type environment
-extendTypeEnvList env things
- = foldl extend env things
- where
- extend env thing = extendNameEnv env (getName thing) thing
+extendTypeEnv :: TypeEnv -> TyThing -> TypeEnv
+extendTypeEnv env thing = extendNameEnv env (getName thing) thing
+
+extendTypeEnvList :: TypeEnv -> [TyThing] -> TypeEnv
+extendTypeEnvList env things = foldl extendTypeEnv env things
\end{code}
\begin{code}
deriving( Eq )
-- Equality used when deciding if the interface has changed
-type IfaceExport = (ModuleName, [GenAvailInfo OccName])
+type IfaceExport = (Module, [GenAvailInfo OccName])
availsToNameSet :: [AvailInfo] -> NameSet
availsToNameSet avails = foldl add emptyNameSet avails
type FixityEnv = NameEnv FixItem
-- We keep the OccName in the range so that we can generate an interface from it
-data FixItem = FixItem OccName Fixity SrcLoc
+data FixItem = FixItem OccName Fixity SrcSpan
instance Outputable FixItem where
ppr (FixItem occ fix loc) = ppr fix <+> ppr occ <+> parens (ppr loc)
-- in the import hierarchy. See TcRnTypes.ImportAvails for details.
--
-- 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 :: [PackageName], -- External package dependencies
- dep_orphs :: [ModuleName] } -- Orphan modules (whether home or external pkg)
+ = 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)
+ deriving( Eq )
+ -- Equality used only for old/new comparison in MkIface.addVersionInfo
noDependencies :: Dependencies
noDependencies = Deps [] [] []
data Usage
- = Usage { usg_name :: ModuleName, -- Name of the module
+ = Usage { usg_name :: Module, -- Name of the module
usg_mod :: Version, -- Module version
usg_entities :: [(OccName,Version)], -- Sorted by occurrence name
usg_exports :: Maybe Version, -- Export-list version, if we depend on it
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
+ --
+ -- The Module 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
+
eps_PIT :: !PackageIfaceTable,
-- The ModuleIFaces for modules in external packages
-- whose interfaces we have opened
-- Holding pens for stuff that has been read in from file,
-- but not yet slurped into the renamer
- eps_decls :: !DeclPool,
- -- A single, global map of Names to unslurped decls
- -- Decls move from here to eps_PTE
-
eps_insts :: !InstPool,
-- The as-yet un-slurped instance decls
-- Decls move from here to eps_inst_env
-- Each instance is 'gated' by the names that must be
-- available before this instance decl is needed.
- eps_rules :: !RulePool
- -- Rules move from here to eps_rule_base when
- -- all their LHS free vars are in the eps_PTE
- -- To maintain this invariant, we need to check the pool
- -- a) when adding to the rule pool by loading an interface
- -- (some of the new rules may alrady have all their
- -- gates in the eps_PTE)
- -- b) when extending the eps_PTE when we load a decl
- -- from the eps_decls pool
+ eps_rules :: !RulePool,
+ -- The as-yet un-slurped rules
+
+ eps_stats :: !EpsStats
}
+
+-- "In" means read from iface files
+-- "Out" means actually sucked in and type-checked
+data EpsStats = EpsStats { n_ifaces_in
+ , n_decls_in, n_decls_out
+ , n_rules_in, n_rules_out
+ , n_insts_in, n_insts_out :: !Int }
\end{code}
The NameCache makes sure that there is just one Unique assigned for
\end{code}
\begin{code}
-data Pool p = Pool (NameEnv p) -- The pool itself, indexed by some primary key
- Int -- Number of decls slurped into the map
- Int -- Number of decls slurped out of the map
+type Gated d = ([Name], (Module, SDoc, d))
+ -- The [Name] 'gate' the declaration; always non-empty
+ -- Module records which module this decl belongs to
+ -- SDoc records the pathname of the file, or similar err-ctxt info
-emptyPool = Pool emptyNameEnv 0 0
+type RulePool = [Gated IfaceRule]
-instance Outputable p => Outputable (Pool p) where
- ppr (Pool p n_in n_out) -- Debug printing only
- = vcat [ptext SLIT("Pool") <+> int n_in <+> int n_out,
- nest 2 (ppr p)]
-
-type DeclPool = Pool IfaceDecl
+addRulesToPool :: RulePool
+ -> [Gated IfaceRule]
+ -> RulePool
+addRulesToPool rules new_rules = new_rules ++ rules
-------------------------
-type Gated d = ([Name], (ModuleName, d)) -- The [Name] 'gate' the declaration
- -- ModuleName records which iface file this
- -- decl came from
-
-type RulePool = Pool [Gated IfaceRule]
-
-addRuleToPool :: NameEnv [Gated IfaceRule]
- -> (ModuleName, IfaceRule)
- -> [Name] -- Free vars of rule; always non-empty
- -> NameEnv [Gated IfaceRule]
-addRuleToPool rules rule (fv:fvs) = extendNameEnv_C combine rules fv [(fvs,rule)]
- where
- combine old _ = (fvs,rule) : old
+addEpsInStats :: EpsStats -> Int -> Int -> Int -> EpsStats
+-- Add stats for one newly-read interface
+addEpsInStats stats n_decls n_insts n_rules
+ = stats { n_ifaces_in = n_ifaces_in stats + 1
+ , n_decls_in = n_decls_in stats + n_decls
+ , n_insts_in = n_insts_in stats + n_insts
+ , n_rules_in = n_rules_in stats + n_rules }
-------------------------
-type InstPool = Pool [Gated IfaceInst]
+type InstPool = NameEnv [Gated IfaceInst]
-- The key of the Pool is the Class
-- The Names are the TyCons in the instance head
-- For example, suppose this is in an interface file
-- instance C T where ...
-- We want to slurp this decl if both C and T are "visible" in
-- the importing module. See "The gating story" in RnIfaces for details.
+
+
+addInstsToPool :: InstPool -> [(Name, Gated IfaceInst)] -> InstPool
+addInstsToPool insts new_insts
+ = foldr add insts new_insts
+ where
+ add :: (Name, Gated IfaceInst) -> NameEnv [Gated IfaceInst] -> NameEnv [Gated IfaceInst]
+ add (cls,new_inst) insts = extendNameEnv_C combine insts cls [new_inst]
+ where
+ combine old_insts _ = new_inst : old_insts
+\end{code}
+
+
+%************************************************************************
+%* *
+ The ModSummary type
+ A ModSummary is a node in the compilation manager's
+ dependency graph, and it's also passed to hscMain
+%* *
+%************************************************************************
+
+The nodes of the module graph are
+ EITHER a regular Haskell source module
+ OR a hi-boot source module
+
+\begin{code}
+data ModSummary
+ = ModSummary {
+ ms_mod :: Module, -- Name of the module
+ ms_hsc_src :: HscSource, -- Source is Haskell, hs-boot, external core
+ ms_location :: ModLocation, -- Location
+ ms_hs_date :: ClockTime, -- Timestamp of summarised file
+ ms_srcimps :: [Module], -- Source imports
+ ms_imps :: [Module], -- Non-source imports
+ ms_hspp_file :: Maybe FilePath, -- Filename of preprocessed source,
+ -- once we have preprocessed it.
+ ms_hspp_buf :: Maybe StringBuffer -- The actual preprocessed source, maybe.
+ }
+
+-- 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
+-- all files anyway, and there's no point in doing this twice -- just
+-- park the result in a temp file, put the name of it in the location,
+-- and let @compile@ read from that file on the way back up.
+
+-- The ModLocation is stable over successive up-sweeps in GHCi, wheres
+-- the ms_hs_date and imports can, of course, change
+
+msHsFilePath, msHiFilePath, msObjFilePath :: ModSummary -> FilePath
+msHsFilePath ms = expectJust "msHsFilePath" (ml_hs_file (ms_location ms))
+msHiFilePath ms = ml_hi_file (ms_location ms)
+msObjFilePath ms = ml_obj_file (ms_location ms)
+
+
+instance Outputable ModSummary where
+ ppr ms
+ = sep [text "ModSummary {",
+ nest 3 (sep [text "ms_hs_date = " <> text (show (ms_hs_date ms)),
+ text "ms_mod =" <+> ppr (ms_mod ms)
+ <> text (hscSourceString (ms_hsc_src ms)) <> comma,
+ text "ms_imps =" <+> ppr (ms_imps ms),
+ text "ms_srcimps =" <+> ppr (ms_srcimps ms)]),
+ char '}'
+ ]
+
+showModMsg :: Bool -> ModSummary -> String
+showModMsg use_object mod_summary
+ = showSDoc (hsep [text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' '),
+ char '(', text (msHsFilePath mod_summary) <> comma,
+ if use_object then text (msObjFilePath mod_summary)
+ else text "interpreted",
+ char ')'])
+ where
+ mod = ms_mod mod_summary
+ mod_str = moduleUserString mod ++ hscSourceString (ms_hsc_src mod_summary)
\end{code}
linkableTime :: ClockTime, -- Time at which this linkable was built
-- (i.e. when the bytecodes were produced,
-- or the mod date on the files)
- linkableModName :: ModuleName, -- Should be Module, but see below
+ linkableModule :: Module, -- Should be Module, but see below
linkableUnlinked :: [Unlinked]
}
projects / ghc-hetmet.git / blobdiff