sheaf pushed to branch wip/andreask/ticked_joins at Glasgow Haskell Compiler / GHC Commits: e7146154 by sheaf at 2026-01-26T20:42:55+01:00 WIP fixes - - - - - 5 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Types/Tickish.hs Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -935,7 +935,12 @@ lintCoreExpr (Tick tickish expr) -- ; when block_joins ; pure r} where - block_joins = not (tickishCanScopeJoin tickish) + block_joins + | ProfNote {} <- tickish + = False -- Turns a true join point into a quasi join point. + -- SLD TODO: proper Core Lint support for quasi join points. + | otherwise + = not (tickishCanScopeJoin tickish) -- TODO Consider whether this is the correct rule. It is consistent with -- the simplifier's behaviour - cost-centre-scoped ticks become part of -- the continuation, and thus they behave like part of an evaluation ===================================== compiler/GHC/Core/Opt/Exitify.hs ===================================== @@ -226,7 +226,7 @@ exitifyRec in_scope pairs let rhs = mkLams abs_vars e avoid = in_scope `extendInScopeSetList` captured -- Remember this binding under a suitable name - ; v <- addExit avoid TrueJoinPoint (length abs_vars) rhs + ; v <- addExit avoid (length abs_vars) rhs -- And jump to it from here ; return $ mkVarApps (Var v) abs_vars } @@ -273,11 +273,11 @@ mkExitJoinId in_scope ty join_ty join_arity = do asJoinId (mkSysLocal (fsLit "exit") initExitJoinUnique ManyTy ty) join_ty join_arity -addExit :: InScopeSet -> JoinPointType -> JoinArity -> CoreExpr -> ExitifyM JoinId -addExit in_scope join_ty join_arity rhs = do +addExit :: InScopeSet -> JoinArity -> CoreExpr -> ExitifyM JoinId +addExit in_scope join_arity rhs = do -- Pick a suitable name let ty = exprType rhs - v <- mkExitJoinId in_scope ty join_ty join_arity + v <- mkExitJoinId in_scope ty TrueJoinPoint join_arity fs <- get put ((v,rhs):fs) return v ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -2299,7 +2299,7 @@ occ_anal_lam_tail env (Cast expr co) _ -> usage1 -- usage3: see Note [Quasi join points] in GHC.Core.Opt.Simplify.Iteration. - usage3 = markAllNonTail usage2 -- SLD TODO: markAllQuasiTail but this prevenst GHC bootstrapping + usage3 = markAllQuasiTail usage2 -- SLD TODO in WUD usage3 (Cast expr' co) @@ -2611,7 +2611,7 @@ occAnal env (Cast expr co) = let (WUD usage expr') = occAnal env expr usage1 = addManyOccs usage (coVarsOfCo co) -- usage1: see Note [Gather occurrences of coercion variables] - usage2 = markAllNonTail usage1 -- SLD TODO: markAllQuasiTail but this prevenst GHC bootstrapping + usage2 = markAllQuasiTail usage1 -- SLD TODO -- usage2: see Note [Quasi join points] in WUD usage2 (Cast expr' co) @@ -3874,8 +3874,10 @@ markAllManyNonTail = markAllMany . markAllNonTail -- effectively sets to noOccIn markAllNonTail ud@(UD { ud_env = env }) = ud { ud_z_tail = fmap (const MarkNonTail) env } -markAllQuasiTail ud@(UD { ud_env = env }) = - ud { ud_z_tail = fmap (const MarkQuasi) env } +markAllQuasiTail ud@(UD { ud_env = env, ud_z_tail = z_tail }) = + let quasis = fmap (const MarkQuasi) env + in ud { ud_z_tail = strictPlusVarEnv_C (Semi.<>) quasis z_tail } + -- NB: be careful not to override any MarkNonTail with MarkQuasi. markAllInsideLamIf, markAllNonTailIf :: HasDebugCallStack => Bool -> UsageDetails -> UsageDetails ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -2134,9 +2134,11 @@ trimJoinCont :: Id -- Used only in error message trimJoinCont _ NotJoinPoint cont = cont -- Not a jump trimJoinCont var (JoinPoint { joinPointType = join_ty, joinPointArity = arity }) cont - = assertPpr (join_ty == TrueJoinPoint) - (text "trimJoinCont: unexpected quasi join point:" <+> ppr var) $ - trim arity cont + | QuasiJoinPoint <- join_ty + -- SLD TODO: not sure why we can end up here. Needs further investigation. + = cont + | otherwise + = trim arity cont where trim 0 cont@(Stop {}) = cont ===================================== compiler/GHC/Types/Tickish.hs ===================================== @@ -330,7 +330,8 @@ tickishCanSplit _ = False -- | Is @join f x in <tick> jump f x@ valid? tickishCanScopeJoin :: GenTickish pass -> Bool tickishCanScopeJoin tick = case tick of - ProfNote{} -> True + ProfNote{} -> False -- Turns the join point into a quasi join point. + -- See Note [Quasi join points] HpcTick{} -> False Breakpoint{} -> False SourceNote{} -> True View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e7146154eb711d91c03f703fbdf83d74... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e7146154eb711d91c03f703fbdf83d74... You're receiving this email because of your account on gitlab.haskell.org.