#include "HsVersions.h"
import HsSyn
+import Packages ( isHomeModule )
import IfaceSyn ( IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..),
IfaceRule(..), IfaceInst(..), IfaceExtName(..), IfaceTyCon(..),
eqIfDecl, eqIfRule, eqIfInst, IfaceEq(..), (&&&), bool,
import LoadIface ( readIface, loadInterface, ifaceInstGates )
import BasicTypes ( Version, initialVersion, bumpVersion )
import TcRnMonad
-import TcRnTypes ( ImportAvails(..), mkModDeps )
+import TcRnTypes ( mkModDeps )
import TcType ( isFFITy )
-import HscTypes ( ModIface(..), TyThing(..),
+import HscTypes ( ModIface(..), TyThing(..), IfacePackage(..),
ModGuts(..), ModGuts, IfaceExport,
- GhciMode(..),
- HscEnv(..), hscEPS,
+ GhciMode(..), HscEnv(..), hscEPS,
Dependencies(..), FixItem(..),
mkIfaceDepCache, mkIfaceFixCache, mkIfaceVerCache,
typeEnvElts,
- Avails, AvailInfo, GenAvailInfo(..), availName,
+ GenAvailInfo(..), availName,
ExternalPackageState(..),
Usage(..), IsBootInterface,
Deprecs(..), IfaceDeprecs, Deprecations,
- lookupIfaceByModName
+ lookupIfaceByModule
)
import CmdLineOpts
-import Name ( Name, nameModule, nameOccName, nameParent, isExternalName,
- nameParent_maybe, isWiredInName, NamedThing(..), nameModuleName )
+import Name ( Name, nameModule, nameOccName, nameParent,
+ isExternalName, nameParent_maybe, isWiredInName,
+ NamedThing(..) )
import NameEnv
import NameSet
-import OccName ( OccName, OccEnv, mkOccEnv, lookupOccEnv, emptyOccEnv, extendOccEnv_C,
+import OccName ( OccName, OccEnv, mkOccEnv, lookupOccEnv, emptyOccEnv,
+ extendOccEnv_C,
OccSet, emptyOccSet, elemOccSet, occSetElts,
extendOccSet, extendOccSetList,
isEmptyOccSet, intersectOccSet, intersectsOccSet,
occNameFS, isTcOcc )
-import TyCon ( visibleDataCons, tyConDataCons, isNewTyCon, newTyConRep )
+import TyCon ( tyConDataCons, isNewTyCon, newTyConRep )
import Class ( classSelIds )
import DataCon ( dataConName, dataConFieldLabels )
-import FieldLabel ( fieldLabelName )
-import Module ( Module, ModuleName, moduleNameFS, moduleName, isHomeModule,
- ModLocation(..), mkSysModuleNameFS, moduleUserString,
+import Module ( Module, moduleFS,
+ ModLocation(..), mkSysModuleFS, moduleUserString,
ModuleEnv, emptyModuleEnv, lookupModuleEnv,
- extendModuleEnv_C, moduleEnvElts
+ extendModuleEnv_C
)
import Outputable
import DriverUtil ( createDirectoryHierarchy, directoryOf )
-import Util ( sortLt, seqList )
+import Util ( sortLe, seqList )
import Binary ( getBinFileWithDict )
import BinIface ( writeBinIface, v_IgnoreHiWay )
import Unique ( Unique, Uniquable(..) )
import ErrUtils ( dumpIfSet_dyn, showPass )
import Digraph ( stronglyConnComp, SCC(..) )
+import SrcLoc ( SrcSpan )
import FiniteMap
import FastString
-> Maybe ModIface -- The old interface, if we have it
-> ModGuts -- The compiled, tidied module
-> IO ModIface -- The new one, complete with decls and versions
--- mkFinalIface
--- a) completes the interface
--- b) writes it out to a file if necessary
+-- mkIface
+-- a) Builds the ModIface
+-- b) Writes it out to a file if necessary
mkIface hsc_env location maybe_old_iface
guts@ModGuts{ mg_module = this_mod,
mg_rules = rules,
mg_types = type_env }
= do { eps <- hscEPS hsc_env
- ; let { this_mod_name = moduleName this_mod
- ; ext_nm = mkExtNameFn hsc_env eps this_mod_name
+ ; let { ext_nm = mkExtNameFn hsc_env eps this_mod
; local_things = [thing | thing <- typeEnvElts type_env,
not (isWiredInName (getName thing)) ]
-- Do not export anything about wired-in things
; deprecs = mkIfaceDeprec src_deprecs
; iface_rules
| omit_prags = []
- | otherwise = sortLt lt_rule $
- map (coreRuleToIfaceRule this_mod_name ext_nm) rules
- ; iface_insts = sortLt lt_inst (map (dfunToIfaceInst this_mod_name) insts)
+ | otherwise = sortLe le_rule $
+ map (coreRuleToIfaceRule this_mod ext_nm) rules
+ ; iface_insts = sortLe le_inst (map dfunToIfaceInst insts)
; intermediate_iface = ModIface {
mi_module = this_mod,
- mi_package = opt_InPackage,
+ mi_package = ThisPackage,
mi_boot = False,
mi_deps = deps,
mi_usages = usages,
; return new_iface }
where
- r1 `lt_rule` r2 = ifRuleName r1 < ifRuleName r2
- i1 `lt_inst` i2 = ifDFun i1 < ifDFun i2
+ r1 `le_rule` r2 = ifRuleName r1 <= ifRuleName r2
+ i1 `le_inst` i2 = ifDFun i1 <= ifDFun i2
dflags = hsc_dflags hsc_env
ghci_mode = hsc_mode hsc_env
-- can only do that if it can "see" the newtype representation
where
exported_data_con con
- = any (`elemNameSet` exports) (dataConName con : field_names)
- where
- field_names = map fieldLabelName (dataConFieldLabels con)
+ = any (`elemNameSet` exports) (dataConName con : dataConFieldLabels con)
mustExposeThing exports (AClass cls)
= any exported_class_op (classSelIds cls)
deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
-----------------------------
-mkExtNameFn :: HscEnv -> ExternalPackageState -> ModuleName -> Name -> IfaceExtName
+mkExtNameFn :: HscEnv -> ExternalPackageState -> Module -> Name -> IfaceExtName
mkExtNameFn hsc_env eps this_mod
= ext_nm
where
+ dflags = hsc_dflags hsc_env
hpt = hsc_HPT hsc_env
pit = eps_PIT eps
ext_nm name
- | mod_nm == this_mod = case nameParent_maybe name of
+ | mod == this_mod = case nameParent_maybe name of
Nothing -> LocalTop occ
Just par -> LocalTopSub occ (nameOccName par)
- | isWiredInName name = ExtPkg mod_nm occ
- | isHomeModule mod = HomePkg mod_nm occ vers
- | otherwise = ExtPkg mod_nm occ
+ | isWiredInName name = ExtPkg mod occ
+ | isHomeModule dflags mod = HomePkg mod occ vers
+ | otherwise = ExtPkg mod occ
where
mod = nameModule name
- mod_nm = moduleName mod
occ = nameOccName name
par_occ = nameOccName (nameParent name)
-- The version of the *parent* is the one want
- vers = lookupVersion mod_nm par_occ
+ vers = lookupVersion mod par_occ
- lookupVersion :: ModuleName -> OccName -> Version
+ lookupVersion :: Module -> OccName -> Version
-- Even though we're looking up a home-package thing, in
-- one-shot mode the imported interfaces may be in the PIT
lookupVersion mod occ
= mi_ver_fn iface occ `orElse`
pprPanic "lookupVers1" (ppr mod <+> ppr occ)
where
- iface = lookupIfaceByModName hpt pit mod `orElse`
+ iface = lookupIfaceByModule hpt pit mod `orElse`
pprPanic "lookupVers2" (ppr mod <+> ppr occ)
-----------------------------
no_deprec_change = mi_deprecs new_iface == mi_deprecs old_iface
-- If the usages havn't changed either, we don't need to write the interface file
- -- Question: should we also check for equality of mi_deps?
- no_other_changes = mi_usages new_iface == mi_usages old_iface
+ no_other_changes = mi_usages new_iface == mi_usages old_iface &&
+ mi_deps new_iface == mi_deps old_iface
no_change_at_all = no_output_change && no_other_changes
pp_diffs = vcat [pp_change no_export_change "Export list"
eq_ind_occs [op | IfaceClassOp op _ _ <- sigs]
eq_indirects (IfaceData {ifName = tc_occ, ifCons = cons})
= same_insts tc_occ &&& same_fixity tc_occ &&& -- The TyCon can have a fixity too
- eq_ind_occs [occ | IfaceConDecl occ _ _ _ _ _ _ <- visibleIfConDecls cons]
+ eq_ind_occs (map ifConOcc (visibleIfConDecls cons))
eq_indirects other = Equal -- Synonyms and foreign declarations
eq_ind_occ :: OccName -> IfaceEq -- For class ops and Ids; check fixity and rules
mkIfaceDeprec :: Deprecations -> IfaceDeprecs
mkIfaceDeprec NoDeprecs = NoDeprecs
mkIfaceDeprec (DeprecAll t) = DeprecAll t
-mkIfaceDeprec (DeprecSome env) = DeprecSome (sortLt (<) (nameEnvElts env))
+mkIfaceDeprec (DeprecSome env) = DeprecSome (sortLe (<=) (nameEnvElts env))
----------------------
bump_unless :: Bool -> Version -> Version
\begin{code}
-mkUsageInfo :: HscEnv -> ImportAvails -> NameSet -> IO [Usage]
-mkUsageInfo hsc_env
- (ImportAvails { imp_mods = dir_imp_mods,
- imp_dep_mods = dep_mods })
- used_names
+mkUsageInfo :: HscEnv
+ -> ModuleEnv (Module, Maybe Bool, SrcSpan)
+ -> [(Module, IsBootInterface)]
+ -> NameSet -> IO [Usage]
+mkUsageInfo hsc_env dir_imp_mods dep_mods used_names
= do { eps <- hscEPS hsc_env
- ; return (mk_usage_info (eps_PIT eps) (hsc_HPT hsc_env)
- dir_imp_mods dep_mods used_names) }
-
-mk_usage_info pit hpt dir_imp_mods dep_mods proto_used_names
- = -- seq the list of Usages returned: occasionally these
- -- don't get evaluated for a while and we can end up hanging on to
- -- the entire collection of Ifaces.
- usages `seqList` usages
+ ; let usages = mk_usage_info (eps_PIT eps) hsc_env
+ dir_imp_mods dep_mods used_names
+ ; usages `seqList` return usages }
+ -- seq the list of Usages returned: occasionally these
+ -- don't get evaluated for a while and we can end up hanging on to
+ -- the entire collection of Ifaces.
+
+mk_usage_info pit hsc_env dir_imp_mods dep_mods proto_used_names
+ = mapCatMaybes mkUsage dep_mods
+ -- ToDo: do we need to sort into canonical order?
where
+ dflags = hsc_dflags hsc_env
+ hpt = hsc_HPT hsc_env
+
used_names = mkNameSet $ -- Eliminate duplicates
[ nameParent n -- Just record usage on the 'main' names
| n <- nameSetToList proto_used_names
mod = nameModule name
add_item occs _ = occ:occs
- usages = mapCatMaybes mkUsage (moduleEnvElts dep_mods)
- -- ToDo: do we need to sort into canonical order?
-
import_all mod = case lookupModuleEnv dir_imp_mods mod of
Just (_,imp_all,_) -> isNothing imp_all
Nothing -> False
-- (need to recompile if its export list changes: export_vers)
-- c) is a home-package orphan module (need to recompile if its
-- instance decls change: rules_vers)
- mkUsage :: (ModuleName, Bool) -> Maybe Usage
+ mkUsage :: (Module, Bool) -> Maybe Usage
mkUsage (mod_name, _)
| isNothing maybe_iface -- We can't depend on it if we didn't
- || not (isHomeModule mod) -- even open the interface!
+ || not (isHomeModule dflags mod) -- even open the interface!
|| (null used_occs
&& not all_imported
&& not orphan_mod)
= Nothing -- Record no usage info
| otherwise
- = Just (Usage { usg_name = moduleName mod,
+ = Just (Usage { usg_name = mod,
usg_mod = mod_vers,
usg_exports = export_vers,
usg_entities = ent_vers,
usg_rules = rules_vers })
where
- maybe_iface = lookupIfaceByModName hpt pit mod_name
+ maybe_iface = lookupIfaceByModule hpt pit mod_name
-- In one-shot mode, the interfaces for home-package
-- modules accumulate in the PIT not HPT. Sigh.
used_occs = lookupModuleEnv ent_map mod `orElse` []
ent_vers :: [(OccName,Version)]
ent_vers = [ (occ, version_env occ `orElse` initialVersion)
- | occ <- sortLt (<) used_occs]
+ | occ <- sortLe (<=) used_occs]
\end{code}
\begin{code}
-mkIfaceExports :: NameSet -> [(ModuleName, [GenAvailInfo OccName])]
+mkIfaceExports :: NameSet -> [(Module, [GenAvailInfo OccName])]
-- Group by module and sort by occurrence
-- This keeps the list in canonical order
mkIfaceExports exports
- = [ (mkSysModuleNameFS fs, eltsFM avails)
+ = [ (mkSysModuleFS fs, eltsFM avails)
| (fs, avails) <- fmToList groupFM
]
where
(unitFM avail_fs avail)
where
occ = nameOccName name
- occ_fs = occNameFS occ
- mod_fs = moduleNameFS (nameModuleName name)
+ mod_fs = moduleFS (nameModule name)
avail | Just p <- nameParent_maybe name = AvailTC (nameOccName p) [occ]
| isTcOcc occ = AvailTC occ [occ]
| otherwise = Avail occ
avail_fs = occNameFS (availName avail)
add_avail avail_fm _ = addToFM_C add_item avail_fm avail_fs avail
- add_item (AvailTC p occs) _ = AvailTC p (insert occ occs)
- add_item (Avail n) _ = pprPanic "MkIface.addAvail" (ppr n <+> ppr name)
+ add_item (AvailTC p occs) _ = AvailTC p (List.insert occ occs)
+ add_item (Avail n) _ = pprPanic "MkIface.addAvail" (ppr n <+> ppr name)
\end{code}
-- Try and read the old interface for the current module
-- from the .hi file left from the last time we compiled it
- readIface (moduleName this_mod) iface_path False `thenM` \ read_result ->
+ readIface this_mod iface_path False `thenM` \ read_result ->
case read_result of {
Left err -> -- Old interface file not found, or garbled; give up
traceIf (text "FYI: cannot read old interface file:"
| not source_unchanged
= returnM outOfDate
| otherwise
- = traceHiDiffs (text "Considering whether compilation is required for" <+>
- ppr (mi_module iface) <> colon) `thenM_`
+ = do { traceHiDiffs (text "Considering whether compilation is required for" <+>
+ ppr (mi_module iface) <> colon)
-- Source code unchanged and no errors yet... carry on
- -- First put the dependent-module info in the envt, just temporarily,
+
+ -- First put the dependent-module info, read from the old interface, into the envt,
-- so that when we look for interfaces we look for the right one (.hi or .hi-boot)
+ --
-- It's just temporary because either the usage check will succeed
-- (in which case we are done with this module) or it'll fail (in which
-- case we'll compile the module from scratch anyhow).
- updGblEnv (\ gbl -> gbl { if_is_boot = mod_deps }) (
- checkList [checkModUsage u | u <- mi_usages iface]
- )
+ --
+ -- We do this regardless of compilation mode
+ ; updateEps_ $ \eps -> eps { eps_is_boot = mod_deps }
+
+ ; checkList [checkModUsage u | u <- mi_usages iface]
+ }
where
-- This is a bit of a hack really
- mod_deps :: ModuleEnv (ModuleName, IsBootInterface)
+ mod_deps :: ModuleEnv (Module, IsBootInterface)
mod_deps = mkModDeps (dep_mods (mi_deps iface))
checkModUsage :: Usage -> IfG RecompileRequired
-- Show a ModIface
pprModIface iface
= vcat [ ptext SLIT("interface")
- <+> doubleQuotes (ftext (mi_package iface))
+ <+> ppr_package (mi_package iface)
<+> ppr (mi_module iface) <+> ppr (mi_mod_vers iface)
<+> pp_sub_vers
<+> (if mi_orphan iface then ptext SLIT("[orphan module]") else empty)
, pprDeprecs (mi_deprecs iface)
]
where
+ ppr_package ThisPackage = empty
+ ppr_package (ExternalPackage id) = doubleQuotes (ftext id)
+
exp_vers = mi_exp_vers iface
rule_vers = mi_rule_vers iface
projects / ghc-hetmet.git / blobdiff