From 1528d17607d8b0e425083dbc432ca16063dcad9f Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Mon, 28 Jul 2025 15:21:13 +0200
Subject: [PATCH] WIP

---
 compiler/lib/flow.ml                | 10 +++++++---
 compiler/lib/generate.ml            | 11 +++++++++++
 compiler/lib/specialize_js.ml       | 29 +++++++++++++++++++++++++++++
 examples/boulderdash/boulderdash.ml | 10 +++++++++-
 examples/boulderdash/custom.js      |  6 ++++++
 examples/boulderdash/dune           |  1 +
 lib/runtime/jsoo_runtime.ml         |  2 ++
 7 files changed, 65 insertions(+), 4 deletions(-)
 create mode 100644 examples/boulderdash/custom.js

diff --git a/compiler/lib/flow.ml b/compiler/lib/flow.ml
index 13de7ffb74..59084f0f0c 100644
--- a/compiler/lib/flow.ml
+++ b/compiler/lib/flow.ml
@@ -47,9 +47,13 @@ module Info = struct
     }
 
   let def t x =
-    match t.info_defs.(Code.Var.idx x) with
-    | Phi _ | Param -> None
-    | Expr x -> Some x
+    let idx = Code.Var.idx x in
+    if Array.length t.info_defs <= idx
+    then None
+    else
+      match t.info_defs.(idx) with
+      | Phi _ | Param -> None
+      | Expr x -> Some x
 
   let possibly_mutable t x = Code.Var.ISet.mem t.info_possibly_mutable x
 
diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml
index bfbd93c5b9..cbd6fdbc15 100644
--- a/compiler/lib/generate.ml
+++ b/compiler/lib/generate.ml
@@ -1547,6 +1547,17 @@ let rec translate_expr ctx loc x e level : (_ * J.statement_list) Expr_builder.t
                    | Some s -> Printf.sprintf ", file %S" s)
                    pi.Parse_info.line
                    pi.Parse_info.col))
+        | Extern "caml_jsoo_runtime", [ Pc (String nm) ] when J.is_ident nm ->
+            let prim = Share.get_prim (runtime_fun ctx) nm ctx.Ctx.share in
+            return prim
+        | Extern "caml_jsoo_runtime", [ (Pc _ | Pv _) ] ->
+            failwith
+              (Printf.sprintf
+                 "%scaml_jsoo_runtime expects a string literal."
+                 (match (loc : J.location) with
+                 | Pi { name = Some name; col; line; _ } ->
+                     Printf.sprintf "%s:%d:%d: " name line col
+                 | Pi _ | N | U -> ""))
         | Extern "%js_array", l ->
             let* args = list_map (fun x -> access' ~ctx x) l in
             return (J.array args)
diff --git a/compiler/lib/specialize_js.ml b/compiler/lib/specialize_js.ml
index dda64b1063..1e18da69b1 100644
--- a/compiler/lib/specialize_js.ml
+++ b/compiler/lib/specialize_js.ml
@@ -288,6 +288,35 @@ let specialize_instrs ~target opt_count info l =
     match l with
     | [] -> List.rev acc
     | i :: r -> (
+        let i =
+          match i with
+          | Let (x, Apply { f; args; exact = false }) -> (
+              match Info.def info f with
+              | None -> i
+              | Some (Prim (Extern "caml_jsoo_runtime", [ name ])) -> (
+                  let name =
+                    match name with
+                    | Pc (String name) -> Some name
+                    | Pc _ -> None
+                    | Pv x -> (
+                        match Info.def info x with
+                        | Some (Constant (String name)) -> Some name
+                        | Some _ | None -> None)
+                  in
+                  match name with
+                  | None -> i
+                  | Some name -> (
+                      let name = Primitive.resolve name in
+                      match Primitive.arity name with
+                      | exception Not_found -> i
+                      | n ->
+                          if List.compare_length_with args ~len:n = 0
+                          then
+                            Let (x, Prim (Extern name, List.map args ~f:(fun x -> Pv x)))
+                          else i))
+              | Some _ -> i)
+          | _ -> i
+        in
         (* We make bound checking explicit. Then, we can remove duplicated
            bound checks. Also, it appears to be more efficient to inline
            the array access. The bound checking function returns the array,
diff --git a/examples/boulderdash/boulderdash.ml b/examples/boulderdash/boulderdash.ml
index 09acaaef59..0b6a7ce73f 100644
--- a/examples/boulderdash/boulderdash.ml
+++ b/examples/boulderdash/boulderdash.ml
@@ -510,4 +510,12 @@ let start _ =
   Dom.appendChild body div;
   Lwt.return ()
 
-let () = Lwt.async start
+let () =
+  let p : Js.js_string Js.t = Jsoo_runtime.Sys.external_ "process" in
+  let o : _ Js.t = Jsoo_runtime.Sys.external_ "obj" in
+  let del : 'a -> Jsoo_runtime.Js.t -> unit =
+    Jsoo_runtime.Sys.external_ "caml_js_delete"
+  in
+  del o (Jsoo_runtime.Js.string "process");
+  print_endline (Js.to_string p);
+  Lwt.async start
diff --git a/examples/boulderdash/custom.js b/examples/boulderdash/custom.js
new file mode 100644
index 0000000000..3784b6b3e4
--- /dev/null
+++ b/examples/boulderdash/custom.js
@@ -0,0 +1,6 @@
+//Provides: process
+var process = "process"
+
+
+//Provides: obj
+var obj = { "process": 42 }
diff --git a/examples/boulderdash/dune b/examples/boulderdash/dune
index 973c7b6921..496c57e99f 100644
--- a/examples/boulderdash/dune
+++ b/examples/boulderdash/dune
@@ -4,6 +4,7 @@
  (modes js wasm)
  (js_of_ocaml
   (compilation_mode separate)
+  (javascript_files custom.js)
   (build_runtime_flags :standard --file %{dep:maps.txt} --file maps))
  (link_deps
   (glob_files maps/*.map))
diff --git a/lib/runtime/jsoo_runtime.ml b/lib/runtime/jsoo_runtime.ml
index 4dee5f64a9..d9d00a38c8 100644
--- a/lib/runtime/jsoo_runtime.ml
+++ b/lib/runtime/jsoo_runtime.ml
@@ -124,6 +124,8 @@ module Sys = struct
   external restore_channel : out_channel -> redirection -> unit
     = "caml_ml_channel_restore"
 
+  external external_ : string -> 'a = "caml_jsoo_runtime"
+
   module Config = struct
     external use_js_string : unit -> bool = "caml_jsoo_flags_use_js_string"