[Git][ghc/ghc][wip/T18291] 2 commits: Allow unsaturated runRW# applications
Ben Gamari
gitlab at gitlab.haskell.org
Tue Jul 28 09:29:40 UTC 2020
Ben Gamari pushed to branch wip/T18291 at Glasgow Haskell Compiler / GHC
Commits:
de986359 by Ben Gamari at 2020-07-28T05:29:34-04:00
Allow unsaturated runRW# applications
Previously we had a very aggressive Core Lint check which caught
unsaturated applications of runRW#. However, there is nothing
wrong with such applications and they may naturally arise in desugared
Core. For instance, the desugared Core of Data.Primitive.Array.runArray#
from the `primitive` package contains:
case ($) (runRW# @_ @_) (\s -> ...) of ...
In this case it's almost certain that ($) will be inlined, turning the
application into a saturated application. However, even if this weren't
the case there isn't a problem: CorePrep (after deleting an unnecessary
case) can simply generate code in its usual way, resulting in a call to
the Haskell definition of runRW#.
Fixes #18291.
- - - - -
1556ebd3 by Ben Gamari at 2020-07-28T05:29:34-04:00
testsuite: Add test for #18291
- - - - -
4 changed files:
- compiler/GHC/Core/Lint.hs
- compiler/GHC/CoreToStg/Prep.hs
- + testsuite/tests/codeGen/should_compile/T18291.hs
- testsuite/tests/codeGen/should_compile/all.T
Changes:
=====================================
compiler/GHC/Core/Lint.hs
=====================================
@@ -729,8 +729,6 @@ lintJoinLams join_arity enforce rhs
where
go 0 expr = lintCoreExpr expr
go n (Lam var body) = lintLambda var $ go (n-1) body
- -- N.B. join points can be cast. e.g. we consider ((\x -> ...) `cast` ...)
- -- to be a join point at join arity 1.
go n expr | Just bndr <- enforce -- Join point with too few RHS lambdas
= failWithL $ mkBadJoinArityMsg bndr join_arity n rhs
| otherwise -- Future join point, not yet eta-expanded
@@ -779,36 +777,26 @@ hurts us here.
Note [Linting of runRW#]
~~~~~~~~~~~~~~~~~~~~~~~~
-runRW# has some very peculiar behavior (see Note [runRW magic] in
-GHC.CoreToStg.Prep) which CoreLint must accommodate.
+runRW# has some very special behavior (see Note [runRW magic] in
+GHC.CoreToStg.Prep) which CoreLint must accommodate, by allowing
+join points in its argument. For example, this is fine:
-As described in Note [Casts and lambdas] in
-GHC.Core.Opt.Simplify.Utils, the simplifier pushes casts out of
-lambdas. Concretely, the simplifier will transform
+ join j x = ...
+ in runRW# (\s. case v of
+ A -> j 3
+ B -> j 4)
- runRW# @r @ty (\s -> expr `cast` co)
+Usually those calls to the join point 'j' would not be valid tail calls,
+because they occur in a function argument. But in the case of runRW#
+they are fine, because runRW# (\s.e) behaves operationally just like e.
+(runRW# is ultimately inlined in GHC.CoreToStg.Prep.)
-into
-
- runRW# @r @ty ((\s -> expr) `cast` co)
-
-Consequently we need to handle the case that the continuation is a
-cast of a lambda. See Note [Casts and lambdas] in
-GHC.Core.Opt.Simplify.Utils.
-
-In the event that the continuation is headed by a lambda (which
-will bind the State# token) we can safely allow calls to join
-points since CorePrep is going to apply the continuation to
-RealWorld.
-
-In the case that the continuation is not a lambda we lint the
-continuation disallowing join points, to rule out things like,
+In the case that the continuation is /not/ a lambda we simply disable this
+special behaviour. For example, this is /not/ fine:
join j = ...
- in runRW# @r @ty (
- let x = jump j
- in x
- )
+ in runRW# @r @ty (jump j)
+
************************************************************************
@@ -929,10 +917,6 @@ lintCoreExpr e@(App _ _)
; (fun_ty2, ue2) <- lintCoreArg fun_pair1 arg_ty2
-- See Note [Linting of runRW#]
; let lintRunRWCont :: CoreArg -> LintM (LintedType, UsageEnv)
- lintRunRWCont (Cast expr co) = do
- (ty, ue) <- lintRunRWCont expr
- new_ty <- lintCastExpr expr ty co
- return (new_ty, ue)
lintRunRWCont expr@(Lam _ _) = do
lintJoinLams 1 (Just fun) expr
lintRunRWCont other = markAllJoinsBad $ lintCoreExpr other
@@ -941,10 +925,6 @@ lintCoreExpr e@(App _ _)
; app_ty <- lintValApp arg3 fun_ty2 arg3_ty ue2 ue3
; lintCoreArgs app_ty rest }
- | Var fun <- fun
- , fun `hasKey` runRWKey
- = failWithL (text "Invalid runRW# application")
-
| otherwise
= do { pair <- lintCoreFun fun (length args)
; lintCoreArgs pair args }
=====================================
compiler/GHC/CoreToStg/Prep.hs
=====================================
@@ -798,10 +798,6 @@ cpeApp top_env expr
_ -> cpe_app env arg (CpeApp (Var realWorldPrimId) : rest) (n-1)
-- TODO: What about casts?
- cpe_app _env (Var f) args n
- | f `hasKey` runRWKey
- = pprPanic "cpe_app(runRW#)" (ppr args $$ ppr n)
-
cpe_app env (Var v) args depth
= do { v1 <- fiddleCCall v
; let e2 = lookupCorePrepEnv env v1
@@ -923,18 +919,33 @@ 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' has a variety of quirks:
+
+ * 'runRW' is known-key with a NOINLINE definition (for historical reasons) in
+ GHC.Magic. However, its correctness needs no special treatment in GHC except
+ the special late inlining here in CorePrep and GHC.CoreToByteCode.
+
+ * It is levity-polymorphic:
runRW# :: forall (r1 :: RuntimeRep). (o :: TYPE r)
=> (State# RealWorld -> (# State# RealWorld, o #))
- -> (# State# RealWorld, o #)
+ -> (# State# RealWorld, o #)
+
+ * It has some special simplification logic to allow unboxing of results when
+ runRW# appears in a strict context. See Note [Simplification of runRW#]
+ below.
-It's correctness needs no special treatment in GHC except this special inlining
-here in CorePrep (and in GHC.CoreToByteCode).
+ * Since its body is inlined, we allow runRW#'s argument to be a join point.
+ That is, the following is allowed:
-However, there are a variety of optimisation opportunities that the simplifier
-takes advantage of. See Note [Simplification of runRW#].
+ join j = \s -> ...
+ in runRW# @_ @_ j
+
+ The Core Linter knows about this. See Note [Linting of runRW#] in
+ GHC.Core.Lint for details.
+
+ The occurrence analyser and SetLevels also know about this, as described in
+ Note [Simplification of runRW#].
Note [Simplification of runRW#]
@@ -950,7 +961,7 @@ contexts into runRW's continuation. That is, it transforms
K[ runRW# @r @ty cont ]
~>
- runRW# @r @ty K[cont]
+ runRW# @r @ty (\s -> K[cont s])
This has a few interesting implications. Consider, for instance, this program:
@@ -973,10 +984,17 @@ completely fine. Both occurrence analysis and Core Lint have special treatment
for runRW# applications. See Note [Linting of runRW#] for details on the latter.
Moreover, it's helpful to ensure that runRW's continuation isn't floated out
-(since doing so would then require a call, whereas we would otherwise end up
-with straight-line). Consequently, GHC.Core.Opt.SetLevels.lvlApp has special
-treatment for runRW# applications, ensure the arguments are not floated if
-MFEs.
+For instance, if we have
+
+ runRW# (\s -> do_something)
+
+where do_something contains only top-level free variables, we may be tempted to
+float the argument to the top-level. However, we must resist this urge as since
+doing so would then require that runRW# lower to a call, whereas we would
+otherwise end up with straight-line code. Consequently,
+GHC.Core.Opt.SetLevels.lvlApp has special treatment for runRW# applications,
+ensure the arguments are not floated as MFEs.
+
Other considered designs
------------------------
=====================================
testsuite/tests/codeGen/should_compile/T18291.hs
=====================================
@@ -0,0 +1,7 @@
+{-# LANGUAGE MagicHash #-}
+module T18291 where
+
+import GHC.Magic
+
+hi :: Int
+hi = runRW# $ \_ -> 42
=====================================
testsuite/tests/codeGen/should_compile/all.T
=====================================
@@ -91,6 +91,7 @@ test('T17648', normal, makefile_test, [])
test('T17904', normal, compile, ['-O'])
test('T18227A', normal, compile, [''])
test('T18227B', normal, compile, [''])
+test('T18291', normal, compile, ['-O0'])
test('T15570',
when(unregisterised(), skip),
compile, ['-Wno-overflowed-literals'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0f5b3d7e6010c9c302ab9d8a7474ba89f89d3651...1556ebd389666417630ad833490ad042f58d75f3
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0f5b3d7e6010c9c302ab9d8a7474ba89f89d3651...1556ebd389666417630ad833490ad042f58d75f3
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200728/e75092a0/attachment-0001.html>
More information about the ghc-commits
mailing list