diff options
author | Ben Gamari <ben@smart-cactus.org> | 2020-04-19 04:49:14 +0000 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2020-04-19 04:50:47 +0000 |
commit | 4fd166ae587683e51f022c0d2657955b05023f28 (patch) | |
tree | 60f25de8e41c94d51d2591e71fec127be1168299 | |
parent | ae6dae6a6c4d668c2639764bee1e0bbf42c646d1 (diff) | |
download | haskell-4fd166ae587683e51f022c0d2657955b05023f28.tar.gz |
CorePrep: Admit nested runRW# applications
We can then end up with applications of the form
runRW# (\s s' -> ...) s''
Which have a higher apparent arity than CorePrep previously expected for
runRW#.
TODO: Do same for keepAlive#
-rw-r--r-- | compiler/GHC/CoreToStg/Prep.hs | 10 |
1 files changed, 7 insertions, 3 deletions
diff --git a/compiler/GHC/CoreToStg/Prep.hs b/compiler/GHC/CoreToStg/Prep.hs index 7285f6edea..108ffa778f 100644 --- a/compiler/GHC/CoreToStg/Prep.hs +++ b/compiler/GHC/CoreToStg/Prep.hs @@ -847,14 +847,18 @@ cpeApp top_env expr -- rather than the far superior "f x y". Test case is par01. = let (terminal, args', depth') = collect_args arg in cpe_app env terminal (args' ++ args) (depth + depth' - 1) - cpe_app env (Var f) [CpeApp _runtimeRep@Type{}, CpeApp _type@Type{}, CpeApp arg] 1 + cpe_app env (Var f) (CpeApp _runtimeRep@Type{} : CpeApp _type@Type{} : CpeApp arg : rest) n | f `hasKey` runRWKey + -- N.B. While it may appear that n == 1 in the case of runRW# + -- applications, keep in mind that we may have applications that return + , n >= 1 -- 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 - Lam s body -> cpe_app (extendCorePrepEnv env s realWorldPrimId) body [] 0 - _ -> cpe_app env arg [CpeApp (Var realWorldPrimId)] 1 + Lam s body -> cpe_app (extendCorePrepEnv env s realWorldPrimId) body rest (n-2) + _ -> cpe_app env arg (CpeApp (Var realWorldPrimId) : rest) (n-1) + -- TODO: What about casts? cpe_app env (Var f) args n | f `hasKey` runRWKey |