Fix compilation of some mutually recursive functions

Implement caml_alloc_dummy_infix

Author: vouillon

CHANGES.md

@@ -16,6 +16,7 @@
 - Effects: fix Js.export and Js.export_all to work with functions
 - Sourcemap: fix incorrect sourcemap with separate compilation
 - Compiler: fix control flow analysis; some annotions were wrong in the runtime
+- Runtime: fix the compilation of some mutually recursive functions
 
 # 5.0.1 (2022-12-20) - Lille
 ## Features/Changes

compiler/tests-check-prim/main.output

@@ -3,7 +3,6 @@ Missing
 
 From main.bc:
 caml_alloc_dummy_function
-caml_alloc_dummy_infix
 caml_dynlink_add_primitive
 caml_dynlink_close_lib
 caml_dynlink_get_current_libs

compiler/tests-check-prim/main.output5

@@ -3,7 +3,6 @@ Missing
 
 From main.bc:
 caml_alloc_dummy_function
-caml_alloc_dummy_infix
 caml_continuation_use
 caml_drop_continuation
 caml_dynlink_add_primitive

compiler/tests-check-prim/unix-unix.output

@@ -3,7 +3,6 @@ Missing
 
 From unix.bc:
 caml_alloc_dummy_function
-caml_alloc_dummy_infix
 caml_dynlink_add_primitive
 caml_dynlink_close_lib
 caml_dynlink_get_current_libs

compiler/tests-check-prim/unix-unix.output5

@@ -3,7 +3,6 @@ Missing
 
 From unix.bc:
 caml_alloc_dummy_function
-caml_alloc_dummy_infix
 caml_continuation_use
 caml_drop_continuation
 caml_dynlink_add_primitive

compiler/tests-check-prim/unix-win32.output

@@ -3,7 +3,6 @@ Missing
 
 From unix.bc:
 caml_alloc_dummy_function
-caml_alloc_dummy_infix
 caml_dynlink_add_primitive
 caml_dynlink_close_lib
 caml_dynlink_get_current_libs

compiler/tests-check-prim/unix-win32.output5

@@ -3,7 +3,6 @@ Missing
 
 From unix.bc:
 caml_alloc_dummy_function
-caml_alloc_dummy_infix
 caml_continuation_use
 caml_drop_continuation
 caml_dynlink_add_primitive

compiler/tests-jsoo/test_rec_fun.ml

@@ -0,0 +1,111 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                OCaml                                   *)
+(*                                                                        *)
+(*   Copyright 2019 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+let rec h =
+  let rec f n = if n >= 0 then g (n - 1)
+  and g n =
+    h n;
+    f n
+  in
+  f
+
+let () = ignore (h 10)
+
+let mooo x =
+  let rec h =
+    ignore (Sys.opaque_identity x);
+    let rec g n =
+      h n;
+      f n
+    and f n = if n >= 0 then g (n - 1) in
+    f
+  in
+  h
+
+let h = mooo 3
+
+let () = ignore (h 10)
+
+let rec foo =
+  let rec f = function
+    | 0 -> 100
+    | n -> foo (n - 1)
+  and g = function
+    | 0 -> 200
+    | n -> f (n - 1)
+  in
+  g
+
+let%expect_test _ =
+  print_int (foo 2);
+  print_newline ();
+  [%expect {| 200 |}]
+
+let%expect_test _ =
+  print_int (foo 7);
+  print_newline ();
+  [%expect {| 100 |}]
+
+let with_free_vars a b c =
+  let rec foo =
+    let rec f = function
+      | 0 -> 100 + a + b + c
+      | n -> foo (n - 1)
+    and g = function
+      | 0 -> 200 + a + b + c
+      | n -> f (n - 1)
+    in
+    g
+  in
+  foo
+
+let%expect_test _ =
+  print_int (with_free_vars 1 2 3 2);
+  print_newline ();
+  [%expect {| 206 |}]
+
+let%expect_test _ =
+  print_int (with_free_vars 1 2 3 7);
+  print_newline ();
+  [%expect {| 106 |}]
+
+let bar =
+  let rec f = function
+    | 0 -> 3
+    | n -> g (n - 1)
+  and g = function
+    | 0 -> 10 + f 10
+    | n -> f (n - 1)
+  in
+  let foof = f and goof = g in
+  foof, goof
+
+let%expect_test _ =
+  print_int (snd bar 42);
+  print_newline ();
+  [%expect {| 13 |}]
+
+let rec foobar =
+  let rec f x = function
+    | 0 -> 100
+    | n -> foobar x (n - 1)
+  and g x = function
+    | 0 -> 200
+    | n -> f x (n - 1)
+  in
+  g
+
+let%expect_test _ =
+  print_int (foobar 5 2);
+  print_newline ();
+  [%expect {| 200 |}]

runtime/obj.js

@@ -22,6 +22,12 @@ function caml_update_dummy (x, y) {
   var i = y.length; while (i--) x[i] = y[i]; return 0;
 }
 
+//Provides: caml_alloc_dummy_infix
+//Requires: caml_call_gen
+function caml_alloc_dummy_infix () {
+  return function f (x) { return caml_call_gen(f.fun, [x]) }
+}
+
 //Provides: caml_obj_is_block const (const)
 function caml_obj_is_block (x) { return +(x instanceof Array); }