WIP

Author: hhugo

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
 

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)

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,

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

examples/boulderdash/custom.js

@@ -0,0 +1,6 @@
+//Provides: process
+var process = "process"
+
+
+//Provides: obj
+var obj = { "process": 42 }

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))

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"