Support for noinline magic function.

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>

Test Plan: validate

Reviewers: simonpj, austin, bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2209

8 files changed, 85 insertions, 6 deletions

diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs
index 151e1cf983..649100a7c0 100644
--- a/compiler/basicTypes/MkId.hs
+++ b/compiler/basicTypes/MkId.hs
@@ -31,7 +31,7 @@ module MkId (
         voidPrimId, voidArgId,
         nullAddrId, seqId, lazyId, lazyIdKey, runRWId,
         coercionTokenId, magicDictId, coerceId,
-        proxyHashId,
+        proxyHashId, noinlineIdName,
 
         -- Re-export error Ids
         module PrelRules
@@ -112,6 +112,9 @@ There are several reasons why an Id might appear in the wiredInIds:
 (4) lazyId is wired in because the wired-in version overrides the
     strictness of the version defined in GHC.Base
 
+(5) noinlineId is wired in because when we serialize to interfaces
+    we may insert noinline statements.
+
 In cases (2-4), the function has a definition in a library module, and
 can be called; but the wired-in version means that the details are
 never read from that module's interface file; instead, the full definition
@@ -120,7 +123,7 @@ is right here.
 
 wiredInIds :: [Id]
 wiredInIds
-  =  [lazyId, dollarId, oneShotId, runRWId]
+  =  [lazyId, dollarId, oneShotId, runRWId, noinlineId]
   ++ errorIds           -- Defined in MkCore
   ++ ghcPrimIds
 
@@ -1039,7 +1042,7 @@ another gun with which to shoot yourself in the foot.
 lazyIdName, unsafeCoerceName, nullAddrName, seqName,
    realWorldName, voidPrimIdName, coercionTokenName,
    magicDictName, coerceName, proxyName, dollarName, oneShotName,
-   runRWName :: Name
+   runRWName, noinlineIdName :: Name
 unsafeCoerceName  = mkWiredInIdName gHC_PRIM  (fsLit "unsafeCoerce#")  unsafeCoerceIdKey  unsafeCoerceId
 nullAddrName      = mkWiredInIdName gHC_PRIM  (fsLit "nullAddr#")      nullAddrIdKey      nullAddrId
 seqName           = mkWiredInIdName gHC_PRIM  (fsLit "seq")            seqIdKey           seqId
@@ -1053,6 +1056,7 @@ proxyName         = mkWiredInIdName gHC_PRIM  (fsLit "proxy#")         proxyHash
 dollarName        = mkWiredInIdName gHC_BASE  (fsLit "$")              dollarIdKey        dollarId
 oneShotName       = mkWiredInIdName gHC_MAGIC (fsLit "oneShot")        oneShotKey         oneShotId
 runRWName         = mkWiredInIdName gHC_MAGIC (fsLit "runRW#")         runRWKey           runRWId
+noinlineIdName    = mkWiredInIdName gHC_MAGIC (fsLit "noinline") noinlineIdKey noinlineId
 
 dollarId :: Id  -- Note [dollarId magic]
 dollarId = pcMiscPrelId dollarName ty
@@ -1159,6 +1163,12 @@ lazyId = pcMiscPrelId lazyIdName ty info
     info = noCafIdInfo
     ty  = mkSpecForAllTys [alphaTyVar] (mkFunTy alphaTy alphaTy)
 
+noinlineId :: Id -- See Note [noinlineId magic]
+noinlineId = pcMiscPrelId noinlineIdName ty info
+  where
+    info = noCafIdInfo
+    ty  = mkSpecForAllTys [alphaTyVar] (mkFunTy alphaTy alphaTy)
+
 oneShotId :: Id -- See Note [The oneShot function]
 oneShotId = pcMiscPrelId oneShotName ty info
   where
@@ -1362,6 +1372,22 @@ Implementing 'lazy' is a bit tricky:
 * lazyId is defined in GHC.Base, so we don't *have* to inline it.  If it
   appears un-applied, we'll end up just calling it.
 
+Note [noinlineId magic]
+~~~~~~~~~~~~~~~~~~~~~~~
+noinline :: forall a. a -> a
+
+'noinline' is used to make sure that a function f is never inlined,
+e.g., as in 'noinline f x'.  Ordinarily, the identity function with NOINLINE
+could be used to achieve this effect; however, this has the unfortunate
+result of leaving a (useless) call to noinline at runtime.  So we have
+a little bit of magic to optimize away 'noinline' after we are done
+running the simplifier.
+
+'noinline' needs to be wired-in because it gets inserted automatically
+when we serialize an expression to the interface format, and we DON'T
+want use its fingerprints.
+
+
 Note [runRW magic]
 ~~~~~~~~~~~~~~~~~~
 Some definitions, for instance @runST@, must have careful control over float out
diff --git a/compiler/coreSyn/CorePrep.hs b/compiler/coreSyn/CorePrep.hs
index 320a98992c..8e9c01a0a9 100644
--- a/compiler/coreSyn/CorePrep.hs
+++ b/compiler/coreSyn/CorePrep.hs
@@ -110,6 +110,7 @@ The goal of this pass is to prepare for code generation.
     aren't inlined by some caller.
 
 9.  Replace (lazy e) by e.  See Note [lazyId magic] in MkId.hs
+    Also replace (noinline e) by e.
 
 10. Convert (LitInteger i t) into the core representation
     for the Integer i. Normally this uses mkInteger, but if
@@ -517,7 +518,8 @@ cpeRhsE _env expr@(Lit {}) = return (emptyFloats, expr)
 cpeRhsE env expr@(Var {})  = cpeApp env expr
 
 cpeRhsE env (Var f `App` _{-type-} `App` arg)
-  | f `hasKey` lazyIdKey          -- Replace (lazy a) by a
+  | f `hasKey` lazyIdKey          -- Replace (lazy a) with a, and
+ || f `hasKey` noinlineIdKey      -- Replace (noinline a) with a
   = cpeRhsE env arg               -- See Note [lazyId magic] in MkId
 
 cpeRhsE env (Var f `App` _runtimeRep `App` _type `App` arg)
diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs
index e5e458d626..00e9ffed96 100644
--- a/compiler/prelude/PrelNames.hs
+++ b/compiler/prelude/PrelNames.hs
@@ -2034,8 +2034,9 @@ breakpointJumpIdKey           = mkPreludeMiscIdUnique 113
 breakpointCondJumpIdKey       = mkPreludeMiscIdUnique 114
 breakpointAutoJumpIdKey       = mkPreludeMiscIdUnique 115
 
-inlineIdKey :: Unique
+inlineIdKey, noinlineIdKey :: Unique
 inlineIdKey                   = mkPreludeMiscIdUnique 120
+-- see below
 
 mapIdKey, groupWithIdKey, dollarIdKey :: Unique
 mapIdKey              = mkPreludeMiscIdUnique 121
@@ -2045,6 +2046,8 @@ dollarIdKey           = mkPreludeMiscIdUnique 123
 coercionTokenIdKey :: Unique
 coercionTokenIdKey    = mkPreludeMiscIdUnique 124
 
+noinlineIdKey                 = mkPreludeMiscIdUnique 125
+
 rationalToFloatIdKey, rationalToDoubleIdKey :: Unique
 rationalToFloatIdKey   = mkPreludeMiscIdUnique 130
 rationalToDoubleIdKey  = mkPreludeMiscIdUnique 131
diff --git a/docs/users_guide/8.2.1-notes.rst b/docs/users_guide/8.2.1-notes.rst
index 0126427ea0..d9dd74ce9a 100644
--- a/docs/users_guide/8.2.1-notes.rst
+++ b/docs/users_guide/8.2.1-notes.rst
@@ -157,6 +157,9 @@ ghc-prim
 
 -  Added new ``isByteArrayPinned#`` and ``isMutableByteArrayPinned#`` operation.
 
+-  New function ``noinline`` in ``GHC.Magic`` lets you mark that a function
+   should not be inlined.  It is optimized away after the simplifier runs.
+
 haskell98
 ~~~~~~~~~
 
diff --git a/libraries/ghc-prim/GHC/Magic.hs b/libraries/ghc-prim/GHC/Magic.hs
index 495705b3b4..96f1742dea 100644
--- a/libraries/ghc-prim/GHC/Magic.hs
+++ b/libraries/ghc-prim/GHC/Magic.hs
@@ -21,7 +21,7 @@
 --
 -----------------------------------------------------------------------------
 
-module GHC.Magic ( inline, lazy, oneShot, runRW# ) where
+module GHC.Magic ( inline, noinline, lazy, oneShot, runRW# ) where
 
 import GHC.Prim
 import GHC.CString ()
@@ -45,6 +45,13 @@ import GHC.CString ()
 inline :: a -> a
 inline x = x
 
+-- | The call @noinline f@ arranges that 'f' will not be inlined.
+-- It is removed during CorePrep so that its use imposes no overhead
+-- (besides the fact that it blocks inlining.)
+{-# NOINLINE noinline #-}
+noinline :: a -> a
+noinline x = x
+
 -- | The 'lazy' function restrains strictness analysis a little. The
 -- call @lazy e@ means the same as 'e', but 'lazy' has a magical
 -- property so far as strictness analysis is concerned: it is lazy in
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index ecf990c29c..d59fa1c8b0 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -241,3 +241,5 @@ test('T12076', extra_clean(['T12076a.hi', 'T12076a.o']), multimod_compile, ['T12
 test('T12076lit', normal, compile, ['-O'])
 test('T12076sat', normal, compile, ['-O'])
 test('T12212', normal, compile, ['-O'])
+
+test('noinline01', only_ways(['optasm']), compile, ['-ddump-stg -dsuppress-uniques -O'])
diff --git a/testsuite/tests/simplCore/should_compile/noinline01.hs b/testsuite/tests/simplCore/should_compile/noinline01.hs
new file mode 100644
index 0000000000..255d584246
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/noinline01.hs
@@ -0,0 +1,7 @@
+module Noinline01 where
+import GHC.Magic
+
+{-# INLINE f #-}
+f x = True
+
+g = noinline f False
diff --git a/testsuite/tests/simplCore/should_compile/noinline01.stderr b/testsuite/tests/simplCore/should_compile/noinline01.stderr
new file mode 100644
index 0000000000..5dc488740e
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/noinline01.stderr
@@ -0,0 +1,29 @@
+
+==================== STG syntax: ====================
+Noinline01.f [InlPrag=INLINE (sat-args=1)]
+  :: forall t. t -> GHC.Types.Bool
+[GblId, Arity=1, Caf=NoCafRefs, Str=<L,A>, Unf=OtherCon []] =
+    \r [eta] GHC.Types.True [];
+
+Noinline01.g1 :: GHC.Types.Bool -> GHC.Types.Bool
+[GblId, Unf=OtherCon []] =
+    \u [] Noinline01.f;
+
+Noinline01.g :: GHC.Types.Bool
+[GblId] =
+    \u [] Noinline01.g1 GHC.Types.False;
+
+Noinline01.$trModule2 :: GHC.Types.TrName
+[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] =
+    NO_CCS GHC.Types.TrNameS! ["main"#];
+
+Noinline01.$trModule1 :: GHC.Types.TrName
+[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] =
+    NO_CCS GHC.Types.TrNameS! ["Noinline01"#];
+
+Noinline01.$trModule :: GHC.Types.Module
+[GblId, Caf=NoCafRefs, Str=m, Unf=OtherCon []] =
+    NO_CCS GHC.Types.Module! [Noinline01.$trModule2
+                              Noinline01.$trModule1];
+
+