From d6a7aba64c9fb023e71090fa53c2053ab496935b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 23 Sep 2024 22:39:25 +0200
Subject: [PATCH] Compiler: Fix global flow analysis (#1680)

It needs to take into account values flowing out of the toplevel function.
PR #1556 added a workaround in the global deadcode analysis for this, but
it's better to fix the issue at its root.
---
 CHANGES.md                      |  1 +
 compiler/lib/global_deadcode.ml |  9 ---------
 compiler/lib/global_flow.ml     | 11 ++++++++++-
 3 files changed, 11 insertions(+), 10 deletions(-)

diff --git a/CHANGES.md b/CHANGES.md
index da8130cc45..ef6609df48 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -24,6 +24,7 @@
 * Toplevel: fix missing primitives with separate compilation
 * Compiler: fix link of packed modules with separate compilation
 * Compiler: Fixed the static evaluation of some equalities (#1659)
+* Compiler: fix global analysis bug (subsumes #1556)
 
 # 5.8.2 (2024-05-26) - Luc
 
diff --git a/compiler/lib/global_deadcode.ml b/compiler/lib/global_deadcode.ml
index c3670b350e..b56c0d5cdd 100644
--- a/compiler/lib/global_deadcode.ml
+++ b/compiler/lib/global_deadcode.ml
@@ -253,15 +253,6 @@ let liveness prog pure_funs (global_info : Global_flow.info) =
     | Stop | Branch _ | Poptrap _ | Pushtrap _ -> ()
   in
   Addr.Map.iter (fun _ block -> live_block block) prog.blocks;
-  Code.traverse
-    { Code.fold = Code.fold_children }
-    (fun pc () ->
-      match Addr.Map.find pc prog.blocks with
-      | { branch = Return x, _; _ } -> add_top x
-      | _ -> ())
-    prog.start
-    prog.blocks
-    ();
   live_vars
 
 (* Returns the set of variables given a table of variables. *)
diff --git a/compiler/lib/global_flow.ml b/compiler/lib/global_flow.ml
index 8cc7368aca..66ce9fe395 100644
--- a/compiler/lib/global_flow.ml
+++ b/compiler/lib/global_flow.ml
@@ -233,7 +233,16 @@ let expr_deps blocks st x e =
       cont_deps blocks st cont
   | Field (y, _, _) -> add_dep st x y
 
-let program_deps st { blocks; _ } =
+let program_deps st { start; blocks; _ } =
+  Code.traverse
+    { Code.fold = Code.fold_children }
+    (fun pc () ->
+      match Addr.Map.find pc blocks with
+      | { branch = Return x, _; _ } -> do_escape st Escape x
+      | _ -> ())
+    start
+    blocks
+    ();
   Addr.Map.iter
     (fun _ block ->
       List.iter block.body ~f:(fun (i, _) ->