Avoid global compiler state for `GHC.Core.Opt.WorkWrap`

Progress towards #17957

5 files changed, 34 insertions, 23 deletions

diff --git a/compiler/GHC/Core/Opt/Pipeline.hs b/compiler/GHC/Core/Opt/Pipeline.hs
index b223f07077..1e336532eb 100644
--- a/compiler/GHC/Core/Opt/Pipeline.hs
+++ b/compiler/GHC/Core/Opt/Pipeline.hs
@@ -14,6 +14,7 @@ import GHC.Driver.Session
 import GHC.Driver.Plugins ( withPlugins, installCoreToDos )
 import GHC.Driver.Env
 import GHC.Driver.Config.Core.Opt.LiberateCase ( initLiberateCaseOpts )
+import GHC.Driver.Config.Core.Opt.WorkWrap ( initWorkWrapOpts )
 import GHC.Platform.Ways  ( hasWay, Way(WayProf) )
 
 import GHC.Core
@@ -518,7 +519,9 @@ doCorePass pass guts = do
                                  updateBindsM (liftIO . cprAnalProgram logger fam_envs)
 
     CoreDoWorkerWrapper       -> {-# SCC "WorkWrap" #-}
-                                 updateBinds (wwTopBinds (mg_module guts) dflags fam_envs us)
+                                 updateBinds (wwTopBinds
+                                               (initWorkWrapOpts (mg_module guts) dflags fam_envs)
+                                               us)
 
     CoreDoSpecialising        -> {-# SCC "Specialise" #-}
                                  specProgram guts
diff --git a/compiler/GHC/Core/Opt/WorkWrap.hs b/compiler/GHC/Core/Opt/WorkWrap.hs
index 93c4c31995..35d818d814 100644
--- a/compiler/GHC/Core/Opt/WorkWrap.hs
+++ b/compiler/GHC/Core/Opt/WorkWrap.hs
@@ -5,18 +5,19 @@
 -}
 
 
-module GHC.Core.Opt.WorkWrap ( wwTopBinds ) where
+module GHC.Core.Opt.WorkWrap
+ ( WwOpts (..)
+ , wwTopBinds
+ )
+where
 
 import GHC.Prelude
 
-import GHC.Driver.Session
-
 import GHC.Core
 import GHC.Core.Unfold.Make
 import GHC.Core.Utils  ( exprType, exprIsHNF )
 import GHC.Core.Type
 import GHC.Core.Opt.WorkWrap.Utils
-import GHC.Core.FamInstEnv
 import GHC.Core.SimpleOpt
 
 import GHC.Types.Var
@@ -35,7 +36,6 @@ import GHC.Utils.Panic
 import GHC.Utils.Panic.Plain
 import GHC.Utils.Monad
 import GHC.Utils.Trace
-import GHC.Unit.Types
 
 {-
 We take Core bindings whose binders have:
@@ -65,14 +65,12 @@ info for exported values).
 \end{enumerate}
 -}
 
-wwTopBinds :: Module -> DynFlags -> FamInstEnvs -> UniqSupply -> CoreProgram -> CoreProgram
+wwTopBinds :: WwOpts -> UniqSupply -> CoreProgram -> CoreProgram
 
-wwTopBinds this_mod dflags fam_envs us top_binds
+wwTopBinds ww_opts us top_binds
   = initUs_ us $ do
     top_binds' <- mapM (wwBind ww_opts) top_binds
     return (concat top_binds')
-  where
-    ww_opts = initWwOpts this_mod dflags fam_envs
 
 {-
 ************************************************************************
diff --git a/compiler/GHC/Core/Opt/WorkWrap/Utils.hs b/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
index 38896ba4f3..0351f53ccb 100644
--- a/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
+++ b/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
@@ -8,7 +8,7 @@ A library for the ``worker\/wrapper'' back-end to the strictness analyser
 {-# LANGUAGE ViewPatterns #-}
 
 module GHC.Core.Opt.WorkWrap.Utils
-   ( WwOpts(..), initWwOpts, mkWwBodies, mkWWstr, mkWWstr_one
+   ( WwOpts(..), mkWwBodies, mkWWstr, mkWWstr_one
    , needsVoidWorkerArg, addVoidWorkerArg
    , DataConPatContext(..)
    , UnboxingDecision(..), wantToUnboxArg
@@ -21,9 +21,6 @@ where
 
 import GHC.Prelude
 
-import GHC.Driver.Session
-import GHC.Driver.Config (initSimpleOpts)
-
 import GHC.Core
 import GHC.Core.Utils
 import GHC.Core.DataCon
@@ -153,15 +150,6 @@ data WwOpts
   , wo_unlift_strict     :: !Bool
   }
 
-initWwOpts :: Module -> DynFlags -> FamInstEnvs -> WwOpts
-initWwOpts this_mod dflags fam_envs = MkWwOpts
-  { wo_fam_envs          = fam_envs
-  , wo_simple_opts       = initSimpleOpts dflags
-  , wo_cpr_anal          = gopt Opt_CprAnal dflags
-  , wo_module            = this_mod
-  , wo_unlift_strict     = gopt Opt_WorkerWrapperUnlift dflags
-  }
-
 type WwResult
   = ([Demand],              -- Demands for worker (value) args
      [CbvMark],             -- Cbv semantics for worker (value) args
diff --git a/compiler/GHC/Driver/Config/Core/Opt/WorkWrap.hs b/compiler/GHC/Driver/Config/Core/Opt/WorkWrap.hs
new file mode 100644
index 0000000000..3524ea9bbd
--- /dev/null
+++ b/compiler/GHC/Driver/Config/Core/Opt/WorkWrap.hs
@@ -0,0 +1,21 @@
+module GHC.Driver.Config.Core.Opt.WorkWrap
+  ( initWorkWrapOpts
+  ) where
+
+import GHC.Prelude ()
+
+import GHC.Driver.Config (initSimpleOpts)
+import GHC.Driver.Session
+
+import GHC.Core.FamInstEnv
+import GHC.Core.Opt.WorkWrap
+import GHC.Unit.Types
+
+initWorkWrapOpts :: Module -> DynFlags -> FamInstEnvs -> WwOpts
+initWorkWrapOpts this_mod dflags fam_envs = MkWwOpts
+  { wo_fam_envs          = fam_envs
+  , wo_simple_opts       = initSimpleOpts dflags
+  , wo_cpr_anal          = gopt Opt_CprAnal dflags
+  , wo_module            = this_mod
+  , wo_unlift_strict     = gopt Opt_WorkerWrapperUnlift dflags
+  }
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 51a1bf7e3f..8c55a17f35 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -390,6 +390,7 @@ Library
         GHC.Driver.Config.CmmToAsm
         GHC.Driver.Config.CmmToLlvm
         GHC.Driver.Config.Core.Opt.LiberateCase
+        GHC.Driver.Config.Core.Opt.WorkWrap
         GHC.Driver.Config.Diagnostic
         GHC.Driver.Config.Finder
         GHC.Driver.Config.HsToCore