[Git][ghc/ghc][wip/runRW] runRW
Ben Gamari
gitlab at gitlab.haskell.org
Fri Apr 24 17:13:51 UTC 2020
Ben Gamari pushed to branch wip/runRW at Glasgow Haskell Compiler / GHC
Commits:
33147251 by Ben Gamari at 2020-04-24T17:13:34+00:00
runRW
- - - - -
4 changed files:
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/Types/Id/Make.hs
Changes:
=====================================
compiler/GHC/Builtin/Names.hs
=====================================
@@ -246,7 +246,6 @@ basicKnownKeyNames
-- See Note [TyConRepNames for non-wired-in TyCons]
ioTyConName, ioDataConName,
runMainIOName,
- runRWName,
-- Type representation types
trModuleTyConName, trModuleDataConName,
@@ -912,9 +911,8 @@ and it's convenient to write them all down in one place.
wildCardName :: Name
wildCardName = mkSystemVarName wildCardKey (fsLit "wild")
-runMainIOName, runRWName :: Name
+runMainIOName :: Name
runMainIOName = varQual gHC_TOP_HANDLER (fsLit "runMainIO") runMainKey
-runRWName = varQual gHC_MAGIC (fsLit "runRW#") runRWKey
orderingTyConName, ordLTDataConName, ordEQDataConName, ordGTDataConName :: Name
orderingTyConName = tcQual gHC_TYPES (fsLit "Ordering") orderingTyConKey
=====================================
compiler/GHC/Core/Lint.hs
=====================================
@@ -875,15 +875,29 @@ lintCoreExpr e@(App _ _)
, arg_ty1 : arg_ty2 : arg3 : rest <- args
= do { fun_ty1 <- lintCoreArg (idType fun) arg_ty1
; fun_ty2 <- lintCoreArg fun_ty1 arg_ty2
+ -- Note [Linting of runRW#]
+ -- ~~~~~~~~~~~~~~~~~~~~~~~~
+ -- runRW# has some very peculiar behavior (see Note [runRW magic] in
+ -- GHC.CoreToStg.Prep) which CoreLint must accommodate.
+ --
-- The simplifier pushes casts out of the continuation lambda;
-- consequently we need to handle the case that the continuation is a
-- cast lambda. See Note [Casts and lambdas] in
-- GHC.Core.Opt.Simplify.Utils.
- ; arg3_ty <- case arg3 of
- Cast expr co -> do
- expr_ty <- lintJoinLams 1 (Just fun) expr
- lintCastExpr expr expr_ty co
- _ -> lintJoinLams 1 (Just fun) arg3
+ --
+ -- 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.
+ ; let lintRunRWCont :: CoreArg -> LintM LintedType
+ lintRunRWCont (Cast expr co) = do
+ ty <- lintRunRWCont expr
+ lintCastExpr expr ty co
+ lintRunRWCont expr@(Lam _ _) = do
+ lintJoinLams 1 (Just fun) expr
+ lintRunRWCont other = markAllJoinsBad $ lintCoreExpr other
+ -- TODO: Look through ticks?
+ ; arg3_ty <- lintRunRWCont arg3
; app_ty <- lintValApp arg3 fun_ty2 arg3_ty
; lintCoreArgs app_ty rest }
=====================================
compiler/GHC/CoreToStg/Prep.hs
=====================================
@@ -974,8 +974,43 @@ pragma. It is levity-polymorphic.
=> (State# RealWorld -> (# State# RealWorld, o #))
-> (# State# RealWorld, o #)
-It needs no special treatment in GHC except this special inlining here
-in CorePrep (and in GHC.CoreToByteCode).
+It's correctness needs no special treatment in GHC except this special inlining
+here in CorePrep (and in GHC.CoreToByteCode).
+
+However, there are a variety of optimisation opportunities that the simplifier
+takes advantage of. See Note [Simplification of runRW#].
+
+
+Note [Simplification of runRW#]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider the program,
+
+ case runRW# (\s -> let n = I# 42# in n) of
+ I# n# -> f n#
+
+There is no reason why we should allocate an I# constructor given that we
+immediately destructure it. To avoid this the simplifier will push strict
+contexts into runRW's continuation. That is, it transforms
+
+ K[ runRW# @r @ty cont ]
+ ~>
+ runRW# @r @ty K[cont]
+
+This has a few interesting implications. Consider, for instance, this program:
+
+ join j = ...
+ in case runRW# @r @ty cont of
+ result -> jump j result
+
+Performing the transform described above would result in:
+
+ join j = ...
+ in runRW# @r @ty (
+ case cont of in
+ result -> jump j result
+
+TODO
+
-- ---------------------------------------------------------------------------
-- CpeArg: produces a result satisfying CpeArg
=====================================
compiler/GHC/Types/Id/Make.hs
=====================================
@@ -147,7 +147,7 @@ wiredInIds
++ errorIds -- Defined in GHC.Core.Make
magicIds :: [Id] -- See Note [magicIds]
-magicIds = [lazyId, oneShotId, noinlineId]
+magicIds = [lazyId, oneShotId, noinlineId, runRWId]
ghcPrimIds :: [Id] -- See Note [ghcPrimIds (aka pseudoops)]
ghcPrimIds
@@ -1323,10 +1323,11 @@ 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, noinlineIdName :: Name
+lazyIdName, oneShotName, noinlineIdName, runRWIdName :: Name
lazyIdName = mkWiredInIdName gHC_MAGIC (fsLit "lazy") lazyIdKey lazyId
oneShotName = mkWiredInIdName gHC_MAGIC (fsLit "oneShot") oneShotKey oneShotId
noinlineIdName = mkWiredInIdName gHC_MAGIC (fsLit "noinline") noinlineIdKey noinlineId
+runRWIdName = mkWiredInIdName gHC_MAGIC (fsLit "runRW#") runRWKey runRWId
------------------------------------------------
proxyHashId :: Id
@@ -1409,6 +1410,13 @@ oneShotId = pcMiscPrelId oneShotName ty info
, body, x'] $
Var body `App` Var x
+runRWId :: Id -- See Note [runRW magic] in GHC.CoreToStg.Prep
+runRWId = pcMiscPrelId runRWIdName ty info
+ where
+ info = noCafIdInfo `setStrictnessInfo` mkClosedStrictSig [strictApply1Dmd] topDiv
+ ty = mkSpecForAllTys [runtimeRep1TyVar, openAlphaTyVar]
+ $ mkVisFunTy (realWorldStatePrimTy `mkVisFunTy` openAlphaTy) openAlphaTy
+
--------------------------------------------------------------------------------
magicDictId :: Id -- See Note [magicDictId magic]
magicDictId = pcMiscPrelId magicDictName ty info
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/331472515fae6011d25708ba4503a2ff68dbb47e
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/331472515fae6011d25708ba4503a2ff68dbb47e
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/20200424/a0780b46/attachment-0001.html>
More information about the ghc-commits
mailing list