Commit 311b1cdf authored by chak@cse.unsw.edu.au.'s avatar chak@cse.unsw.edu.au.

Keep track of family instance modules

- Now each modules carries
  (1) a flag saying whether it contains family instance declarations and
  (2) a list of all modules further down in the import tree that contain
      family instance declarations.
  (The information is split into these two parts for the exact same reasons why
  the info about orphan modules is split, too.)
- This is the first step to *optimised* overlap checking of family instances
  coming from imported modules.

*** WARNING: This patch changes the interface file format! ***
***          Recompile libraries and stage2 from scratch!  ***
parent 8a5d47de
......@@ -139,9 +139,10 @@ deSugar hsc_env
le_dep_mod :: (ModuleName, IsBootInterface) -> (ModuleName, IsBootInterface) -> Bool
le_dep_mod (m1,_) (m2,_) = moduleNameFS m1 <= moduleNameFS m2
deps = Deps { dep_mods = sortLe le_dep_mod dep_mods,
dep_pkgs = sortLe (<=) pkgs,
dep_orphs = sortLe le_mod (imp_orphs imports) }
deps = Deps { dep_mods = sortLe le_dep_mod dep_mods,
dep_pkgs = sortLe (<=) pkgs,
dep_orphs = sortLe le_mod (imp_orphs imports),
dep_finsts = sortLe le_mod (imp_finsts imports) }
-- sort to get into canonical order
mod_guts = ModGuts {
......
......@@ -251,6 +251,7 @@ instance Binary ModIface where
mi_boot = is_boot,
mi_mod_vers = mod_vers,
mi_orphan = orphan,
mi_finsts = hasFamInsts,
mi_deps = deps,
mi_usages = usages,
mi_exports = exports,
......@@ -269,6 +270,7 @@ instance Binary ModIface where
put_ bh is_boot
put_ bh mod_vers
put_ bh orphan
put_ bh hasFamInsts
lazyPut bh deps
lazyPut bh usages
put_ bh exports
......@@ -305,6 +307,7 @@ instance Binary ModIface where
is_boot <- get bh
mod_vers <- get bh
orphan <- get bh
hasFamInsts <- get bh
deps <- lazyGet bh
usages <- {-# SCC "bin_usages" #-} lazyGet bh
exports <- {-# SCC "bin_exports" #-} get bh
......@@ -321,6 +324,7 @@ instance Binary ModIface where
mi_boot = is_boot,
mi_mod_vers = mod_vers,
mi_orphan = orphan,
mi_finsts = hasFamInsts,
mi_deps = deps,
mi_usages = usages,
mi_exports = exports,
......@@ -355,11 +359,14 @@ instance Binary Dependencies where
put_ bh deps = do put_ bh (dep_mods deps)
put_ bh (dep_pkgs deps)
put_ bh (dep_orphs deps)
put_ bh (dep_finsts deps)
get bh = do ms <- get bh
ps <- get bh
os <- get bh
return (Deps { dep_mods = ms, dep_pkgs = ps, dep_orphs = os })
fis <- get bh
return (Deps { dep_mods = ms, dep_pkgs = ps, dep_orphs = os,
dep_finsts = fis })
instance (Binary name) => Binary (GenAvailInfo name) where
put_ bh (Avail aa) = do
......
......@@ -17,7 +17,7 @@ module IfaceSyn (
-- Equality
GenIfaceEq(..), IfaceEq, (&&&), bool, eqListBy, eqMaybeBy,
eqIfDecl, eqIfInst, eqIfRule, checkBootDecl,
eqIfDecl, eqIfInst, eqIfFamInst, eqIfRule, checkBootDecl,
-- Pretty printing
pprIfaceExpr, pprIfaceDeclHead
......@@ -649,6 +649,9 @@ eqWith = eq_ifTvBndrs emptyEqEnv
eqIfInst d1 d2 = bool (ifDFun d1 == ifDFun d2 && ifOFlag d1 == ifOFlag d2)
-- All other changes are handled via the version info on the dfun
eqIfFamInst d1 d2 = bool (ifFamInstTyCon d1 == ifFamInstTyCon d2)
-- All other changes are handled via the version info on the tycon
eqIfRule (IfaceRule n1 a1 bs1 f1 es1 rhs1 o1)
(IfaceRule n2 a2 bs2 f2 es2 rhs2 o2)
= bool (n1==n2 && a1==a2 && o1 == o2) &&&
......
......@@ -81,6 +81,7 @@ data IfaceTyCon -- Abbreviations for common tycons with known names
| IfaceTupTc Boxity Arity
| IfaceLiftedTypeKindTc | IfaceOpenTypeKindTc | IfaceUnliftedTypeKindTc
| IfaceUbxTupleKindTc | IfaceArgTypeKindTc
deriving( Eq )
ifaceTyConName :: IfaceTyCon -> Name
ifaceTyConName IfaceIntTc = intTyConName
......
......@@ -88,8 +88,10 @@ loadSrcInterface doc mod want_boot = do
failWithTc (cannotFindInterface dflags mod err)
-- | Load interfaces for a collection of orphan modules.
loadOrphanModules :: [Module] -> TcM ()
loadOrphanModules mods
loadOrphanModules :: [Module] -- the modules
-> Bool -- these are family instance-modules
-> TcM ()
loadOrphanModules mods isFamInstMod
| null mods = returnM ()
| otherwise = initIfaceTcRn $
do { traceIf (text "Loading orphan modules:" <+>
......@@ -98,7 +100,9 @@ loadOrphanModules mods
; returnM () }
where
load mod = loadSysInterface (mk_doc mod) mod
mk_doc mod = ppr mod <+> ptext SLIT("is a orphan-instance module")
mk_doc mod
| isFamInstMod = ppr mod <+> ptext SLIT("is a family-instance module")
| otherwise = ppr mod <+> ptext SLIT("is a orphan-instance module")
-- | Loads the interface for a given Name.
loadInterfaceForName :: SDoc -> Name -> TcRn ModIface
......@@ -528,6 +532,7 @@ pprModIface iface
<+> ppr (mi_module iface) <+> pp_boot
<+> ppr (mi_mod_vers iface) <+> pp_sub_vers
<+> (if mi_orphan iface then ptext SLIT("[orphan module]") else empty)
<+> (if mi_finsts iface then ptext SLIT("[family instance module]") else empty)
<+> int opt_HiVersion
<+> ptext SLIT("where")
, vcat (map pprExport (mi_exports iface))
......@@ -583,10 +588,12 @@ pprUsage usage
pp_export_version (Just v) = int v
pprDeps :: Dependencies -> SDoc
pprDeps (Deps { dep_mods = mods, dep_pkgs = pkgs, dep_orphs = orphs})
pprDeps (Deps { dep_mods = mods, dep_pkgs = pkgs, dep_orphs = orphs,
dep_finsts = finsts })
= vcat [ptext SLIT("module dependencies:") <+> fsep (map ppr_mod mods),
ptext SLIT("package dependencies:") <+> fsep (map ppr pkgs),
ptext SLIT("orphans:") <+> fsep (map ppr orphs)
ptext SLIT("orphans:") <+> fsep (map ppr orphs),
ptext SLIT("family instance modules:") <+> fsep (map ppr finsts)
]
where
ppr_mod (mod_name, boot) = ppr mod_name <+> ppr_boot boot
......
......@@ -289,6 +289,7 @@ mkIface hsc_env maybe_old_iface
mi_rule_vers = initialVersion,
mi_orphan = False, -- Always set by addVersionInfo, but
-- it's a strict field, so we can't omit it.
mi_finsts = False, -- Ditto
mi_decls = deliberatelyOmitted "decls",
mi_ver_fn = deliberatelyOmitted "ver_fn",
......@@ -371,9 +372,12 @@ addVersionInfo
addVersionInfo ver_fn Nothing new_iface new_decls
-- No old interface, so definitely write a new one!
= (new_iface { mi_orphan = anyNothing ifInstOrph (mi_insts new_iface)
|| anyNothing ifRuleOrph (mi_rules new_iface),
mi_decls = [(initialVersion, decl) | decl <- new_decls],
mi_ver_fn = mkIfaceVerCache (zip (repeat initialVersion) new_decls)},
|| anyNothing ifRuleOrph (mi_rules new_iface)
, mi_finsts = not . null $ mi_fam_insts new_iface
, mi_decls = [(initialVersion, decl) | decl <- new_decls]
, mi_ver_fn = mkIfaceVerCache (zip (repeat initialVersion)
new_decls)
},
False,
ptext SLIT("No old interface file"),
pprOrphans orph_insts orph_rules)
......@@ -401,6 +405,7 @@ addVersionInfo ver_fn (Just old_iface@(ModIface {
mi_exp_vers = bump_unless no_export_change old_exp_vers,
mi_rule_vers = bump_unless no_rule_change old_rule_vers,
mi_orphan = not (null new_orph_rules && null new_orph_insts),
mi_finsts = not . null $ mi_fam_insts new_iface,
mi_decls = decls_w_vers,
mi_ver_fn = mkIfaceVerCache decls_w_vers }
......@@ -411,6 +416,8 @@ addVersionInfo ver_fn (Just old_iface@(ModIface {
mkOrphMap ifInstOrph (mi_insts old_iface)
(new_non_orph_insts, new_orph_insts) =
mkOrphMap ifInstOrph (mi_insts new_iface)
old_fam_insts = mi_fam_insts old_iface
new_fam_insts = mi_fam_insts new_iface
same_insts occ = eqMaybeBy (eqListBy eqIfInst)
(lookupOccEnv old_non_orph_insts occ)
(lookupOccEnv new_non_orph_insts occ)
......@@ -430,7 +437,8 @@ addVersionInfo ver_fn (Just old_iface@(ModIface {
-- Kept sorted
no_decl_change = isEmptyOccSet changed_occs
no_rule_change = not (changedWrtNames changed_occs (eqListBy eqIfRule old_orph_rules new_orph_rules)
|| changedWrtNames changed_occs (eqListBy eqIfInst old_orph_insts new_orph_insts))
|| changedWrtNames changed_occs (eqListBy eqIfInst old_orph_insts new_orph_insts)
|| changedWrtNames changed_occs (eqListBy eqIfFamInst old_fam_insts new_fam_insts))
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
......@@ -710,14 +718,15 @@ mk_usage_info pit hsc_env dir_imp_mods dep_mods used_names
-- a) we used something from; has something in used_names
-- b) we imported all of it, even if we used nothing from it
-- (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)
-- c) is a home-package orphan or family-instance module (need to
-- recompile if its instance decls change: rules_vers)
mkUsage :: (ModuleName, IsBootInterface) -> Maybe Usage
mkUsage (mod_name, _)
| isNothing maybe_iface -- We can't depend on it if we didn't
|| (null used_occs -- load its interface.
&& isNothing export_vers
&& not orphan_mod)
&& not orphan_mod
&& not finsts_mod)
= Nothing -- Record no usage info
| otherwise
......@@ -735,6 +744,7 @@ mk_usage_info pit hsc_env dir_imp_mods dep_mods used_names
Just iface = maybe_iface
orphan_mod = mi_orphan iface
finsts_mod = mi_finsts iface
version_env = mi_ver_fn iface
mod_vers = mi_mod_vers iface
rules_vers = mi_rule_vers iface
......
......@@ -367,6 +367,7 @@ data ModIface
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,
......@@ -420,7 +421,8 @@ data ModIface
mi_fam_insts :: [IfaceFamInst], -- Sorted
mi_rules :: [IfaceRule], -- Sorted
mi_rule_vers :: !Version, -- Version number for rules and
-- instances combined
-- instances (for classes and families)
-- combined
-- Cached environments for easy lookup
-- These are computed (lazily) from other fields
......@@ -550,6 +552,7 @@ emptyModIface mod
= ModIface { mi_module = mod,
mi_mod_vers = initialVersion,
mi_orphan = False,
mi_finsts = False,
mi_boot = False,
mi_deps = noDependencies,
mi_usages = [],
......@@ -904,22 +907,32 @@ type WhetherHasOrphans = Bool
-- * 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
......
......@@ -163,10 +163,11 @@ rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name want_boot
(warnRedundantSourceImport imp_mod_name)
let
imp_mod = mi_module iface
deprecs = mi_deprecs iface
is_orph = mi_orphan iface
deps = mi_deps iface
imp_mod = mi_module iface
deprecs = mi_deprecs iface
is_orph = mi_orphan iface
has_finsts = mi_finsts iface
deps = mi_deps iface
filtered_exports = filter not_this_mod (mi_exports iface)
not_this_mod (mod,_) = mod /= this_mod
......@@ -211,6 +212,10 @@ rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name want_boot
imp_mod : dep_orphs deps
| otherwise = dep_orphs deps
finsts | has_finsts = ASSERT( not (imp_mod `elem` dep_finsts deps) )
imp_mod : dep_finsts deps
| otherwise = dep_finsts deps
pkg = modulePackageId (mi_module iface)
(dependent_mods, dependent_pkgs)
......@@ -244,6 +249,7 @@ rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name want_boot
imp_env = unitUFM qual_mod_name filtered_avails,
imp_mods = unitModuleEnv imp_mod (imp_mod, import_all, loc),
imp_orphs = orphans,
imp_finsts = finsts,
imp_dep_mods = mkModDeps dependent_mods,
imp_dep_pkgs = dependent_pkgs,
imp_parent = emptyNameEnv
......
......@@ -167,9 +167,11 @@ tcRnModule hsc_env hsc_src save_rn_syntax
traceIf (text "rdr_env: " <+> ppr rdr_env) ;
failIfErrsM ;
-- Load any orphan-module interfaces, so that
-- their rules and instance decls will be found
loadOrphanModules (imp_orphs imports) ;
-- Load any orphan-module and family instance-module
-- interfaces, so that their rules and instance decls will be
-- found.
loadOrphanModules (imp_orphs imports) False ;
loadOrphanModules (imp_finsts imports) True ;
traceRn (text "rn1a") ;
-- Rename and type check the declarations
......@@ -1098,9 +1100,12 @@ tcGetModuleExports :: Module -> TcM [AvailInfo]
tcGetModuleExports mod = do
let doc = ptext SLIT("context for compiling statements")
iface <- initIfaceTcRn $ loadSysInterface doc mod
loadOrphanModules (dep_orphs (mi_deps iface))
loadOrphanModules (dep_orphs (mi_deps iface)) False
-- Load any orphan-module interfaces,
-- so their instances are visible
loadOrphanModules (dep_finsts (mi_finsts iface)) True
-- Load any family instance-module interfaces,
-- so all family instances are visible
ifaceExportNames (mi_exports iface)
tcRnLookupRdrName :: HscEnv -> RdrName -> IO (Maybe [Name])
......
......@@ -529,7 +529,12 @@ data ImportAvails
-- modules imported from other packages.
imp_orphs :: [Module],
-- Orphan modules below us in the import tree
-- Orphan modules below us in the import tree (and maybe
-- including us for imported modules)
imp_finsts :: [Module],
-- Family instance modules below us in the import tree (and
-- maybe including us for imported modules)
imp_parent :: NameEnv AvailInfo
-- for the names in scope in this module, tells us
......@@ -550,21 +555,25 @@ emptyImportAvails = ImportAvails { imp_env = emptyUFM,
imp_dep_mods = emptyUFM,
imp_dep_pkgs = [],
imp_orphs = [],
imp_finsts = [],
imp_parent = emptyNameEnv }
plusImportAvails :: ImportAvails -> ImportAvails -> ImportAvails
plusImportAvails
(ImportAvails { imp_env = env1, imp_mods = mods1,
imp_dep_mods = dmods1, imp_dep_pkgs = dpkgs1,
imp_orphs = orphs1, imp_parent = parent1 })
imp_orphs = orphs1, imp_finsts = finsts1,
imp_parent = parent1 })
(ImportAvails { imp_env = env2, imp_mods = mods2,
imp_dep_mods = dmods2, imp_dep_pkgs = dpkgs2,
imp_orphs = orphs2, imp_parent = parent2 })
imp_orphs = orphs2, imp_finsts = finsts2,
imp_parent = parent2 })
= ImportAvails { imp_env = plusUFM_C (++) env1 env2,
imp_mods = mods1 `plusModuleEnv` mods2,
imp_dep_mods = plusUFM_C plus_mod_dep dmods1 dmods2,
imp_dep_pkgs = dpkgs1 `unionLists` dpkgs2,
imp_orphs = orphs1 `unionLists` orphs2,
imp_finsts = finsts1 `unionLists` finsts2,
imp_parent = plusNameEnv_C plus_avails parent1 parent2 }
where
plus_avails (AvailTC tc subs1) (AvailTC _ subs2)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment