diff options
| -rw-r--r-- | compiler/GHC/Core/Opt/OccurAnal.hs | 18 |
1 files changed, 13 insertions, 5 deletions
diff --git a/compiler/GHC/Core/Opt/OccurAnal.hs b/compiler/GHC/Core/Opt/OccurAnal.hs index 83c44dcec2..7efcba8cd8 100644 --- a/compiler/GHC/Core/Opt/OccurAnal.hs +++ b/compiler/GHC/Core/Opt/OccurAnal.hs @@ -2124,10 +2124,22 @@ occAnalApp env (fun, args, ticks) -- often leaves behind beta redexs like -- (\x y -> e) a1 a2 -- Here we would like to mark x,y as one-shot, and treat the whole - -- thing much like a let. We do this by pushing some True items + -- thing much like a let. We do this by pushing some OneShotLam items -- onto the context stack. !(args_uds, args') = occAnalArgs env args [] +addAppCtxt :: OccEnv -> [Arg CoreBndr] -> OccEnv +addAppCtxt env@(OccEnv { occ_one_shots = ctxt }) args + | n_val_args > 0 + = env { occ_one_shots = replicate n_val_args OneShotLam ++ ctxt + , occ_encl = OccVanilla } + -- OccVanilla: the function part of the application + -- is no longer on OccRhs or OccScrut + | otherwise + = env + where + n_val_args = valArgCount args + {- Note [Sources of one-shot information] @@ -2407,10 +2419,6 @@ markJoinOneShots mb_join_arity bndrs b' | isId b = setOneShotLambda b | otherwise = b -addAppCtxt :: OccEnv -> [Arg CoreBndr] -> OccEnv -addAppCtxt env@(OccEnv { occ_one_shots = ctxt }) args - = env { occ_one_shots = replicate (valArgCount args) OneShotLam ++ ctxt } - -------------------- transClosureFV :: VarEnv VarSet -> VarEnv VarSet -- If (f,g), (g,h) are in the input, then (f,h) is in the output |