Add the OPAQUE pragma

A new pragma, `OPAQUE`, that ensures that every call of a named
function annotated with an `OPAQUE` pragma remains a call of that
named function, not some name-mangled variant.

Implements GHC proposal 0415:
https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0415-opaque-pragma.rst

This commit also updates the haddock submodule to handle the newly
introduced lexer tokens corresponding to the OPAQUE pragma.

15 files changed, 233 insertions, 21 deletions

diff --git a/compiler/GHC/Builtin/Names/TH.hs b/compiler/GHC/Builtin/Names/TH.hs
index 0c1d626581..f5dbc4fdc9 100644
--- a/compiler/GHC/Builtin/Names/TH.hs
+++ b/compiler/GHC/Builtin/Names/TH.hs
@@ -594,10 +594,11 @@ quoteDecName        = qqFun (fsLit "quoteDec")  quoteDecKey
 quoteTypeName       = qqFun (fsLit "quoteType") quoteTypeKey
 
 -- data Inline = ...
-noInlineDataConName, inlineDataConName, inlinableDataConName :: Name
+noInlineDataConName, inlineDataConName, inlinableDataConName, opaqueDataConName :: Name
 noInlineDataConName  = thCon (fsLit "NoInline")  noInlineDataConKey
 inlineDataConName    = thCon (fsLit "Inline")    inlineDataConKey
 inlinableDataConName = thCon (fsLit "Inlinable") inlinableDataConKey
+opaqueDataConName    = thCon (fsLit "Opaque")    opaqueDataConKey
 
 -- data RuleMatch = ...
 conLikeDataConName, funLikeDataConName :: Name
@@ -700,21 +701,22 @@ modNameTyConKey         = mkPreludeTyConUnique 239
 -- If you want to change this, make sure you check in GHC.Builtin.Names
 
 -- data Inline = ...
-noInlineDataConKey, inlineDataConKey, inlinableDataConKey :: Unique
+noInlineDataConKey, inlineDataConKey, inlinableDataConKey, opaqueDataConKey :: Unique
 noInlineDataConKey  = mkPreludeDataConUnique 200
 inlineDataConKey    = mkPreludeDataConUnique 201
 inlinableDataConKey = mkPreludeDataConUnique 202
+opaqueDataConKey    = mkPreludeDataConUnique 203
 
 -- data RuleMatch = ...
 conLikeDataConKey, funLikeDataConKey :: Unique
-conLikeDataConKey = mkPreludeDataConUnique 203
-funLikeDataConKey = mkPreludeDataConUnique 204
+conLikeDataConKey = mkPreludeDataConUnique 204
+funLikeDataConKey = mkPreludeDataConUnique 205
 
 -- data Phases = ...
 allPhasesDataConKey, fromPhaseDataConKey, beforePhaseDataConKey :: Unique
-allPhasesDataConKey   = mkPreludeDataConUnique 205
-fromPhaseDataConKey   = mkPreludeDataConUnique 206
-beforePhaseDataConKey = mkPreludeDataConUnique 207
+allPhasesDataConKey   = mkPreludeDataConUnique 206
+fromPhaseDataConKey   = mkPreludeDataConUnique 207
+beforePhaseDataConKey = mkPreludeDataConUnique 208
 
 -- data Overlap = ..
 overlappableDataConKey,
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
 
diff --git a/compiler/GHC/HsToCore/Binds.hs b/compiler/GHC/HsToCore/Binds.hs
index 9220326258..793f8c9ffb 100644
--- a/compiler/GHC/HsToCore/Binds.hs
+++ b/compiler/GHC/HsToCore/Binds.hs
@@ -399,6 +399,7 @@ makeCorePair dflags gbl_id is_default_method dict_arity rhs
   = case inlinePragmaSpec inline_prag of
           NoUserInlinePrag -> (gbl_id, rhs)
           NoInline  {}     -> (gbl_id, rhs)
+          Opaque    {}     -> (gbl_id, rhs)
           Inlinable {}     -> (gbl_id `setIdUnfolding` inlinable_unf, rhs)
           Inline    {}     -> inline_pair
   where
@@ -769,6 +770,7 @@ dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl))
     -- phase specification in the SPECIALISE pragma
     no_act_spec = case inlinePragmaSpec spec_inl of
                     NoInline _   -> isNeverActive  spec_prag_act
+                    Opaque _     -> isNeverActive  spec_prag_act
                     _            -> isAlwaysActive spec_prag_act
     rule_act | no_act_spec = inlinePragmaActivation id_inl   -- Inherit
              | otherwise   = spec_prag_act                   -- Specified by user
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index 38dc46364e..22fc242e87 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -1118,6 +1118,7 @@ rep_specialiseInst ty loc
 
 repInline :: InlineSpec -> MetaM (Core TH.Inline)
 repInline (NoInline          _ )   = dataCon noInlineDataConName
+repInline (Opaque            _ )   = dataCon opaqueDataConName
 repInline (Inline            _ )   = dataCon inlineDataConName
 repInline (Inlinable         _ )   = dataCon inlinableDataConName
 repInline NoUserInlinePrag        = notHandled ThNoUserInline
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index 418d67dc67..225eabd212 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -622,6 +622,7 @@ are the most common patterns, rewritten as regular expressions for clarity:
  'dependency'   { L _ ITdependency }
 
  '{-# INLINE'             { L _ (ITinline_prag _ _ _) } -- INLINE or INLINABLE
+ '{-# OPAQUE'             { L _ (ITopaque_prag _) }
  '{-# SPECIALISE'         { L _ (ITspec_prag _) }
  '{-# SPECIALISE_INLINE'  { L _ (ITspec_inline_prag _ _) }
  '{-# SOURCE'             { L _ (ITsource_prag _) }
@@ -2575,7 +2576,9 @@ sigdecl :: { LHsDecl GhcPs }
                 {% acsA (\cs -> (sLL $1 $> $ SigD noExtField (InlineSig (EpAnn (glR $1) ((mo $1:fst $2) ++ [mc $4]) cs) $3
                             (mkInlinePragma (getINLINE_PRAGs $1) (getINLINE $1)
                                             (snd $2))))) }
-
+        | '{-# OPAQUE' qvar '#-}'
+                {% acsA (\cs -> (sLL $1 $> $ SigD noExtField (InlineSig (EpAnn (glR $1) [mo $1, mc $3] cs) $2
+                            (mkOpaquePragma (getOPAQUE_PRAGs $1))))) }
         | '{-# SCC' qvar '#-}'
           {% acsA (\cs -> sLL $1 $> (SigD noExtField (SCCFunSig (EpAnn (glR $1) [mo $1, mc $3] cs) (getSCC_PRAGs $1) $2 Nothing))) }
 
@@ -3914,6 +3917,7 @@ getPRIMWORDs    (L _ (ITprimword   src _)) = src
 
 -- See Note [Pragma source text] in "GHC.Types.Basic" for the following
 getINLINE_PRAGs       (L _ (ITinline_prag       _ inl _)) = inlineSpecSource inl
+getOPAQUE_PRAGs       (L _ (ITopaque_prag       src))     = src
 getSPEC_PRAGs         (L _ (ITspec_prag         src))     = src
 getSPEC_INLINE_PRAGs  (L _ (ITspec_inline_prag  src _))   = src
 getSOURCE_PRAGs       (L _ (ITsource_prag       src)) = src
diff --git a/compiler/GHC/Parser/Lexer.x b/compiler/GHC/Parser/Lexer.x
index 02717c7dae..b1d8f43350 100644
--- a/compiler/GHC/Parser/Lexer.x
+++ b/compiler/GHC/Parser/Lexer.x
@@ -761,6 +761,7 @@ data Token
 
   -- Pragmas, see  Note [Pragma source text] in "GHC.Types.Basic"
   | ITinline_prag       SourceText InlineSpec RuleMatchInfo
+  | ITopaque_prag       SourceText
   | ITspec_prag         SourceText                -- SPECIALISE
   | ITspec_inline_prag  SourceText Bool    -- SPECIALISE INLINE (or NOINLINE)
   | ITsource_prag       SourceText
@@ -3446,6 +3447,7 @@ oneWordPrags = Map.fromList [
                                     -- Spelling variant
      ("notinline",
          strtoken (\s -> (ITinline_prag (SourceText s) (NoInline (SourceText s)) FunLike))),
+     ("opaque", strtoken (\s -> ITopaque_prag (SourceText s))),
      ("specialize", strtoken (\s -> ITspec_prag (SourceText s))),
      ("source", strtoken (\s -> ITsource_prag (SourceText s))),
      ("warning", strtoken (\s -> ITwarning_prag (SourceText s))),
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index 444471abca..e6daea8fe8 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -30,6 +30,7 @@ module GHC.Parser.PostProcess (
         mkTyFamInst,
         mkFamDecl,
         mkInlinePragma,
+        mkOpaquePragma,
         mkPatSynMatchGroup,
         mkRecConstrOrUpdate,
         mkTyClD, mkInstD,
@@ -2559,8 +2560,22 @@ mkInlinePragma src (inl, match_info) mb_act
             Nothing  -> -- No phase specified
                         case inl of
                           NoInline _  -> NeverActive
+                          Opaque _    -> NeverActive
                           _other      -> AlwaysActive
 
+mkOpaquePragma :: SourceText -> InlinePragma
+mkOpaquePragma src
+  = InlinePragma { inl_src    = src
+                 , inl_inline = Opaque src
+                 , inl_sat    = Nothing
+                 -- By marking the OPAQUE pragma NeverActive we stop
+                 -- (constructor) specialisation on OPAQUE things.
+                 --
+                 -- See Note [OPAQUE pragma]
+                 , inl_act    = NeverActive
+                 , inl_rule   = FunLike
+                 }
+
 -----------------------------------------------------------------------------
 -- utilities for foreign declarations
 
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index d90ef38341..ebcaad926a 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -780,6 +780,17 @@ cvtPragmaD (InlineP nm inline rm phases)
                      toSrcTxt a = SourceText $ src a
        ; returnJustLA $ Hs.SigD noExtField $ InlineSig noAnn nm' ip }
 
+cvtPragmaD (OpaqueP nm)
+  = do { nm' <- vNameN nm
+       ; let ip = InlinePragma { inl_src    = srcTxt
+                               , inl_inline = Opaque srcTxt
+                               , inl_rule   = Hs.FunLike
+                               , inl_act    = NeverActive
+                               , inl_sat    = Nothing }
+                  where
+                    srcTxt = SourceText "{-# OPAQUE"
+       ; returnJustLA $ Hs.SigD noExtField $ InlineSig noAnn nm' ip }
+
 cvtPragmaD (SpecialiseP nm ty inline phases)
   = do { nm' <- vNameN nm
        ; ty' <- cvtSigType ty
diff --git a/compiler/GHC/Types/Basic.hs b/compiler/GHC/Types/Basic.hs
index 2e234c383b..3843e2c880 100644
--- a/compiler/GHC/Types/Basic.hs
+++ b/compiler/GHC/Types/Basic.hs
@@ -88,7 +88,7 @@ module GHC.Types.Basic (
         InlinePragma(..), defaultInlinePragma, alwaysInlinePragma,
         neverInlinePragma, dfunInlinePragma,
         isDefaultInlinePragma,
-        isInlinePragma, isInlinablePragma, isNoInlinePragma,
+        isInlinePragma, isInlinablePragma, isNoInlinePragma, isOpaquePragma,
         isAnyInlinePragma, alwaysInlineConLikePragma,
         inlinePragmaSource,
         inlinePragmaName, inlineSpecSource,
@@ -1438,6 +1438,7 @@ data InlineSpec   -- What the user's INLINE pragma looked like
   = Inline    SourceText       -- User wrote INLINE
   | Inlinable SourceText       -- User wrote INLINABLE
   | NoInline  SourceText       -- User wrote NOINLINE
+  | Opaque    SourceText       -- User wrote OPAQUE
                                -- Each of the above keywords is accompanied with
                                -- a string of type SourceText written by the user
   | NoUserInlinePrag -- User did not write any of INLINE/INLINABLE/NOINLINE
@@ -1465,7 +1466,7 @@ If you want to know where InlinePragmas take effect: Look in GHC.HsToCore.Binds.
 Note [inl_inline and inl_act]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 * inl_inline says what the user wrote: did they say INLINE, NOINLINE,
-  INLINABLE, or nothing at all
+  INLINABLE, OPAQUE, or nothing at all
 
 * inl_act says in what phases the unfolding is active or inactive
   E.g  If you write INLINE[1]    then inl_act will be set to ActiveAfter 1
@@ -1514,6 +1515,52 @@ The main effects of CONLIKE are:
 
     - The rule matcher consults this field.  See
       Note [Expanding variables] in GHC.Core.Rules.
+
+Note [OPAQUE pragma]
+~~~~~~~~~~~~~~~~~~~~
+Suppose a function `f` is marked {-# OPAQUE f #-}.  Then every call of `f`
+should remain a call of `f` throughout optimisation; it should not be turned
+into a call of a name-mangled variant of `f` (e.g by worker/wrapper).
+
+The motivation for the OPAQUE pragma is discussed in GHC proposal 0415:
+https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0415-opaque-pragma.rst
+Basically it boils down to the desire of GHC API users and GHC RULE writers for
+calls to certain binders to be left completely untouched by GHCs optimisations.
+
+What this entails at the time of writing, is that for every binder annotated
+with the OPAQUE pragma we:
+
+* Do not do worker/wrapper via cast W/W:
+  See the guard in GHC.Core.Opt.Simplify.tryCastWorkerWrapper
+
+* Do not any worker/wrapper after demand/CPR analysis. To that end add a guard
+  in GHC.Core.Opt.WorkWrap.tryWW to disable worker/wrapper
+
+* It is important that the demand signature and CPR signature do not lie, else
+  clients of the function will believe that it has the CPR property etc. But it
+  won't, because we've disabled worker/wrapper. To avoid the signatures lying:
+  * Strip boxity information from the demand signature
+    in GHC.Core.Opt.DmdAnal.finaliseArgBoxities
+    See Note [The OPAQUE pragma and avoiding the reboxing of arguments]
+  * Strip CPR information from the CPR signature
+    in GHC.Core.Opt.CprAnal.cprAnalBind
+    See Note [The OPAQUE pragma and avoiding the reboxing of results]
+
+* Do create specialised versions of the function in
+  * Specialise: see GHC.Core.Opt.Specialise.specCalls
+  * SpecConstr: see GHC.Core.Opt.SpecConstr.specialise
+  Both are accomplished easily: these passes already skip NOINLINE
+  functions with NeverActive activation, and an OPAQUE function is
+  also NeverActive.
+
+At the moment of writing, the major difference between the NOINLINE pragma and
+the OPAQUE pragma is that binders annoted with the NOINLINE pragma _are_ W/W
+transformed (see also Note [Worker/wrapper for NOINLINE functions]) where
+binders annoted with the OPAQUE pragma are _not_ W/W transformed.
+
+Future "name-mangling" optimisations should respect the OPAQUE pragma and
+update the list of moving parts referenced in this note.
+
 -}
 
 isConLike :: RuleMatchInfo -> Bool
@@ -1550,6 +1597,7 @@ inlinePragmaSource prag = case inl_inline prag of
                             Inline    x      -> x
                             Inlinable y      -> y
                             NoInline  z      -> z
+                            Opaque    q      -> q
                             NoUserInlinePrag -> NoSourceText
 
 inlineSpecSource :: InlineSpec -> SourceText
@@ -1557,6 +1605,7 @@ inlineSpecSource spec = case spec of
                             Inline    x      -> x
                             Inlinable y      -> y
                             NoInline  z      -> z
+                            Opaque    q      -> q
                             NoUserInlinePrag -> NoSourceText
 
 -- A DFun has an always-active inline activation so that
@@ -1594,6 +1643,11 @@ isAnyInlinePragma prag = case inl_inline prag of
                         Inlinable _   -> True
                         _             -> False
 
+isOpaquePragma :: InlinePragma -> Bool
+isOpaquePragma prag = case inl_inline prag of
+                        Opaque _ -> True
+                        _        -> False
+
 inlinePragmaSat :: InlinePragma -> Maybe Arity
 inlinePragmaSat = inl_sat
 
@@ -1660,6 +1714,7 @@ instance Outputable InlineSpec where
     ppr (Inline          src)  = text "INLINE" <+> pprWithSourceText src empty
     ppr (NoInline        src)  = text "NOINLINE" <+> pprWithSourceText src empty
     ppr (Inlinable       src)  = text "INLINABLE" <+> pprWithSourceText src empty
+    ppr (Opaque          src)  = text "OPAQUE" <+> pprWithSourceText src empty
     ppr NoUserInlinePrag       = empty
 
 instance Binary InlineSpec where
@@ -1670,6 +1725,8 @@ instance Binary InlineSpec where
                                   put_ bh s
     put_ bh (NoInline s)     = do putByte bh 3
                                   put_ bh s
+    put_ bh (Opaque s)       = do putByte bh 4
+                                  put_ bh s
 
     get bh = do h <- getByte bh
                 case h of
@@ -1680,9 +1737,12 @@ instance Binary InlineSpec where
                   2 -> do
                         s <- get bh
                         return (Inlinable s)
-                  _ -> do
+                  3 -> do
                         s <- get bh
                         return (NoInline s)
+                  _ -> do
+                        s <- get bh
+                        return (Opaque s)
 
 instance Outputable InlinePragma where
   ppr = pprInline
@@ -1710,6 +1770,7 @@ inlinePragmaName :: InlineSpec -> SDoc
 inlinePragmaName (Inline            _)  = text "INLINE"
 inlinePragmaName (Inlinable         _)  = text "INLINABLE"
 inlinePragmaName (NoInline          _)  = text "NOINLINE"
+inlinePragmaName (Opaque            _)  = text "OPAQUE"
 inlinePragmaName NoUserInlinePrag       = empty
 
 pprInline :: InlinePragma -> SDoc
@@ -1732,6 +1793,7 @@ pprInline' emptyInline (InlinePragma
 
       pp_act Inline   {}  AlwaysActive = empty
       pp_act NoInline {}  NeverActive  = empty
+      pp_act Opaque   {}  NeverActive  = empty
       pp_act _            act          = ppr act
 
       pp_sat | Just ar <- mb_arity = parens (text "sat-args=" <> int ar)
diff --git a/compiler/GHC/Types/Demand.hs b/compiler/GHC/Types/Demand.hs
index 98db1c38b8..4163e9a525 100644
--- a/compiler/GHC/Types/Demand.hs
+++ b/compiler/GHC/Types/Demand.hs
@@ -31,7 +31,7 @@ module GHC.Types.Demand (
     -- ** Predicates on @Card@inalities and @Demand@s
     isAbs, isUsedOnce, isStrict,
     isAbsDmd, isUsedOnceDmd, isStrUsedDmd, isStrictDmd,
-    isTopDmd, isWeakDmd,
+    isTopDmd, isWeakDmd, onlyBoxedArguments,
     -- ** Special demands
     evalDmd,
     -- *** Demands used in PrimOp signatures
@@ -66,7 +66,7 @@ module GHC.Types.Demand (
     -- * Demand signatures
     DmdSig(..), mkDmdSigForArity, mkClosedDmdSig,
     splitDmdSig, dmdSigDmdEnv, hasDemandEnvSig,
-    nopSig, botSig, isTopSig, isDeadEndSig, appIsDeadEnd,
+    nopSig, botSig, isTopSig, isDeadEndSig, appIsDeadEnd, trimBoxityDmdSig,
     -- ** Handling arity adjustments
     prependArgsDmdSig, etaConvertDmdSig,
 
@@ -103,6 +103,7 @@ import GHC.Utils.Outputable
 import GHC.Utils.Panic
 import GHC.Utils.Panic.Plain
 
+import Data.Coerce (coerce)
 import Data.Function
 
 import GHC.Utils.Trace
@@ -1955,6 +1956,20 @@ isTopSig (DmdSig ty) = isTopDmdType ty
 isDeadEndSig :: DmdSig -> Bool
 isDeadEndSig (DmdSig (DmdType _ _ res)) = isDeadEndDiv res
 
+-- | True when the signature indicates all arguments are boxed
+onlyBoxedArguments :: DmdSig -> Bool
+onlyBoxedArguments (DmdSig (DmdType _ dmds _)) = all demandIsBoxed dmds
+ where
+   demandIsBoxed BotDmd    = True
+   demandIsBoxed AbsDmd    = True
+   demandIsBoxed (_ :* sd) = subDemandIsboxed sd
+
+   subDemandIsboxed (Poly Unboxed _) = False
+   subDemandIsboxed (Poly _ _)       = True
+   subDemandIsboxed (Call _ sd)      = subDemandIsboxed sd
+   subDemandIsboxed (Prod Unboxed _) = False
+   subDemandIsboxed (Prod _ ds)      = all demandIsBoxed ds
+
 -- | Returns true if an application to n args would diverge or throw an
 -- exception.
 --
@@ -1966,6 +1981,13 @@ appIsDeadEnd :: DmdSig -> Int -> Bool
 appIsDeadEnd (DmdSig (DmdType _ ds res)) n
   = isDeadEndDiv res && not (lengthExceeds ds n)
 
+trimBoxityDmdType :: DmdType -> DmdType
+trimBoxityDmdType (DmdType fvs ds res) =
+  DmdType (mapVarEnv trimBoxity fvs) (map trimBoxity ds) res
+
+trimBoxityDmdSig :: DmdSig -> DmdSig
+trimBoxityDmdSig = coerce trimBoxityDmdType
+
 prependArgsDmdSig :: Int -> DmdSig -> DmdSig
 -- ^ Add extra ('topDmd') arguments to a strictness signature.
 -- In contrast to 'etaConvertDmdSig', this /prepends/ additional argument