diff options
| author | John Ericson <John.Ericson@Obsidian.Systems> | 2022-02-03 15:45:24 +0000 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-02-07 11:04:43 -0500 |
| commit | b09389a6b658f8bdc5c90003d1e79d5d092fec9e (patch) | |
| tree | 5c15c7a5b543c000904d5363dbd502e07079e6a8 | |
| parent | 4ff19981106230e1a5c8e03fde5e31e5e906c95b (diff) | |
| download | haskell-b09389a6b658f8bdc5c90003d1e79d5d092fec9e.tar.gz | |
Create `CoverageConfig`
As requested by @mpickering to collect the information we project from
`HscEnv`
| -rw-r--r-- | compiler/GHC/HsToCore.hs | 8 | ||||
| -rw-r--r-- | compiler/GHC/HsToCore/Coverage.hs | 26 |
2 files changed, 27 insertions, 7 deletions
diff --git a/compiler/GHC/HsToCore.hs b/compiler/GHC/HsToCore.hs index 2b44551fba..c32f03eb97 100644 --- a/compiler/GHC/HsToCore.hs +++ b/compiler/GHC/HsToCore.hs @@ -150,8 +150,12 @@ deSugar hsc_env ; (binds_cvr, ds_hpc_info, modBreaks) <- if not (isHsBootOrSig hsc_src) then addTicksToBinds - (hsc_logger hsc_env) (hsc_dflags hsc_env) - (hsc_interp hsc_env) mod mod_loc + (CoverageConfig + { coverageConfig_logger = hsc_logger hsc_env + , coverageConfig_dynFlags = hsc_dflags hsc_env + , coverageConfig_mInterp = hsc_interp hsc_env + }) + mod mod_loc export_set (typeEnvTyCons type_env) binds else return (binds, hpcInfo, Nothing) ; (msgs, mb_res) <- initDs hsc_env tcg_env $ diff --git a/compiler/GHC/HsToCore/Coverage.hs b/compiler/GHC/HsToCore/Coverage.hs index 50d50eebce..77c6ba651c 100644 --- a/compiler/GHC/HsToCore/Coverage.hs +++ b/compiler/GHC/HsToCore/Coverage.hs @@ -9,7 +9,11 @@ (c) University of Glasgow, 2007 -} -module GHC.HsToCore.Coverage (addTicksToBinds, hpcInitCode) where +module GHC.HsToCore.Coverage + ( CoverageConfig (..) + , addTicksToBinds + , hpcInitCode + ) where import GHC.Prelude as Prelude @@ -74,10 +78,17 @@ import qualified Data.Set as Set ************************************************************************ -} +data CoverageConfig = CoverageConfig + { coverageConfig_logger :: Logger + + -- FIXME: replace this with the specific fields of DynFlags we care about. + , coverageConfig_dynFlags :: DynFlags + + , coverageConfig_mInterp :: Maybe Interp + } + addTicksToBinds - :: Logger - -> DynFlags - -> (Maybe Interp) + :: CoverageConfig -> Module -> ModLocation -- ... off the current module -> NameSet -- Exported Ids. When we call addTicksToBinds, @@ -87,7 +98,12 @@ addTicksToBinds -> LHsBinds GhcTc -> IO (LHsBinds GhcTc, HpcInfo, Maybe ModBreaks) -addTicksToBinds logger dflags m_interp mod mod_loc exports tyCons binds +addTicksToBinds (CoverageConfig + { coverageConfig_logger = logger + , coverageConfig_dynFlags = dflags + , coverageConfig_mInterp = m_interp + }) + mod mod_loc exports tyCons binds | let passes = coveragePasses dflags , not (null passes) , Just orig_file <- ml_hs_file mod_loc = do |