GitLab

Ben Gamari pushed to branch wip/T26110 at Glasgow Haskell Compiler / GHC

Commits:

bb3b2fa7

by Ben Gamari at 2025-06-12T13:38:55-04:00

compiler: Fix seq'ing of typecheck output for timing

As noted in #26110, previously the `withTiming` call characterising
typechecking would fail to force anything at all. This meant that
laziness could easily compromise the accuracy of timings.

We now try to force a reasonable subset of `TcGblEnv`. I do *not* force
the entire structure as many of its constituents have no easy way to
reduce them to normal form.

Fixes #26110.

2 changed files:

compiler/GHC/Tc/Module.hs
compiler/GHC/Tc/Types.hs

Changes:

compiler/GHC/Tc/Module.hs

@@ -211,7 +211,7 @@ tcRnModule hsc_env mod_sum save_rn_syntax
   | RealSrcSpan real_loc _ <- loc
   = withTiming logger
                (text "Renamer/typechecker"<+>brackets (ppr this_mod))
 -              (const ()) $
 +              (maybe () seqTcGblEnv . snd) $
     initTc hsc_env hsc_src save_rn_syntax this_mod real_loc $
            withTcPlugins hsc_env $
            withDefaultingPlugins hsc_env $

compiler/GHC/Tc/Types.hs

@@ -30,7 +30,7 @@ module GHC.Tc.Types(
          -- The environment types
          Env(..),
 -        TcGblEnv(..), TcLclEnv(..), modifyLclCtxt, TcLclCtxt(..),
 +        TcGblEnv(..), seqTcGblEnv, TcLclEnv(..), modifyLclCtxt, TcLclCtxt(..),
          setLclEnvTcLevel, getLclEnvTcLevel,
          setLclEnvLoc, getLclEnvLoc, lclEnvInGeneratedCode,
          IfGblEnv(..), IfLclEnv(..),
@@ -171,10 +171,11 @@ import GHC.Unit.Module.Deps
  import GHC.Unit.Module.ModDetails
  import GHC.Utils.Error
 -import GHC.Utils.Outputable
  import GHC.Utils.Fingerprint
 -import GHC.Utils.Panic
  import GHC.Utils.Logger
 +import GHC.Utils.Misc ( seqList )
 +import GHC.Utils.Outputable
 +import GHC.Utils.Panic
  import GHC.Builtin.Names ( isUnboundName )
@@ -697,6 +698,19 @@ data TcGblEnv
          -- ^ See Note [Generating fresh names for FFI wrappers]
+     }
 +-- | Force the final result bits of a 'TcGblEnv'. This is used
 +-- to
 +seqTcGblEnv :: TcGblEnv -> ()
 +seqTcGblEnv env =
 +    tcg_type_env env `seq`
 +    tcg_ann_env env `seq`
 +    maybe () (`seqList` ()) (tcg_rn_exports env) `seq`
 +    seqList (tcg_import_decls env) `seq`
 +    seqList (tcg_merged env) `seq`
 +    maybe () (`seq` ()) (tcg_rn_decls env) `seq`
 +    tcg_dus env `seq`
 +    ()
++
  -- NB: topModIdentity, not topModSemantic!
  -- Definition sites of orphan identities will be identity modules, not semantic
  -- modules.