diff options
| -rw-r--r-- | compiler/GHC/Core/Opt/Pipeline.hs | 5 | ||||
| -rw-r--r-- | compiler/GHC/Core/Opt/WorkWrap.hs | 16 | ||||
| -rw-r--r-- | compiler/GHC/Core/Opt/WorkWrap/Utils.hs | 14 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Config/Core/Opt/WorkWrap.hs | 21 | ||||
| -rw-r--r-- | compiler/ghc.cabal.in | 1 |
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 |