Simon Peyton Jones pushed to branch wip/T26425 at Glasgow Haskell Compiler / GHC Commits: fcc38ef7 by Simon Peyton Jones at 2025-11-11T17:47:50+00:00 Wibbles - - - - - 2 changed files: - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -660,18 +660,35 @@ through A, so it should have ManyOcc. Bear this case in mind! * In occ_env, the new (occ_join_points :: IdEnv OccInfoEnv) maps each in-scope non-recursive join point, such as `j` above, to a "zeroed form" of its RHS's usage details. The "zeroed form" + * has only occ_nested_lets in its domain (see (W5) below) * deletes ManyOccs * maps a OneOcc to OneOcc{ occ_n_br = 0 } - In our example, occ_join_points will be extended with + In our example, assuming `v` is locally-let-bound, occ_join_points will + be extended with [j :-> [v :-> OneOcc{occ_n_br=0}]] See `addJoinPoint` and (W5) below. * At an occurrence of a join point, we do everything as normal, but add in the UsageDetails from the occ_join_points. See mkOneOcc. -* Crucially, at the NonRec binding of the join point, in `occAnalBind`, we use - `combineJoinPointUDs`, not `andUDs` to combine the usage from the RHS with - the usage from the body. +* Crucially, at the NonRec binding of a join point `j`, in `occAnalBind`, + we use `combineJoinPointUDs`, not `andUDs` to combine the usage from the + RHS with the usage from the body. `combineJoinPointUDs` behaves like this: + + * For all variables than `occ_nested_lets`, use `andUDs`, just like for + any normal let-binding. + + * But for a variable `v` in `occ_nested_lets`, use `orUDs`: + - If `v` occurs `ManyOcc` in the join-point RHS, the variable won't be in + `occ_join_points`; but we'll get `ManyOcc` anyway. + - If `v` occurs `OneOcc` in the join-point RHS, the variable will be in + `occ_join_points` and we'll thereby get a `OneOcc{occ_n_br=0}` from + each of j's tail calls. We can `or` that with the `OncOcc{occ_n_br=n}` + from j's RHS. + + The only reason for `occ_nested_lets` is to reduce the size of the info + duplicate at each tail call; see (W5). It would sound to put *all* variables + into `occ_nested_lets`. Here are the consequences @@ -682,8 +699,9 @@ Here are the consequences There are two lexical occurrences of `v`! (NB: `orUDs` adds occ_n_br together, so occ_n_br=1 is impossible, too.) -* In the tricky (P3) we'll get an `andUDs` of - * OneOcc{occ_n_br=0} from the occurrences of `j`) +* In the tricky (P3), when analysing `case (f v) of ...`, we'll get + an `andUDs` of + * OneOcc{occ_n_br=0} from the occurrences of `j` * OneOcc{occ_n_br=1} from the (f v) These are `andUDs` together in `addOccInfo`, and hence `v` gets ManyOccs, just as it should. Clever! @@ -739,7 +757,7 @@ Wrinkles (W1) and (W2) are very similar to Note [Binder swap] (BS3). will use only one of them. So again, we can use `combineJoinPointUDs` to combine usage info from all these alternatives RHSs. -(W5) Other things being equal, we want keep the OccInfoEnv in the range of +(W5) Other things being equal, we want keep the OccInfoEnv stored in `occ_join_points` as small as possible, because it is /duplicated/ at /every occurrence/ of the join point. We really only want to include OccInfo for @@ -759,9 +777,10 @@ Wrinkles (W1) and (W2) are very similar to Note [Binder swap] (BS3). not `x` (lambda bound) nor `z` (occurs many times). To exploit this: - * `occ_local_lets` tracks which Ids are local, non-recursive lets + * `occ_nested_lets` tracks which Ids are + nested (not-top-level), non-recursive lets * `addJoinPoint` only populates j's entry with occ-info for the "tracked Ids" - of `j`; that is, that are (a) in occ_local_lets and (b) have OneOcc. + of `j`; that is, that are (a) in occ_nested_lets and (b) have OneOcc. * `combineJoinPointUDs` uses orLocalOcc for local-let Ids andLocalOcc for non-local-let Ids @@ -2913,7 +2932,7 @@ data OccEnv -- See Note [Occurrence analysis for join points] , occ_join_points :: !JoinPointInfo - , occ_local_lets :: IdSet -- Non-top-level non-rec-bound lets + , occ_nested_lets :: IdSet -- Non-top-level, non-rec-bound lets -- I tried making this field strict, but -- doing so slightly increased allocation } @@ -2968,7 +2987,7 @@ initOccEnv , occ_join_points = emptyVarEnv , occ_bs_env = emptyVarEnv , occ_bs_rng = emptyVarSet - , occ_local_lets = emptyVarSet } + , occ_nested_lets = emptyVarSet } noBinderSwaps :: OccEnv -> Bool noBinderSwaps (OccEnv { occ_bs_env = bs_env }) = isEmptyVarEnv bs_env @@ -3209,19 +3228,19 @@ postprocess_uds bndrs bad_joins uds | otherwise = env addLocalLet :: OccEnv -> TopLevelFlag -> Id -> OccEnv -addLocalLet env@(OccEnv { occ_local_lets = ids }) top_lvl id +addLocalLet env@(OccEnv { occ_nested_lets = ids }) top_lvl id | isTopLevel top_lvl = env - | otherwise = env { occ_local_lets = ids `extendVarSet` id } + | otherwise = env { occ_nested_lets = ids `extendVarSet` id } addJoinPoint :: OccEnv -> Id -> UsageDetails -> OccEnv -addJoinPoint env@(OccEnv { occ_join_points = join_points, occ_local_lets = local_lets }) +addJoinPoint env@(OccEnv { occ_join_points = join_points, occ_nested_lets = nested_lets }) join_bndr (UD { ud_env = rhs_occs }) | isEmptyVarEnv zeroed_form = env | otherwise = env { occ_join_points = extendVarEnv join_points join_bndr zeroed_form } where - zeroed_form = mapMaybeUniqSetToUFM do_one local_lets + zeroed_form = mapMaybeUniqSetToUFM do_one nested_lets -- See Note [Occurrence analysis for join points] for "zeroed form" do_one :: Var -> Maybe LocalOcc @@ -3748,12 +3767,12 @@ orUDs = combineUsageDetailsWith (\_uniq -> orLocalOcc) combineJoinPointUDs :: OccEnv -> UsageDetails -> UsageDetails -> UsageDetails -- See (W5) in Note [Occurrence analysis for join points] -combineJoinPointUDs (OccEnv { occ_local_lets = local_lets }) uds1 uds2 +combineJoinPointUDs (OccEnv { occ_nested_lets = nested_lets }) uds1 uds2 = combineUsageDetailsWith combine uds1 uds2 where combine uniq occ1 occ2 - | uniq `elemVarSetByKey` local_lets = orLocalOcc occ1 occ2 - | otherwise = andLocalOcc occ1 occ2 + | uniq `elemVarSetByKey` nested_lets = orLocalOcc occ1 occ2 + | otherwise = andLocalOcc occ1 occ2 mkOneOcc :: OccEnv -> Id -> InterestingCxt -> JoinArity -> UsageDetails mkOneOcc !env id int_cxt arity ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -4595,21 +4595,13 @@ mkLetUnfolding :: SimplEnv -> TopLevelFlag -> UnfoldingSource -> InId -> Bool -- True <=> this is a join point -> OutExpr -> SimplM Unfolding mkLetUnfolding env top_lvl src id is_join new_rhs --- | is_join --- , UnfNever <- guidance --- = -- For large join points, don't keep an unfolding at all if it is large --- -- This is just an attempt to keep residency under control in --- -- deeply-nested join-point such as those arising in #26425 --- return NoUnfolding - - | otherwise - = return (mkCoreUnfolding src is_top_lvl new_rhs Nothing guidance) - -- We make an unfolding *even for loop-breakers*. - -- Reason: (a) It might be useful to know that they are WHNF - -- (b) In GHC.Iface.Tidy we currently assume that, if we want to - -- expose the unfolding then indeed we *have* an unfolding - -- to expose. (We could instead use the RHS, but currently - -- we don't.) The simple thing is always to have one. + = return (mkUnfolding uf_opts src is_top_lvl is_bottoming is_join new_rhs Nothing) + -- We make an unfolding *even for loop-breakers*. + -- Reason: (a) It might be useful to know that they are WHNF + -- (b) In GHC.Iface.Tidy we currently assume that, if we want to + -- expose the unfolding then indeed we *have* an unfolding + -- to expose. (We could instead use the RHS, but currently + -- we don't.) The simple thing is always to have one. where -- !opts: otherwise, we end up retaining all the SimpleEnv !uf_opts = seUnfoldingOpts env @@ -4620,9 +4612,6 @@ mkLetUnfolding env top_lvl src id is_join new_rhs -- See Note [Force bottoming field] !is_bottoming = isDeadEndId id - is_top_bottoming = is_top_lvl && is_bottoming - guidance = calcUnfoldingGuidance uf_opts is_top_bottoming is_join new_rhs - ------------------- simplStableUnfolding :: SimplEnv -> BindContext -> InId View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fcc38ef7a460f92e4d785bb845524eac... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fcc38ef7a460f92e4d785bb845524eac... You're receiving this email because of your account on gitlab.haskell.org.