From 4fd166ae587683e51f022c0d2657955b05023f28 Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Sun, 19 Apr 2020 04:49:14 +0000 Subject: 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# --- compiler/GHC/CoreToStg/Prep.hs | 10 +++++++--- 1 file 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 -- cgit v1.2.1