Zubin pushed to branch wip/26416 at Glasgow Haskell Compiler / GHC Commits: 23c13b1c by Zubin Duggal at 2026-02-11T15:41:09+05:30 wip - - - - - 2 changed files: - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Types/Demand.hs Changes: ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -1105,19 +1105,13 @@ dmdAnalRhsSig top_lvl rec_flag env let_sd id rhs rhs_sd = mkCalledOnceDmds ww_arity adjusted_body_sd WithDmdType rhs_dmd_ty rhs' = dmdAnal env rhs_sd rhs - DmdType rhs_env rhs_dmds = rhs_dmd_ty - -- See Note [Absence analysis for stable unfoldings and RULES] - -- If there's a stable unfolding, we need to combine argument demands - -- from the unfolding with those from the RHS, because the unfolding - -- might use arguments that the (optimised) RHS doesn't. - -- Any argument with a demand absent in one but not the other can - -- be problematic, see #26416 - -- Also combine the DmdEnv (free variables) from the unfolding - (unf_fv_env, combined_rhs_dmds) = combineUnfoldingDmds env rhs_sd id rhs_env rhs_dmds + -- See Note [Absence analysis for stable unfoldings and RULES], Wrinkle (W3) + full_dmd_ty = addUnfoldingDemands env rhs_sd id rhs_dmd_ty + DmdType full_rhs_env combined_rhs_dmds = full_dmd_ty (final_rhs_dmds, final_rhs) = finaliseArgBoxities env id ww_arity - combined_rhs_dmds (de_div rhs_env) rhs' + combined_rhs_dmds (de_div full_rhs_env) rhs' dmd_sig_arity = ww_arity + strictCallArity body_sd sig = mkDmdSigForArity dmd_sig_arity (DmdType sig_env final_rhs_dmds) @@ -1141,14 +1135,13 @@ dmdAnalRhsSig top_lvl rec_flag env let_sd id rhs -- we never get used-once info for FVs of recursive functions. -- See #14816 where we try to get rid of reuseEnv. rhs_env1 = case rec_flag of - Recursive -> reuseEnv rhs_env - NonRecursive -> rhs_env + Recursive -> reuseEnv full_rhs_env + NonRecursive -> full_rhs_env -- See Note [Absence analysis for stable unfoldings and RULES] - -- The unfolding FVs are handled via unf_fv_env from combineUnfoldingDmds. + -- The unfolding FVs are already included in full_rhs_env via addUnfoldingDemands. -- Here we only need demandRoots for RULES. - rhs_env2 = rhs_env1 `plusDmdEnv` unf_fv_env - `plusDmdEnv` demandRootSet env (idRuleVars id) + rhs_env2 = rhs_env1 `plusDmdEnv` demandRootSet env (idRuleVars id) -- See Note [Lazy and unleashable free variables] !(!sig_env, !weak_fvs) = splitWeakDmds rhs_env2 @@ -1160,27 +1153,19 @@ splitWeakDmds (DE fvs div) = (DE sig_fvs div, weak_fvs) -- | If there is a stable unfolding, combine argument demands and free variable -- demands from the unfolding with those from the RHS. -- See Note [Absence analysis for stable unfoldings and RULES], Wrinkle (W3). --- --- Returns (combined DmdEnv for free variables, combined arg demands) --- The DmdEnv is nopDmdEnv if there's no stable unfolding. -combineUnfoldingDmds :: AnalEnv -> SubDemand -> Id -> DmdEnv -> [Demand] -> (DmdEnv, [Demand]) -combineUnfoldingDmds env rhs_sd id rhs_fv_env rhs_dmds - | not (isStableUnfolding unf) - = (nopDmdEnv, rhs_dmds) -- No stable unfolding, nothing to do - - | Just unf_body <- maybeUnfoldingTemplate unf - , let WithDmdType (DmdType unf_fv_env unf_dmds) _ = dmdAnal env rhs_sd unf_body - , let combined_dmds = go rhs_dmds unf_dmds - -- Lub the free variable demands from unfolding with RHS - combined_fv_env = lubDmdEnv rhs_fv_env unf_fv_env - = -- pprTrace "combineUnfoldingDmds" (ppr id $$ ppr rhs_dmds $$ ppr unf_dmds $$ ppr combined_dmds) $ - (combined_fv_env, combined_dmds) - | otherwise = (nopDmdEnv, rhs_dmds) +-- See Note [Combining demands for stable unfoldings] in GHC.Types.Demand. +addUnfoldingDemands :: AnalEnv -> SubDemand -> Id -> DmdType -> DmdType +addUnfoldingDemands env rhs_sd id rhs_dmd_ty + | isStableUnfolding unf + , Just unf_body <- maybeUnfoldingTemplate unf + , let WithDmdType unf_dmd_ty _ = dmdAnal env rhs_sd unf_body + = -- pprTrace "addUnfoldingDemands" (ppr id $$ ppr rhs_dmd_ty $$ ppr unf_dmd_ty) $ + lubUBglbLBDmdType rhs_dmd_ty unf_dmd_ty + + | otherwise + = rhs_dmd_ty -- No stable unfolding, nothing to do where unf = realIdUnfolding id - go rhs [] = rhs - go [] _ = [] - go (r:rhs) (u:unfs) = lubUBglbLBDmd r u : go rhs unfs -- | The result type after applying 'idArity' many arguments. Returns 'Nothing' -- when the type doesn't have exactly 'idArity' many arrows. @@ -1577,17 +1562,13 @@ Wrinkles: SOLUTION: in `dmdAnalRhsSig`, if the function has a stable unfolding, analyse it with `dmdAnal` and combine the resulting `DmdType` with the - RHS's `DmdType`. This is done by `combineUnfoldingDmds`, which: - - * For argument demands: combines them using `lubUBglbLBDmd`, which takes - the glb (max) of lower bounds (strictness) and lub (max) of upper - bounds (usage). See Note [Combining demands for stable unfoldings]. - This ensures that if the unfolding uses an argument, it won't be - marked as absent, while preserving any strictness the RHS reveals. + RHS's `DmdType`. This is done by `addUnfoldingDemands`, which uses + `lubUBglbLBDmdType` to combine both argument demands and free variable + demands. See Note [Combining demands for stable unfoldings] in + GHC.Types.Demand for details of the combining operation. - * For free variable demands: combines them using `lubDmdEnv`. This - replaces the `demandRoots` approach for stable unfoldings (though - we still use `demandRoots` for RULES via `idRuleVars`). + This replaces the `demandRoots` approach for stable unfoldings (though + we still use `demandRoots` for RULES via `idRuleVars`). Note [DmdAnal for DataCon wrappers] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -57,7 +57,7 @@ module GHC.Types.Demand ( DmdType(..), dmdTypeDepth, -- ** Algebra nopDmdType, botDmdType, - lubDmdType, plusDmdType, multDmdType, discardArgDmds, + lubDmdType, lubUBglbLBDmdType, plusDmdType, multDmdType, discardArgDmds, -- ** Other operations peelFV, findIdDemand, addDemand, splitDmdTy, deferAfterPreciseException, @@ -1907,6 +1907,26 @@ lubDmdType d1 d2 = DmdType lub_fv lub_ds lub_ds = zipWithEqual lubDmd ds1 ds2 lub_fv = lubDmdEnv fv1 fv2 +-- | Combine two 'DmdType's for stable unfolding analysis. +-- See Note [Combining demands for stable unfoldings]. +lubUBglbLBDmdType :: DmdType -> DmdType -> DmdType +lubUBglbLBDmdType (DmdType fv1 ds1) (DmdType fv2 ds2) + = DmdType combined_fv combined_ds + where + combined_fv = lubUBglbLBDmdEnv fv1 fv2 + combined_ds = go ds1 ds2 + -- If lists have different lengths, keep remaining ds1 (from RHS) + go rhs [] = rhs + go [] _ = [] + go (r:rhs) (u:unfs) = lubUBglbLBDmd r u : go rhs unfs + +-- | See Note [Combining demands for stable unfoldings]. +lubUBglbLBDmdEnv :: DmdEnv -> DmdEnv -> DmdEnv +lubUBglbLBDmdEnv (DE fv1 d1) (DE fv2 d2) = DE combined_fv combined_div + where + combined_fv = plusVarEnv_CD lubUBglbLBDmd fv1 (defaultFvDmd d1) fv2 (defaultFvDmd d2) + combined_div = lubDivergence d1 d2 + discardArgDmds :: DmdType -> DmdEnv discardArgDmds (DmdType fv _) = fv View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/23c13b1c34ad955f2abe935176ac4e4f... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/23c13b1c34ad955f2abe935176ac4e4f... You're receiving this email because of your account on gitlab.haskell.org.