Commit f90e61ad authored by rwbarton's avatar rwbarton Committed by Ben Gamari
Browse files

Make deSugarExpr use runTcInteractive

Preparation for #13102, which needs to add more logic to
runTcInteractive, which would need to be duplicated in deSugarExpr.

In order to break an import cycle, I had to move
"Dependency/fingerprinting code" to a new module
DsUsage; which seems sensible anyways.

Test Plan: validate

Reviewers: simonpj, austin, bgamari

Reviewed By: bgamari

Subscribers: thomie, snowleopard

Differential Revision: https://phabricator.haskell.org/D3125
parent bedcb716
......@@ -10,22 +10,21 @@ The Desugarer: turning HsSyn into Core.
module Desugar (
-- * Desugaring operations
deSugar, deSugarExpr,
-- * Dependency/fingerprinting code (used by MkIface)
mkUsageInfo, mkUsedNames, mkDependencies
deSugar, deSugarExpr
) where
#include "HsVersions.h"
import DsUsage
import DynFlags
import HscTypes
import HsSyn
import TcRnTypes
import TcRnMonad ( finalSafeMode, fixSafeInstances )
import TcRnDriver ( runTcInteractive )
import Id
import Name
import Type
import FamInstEnv
import InstEnv
import Class
import Avail
......@@ -60,201 +59,10 @@ import Coverage
import Util
import MonadUtils
import OrdList
import UniqFM
import UniqDFM
import ListSetOps
import Fingerprint
import Maybes
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 = eltsUDFM (delFromUDFM (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 (toInstalledUnitId 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 = sort pkgs
trust_pkgs = imp_trust_pkgs imports
dep_pkgs' = map (\x -> (x, x `elem` trust_pkgs)) sorted_pkgs
return Deps { dep_mods = 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] -> [(Module, Fingerprint)] -> IO [Usage]
mkUsageInfo hsc_env this_mod dir_imp_mods used_names dependent_files merged
= 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
usages = mod_usages ++ [ UsageFile { usg_file_path = f
, usg_file_hash = hash }
| (f, hash) <- zip dependent_files hashes ]
++ [ UsageMergedRequirement
{ usg_mod = mod,
usg_mod_hash = hash
}
| (mod, hash) <- merged ]
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 = nonDetFoldUFM add_mv emptyModuleEnv used_names
-- nonDetFoldUFM is OK here. If you follow the logic, we sort by OccName
-- in ent_hashs
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!
-}
{-
************************************************************************
......@@ -446,25 +254,19 @@ and Rec the rest.
deSugarExpr :: HscEnv -> LHsExpr Id -> IO (Messages, Maybe CoreExpr)
deSugarExpr hsc_env tc_expr
= do { let dflags = hsc_dflags hsc_env
icntxt = hsc_IC hsc_env
rdr_env = ic_rn_gbl_env icntxt
type_env = mkTypeEnvWithImplicits (ic_tythings icntxt)
fam_insts = snd (ic_instances icntxt)
fam_inst_env = extendFamInstEnvList emptyFamInstEnv fam_insts
-- This stuff is a half baked version of TcRnDriver.setInteractiveContext
deSugarExpr hsc_env tc_expr = do {
let dflags = hsc_dflags hsc_env
; showPass dflags "Desugar"
-- Do desugaring
; (msgs, mb_core_expr) <- initDs hsc_env (icInteractiveModule icntxt) rdr_env
type_env fam_inst_env [] $
; (msgs, mb_core_expr) <- runTcInteractive hsc_env $ initDsTc $
dsLExpr tc_expr
; case mb_core_expr of
Nothing -> return ()
Just expr -> dumpIfSet_dyn dflags Opt_D_dump_ds "Desugared" (pprCoreExpr expr)
Just expr -> dumpIfSet_dyn dflags Opt_D_dump_ds "Desugared"
(pprCoreExpr expr)
; return (msgs, mb_core_expr) }
......
{-# LANGUAGE CPP #-}
module DsUsage (
-- * Dependency/fingerprinting code (used by MkIface)
mkUsageInfo, mkUsedNames, mkDependencies
) where
#include "HsVersions.h"
import DynFlags
import HscTypes
import TcRnTypes
import Name
import NameSet
import Module
import Outputable
import Util
import UniqFM
import UniqDFM
import ListSetOps
import Fingerprint
import Maybes
import Data.List
import Data.IORef
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 = eltsUDFM (delFromUDFM (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 (toInstalledUnitId 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 = sort pkgs
trust_pkgs = imp_trust_pkgs imports
dep_pkgs' = map (\x -> (x, x `elem` trust_pkgs)) sorted_pkgs
return Deps { dep_mods = 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] -> [(Module, Fingerprint)] -> IO [Usage]
mkUsageInfo hsc_env this_mod dir_imp_mods used_names dependent_files merged
= 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
usages = mod_usages ++ [ UsageFile { usg_file_path = f
, usg_file_hash = hash }
| (f, hash) <- zip dependent_files hashes ]
++ [ UsageMergedRequirement
{ usg_mod = mod,
usg_mod_hash = hash
}
| (mod, hash) <- merged ]
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 = nonDetFoldUFM add_mv emptyModuleEnv used_names
-- nonDetFoldUFM is OK here. If you follow the logic, we sort by OccName
-- in ent_hashs
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!
-}
......@@ -298,6 +298,7 @@ Library
DsGRHSs
DsListComp
DsMonad
DsUsage
DsUtils
Match
MatchCon
......
......@@ -64,7 +64,7 @@ import LoadIface
import ToIface
import FlagChecker
import Desugar ( mkUsageInfo, mkUsedNames, mkDependencies )
import DsUsage ( mkUsageInfo, mkUsedNames, mkDependencies )
import Id
import Annotations
import CoreSyn
......
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