GitLab

sheaf pushed to branch wip/debug-join-point at Glasgow Haskell Compiler / GHC

Commits:

f0cca3b4
by sheaf at 2026-02-03T11:58:32+01:00
```
WIP: debug panic
```

2 changed files:

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

Changes:

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

@@ -1905,7 +1905,7 @@ simplNonRecE :: HasDebugCallStack
  -- Otherwise it may or may not satisfy it.
  simplNonRecE env from_what bndr (rhs, rhs_se) body cont
 -  | assert (isId bndr && not (isJoinId bndr) ) $
 +  | assert (isId bndr && isNothing (joinPointBinding_maybe bndr rhs)) $
      is_strict_bind
    = -- Evaluate RHS strictly
      simplExprF (rhs_se `setInScopeFromE` env) rhs
@@ -1943,7 +1943,7 @@ simplRecE :: SimplEnv
  -- Precondition: not a join-point binding
  simplRecE env pairs body cont
    = do  { let bndrs = map fst pairs
 -        ; massert (all (not . isJoinId) bndrs)
 +        ; massert (isNothing $ joinPointBindings_maybe pairs)
          ; env1 <- simplRecBndrs env bndrs
                  -- NB: bndrs' don't have unfoldings or rules
                  -- We add them as we go down

compiler/GHC/Core/SimpleOpt.hs

@@ -1059,28 +1059,27 @@ and again its arity increases (#15517)
  -}
 --- | Returns Just (bndr,rhs) if the binding is a join point:
 --- If it's a JoinId, just return it
 --- If it's not yet a JoinId but is always tail-called,
 ---    make it into a JoinId and return it.
 --- In the latter case, eta-expand the RHS if necessary, to make the
 --- lambdas explicit, as is required for join points
 ---
 --- Precondition: the InBndr has been occurrence-analysed,
 ---               so its OccInfo is valid
 +-- | Returns @Just (bndr,rhs)@ if the binding is a join point or can be made
 +-- into a join point (it is always tail called). In the latter case, eta-expand
 +-- the RHS if necessary, to make the lambdas explicit, as is required for join points.
  joinPointBinding_maybe :: InBndr -> InExpr -> Maybe (InBndr, InExpr)
  joinPointBinding_maybe bndr rhs
    | not (isId bndr)
    = Nothing
 +  -- NB: the 'OccInfo' of the 'InBndr' may have been zapped, e.g. if we
 +  -- have inlined it. In this case, we may lose the join-point-hood of the
 +  -- original binder. A later occurrence analysis pass may recover it.
    | isJoinId bndr
 -  = Just (bndr, rhs)
 +  = case tailCallInfo (idOccInfo bndr) of
 +      NoTailCallInfo -> Nothing
 +      AlwaysTailCalled {} -> Just (bndr, rhs)
    | AlwaysTailCalled join_arity <- tailCallInfo (idOccInfo bndr)
    , (bndrs, body) <- etaExpandToJoinPoint join_arity rhs
    , let str_sig   = idDmdSig bndr
          str_arity = count isId bndrs  -- Strictness demands are for Ids only
 -        join_bndr = bndr `asJoinId`        join_arity
 +        join_bndr = bndr `asJoinId`    join_arity
                           `setIdDmdSig` etaConvertDmdSig str_arity str_sig
    = Just (join_bndr, mkLams bndrs body)