summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/basicTypes/MkId.hs67
-rw-r--r--compiler/coreSyn/CorePrep.hs43
-rw-r--r--compiler/prelude/PrelNames.hs4
-rw-r--r--libraries/ghc-prim/GHC/Magic.hs5
4 files changed, 50 insertions, 69 deletions
diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs
index 433f70a04f..38c772c935 100644
--- a/compiler/basicTypes/MkId.hs
+++ b/compiler/basicTypes/MkId.hs
@@ -29,7 +29,7 @@ module MkId (
wiredInIds, ghcPrimIds,
unsafeCoerceName, unsafeCoerceId, realWorldPrimId,
voidPrimId, voidArgId,
- nullAddrId, seqId, lazyId, lazyIdKey, runRWId,
+ nullAddrId, seqId, lazyId, lazyIdKey,
coercionTokenId, magicDictId, coerceId,
proxyHashId, noinlineId, noinlineIdName,
@@ -145,7 +145,7 @@ wiredInIds
++ errorIds -- Defined in MkCore
magicIds :: [Id] -- See Note [magicIds]
-magicIds = [lazyId, oneShotId, runRWId, noinlineId]
+magicIds = [lazyId, oneShotId, noinlineId]
ghcPrimIds :: [Id] -- See Note [ghcPrimIds (aka pseudoops)]
ghcPrimIds
@@ -1187,10 +1187,9 @@ magicDictName = mkWiredInIdName gHC_PRIM (fsLit "magicDict") magicDict
coerceName = mkWiredInIdName gHC_PRIM (fsLit "coerce") coerceKey coerceId
proxyName = mkWiredInIdName gHC_PRIM (fsLit "proxy#") proxyHashKey proxyHashId
-lazyIdName, oneShotName, runRWName, noinlineIdName :: Name
+lazyIdName, oneShotName, noinlineIdName :: Name
lazyIdName = mkWiredInIdName gHC_MAGIC (fsLit "lazy") lazyIdKey lazyId
oneShotName = mkWiredInIdName gHC_MAGIC (fsLit "oneShot") oneShotKey oneShotId
-runRWName = mkWiredInIdName gHC_MAGIC (fsLit "runRW#") runRWKey runRWId
noinlineIdName = mkWiredInIdName gHC_MAGIC (fsLit "noinline") noinlineIdKey noinlineId
------------------------------------------------
@@ -1289,27 +1288,6 @@ oneShotId = pcMiscPrelId oneShotName ty info
, body, x'] $
Var body `App` Var x
-runRWId :: Id -- See Note [runRW magic] in this module
-runRWId = pcMiscPrelId runRWName ty info
- where
- info = noCafIdInfo `setInlinePragInfo` neverInlinePragma
- `setStrictnessInfo` strict_sig
- `setArityInfo` 1
- strict_sig = mkClosedStrictSig [strictApply1Dmd] topRes
- -- Important to express its strictness,
- -- since it is not inlined until CorePrep
- -- Also see Note [runRW arg] in CorePrep
-
- -- State# RealWorld
- stateRW = mkTyConApp statePrimTyCon [realWorldTy]
- -- o
- ret_ty = openAlphaTy
- -- State# RealWorld -> o
- arg_ty = stateRW `mkFunTy` ret_ty
- -- (State# RealWorld -> o) -> o
- ty = mkSpecForAllTys [runtimeRep1TyVar, openAlphaTyVar] $
- arg_ty `mkFunTy` ret_ty
-
--------------------------------------------------------------------------------
magicDictId :: Id -- See Note [magicDictId magic]
magicDictId = pcMiscPrelId magicDictName ty info
@@ -1464,45 +1442,6 @@ 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
-of the bindings in their body. Consider this use of @runST@,
-
- f x = runST ( \ s -> let (a, s') = newArray# 100 [] s
- (_, s'') = fill_in_array_or_something a x s'
- in freezeArray# a s'' )
-
-If we inline @runST@, we'll get:
-
- f x = let (a, s') = newArray# 100 [] realWorld#{-NB-}
- (_, s'') = fill_in_array_or_something a x s'
- in freezeArray# a s''
-
-And now if we allow the @newArray#@ binding to float out to become a CAF,
-we end up with a result that is totally and utterly wrong:
-
- f = let (a, s') = newArray# 100 [] realWorld#{-NB-} -- YIKES!!!
- in \ x ->
- let (_, s'') = fill_in_array_or_something a x s'
- in freezeArray# a s''
-
-All calls to @f@ will share a {\em single} array! Clearly this is nonsense and
-must be prevented.
-
-This is what @runRW#@ gives us: by being inlined extremely late in the
-optimization (right before lowering to STG, in CorePrep), we can ensure that
-no further floating will occur. This allows us to safely inline things like
-@runST@, which are otherwise needlessly expensive (see #10678 and #5916).
-
-While the definition of @GHC.Magic.runRW#@, we override its type in @MkId@
-to be open-kinded,
-
- runRW# :: forall (r1 :: RuntimeRep). (o :: TYPE r)
- => (State# RealWorld -> (# State# RealWorld, o #))
- -> (# State# RealWorld, o #)
-
-
Note [The oneShot function]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
In the context of making left-folds fuse somewhat okish (see ticket #7994
diff --git a/compiler/coreSyn/CorePrep.hs b/compiler/coreSyn/CorePrep.hs
index 79f378cd56..f618a60514 100644
--- a/compiler/coreSyn/CorePrep.hs
+++ b/compiler/coreSyn/CorePrep.hs
@@ -825,6 +825,7 @@ cpeApp top_env expr
in cpe_app env terminal (args' ++ args) (depth + depth' - 1)
cpe_app env (Var f) [CpeApp _runtimeRep@Type{}, CpeApp _type@Type{}, CpeApp arg] 1
| f `hasKey` runRWKey
+ -- See Note [runRW magic]
-- Replace (runRW# f) by (f realWorld#), beta reducing if possible (this
-- is why we return a CorePrepEnv as well)
= case arg of
@@ -918,11 +919,51 @@ isLazyExpr (Tick _ e) = isLazyExpr e
isLazyExpr (Var f `App` _ `App` _) = f `hasKey` lazyIdKey
isLazyExpr _ = False
+{- Note [runRW magic]
+~~~~~~~~~~~~~~~~~~~~~
+Some definitions, for instance @runST@, must have careful control over float out
+of the bindings in their body. Consider this use of @runST@,
+
+ f x = runST ( \ s -> let (a, s') = newArray# 100 [] s
+ (_, s'') = fill_in_array_or_something a x s'
+ in freezeArray# a s'' )
+
+If we inline @runST@, we'll get:
+
+ f x = let (a, s') = newArray# 100 [] realWorld#{-NB-}
+ (_, s'') = fill_in_array_or_something a x s'
+ in freezeArray# a s''
+
+And now if we allow the @newArray#@ binding to float out to become a CAF,
+we end up with a result that is totally and utterly wrong:
+
+ f = let (a, s') = newArray# 100 [] realWorld#{-NB-} -- YIKES!!!
+ in \ x ->
+ let (_, s'') = fill_in_array_or_something a x s'
+ in freezeArray# a s''
+
+All calls to @f@ will share a {\em single} array! Clearly this is nonsense and
+must be prevented.
+
+This is what @runRW#@ gives us: by being inlined extremely late in the
+optimization (right before lowering to STG, in CorePrep), we can ensure that
+no further floating will occur. This allows us to safely inline things like
+@runST@, which are otherwise needlessly expensive (see #10678 and #5916).
+
+'runRW' is defined (for historical reasons) in GHC.Magic, with a NOINLINE
+pragma. It is levity-polymorphic.
+
+ runRW# :: forall (r1 :: RuntimeRep). (o :: TYPE r)
+ => (State# RealWorld -> (# State# RealWorld, o #))
+ -> (# State# RealWorld, o #)
+
+It needs no special treatment in GHC except this special inlining here
+in CorePrep (and in ByteCodeGen).
+
-- ---------------------------------------------------------------------------
-- CpeArg: produces a result satisfying CpeArg
-- ---------------------------------------------------------------------------
-{-
Note [ANF-ising literal string arguments]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs
index fe70b3d2e0..d5fc5b3136 100644
--- a/compiler/prelude/PrelNames.hs
+++ b/compiler/prelude/PrelNames.hs
@@ -216,6 +216,7 @@ basicKnownKeyNames
-- See Note [TyConRepNames for non-wired-in TyCons]
ioTyConName, ioDataConName,
runMainIOName,
+ runRWName,
-- Type representation types
trModuleTyConName, trModuleDataConName,
@@ -886,8 +887,9 @@ and it's convenient to write them all down in one place.
wildCardName :: Name
wildCardName = mkSystemVarName wildCardKey (fsLit "wild")
-runMainIOName :: Name
+runMainIOName, runRWName :: Name
runMainIOName = varQual gHC_TOP_HANDLER (fsLit "runMainIO") runMainKey
+runRWName = varQual gHC_MAGIC (fsLit "runRW#") runRWKey
orderingTyConName, ltDataConName, eqDataConName, gtDataConName :: Name
orderingTyConName = tcQual gHC_TYPES (fsLit "Ordering") orderingTyConKey
diff --git a/libraries/ghc-prim/GHC/Magic.hs b/libraries/ghc-prim/GHC/Magic.hs
index 2d4de6fb70..7d6f60e411 100644
--- a/libraries/ghc-prim/GHC/Magic.hs
+++ b/libraries/ghc-prim/GHC/Magic.hs
@@ -114,11 +114,10 @@ oneShot f = f
runRW# :: forall (r :: RuntimeRep) (o :: TYPE r).
(State# RealWorld -> o) -> o
--- See Note [runRW magic] in MkId
+-- See Note [runRW magic] in CorePrep
+{-# NOINLINE runRW# #-} -- runRW# is inlined manually in CorePrep
#if !defined(__HADDOCK_VERSION__)
runRW# m = m realWorld#
#else
runRW# = runRW# -- The realWorld# is too much for haddock
#endif
-{-# NOINLINE runRW# #-}
--- This is inlined manually in CorePrep
View Lorry Controller Status