ModDetails(..), emptyModDetails,
ModGuts(..), CoreModule(..), CgGuts(..), ModImports(..), ForeignStubs(..),
+ ImportedMods,
ModSummary(..), ms_mod_name, showModMsg, isBootSummary,
msHsFilePath, msHiFilePath, msObjFilePath,
icPrintUnqual, mkPrintUnqualified, extendInteractiveContext,
substInteractiveContext,
- ModIface(..), mkIfaceDepCache, mkIfaceVerCache, mkIfaceFixCache,
- emptyIfaceDepCache,
+ ModIface(..), mkIfaceWarnCache, mkIfaceHashCache, mkIfaceFixCache,
+ emptyIfaceWarnCache,
FixityEnv, FixItem(..), lookupFixity, emptyFixityEnv,
GenAvailInfo(..), AvailInfo, RdrAvailInfo,
IfaceExport,
- Deprecations(..), DeprecTxt, plusDeprecs,
+ Warnings(..), WarningTxt(..), plusWarns,
PackageInstEnv, PackageRuleBase,
import CoreSyn ( CoreBind )
import VarEnv
import VarSet
-import Var hiding ( setIdType )
+import Var
import Id
import Type
import Class ( Class, classSelIds, classATs, classTyCon )
import TyCon
-import DataCon ( DataCon, dataConImplicitIds )
+import DataCon ( DataCon, dataConImplicitIds, dataConWrapId )
import PrelNames ( gHC_PRIM )
import Packages hiding ( Version(..) )
import DynFlags ( DynFlags(..), isOneShot, HscTarget (..) )
import DriverPhases ( HscSource(..), isHsBoot, hscSourceString, Phase )
-import BasicTypes ( Version, initialVersion, IPName,
- Fixity, defaultFixity, DeprecTxt )
+import BasicTypes ( IPName, Fixity, defaultFixity, WarningTxt(..) )
+import OptimizationFuel ( OptFuelState )
import IfaceSyn
import FiniteMap ( FiniteMap )
import CoreSyn ( CoreRule )
-import Maybes ( orElse, expectJust, catMaybes, seqMaybe )
+import Maybes ( orElse, expectJust, catMaybes )
import Outputable
import BreakArray
import SrcLoc ( SrcSpan, Located )
-import UniqFM ( lookupUFM, eltsUFM, emptyUFM )
+import LazyUniqFM ( lookupUFM, eltsUFM, emptyUFM )
import UniqSupply ( UniqSupply )
-import FastString ( FastString )
+import FastString
import StringBuffer ( StringBuffer )
+import Fingerprint
+import System.FilePath
import System.Time ( ClockTime )
import Data.IORef
import Data.Array ( Array, array )
import Data.List
+import Control.Monad ( mplus )
\end{code}
-- The finder's cache. This caches the location of modules,
-- so we don't have to search the filesystem multiple times.
+ hsc_OptFuel :: OptFuelState,
+ -- Settings to control the use of optimization fuel:
+ -- by limiting the number of transformations,
+ -- we can use binary search to help find compiler bugs.
+
+ hsc_type_env_var :: Maybe (Module, IORef TypeEnv),
+ -- Used for one-shot compilation only, to initialise
+ -- the IfGblEnv. See TcRnTypes.TcGblEnv.tcg_type_env_var
+
hsc_global_rdr_env :: GlobalRdrEnv,
hsc_global_type_env :: TypeEnv
}
-- 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
+ `mplus` lookupModuleEnv pit mod
| otherwise = lookupModuleEnv pit mod -- Look in PIT only
-- (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
+-- We could eliminate (b) if we wanted, by making GHC.Prim belong to a package
-- of its own, but it doesn't seem worth the bother.
\end{code}
, 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")]
+ 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
| NoPackage PackageId
-- the requested package was not found
| FoundMultiple [PackageId]
- -- *error*: both in multiple packages
+ -- _error_: both in multiple packages
| PackageHidden PackageId
-- for an explicit source import: the package containing the module is
-- not exposed.
data ModIface
= ModIface {
mi_module :: !Module,
- mi_mod_vers :: !Version, -- Module version: changes when anything changes
+ mi_iface_hash :: !Fingerprint, -- Hash of the whole interface
+ mi_mod_hash :: !Fingerprint, -- Hash of the ABI only
mi_orphan :: !WhetherHasOrphans, -- Whether this module has orphans
mi_finsts :: !WhetherHasFamInst, -- Whether module has family insts
-- Usages; kept sorted so that it's easy to decide
-- whether to write a new iface file (changing usages
- -- doesn't affect the version of this module)
+ -- doesn't affect the hash of this module)
mi_usages :: [Usage],
-- NOT STRICT! we read this field lazily from the interface file
-- It is *only* consulted by the recompilation checker
-- Exports
-- Kept sorted by (mod,occ), to make version comparisons easier
mi_exports :: ![IfaceExport],
- mi_exp_vers :: !Version, -- Version number of export list
+ mi_exp_hash :: !Fingerprint, -- Hash of export list
-- Fixities
mi_fixities :: [(OccName,Fixity)],
-- NOT STRICT! we read this field lazily from the interface file
- -- Deprecations
- mi_deprecs :: Deprecations,
+ -- Warnings
+ mi_warns :: Warnings,
-- NOT STRICT! we read this field lazily from the interface file
-- Type, class and variable declarations
- -- The version of an Id changes if its fixity or deprecations change
+ -- The hash of an Id changes if its fixity or deprecations change
-- (as well as its type of course)
-- Ditto data constructors, class operations, except that
- -- the version of the parent class/tycon changes
- mi_decls :: [(Version,IfaceDecl)], -- Sorted
+ -- the hash of the parent class/tycon changes
+ mi_decls :: [(Fingerprint,IfaceDecl)], -- Sorted
mi_globals :: !(Maybe GlobalRdrEnv),
-- Binds all the things defined at the top level in
mi_insts :: [IfaceInst], -- Sorted
mi_fam_insts :: [IfaceFamInst], -- Sorted
mi_rules :: [IfaceRule], -- Sorted
- mi_rule_vers :: !Version, -- Version number for rules and
+ mi_orphan_hash :: !Fingerprint, -- Hash for orphan 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_warn_fn :: Name -> Maybe WarningTxt, -- Cached lookup for mi_warns
mi_fix_fn :: OccName -> Fixity, -- Cached lookup for mi_fixities
- mi_ver_fn :: OccName -> Maybe (OccName, Version),
+ mi_hash_fn :: OccName -> Maybe (OccName, Fingerprint),
-- Cached lookup for mi_decls
- -- The Nothing in mi_ver_fn means that the thing
+ -- The Nothing in mi_hash_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.
-- being compiled right now. Once it is compiled, a ModIface and
-- ModDetails are extracted and the ModGuts is dicarded.
+type ImportedMods = ModuleEnv [(ModuleName, Bool, SrcSpan)]
+
data ModGuts
= ModGuts {
mg_module :: !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
+ mg_dir_imps :: !ImportedMods, -- Directly-imported modules; used to
-- generate initialisation code
- mg_usages :: ![Usage], -- Version info for what it needed
+ mg_used_names:: !NameSet, -- What it needed (used in mkIface)
mg_rdr_env :: !GlobalRdrEnv, -- Top-level lexical environment
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_warns :: !Warnings, -- Warnings declared in the module
mg_hpc_info :: !HpcInfo, -- info about coverage tick boxes
mg_modBreaks :: !ModBreaks,
mg_vect_info :: !VectInfo, -- Pool of vectorised declarations
-- this module, rather than for *just* this module.
-- Reason: when looking up an instance we don't want to have to
-- look at each module in the home package in turn
- 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_inst_env :: InstEnv,
+ -- ^ Class instance enviroment from /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
}
-- A CoreModule consists of just the fields of a ModGuts that are needed for
-- Type environment for types declared in this module
cm_types :: !TypeEnv,
-- Declarations
- cm_binds :: [CoreBind]
+ cm_binds :: [CoreBind],
+ -- Imports
+ cm_imports :: ![Module]
}
instance Outputable CoreModule where
-- "foreign exported" functions
SDoc -- C stubs to use when calling
-- "foreign exported" functions
- [FastString] -- Headers that need to be included
- -- into C code generated for this module
-
\end{code}
\begin{code}
emptyModIface :: Module -> ModIface
emptyModIface mod
= ModIface { mi_module = mod,
- mi_mod_vers = initialVersion,
+ mi_iface_hash = fingerprint0,
+ mi_mod_hash = fingerprint0,
mi_orphan = False,
mi_finsts = False,
mi_boot = False,
mi_deps = noDependencies,
mi_usages = [],
mi_exports = [],
- mi_exp_vers = initialVersion,
+ mi_exp_hash = fingerprint0,
mi_fixities = [],
- mi_deprecs = NoDeprecs,
+ mi_warns = NoWarnings,
mi_insts = [],
mi_fam_insts = [],
mi_rules = [],
mi_decls = [],
mi_globals = Nothing,
- mi_rule_vers = initialVersion,
+ mi_orphan_hash = fingerprint0,
mi_vect_info = noIfaceVectInfo,
- mi_dep_fn = emptyIfaceDepCache,
- mi_fix_fn = emptyIfaceFixCache,
- mi_ver_fn = emptyIfaceVerCache,
- mi_hpc = False
+ mi_warn_fn = emptyIfaceWarnCache,
+ mi_fix_fn = emptyIfaceFixCache,
+ mi_hash_fn = emptyIfaceHashCache,
+ mi_hpc = False
}
\end{code}
tyThingDataCon other = pprPanic "tyThingDataCon" (pprTyThing other)
tyThingId :: TyThing -> Id
-tyThingId (AnId id) = id
-tyThingId other = pprPanic "tyThingId" (pprTyThing other)
+tyThingId (AnId id) = id
+tyThingId (ADataCon dc) = dataConWrapId dc
+tyThingId other = pprPanic "tyThingId" (pprTyThing other)
\end{code}
-%************************************************************************
-%* *
-\subsection{Auxiliary types}
-%* *
-%************************************************************************
-
-These types are defined here because they are mentioned in ModDetails,
-but they are mostly elaborated elsewhere
-
\begin{code}
-mkIfaceVerCache :: [(Version,IfaceDecl)]
- -> (OccName -> Maybe (OccName, Version))
-mkIfaceVerCache pairs
+mkIfaceHashCache :: [(Fingerprint,IfaceDecl)]
+ -> (OccName -> Maybe (OccName, Fingerprint))
+mkIfaceHashCache pairs
= \occ -> lookupOccEnv env occ
where
env = foldr add_decl emptyOccEnv pairs
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
+emptyIfaceHashCache :: OccName -> Maybe (OccName, Fingerprint)
+emptyIfaceHashCache _occ = Nothing
+\end{code}
------------------- Deprecations -------------------------
-data Deprecations
- = NoDeprecs
- | DeprecAll DeprecTxt -- Whole module deprecated
- | DeprecSome [(OccName,DeprecTxt)] -- Some specific things deprecated
+%************************************************************************
+%* *
+\subsection{Auxiliary types}
+%* *
+%************************************************************************
+
+These types are defined here because they are mentioned in ModDetails,
+but they are mostly elaborated elsewhere
+
+\begin{code}
+------------------ Warnings -------------------------
+data Warnings
+ = NoWarnings
+ | WarnAll WarningTxt -- Whole module deprecated
+ | WarnSome [(OccName,WarningTxt)] -- Some specific things deprecated
-- Only an OccName is needed because
-- (1) a deprecation always applies to a binding
-- defined in the module in which the deprecation appears.
-- a Name to its fixity declaration.
deriving( Eq )
-mkIfaceDepCache :: Deprecations -> Name -> Maybe DeprecTxt
-mkIfaceDepCache NoDeprecs = \_ -> Nothing
-mkIfaceDepCache (DeprecAll t) = \_ -> Just t
-mkIfaceDepCache (DeprecSome pairs) = lookupOccEnv (mkOccEnv pairs) . nameOccName
+mkIfaceWarnCache :: Warnings -> Name -> Maybe WarningTxt
+mkIfaceWarnCache NoWarnings = \_ -> Nothing
+mkIfaceWarnCache (WarnAll t) = \_ -> Just t
+mkIfaceWarnCache (WarnSome pairs) = lookupOccEnv (mkOccEnv pairs) . nameOccName
-emptyIfaceDepCache :: Name -> Maybe DeprecTxt
-emptyIfaceDepCache _ = Nothing
+emptyIfaceWarnCache :: Name -> Maybe WarningTxt
+emptyIfaceWarnCache _ = Nothing
-plusDeprecs :: Deprecations -> Deprecations -> Deprecations
-plusDeprecs d NoDeprecs = d
-plusDeprecs NoDeprecs d = d
-plusDeprecs _ (DeprecAll t) = DeprecAll t
-plusDeprecs (DeprecAll t) _ = DeprecAll t
-plusDeprecs (DeprecSome v1) (DeprecSome v2) = DeprecSome (v1 ++ v2)
+plusWarns :: Warnings -> Warnings -> Warnings
+plusWarns d NoWarnings = d
+plusWarns NoWarnings d = d
+plusWarns _ (WarnAll t) = WarnAll t
+plusWarns (WarnAll t) _ = WarnAll t
+plusWarns (WarnSome v1) (WarnSome v2) = WarnSome (v1 ++ v2)
\end{code}
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)
- } deriving( Eq )
- -- This type doesn't let you say "I imported f but none of the rules in
- -- the module". If you use anything in the module you get its rule version
- -- So if the rules change, you'll recompile, even if you don't use them.
- -- This is easy to implement, and it's safer: you might not have used the rules last
- -- time round, but if someone has added a new rule you might need it this time
-
+ = UsagePackageModule {
+ usg_mod :: Module,
+ usg_mod_hash :: Fingerprint
+ }
+ | UsageHomeModule {
+ usg_mod_name :: ModuleName, -- Name of the module
+ usg_mod_hash :: Fingerprint, -- Module fingerprint
+ -- (optimisation only)
+ usg_entities :: [(OccName,Fingerprint)],
+ -- Sorted by occurrence name.
+ -- NB. usages are for parent names only,
+ -- eg. tycon but not constructors.
+ usg_exports :: Maybe Fingerprint
+ -- Export-list fingerprint, if we depend on it
+ }
+ deriving( Eq )
-- The export list field is (Just v) if we depend on the export list:
-- i.e. we imported the module directly, whether or not we
- -- enumerated the things we imported, or just imported everything
+ -- enumerated the things we imported, or just imported
+ -- everything
-- We need to recompile if M's exports change, because
- -- if the import was import M, we might now have a name clash in the
- -- importing module.
+ -- if the import was import M, we might now have a name clash
+ -- in the importing module.
-- if the import was import M(x) M might no longer export x
-- The only way we don't depend on the export list is if we have
-- import M()
-- (below), not in the mi_decls fields of the iPIT.
-- What _is_ in the iPIT is:
-- * The Module
- -- * Version info
+ -- * Fingerprint info
-- * Its exports
-- * Fixities
- -- * Deprecations
+ -- * Warnings
eps_PTE :: !PackageTypeEnv, -- Domain = external-package modules
showModMsg :: HscTarget -> Bool -> ModSummary -> String
showModMsg target recomp mod_summary
- = showSDoc (hsep [text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' '),
- char '(', text (msHsFilePath mod_summary) <> comma,
- case target of
- HscInterpreted | recomp
- -> text "interpreted"
- HscNothing -> text "nothing"
- _other -> text (msObjFilePath mod_summary),
- char ')'])
+ = showSDoc $
+ hsep [text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' '),
+ char '(', text (normalise $ msHsFilePath mod_summary) <> comma,
+ case target of
+ HscInterpreted | recomp
+ -> text "interpreted"
+ HscNothing -> text "nothing"
+ _ -> text (normalise $ msObjFilePath mod_summary),
+ char ')']
where
mod = moduleName (ms_mod mod_summary)
mod_str = showSDoc (ppr mod) ++ hscSourceString (ms_hsc_src mod_summary)
| BCOs CompiledByteCode ModBreaks
#ifndef GHCI
-data CompiledByteCode
+data CompiledByteCode = CompiledByteCodeUndefined
+_unused :: CompiledByteCode
+_unused = CompiledByteCodeUndefined
#endif
instance Outputable Unlinked where