GitLab

Simon Peyton Jones pushed to branch wip/T26425 at Glasgow Haskell Compiler / GHC

Commits:

0675a96c
by Simon Peyton Jones at 2025-10-27T15:22:49+00:00
```
Fix buglet that led to non-termination!
```

2 changed files:

compiler/GHC/Core/Opt/Simplify/Iteration.hs
compiler/GHC/Core/Unfold/Make.hs

Changes:

compiler/GHC/Core/Opt/Simplify/Iteration.hs

@@ -4598,13 +4598,21 @@ 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
 -  = 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.
 +  | 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.
    where
      -- !opts: otherwise, we end up retaining all the SimpleEnv
      !uf_opts = seUnfoldingOpts env
@@ -4615,6 +4623,9 @@ 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

compiler/GHC/Core/Unfold/Make.hs

@@ -354,14 +354,6 @@ mkCoreUnfolding :: UnfoldingSource -> Bool -> CoreExpr
                  -> Maybe UnfoldingCache -> UnfoldingGuidance -> Unfolding
  -- Occurrence-analyses the expression before capturing it
  mkCoreUnfolding src top_lvl expr precomputed_cache guidance
 -  | UnfNever <- guidance
 -  , not top_lvl
 -  = -- For large, non-top-level bindings, don't keep an unfolding at all if it is large
 -    -- Keep top-level ones in case of -fexpose-all-unfoldings
 -    -- Just an attempt to keep residency under control in deeply-nested let bindings
 -    NoUnfolding
+-
 -  | otherwise
    = CoreUnfolding { uf_tmpl = cache `seq`
                                occurAnalyseExpr expr
        -- occAnalyseExpr: see Note [OccInfo in unfoldings and rules] in GHC.Core