Compiler: less agressive flushing for function

ocsigen · Jan 4, 2024 · c0d1e32 · c0d1e32
1 parent c6394d1
commit c0d1e32
Show file tree

Hide file tree

Showing 3 changed files with 1,049 additions and 1,112 deletions.
diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml
@@ -1393,13 +1393,19 @@ and translate_instrs (ctx : Ctx.t) expr_queue instr last =
       let names, mut, pcs, all, rem = collect_closures ctx instr in
       match Code.Var.Set.cardinal mut with
       | 0 ->
-          let st_rev, expr_queue =
-            List.fold_left all ~init:([], expr_queue) ~f:(fun (st_rev, expr_queue) i ->
-                let l, expr_queue = translate_instr ctx expr_queue i in
+          let st_rev, expr_queue_fun =
+            List.fold_left all ~init:([], []) ~f:(fun (st_rev, expr_queue) i ->
+                let l, expr_queue_fun = translate_instr ctx [] i in
+                let expr_queue =
+                  match expr_queue_fun with
+                  | [] -> expr_queue
+                  | [ x ] -> x :: expr_queue
+                  | _ -> assert false
+                in
                 List.rev_append l st_rev, expr_queue)
           in
-          let instrs, expr_queue = translate_instrs ctx expr_queue rem last in
-          List.rev_append st_rev instrs, expr_queue
+          let instrs, expr_queue_after = translate_instrs ctx expr_queue_fun rem last in
+          flush_all expr_queue (List.rev_append st_rev instrs), expr_queue_after
       | _ ->
           let muts =
             Code.Var.Set.diff mut names
@@ -1436,7 +1442,7 @@ and translate_instrs (ctx : Ctx.t) expr_queue instr last =
             in
             (J.variable_declaration ~kind:Let (List.rev l_rev), J.N) :: st_rev, expr_queue
           in
-          (* Mutually recursive need to be properly scoped. *)
+          (* Mutually recursive functions need to be properly scoped. *)
           let st_rev, expr_queue =
             List.fold_left all ~init:([], expr_queue) ~f:(fun (st_rev, expr_queue) i ->
                 let l, expr_queue = translate_instr ctx expr_queue i in

diff --git a/compiler/tests-compiler/direct_calls.ml b/compiler/tests-compiler/direct_calls.ml
@@ -139,17 +139,18 @@ let%expect_test "direct calls with --enable effects" =
     function test2(param, cont){
      function f(g, x, cont){return caml_cps_exact_call2(g, x, cont);}
      var _f_ = 7;
-     function _g_(x, cont){return cont(undef);}
      return caml_cps_exact_call3
              (f,
-              _g_,
+              function(x, cont){return cont(undef);},
               _f_,
-              function(_h_){
-               function _i_(x, cont){
-                return caml_cps_call3(Stdlib[28], x, cst_a$0, cont);
-               }
+              function(_g_){
                return caml_cps_exact_call3
-                       (f, _i_, cst_a, function(_j_){return cont(0);});
+                       (f,
+                        function(x, cont){
+                         return caml_cps_call3(Stdlib[28], x, cst_a$0, cont);
+                        },
+                        cst_a,
+                        function(_h_){return cont(0);});
               });
     }
     //end