Commit 9193629a authored by Edward Z. Yang's avatar Edward Z. Yang

Move usage calculation to desugaring, simplifying ModGuts.

Summary:
(This patch was excised from the fat interfaces patch, which
has been put indefinitely on hold.)
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>

Test Plan: validate

Reviewers: simonpj, austin, bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1469
parent 3d88e899
......@@ -353,7 +353,7 @@ pprStrictness sig = ppr sig
Note [Specialisations and RULES in IdInfo]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Generally speaking, a GlobalIdshas an *empty* RuleInfo. All their
Generally speaking, a GlobalId has an *empty* RuleInfo. All their
RULES are contained in the globally-built rule-base. In principle,
one could attach the to M.f the RULES for M.f that are defined in M.
But we don't do that for instance declarations and so we just treat
......
......@@ -8,14 +8,20 @@ The Desugarer: turning HsSyn into Core.
{-# LANGUAGE CPP #-}
module Desugar ( deSugar, deSugarExpr ) where
module Desugar (
-- * Desugaring operations
deSugar, deSugarExpr,
-- * Dependency/fingerprinting code (used by MkIface)
mkUsageInfo, mkUsedNames, mkDependencies
) where
#include "HsVersions.h"
import DynFlags
import HscTypes
import HsSyn
import TcRnTypes
import TcRnMonad ( finalSafeMode, fixSafeInstances )
import MkIface
import Id
import Name
import Type
......@@ -52,9 +58,193 @@ import Util
import MonadUtils
import OrdList
import StaticPtrTable
import UniqFM
import ListSetOps
import Fingerprint
import Maybes
import Data.Function
import Data.List
import Data.IORef
import Control.Monad( when )
import Data.Map (Map)
import qualified Data.Map as Map
-- | Extract information from the rename and typecheck phases to produce
-- a dependencies information for the module being compiled.
mkDependencies :: TcGblEnv -> IO Dependencies
mkDependencies
TcGblEnv{ tcg_mod = mod,
tcg_imports = imports,
tcg_th_used = th_var
}
= do
-- Template Haskell used?
th_used <- readIORef th_var
let dep_mods = eltsUFM (delFromUFM (imp_dep_mods imports) (moduleName mod))
-- M.hi-boot can be in the imp_dep_mods, but we must remove
-- it before recording the modules on which this one depends!
-- (We want to retain M.hi-boot in imp_dep_mods so that
-- loadHiBootInterface can see if M's direct imports depend
-- on M.hi-boot, and hence that we should do the hi-boot consistency
-- check.)
pkgs | th_used = insertList thUnitId (imp_dep_pkgs imports)
| otherwise = imp_dep_pkgs imports
-- Set the packages required to be Safe according to Safe Haskell.
-- See Note [RnNames . Tracking Trust Transitively]
sorted_pkgs = sortBy stableUnitIdCmp pkgs
trust_pkgs = imp_trust_pkgs imports
dep_pkgs' = map (\x -> (x, x `elem` trust_pkgs)) sorted_pkgs
return Deps { dep_mods = sortBy (stableModuleNameCmp `on` fst) dep_mods,
dep_pkgs = dep_pkgs',
dep_orphs = sortBy stableModuleCmp (imp_orphs imports),
dep_finsts = sortBy stableModuleCmp (imp_finsts imports) }
-- sort to get into canonical order
-- NB. remember to use lexicographic ordering
mkUsedNames :: TcGblEnv -> NameSet
mkUsedNames TcGblEnv{ tcg_dus = dus } = allUses dus
mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> [FilePath] -> IO [Usage]
mkUsageInfo hsc_env this_mod dir_imp_mods used_names dependent_files
= do
eps <- hscEPS hsc_env
hashes <- mapM getFileHash dependent_files
let mod_usages = mk_mod_usage_info (eps_PIT eps) hsc_env this_mod
dir_imp_mods used_names
let usages = mod_usages ++ [ UsageFile { usg_file_path = f
, usg_file_hash = hash }
| (f, hash) <- zip dependent_files hashes ]
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_mod_usage_info :: PackageIfaceTable
-> HscEnv
-> Module
-> ImportedMods
-> NameSet
-> [Usage]
mk_mod_usage_info pit hsc_env this_mod direct_imports used_names
= mapMaybe mkUsage usage_mods
where
hpt = hsc_HPT hsc_env
dflags = hsc_dflags hsc_env
this_pkg = thisPackage dflags
used_mods = moduleEnvKeys ent_map
dir_imp_mods = moduleEnvKeys direct_imports
all_mods = used_mods ++ filter (`notElem` used_mods) dir_imp_mods
usage_mods = sortBy stableModuleCmp all_mods
-- canonical order is imported, to avoid interface-file
-- wobblage.
-- ent_map groups together all the things imported and used
-- from a particular module
ent_map :: ModuleEnv [OccName]
ent_map = foldNameSet add_mv emptyModuleEnv used_names
where
add_mv name mv_map
| isWiredInName name = mv_map -- ignore wired-in names
| otherwise
= case nameModule_maybe name of
Nothing -> ASSERT2( isSystemName name, ppr name ) mv_map
-- See Note [Internal used_names]
Just mod -> -- This lambda function is really just a
-- specialised (++); originally came about to
-- avoid quadratic behaviour (trac #2680)
extendModuleEnvWith (\_ xs -> occ:xs) mv_map mod [occ]
where occ = nameOccName name
-- We want to create a Usage for a home module if
-- a) we used something from it; has something in used_names
-- b) we imported it, even if we used nothing from it
-- (need to recompile if its export list changes: export_fprint)
mkUsage :: Module -> Maybe Usage
mkUsage mod
| isNothing maybe_iface -- We can't depend on it if we didn't
-- load its interface.
|| mod == this_mod -- We don't care about usages of
-- things in *this* module
= Nothing
| moduleUnitId mod /= this_pkg
= Just UsagePackageModule{ usg_mod = mod,
usg_mod_hash = mod_hash,
usg_safe = imp_safe }
-- for package modules, we record the module hash only
| (null used_occs
&& isNothing export_hash
&& not is_direct_import
&& not finsts_mod)
= Nothing -- Record no usage info
-- for directly-imported modules, we always want to record a usage
-- on the orphan hash. This is what triggers a recompilation if
-- an orphan is added or removed somewhere below us in the future.
| otherwise
= Just UsageHomeModule {
usg_mod_name = moduleName mod,
usg_mod_hash = mod_hash,
usg_exports = export_hash,
usg_entities = Map.toList ent_hashs,
usg_safe = imp_safe }
where
maybe_iface = lookupIfaceByModule dflags hpt pit mod
-- In one-shot mode, the interfaces for home-package
-- modules accumulate in the PIT not HPT. Sigh.
Just iface = maybe_iface
finsts_mod = mi_finsts iface
hash_env = mi_hash_fn iface
mod_hash = mi_mod_hash iface
export_hash | depend_on_exports = Just (mi_exp_hash iface)
| otherwise = Nothing
(is_direct_import, imp_safe)
= case lookupModuleEnv direct_imports mod of
Just (imv : _xs) -> (True, imv_is_safe imv)
Just _ -> pprPanic "mkUsage: empty direct import" Outputable.empty
Nothing -> (False, safeImplicitImpsReq dflags)
-- Nothing case is for implicit imports like 'System.IO' when 'putStrLn'
-- is used in the source code. We require them to be safe in Safe Haskell
used_occs = lookupModuleEnv ent_map mod `orElse` []
-- Making a Map here ensures that (a) we remove duplicates
-- when we have usages on several subordinates of a single parent,
-- and (b) that the usages emerge in a canonical order, which
-- is why we use Map rather than OccEnv: Map works
-- using Ord on the OccNames, which is a lexicographic ordering.
ent_hashs :: Map OccName Fingerprint
ent_hashs = Map.fromList (map lookup_occ used_occs)
lookup_occ occ =
case hash_env occ of
Nothing -> pprPanic "mkUsage" (ppr mod <+> ppr occ <+> ppr used_names)
Just r -> r
depend_on_exports = is_direct_import
{- True
Even if we used 'import M ()', we have to register a
usage on the export list because we are sensitive to
changes in orphan instances/rules.
False
In GHC 6.8.x we always returned true, and in
fact it recorded a dependency on *all* the
modules underneath in the dependency tree. This
happens to make orphans work right, but is too
expensive: it'll read too many interface files.
The 'isNothing maybe_iface' check above saved us
from generating many of these usages (at least in
one-shot mode), but that's even more bogus!
-}
{-
************************************************************************
......@@ -167,16 +357,16 @@ deSugar hsc_env
; used_th <- readIORef tc_splice_used
; dep_files <- readIORef dependent_files
; safe_mode <- finalSafeMode dflags tcg_env
; usages <- mkUsageInfo hsc_env mod (imp_mods imports) used_names dep_files
; let mod_guts = ModGuts {
mg_module = mod,
mg_hsc_src = hsc_src,
mg_loc = mkFileSrcSpan mod_loc,
mg_exports = exports,
mg_usages = usages,
mg_deps = deps,
mg_used_names = used_names,
mg_used_th = used_th,
mg_dir_imps = imp_mods imports,
mg_rdr_env = rdr_env,
mg_fix_env = fix_env,
mg_warns = warns,
......@@ -195,8 +385,7 @@ deSugar hsc_env
mg_vect_decls = ds_vects,
mg_vect_info = noVectInfo,
mg_safe_haskell = safe_mode,
mg_trust_pkg = imp_trust_own_pkg imports,
mg_dependent_files = dep_files
mg_trust_pkg = imp_trust_own_pkg imports
}
; return (msgs, Just mod_guts)
}}}
......
......@@ -9,8 +9,6 @@
-- writing them to disk and comparing two versions to see if
-- recompilation is required.
module MkIface (
mkUsedNames,
mkDependencies,
mkIface, -- Build a ModIface from a ModGuts,
-- including computing version information
......@@ -64,6 +62,7 @@ import IfaceSyn
import LoadIface
import FlagChecker
import Desugar ( mkUsageInfo, mkUsedNames, mkDependencies )
import Id
import IdInfo
import Demand
......@@ -102,13 +101,11 @@ import Digraph
import SrcLoc
import Outputable
import BasicTypes hiding ( SuccessFlag(..) )
import UniqFM
import Unique
import Util hiding ( eqListBy )
import FastString
import FastStringEnv
import Maybes
import ListSetOps
import Binary
import Fingerprint
import Exception
......@@ -116,7 +113,6 @@ import Exception
import Control.Monad
import Data.Function
import Data.List
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Ord
import Data.IORef
......@@ -143,22 +139,20 @@ mkIface :: HscEnv
mkIface hsc_env maybe_old_fingerprint mod_details
ModGuts{ mg_module = this_mod,
mg_hsc_src = hsc_src,
mg_used_names = used_names,
mg_usages = usages,
mg_used_th = used_th,
mg_deps = deps,
mg_dir_imps = dir_imp_mods,
mg_rdr_env = rdr_env,
mg_fix_env = fix_env,
mg_warns = warns,
mg_hpc_info = hpc_info,
mg_safe_haskell = safe_mode,
mg_trust_pkg = self_trust,
mg_dependent_files = dependent_files
mg_trust_pkg = self_trust
}
= mkIface_ hsc_env maybe_old_fingerprint
this_mod hsc_src used_names used_th deps rdr_env fix_env
warns hpc_info dir_imp_mods self_trust dependent_files
safe_mode mod_details
this_mod hsc_src used_th deps rdr_env fix_env
warns hpc_info self_trust
safe_mode usages mod_details
-- | Make an interface from a manually constructed 'ModIface'. We use
-- this when we are merging 'ModIface's. We assume that the 'ModIface'
......@@ -215,62 +209,25 @@ mkIfaceTc hsc_env maybe_old_fingerprint safe_mode mod_details
let hpc_info = emptyHpcInfo other_hpc_info
used_th <- readIORef tc_splice_used
dep_files <- (readIORef dependent_files)
usages <- mkUsageInfo hsc_env this_mod (imp_mods imports) used_names dep_files
mkIface_ hsc_env maybe_old_fingerprint
this_mod hsc_src used_names
this_mod hsc_src
used_th deps rdr_env
fix_env warns hpc_info (imp_mods imports)
(imp_trust_own_pkg imports) dep_files safe_mode mod_details
fix_env warns hpc_info
(imp_trust_own_pkg imports) safe_mode usages mod_details
mkUsedNames :: TcGblEnv -> NameSet
mkUsedNames TcGblEnv{ tcg_dus = dus } = allUses dus
-- | Extract information from the rename and typecheck phases to produce
-- a dependencies information for the module being compiled.
mkDependencies :: TcGblEnv -> IO Dependencies
mkDependencies
TcGblEnv{ tcg_mod = mod,
tcg_imports = imports,
tcg_th_used = th_var
}
= do
-- Template Haskell used?
th_used <- readIORef th_var
let dep_mods = eltsUFM (delFromUFM (imp_dep_mods imports) (moduleName mod))
-- M.hi-boot can be in the imp_dep_mods, but we must remove
-- it before recording the modules on which this one depends!
-- (We want to retain M.hi-boot in imp_dep_mods so that
-- loadHiBootInterface can see if M's direct imports depend
-- on M.hi-boot, and hence that we should do the hi-boot consistency
-- check.)
pkgs | th_used = insertList thUnitId (imp_dep_pkgs imports)
| otherwise = imp_dep_pkgs imports
-- Set the packages required to be Safe according to Safe Haskell.
-- See Note [RnNames . Tracking Trust Transitively]
sorted_pkgs = sortBy stableUnitIdCmp pkgs
trust_pkgs = imp_trust_pkgs imports
dep_pkgs' = map (\x -> (x, x `elem` trust_pkgs)) sorted_pkgs
return Deps { dep_mods = sortBy (stableModuleNameCmp `on` fst) dep_mods,
dep_pkgs = dep_pkgs',
dep_orphs = sortBy stableModuleCmp (imp_orphs imports),
dep_finsts = sortBy stableModuleCmp (imp_finsts imports) }
-- sort to get into canonical order
-- NB. remember to use lexicographic ordering
mkIface_ :: HscEnv -> Maybe Fingerprint -> Module -> HscSource
-> NameSet -> Bool -> Dependencies -> GlobalRdrEnv
-> Bool -> Dependencies -> GlobalRdrEnv
-> NameEnv FixItem -> Warnings -> HpcInfo
-> ImportedMods -> Bool
-> [FilePath]
-> Bool
-> SafeHaskellMode
-> [Usage]
-> ModDetails
-> IO (ModIface, Bool)
mkIface_ hsc_env maybe_old_fingerprint
this_mod hsc_src used_names used_th deps rdr_env fix_env src_warns
hpc_info dir_imp_mods pkg_trust_req dependent_files safe_mode
this_mod hsc_src used_th deps rdr_env fix_env src_warns
hpc_info pkg_trust_req safe_mode usages
ModDetails{ md_insts = insts,
md_fam_insts = fam_insts,
md_rules = rules,
......@@ -284,8 +241,6 @@ mkIface_ hsc_env maybe_old_fingerprint
-- to expose in the interface
= do
usages <- mkUsageInfo hsc_env this_mod dir_imp_mods used_names dependent_files
let entities = typeEnvElts type_env
decls = [ tyThingToIfaceDecl entity
| entity <- entities,
......@@ -930,143 +885,6 @@ mkOrphMap get_key decls
************************************************************************
-}
mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> [FilePath] -> IO [Usage]
mkUsageInfo hsc_env this_mod dir_imp_mods used_names dependent_files
= do
eps <- hscEPS hsc_env
hashes <- mapM getFileHash dependent_files
let mod_usages = mk_mod_usage_info (eps_PIT eps) hsc_env this_mod
dir_imp_mods used_names
let usages = mod_usages ++ [ UsageFile { usg_file_path = f
, usg_file_hash = hash }
| (f, hash) <- zip dependent_files hashes ]
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_mod_usage_info :: PackageIfaceTable
-> HscEnv
-> Module
-> ImportedMods
-> NameSet
-> [Usage]
mk_mod_usage_info pit hsc_env this_mod direct_imports used_names
= mapMaybe mkUsage usage_mods
where
hpt = hsc_HPT hsc_env
dflags = hsc_dflags hsc_env
this_pkg = thisPackage dflags
used_mods = moduleEnvKeys ent_map
dir_imp_mods = moduleEnvKeys direct_imports
all_mods = used_mods ++ filter (`notElem` used_mods) dir_imp_mods
usage_mods = sortBy stableModuleCmp all_mods
-- canonical order is imported, to avoid interface-file
-- wobblage.
-- ent_map groups together all the things imported and used
-- from a particular module
ent_map :: ModuleEnv [OccName]
ent_map = foldNameSet add_mv emptyModuleEnv used_names
where
add_mv name mv_map
| isWiredInName name = mv_map -- ignore wired-in names
| otherwise
= case nameModule_maybe name of
Nothing -> ASSERT2( isSystemName name, ppr name ) mv_map
-- See Note [Internal used_names]
Just mod -> -- This lambda function is really just a
-- specialised (++); originally came about to
-- avoid quadratic behaviour (trac #2680)
extendModuleEnvWith (\_ xs -> occ:xs) mv_map mod [occ]
where occ = nameOccName name
-- We want to create a Usage for a home module if
-- a) we used something from it; has something in used_names
-- b) we imported it, even if we used nothing from it
-- (need to recompile if its export list changes: export_fprint)
mkUsage :: Module -> Maybe Usage
mkUsage mod
| isNothing maybe_iface -- We can't depend on it if we didn't
-- load its interface.
|| mod == this_mod -- We don't care about usages of
-- things in *this* module
= Nothing
| moduleUnitId mod /= this_pkg
= Just UsagePackageModule{ usg_mod = mod,
usg_mod_hash = mod_hash,
usg_safe = imp_safe }
-- for package modules, we record the module hash only
| (null used_occs
&& isNothing export_hash
&& not is_direct_import
&& not finsts_mod)
= Nothing -- Record no usage info
-- for directly-imported modules, we always want to record a usage
-- on the orphan hash. This is what triggers a recompilation if
-- an orphan is added or removed somewhere below us in the future.
| otherwise
= Just UsageHomeModule {
usg_mod_name = moduleName mod,
usg_mod_hash = mod_hash,
usg_exports = export_hash,
usg_entities = Map.toList ent_hashs,
usg_safe = imp_safe }
where
maybe_iface = lookupIfaceByModule dflags hpt pit mod
-- In one-shot mode, the interfaces for home-package
-- modules accumulate in the PIT not HPT. Sigh.
Just iface = maybe_iface
finsts_mod = mi_finsts iface
hash_env = mi_hash_fn iface
mod_hash = mi_mod_hash iface
export_hash | depend_on_exports = Just (mi_exp_hash iface)
| otherwise = Nothing
(is_direct_import, imp_safe)
= case lookupModuleEnv direct_imports mod of
Just (imv : _xs) -> (True, imv_is_safe imv)
Just _ -> pprPanic "mkUsage: empty direct import" Outputable.empty
Nothing -> (False, safeImplicitImpsReq dflags)
-- Nothing case is for implicit imports like 'System.IO' when 'putStrLn'
-- is used in the source code. We require them to be safe in Safe Haskell
used_occs = lookupModuleEnv ent_map mod `orElse` []
-- Making a Map here ensures that (a) we remove duplicates
-- when we have usages on several subordinates of a single parent,
-- and (b) that the usages emerge in a canonical order, which
-- is why we use Map rather than OccEnv: Map works
-- using Ord on the OccNames, which is a lexicographic ordering.
ent_hashs :: Map OccName Fingerprint
ent_hashs = Map.fromList (map lookup_occ used_occs)
lookup_occ occ =
case hash_env occ of
Nothing -> pprPanic "mkUsage" (ppr mod <+> ppr occ <+> ppr used_names)
Just r -> r
depend_on_exports = is_direct_import
{- True
Even if we used 'import M ()', we have to register a
usage on the export list because we are sensitive to
changes in orphan instances/rules.
False
In GHC 6.8.x we always returned true, and in
fact it recorded a dependency on *all* the
modules underneath in the dependency tree. This
happens to make orphans work right, but is too
expensive: it'll read too many interface files.
The 'isNothing maybe_iface' check above saved us
from generating many of these usages (at least in
one-shot mode), but that's even more bogus!
-}
mkIfaceAnnotation :: Annotation -> IfaceAnnotation
mkIfaceAnnotation (Annotation { ann_target = target, ann_value = payload })
......
......@@ -141,7 +141,6 @@ import CmmPipeline
import CmmInfo
import CodeOutput
import NameEnv ( emptyNameEnv )
import NameSet ( emptyNameSet )
import InstEnv
import FamInstEnv
import Fingerprint ( Fingerprint )
......@@ -1747,9 +1746,8 @@ mkModGuts mod safe binds =
mg_loc = mkGeneralSrcSpan (moduleNameFS (moduleName mod)),
-- A bit crude
mg_exports = [],
mg_usages = [],
mg_deps = noDependencies,
mg_dir_imps = emptyModuleEnv,
mg_used_names = emptyNameSet,
mg_used_th = False,
mg_rdr_env = emptyGlobalRdrEnv,
mg_fix_env = emptyFixityEnv,
......@@ -1769,8 +1767,7 @@ mkModGuts mod safe binds =
mg_inst_env = emptyInstEnv,
mg_fam_inst_env = emptyFamInstEnv,
mg_safe_haskell = safe,
mg_trust_pkg = False,
mg_dependent_files = []
mg_trust_pkg = False
}
......
......@@ -1051,9 +1051,7 @@ data ModGuts
mg_exports :: ![AvailInfo], -- ^ What it exports
mg_deps :: !Dependencies, -- ^ What it depends on, directly or
-- otherwise
mg_dir_imps :: !ImportedMods, -- ^ Directly-imported modules; used to
-- generate initialisation code
mg_used_names:: !NameSet, -- ^ What the module needed (used in 'MkIface.mkIface')
mg_usages :: ![Usage], -- ^ What was used? Used for interfaces.
mg_used_th :: !Bool, -- ^ Did we run a TH splice?
mg_rdr_env :: !GlobalRdrEnv, -- ^ Top-level lexical environment
......@@ -1092,11 +1090,9 @@ data ModGuts
-- one); c.f. 'tcg_fam_inst_env'
mg_safe_haskell :: SafeHaskellMode, -- ^ Safe Haskell mode
mg_trust_pkg :: Bool, -- ^ Do we need to trust our
mg_trust_pkg :: Bool -- ^ Do we need to trust our
-- own package for Safe Haskell?
-- See Note [RnNames . Trust Own Package]
mg_dependent_files :: [FilePath] -- ^ Dependencies from addDependentFile
}
-- The ModGuts takes on several slightly different forms:
......
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