[Git][ghc/ghc][wip/T22404] Wibbles

Simon Peyton Jones (@simonpj) gitlab at gitlab.haskell.org
Thu Feb 2 00:03:44 UTC 2023



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


Commits:
e1b5fea7 by Simon Peyton Jones at 2023-02-02T00:04:19+00:00
Wibbles

- - - - -


1 changed file:

- compiler/GHC/Core/Opt/OccurAnal.hs


Changes:

=====================================
compiler/GHC/Core/Opt/OccurAnal.hs
=====================================
@@ -3461,8 +3461,9 @@ tagNonRecBinder lvl usage binder
  where
     occ     = lookupDetails usage binder
     will_be_join = decideJoinPointHood lvl usage (NE.singleton binder)
-    occ'    | will_be_join = -- must already be marked AlwaysTailCalled
-                             assert (isAlwaysTailCalled occ) occ
+    occ'    | will_be_join = -- Must already be marked AlwaysTailCalled, unless
+                             -- it was a join point before but is now dead
+                             assert (isAlwaysTailCalled occ || isDeadOcc occ) occ
             | otherwise    = markNonTail occ
 
 tagRecBinders :: TopLevelFlag           -- At top level?
@@ -3546,14 +3547,21 @@ decideJoinPointHood :: TopLevelFlag -> UsageDetails
                     -> Bool
 decideJoinPointHood TopLevel _ _
   = False
+
 decideJoinPointHood NotTopLevel usage bndrs
-  | isJoinId (NE.head bndrs)
-  = warnPprTrace (not all_ok)
-                 "OccurAnal failed to rediscover join point(s)" (ppr bndrs)
-                 all_ok
+  | isJoinId bndr1
+--  = warnPprTrace lost_join_point
+--                 "OccurAnal failed to rediscover join point(s)" (ppr bndrs)
+--    all_ok
+  = assertPpr (not lost_join_point) (ppr bndrs)
+    True
+
   | otherwise
   = all_ok
   where
+    bndr1 = NE.head bndrs
+    lost_join_point = not (isDeadOcc (lookupDetails usage bndr1)) && not all_ok
+
     -- See Note [Invariants on join points]; invariants cited by number below.
     -- Invariant 2 is always satisfiable by the simplifier by eta expansion.
     all_ok = -- Invariant 3: Either all are join points or none are



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e1b5fea7b573441198e4cf8193ac8963fa1dadae

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e1b5fea7b573441198e4cf8193ac8963fa1dadae
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230201/093154fc/attachment-0001.html>


More information about the ghc-commits mailing list