summaryrefslogtreecommitdiff
path: root/compiler/GHC/Core/Opt
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Core/Opt')
-rw-r--r--compiler/GHC/Core/Opt/CprAnal.hs33
-rw-r--r--compiler/GHC/Core/Opt/DmdAnal.hs26
-rw-r--r--compiler/GHC/Core/Opt/Simplify.hs2
-rw-r--r--compiler/GHC/Core/Opt/SpecConstr.hs9
-rw-r--r--compiler/GHC/Core/Opt/Specialise.hs5
-rw-r--r--compiler/GHC/Core/Opt/WorkWrap.hs32
6 files changed, 99 insertions, 8 deletions
diff --git a/compiler/GHC/Core/Opt/CprAnal.hs b/compiler/GHC/Core/Opt/CprAnal.hs
index 51bc507a20..3f6455c9cf 100644
--- a/compiler/GHC/Core/Opt/CprAnal.hs
+++ b/compiler/GHC/Core/Opt/CprAnal.hs
@@ -428,6 +428,31 @@ cprFix orig_env orig_pairs
where
(id', rhs', env') = cprAnalBind env id rhs
+{-
+Note [The OPAQUE pragma and avoiding the reboxing of results]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider:
+
+ {-# OPAQUE f #-}
+ f x = (x,y)
+
+ g True = f 2 x
+ g False = (0,0)
+
+Where if we didn't strip the CPR info from 'f' we would end up with the
+following W/W pair for 'g':
+
+ $wg True = case f 2 of (x, y) -> (# x, y #)
+ $wg False = (# 0, 0 #)
+
+ g b = case wg$ b of (# x, y #) -> (x, y)
+
+Where the worker unboxes the result of 'f', only for wrapper to box it again.
+That's because the non-stripped CPR signature of 'f' is saying to W/W-transform
+'f'. However, OPAQUE-annotated binders aren't W/W transformed (see
+Note [OPAQUE pragma]), so we should strip 'f's CPR signature.
+-}
+
-- | Process the RHS of the binding for a sensible arity, add the CPR signature
-- to the Id, and augment the environment with the signature as well.
cprAnalBind
@@ -452,8 +477,12 @@ cprAnalBind env id rhs
| otherwise = rhs_ty
-- See Note [Arity trimming for CPR signatures]
sig = mkCprSigForArity (idArity id) rhs_ty'
- id' = setIdCprSig id sig
- env' = extendSigEnv env id sig
+ -- See Note [OPAQUE pragma]
+ -- See Note [The OPAQUE pragma and avoiding the reboxing of results]
+ sig' | isOpaquePragma (idInlinePragma id) = topCprSig
+ | otherwise = sig
+ id' = setIdCprSig id sig'
+ env' = extendSigEnv env id sig'
-- See Note [CPR for thunks]
stays_thunk = is_thunk && not_strict
diff --git a/compiler/GHC/Core/Opt/DmdAnal.hs b/compiler/GHC/Core/Opt/DmdAnal.hs
index 93c7e38ef9..347cc4228d 100644
--- a/compiler/GHC/Core/Opt/DmdAnal.hs
+++ b/compiler/GHC/Core/Opt/DmdAnal.hs
@@ -1516,6 +1516,24 @@ next layer, using that depleted budget.
To achieve this, we use the classic almost-circular programming technique in
which we we write one pass that takes a lazy list of the Budgets for every
layer.
+
+Note [The OPAQUE pragma and avoiding the reboxing of arguments]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In https://gitlab.haskell.org/ghc/ghc/-/issues/13143 it was identified that when
+a function 'f' with a NOINLINE pragma is W/W transformed, then the worker for
+'f' should get the NOINLINE annotation, while the wrapper /should/ be inlined.
+
+That's because if the wrapper for 'f' had stayed NOINLINE, then any worker of a
+W/W-transformed /caller of/ 'f' would immediately rebox any unboxed arguments
+that is applied to the wrapper of 'f'. When the wrapper is inlined, that kind of
+reboxing does not happen.
+
+But now we have functions with OPAQUE pragmas, which by definition (See Note
+[OPAQUE pragma]) do not get W/W-transformed. So in order to avoid reboxing
+workers of any W/W-transformed /callers of/ 'f' we need to strip all boxity
+information from 'f' in the demand analysis. This will inform the
+W/W-transformation code that boxed arguments of 'f' must definitely be passed
+along in boxed form and as such dissuade the creation of reboxing workers.
-}
data Budgets = MkB Arity Budgets -- An infinite list of arity budgets
@@ -1560,10 +1578,14 @@ finaliseArgBoxities env fn arity rhs div
mk_triple :: Id -> (Type,StrictnessMark,Demand)
mk_triple bndr | is_cls_arg ty = (ty, NotMarkedStrict, trimBoxity dmd)
| is_bot_fn = (ty, NotMarkedStrict, unboxDeeplyDmd dmd)
+ -- See Note [OPAQUE pragma]
+ -- See Note [The OPAQUE pragma and avoiding the reboxing of arguments]
+ | is_opaque = (ty, NotMarkedStrict, trimBoxity dmd)
| otherwise = (ty, NotMarkedStrict, dmd)
where
- ty = idType bndr
- dmd = idDemandInfo bndr
+ ty = idType bndr
+ dmd = idDemandInfo bndr
+ is_opaque = isOpaquePragma (idInlinePragma fn)
-- is_cls_arg: see Note [Do not unbox class dictionaries]
is_cls_arg arg_ty = is_inlinable_fn && isClassPred arg_ty
diff --git a/compiler/GHC/Core/Opt/Simplify.hs b/compiler/GHC/Core/Opt/Simplify.hs
index 3c3854bf41..a5b40879b1 100644
--- a/compiler/GHC/Core/Opt/Simplify.hs
+++ b/compiler/GHC/Core/Opt/Simplify.hs
@@ -624,6 +624,8 @@ tryCastWorkerWrapper env top_lvl old_bndr occ_info bndr (Cast rhs co)
, isConcrete (typeKind rhs_ty) -- Don't peel off a cast if doing so would
-- lose the underlying runtime representation.
-- See Note [Preserve RuntimeRep info in cast w/w]
+ , not (isOpaquePragma (idInlinePragma old_bndr)) -- Not for OPAQUE bindings
+ -- See Note [OPAQUE pragma]
= do { (rhs_floats, work_rhs) <- prepareRhs env top_lvl occ_fs rhs
; uniq <- getUniqueM
; let work_name = mkSystemVarName uniq occ_fs
diff --git a/compiler/GHC/Core/Opt/SpecConstr.hs b/compiler/GHC/Core/Opt/SpecConstr.hs
index aec343508e..a5579108e6 100644
--- a/compiler/GHC/Core/Opt/SpecConstr.hs
+++ b/compiler/GHC/Core/Opt/SpecConstr.hs
@@ -1650,7 +1650,14 @@ specialise env bind_calls (RI { ri_fn = fn, ri_lam_bndrs = arg_bndrs
= -- pprTrace "specialise bot" (ppr fn) $
return (nullUsage, spec_info)
- | not (isNeverActive (idInlineActivation fn)) -- See Note [Transfer activation]
+ | not (isNeverActive (idInlineActivation fn))
+ -- See Note [Transfer activation]
+ --
+ --
+ -- Don't specialise OPAQUE things, see Note [OPAQUE pragma].
+ -- Since OPAQUE things are always never-active (see
+ -- GHC.Parser.PostProcess.mkOpaquePragma) this guard never fires for
+ -- OPAQUE things.
, not (null arg_bndrs) -- Only specialise functions
, Just all_calls <- lookupVarEnv bind_calls fn -- Some calls to it
= -- pprTrace "specialise entry {" (ppr fn <+> ppr all_calls) $
diff --git a/compiler/GHC/Core/Opt/Specialise.hs b/compiler/GHC/Core/Opt/Specialise.hs
index d80e78f685..d9cc090d3d 100644
--- a/compiler/GHC/Core/Opt/Specialise.hs
+++ b/compiler/GHC/Core/Opt/Specialise.hs
@@ -1431,6 +1431,11 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
&& not (isNeverActive (idInlineActivation fn))
-- Don't specialise NOINLINE things
-- See Note [Auto-specialisation and RULES]
+ --
+ -- Don't specialise OPAQUE things, see Note [OPAQUE pragma].
+ -- Since OPAQUE things are always never-active (see
+ -- GHC.Parser.PostProcess.mkOpaquePragma) this guard never fires for
+ -- OPAQUE things.
-- && not (certainlyWillInline (idUnfolding fn)) -- And it's not small
-- See Note [Inline specialisations] for why we do not
diff --git a/compiler/GHC/Core/Opt/WorkWrap.hs b/compiler/GHC/Core/Opt/WorkWrap.hs
index 092fdbb7a7..a6e583a210 100644
--- a/compiler/GHC/Core/Opt/WorkWrap.hs
+++ b/compiler/GHC/Core/Opt/WorkWrap.hs
@@ -534,9 +534,6 @@ tryWW :: WwOpts
-- if two, then a worker and a
-- wrapper.
tryWW ww_opts is_rec fn_id rhs
- -- Do this even if there is a NOINLINE pragma
- -- See Note [Worker/wrapper for NOINLINE functions]
-
-- See Note [Drop absent bindings]
| isAbsDmd (demandInfo fn_info)
, not (isJoinId fn_id)
@@ -551,6 +548,35 @@ tryWW ww_opts is_rec fn_id rhs
| isRecordSelector fn_id
= return [ (new_fn_id, rhs ) ]
+ -- Don't w/w OPAQUE things
+ -- See Note [OPAQUE pragma]
+ --
+ -- Whilst this check might seem superfluous, since we strip boxity
+ -- information in GHC.Core.Opt.DmdAnal.finaliseArgBoxities and
+ -- CPR information in GHC.Core.Opt.CprAnal.cprAnalBind, it actually
+ -- isn't. That is because we would still perform w/w when:
+ --
+ -- * An argument is used strictly, and -fworker-wrapper-cbv is
+ -- enabled, or,
+ -- * When demand analysis marks an argument as absent.
+ --
+ -- In a debug build we do assert that boxity and CPR information
+ -- are actually stripped, since we want to prevent callers of OPAQUE
+ -- things to do reboxing. See:
+ -- * Note [The OPAQUE pragma and avoiding the reboxing of arguments]
+ -- * Note [The OPAQUE pragma and avoiding the reboxing of results]
+ | isOpaquePragma (inlinePragInfo fn_info)
+ = assertPpr (onlyBoxedArguments (dmdSigInfo fn_info) &&
+ isTopCprSig (cprSigInfo fn_info))
+ (text "OPAQUE fun with boxity" $$
+ ppr new_fn_id $$
+ ppr (dmdSigInfo fn_info) $$
+ ppr (cprSigInfo fn_info) $$
+ ppr rhs) $
+ return [ (new_fn_id, rhs) ]
+
+ -- Do this even if there is a NOINLINE pragma
+ -- See Note [Worker/wrapper for NOINLINE functions]
| is_fun
= splitFun ww_opts new_fn_id rhs