Improve compatibility with Wasm_of_ocaml

CHANGES.md

@@ -2,6 +2,7 @@
 
 * Runtime: fix Dom_html.onIE (#1493)
 * Compiler: fix global flow analysis (#1494)
+* Runtime: add conversion functions + strict equality for compatibility with Wasm_of_ocaml (#1492)
 
 # 5.4.0 (2023-07-06) - Lille
 

compiler/lib/generate.ml

@@ -1162,6 +1162,8 @@ let _ =
       J.EUn (J.Delete, J.EAccess (cx, ANormal, cy)));
   register_bin_prim "caml_js_equals" `Mutable (fun cx cy _ ->
       bool (J.EBin (J.EqEq, cx, cy)));
+  register_bin_prim "caml_js_strict_equals" `Mutable (fun cx cy _ ->
+      bool (J.EBin (J.EqEqEq, cx, cy)));
   register_bin_prim "caml_js_instanceof" `Mutator (fun cx cy _ ->
       bool (J.EBin (J.InstanceOf, cx, cy)));
   register_un_prim "caml_js_typeof" `Mutator (fun cx _ -> J.EUn (J.Typeof, cx))
@@ -2186,6 +2188,10 @@ let init () =
     ; "caml_ensure_stack_capacity", "%identity"
     ; "caml_js_from_float", "%identity"
     ; "caml_js_to_float", "%identity"
+    ; "caml_js_from_int32", "%identity"
+    ; "caml_js_from_nativeint", "%identity"
+    ; "caml_js_to_int32", "caml_int_of_float"
+    ; "caml_js_to_nativeint", "caml_int_of_float"
     ];
   Hashtbl.iter
     (fun name (k, _) -> Primitive.register name k None None)

compiler/tests-compiler/jsopt.ml

@@ -48,6 +48,14 @@ module Js = struct
 
   external float_of_number : t -> float = "caml_js_to_float"
 
+  external number_of_int32 : int32 -> t = "caml_js_from_int32"
+
+  external int32_of_number : t -> int32 = "caml_js_to_int32"
+
+  external number_of_nativeint : nativeint -> t = "caml_js_from_nativeint"
+
+  external nativeint_of_number : t -> nativeint = "caml_js_to_nativeint"
+
   external typeof : t -> t = "caml_js_typeof"
 
   external instanceof : t -> t -> bool = "caml_js_instanceof"

examples/cubes/cubes.ml

@@ -65,64 +65,64 @@ let on_cube c i j k f =
   let x = float (i - k + n - 1) *. w in
   let y = (float (n - 1 - j) *. h) +. (float (i + k) *. h /. 2.) in
   c##save;
-  c##translate x y;
+  c##translate (Js.float x) (Js.float y);
   f c;
   c##restore
 
 let draw_top c =
   c##.fillStyle := top;
   c##beginPath;
-  c##moveTo w 0.;
-  c##lineTo (2. *. w) (h /. 2.);
-  c##lineTo w h;
-  c##lineTo 0. (h /. 2.);
+  c##moveTo (Js.float w) (Js.float 0.);
+  c##lineTo (Js.float (2. *. w)) (Js.float (h /. 2.));
+  c##lineTo (Js.float w) (Js.float h);
+  c##lineTo (Js.float 0.) (Js.float (h /. 2.));
   c##fill
 
 let top_edges c =
   c##beginPath;
-  c##moveTo 0. (h /. 2.);
-  c##lineTo w 0.;
-  c##lineTo (2. *. w) (h /. 2.);
+  c##moveTo (Js.float 0.) (Js.float (h /. 2.));
+  c##lineTo (Js.float w) (Js.float 0.);
+  c##lineTo (Js.float (2. *. w)) (Js.float (h /. 2.));
   c##stroke
 
 let draw_right c =
   c##.fillStyle := right;
   c##beginPath;
-  c##moveTo w h;
-  c##lineTo w (2. *. h);
-  c##lineTo (2. *. w) (1.5 *. h);
-  c##lineTo (2. *. w) (h /. 2.);
+  c##moveTo (Js.float w) (Js.float h);
+  c##lineTo (Js.float w) (Js.float (2. *. h));
+  c##lineTo (Js.float (2. *. w)) (Js.float (1.5 *. h));
+  c##lineTo (Js.float (2. *. w)) (Js.float (h /. 2.));
   c##fill
 
 let right_edges c =
   c##beginPath;
-  c##moveTo w (2. *. h);
-  c##lineTo w h;
-  c##lineTo (2. *. w) (h /. 2.);
+  c##moveTo (Js.float w) (Js.float (2. *. h));
+  c##lineTo (Js.float w) (Js.float h);
+  c##lineTo (Js.float (2. *. w)) (Js.float (h /. 2.));
   c##stroke
 
 let draw_left c =
   c##.fillStyle := left;
   c##beginPath;
-  c##moveTo w h;
-  c##lineTo w (2. *. h);
-  c##lineTo 0. (1.5 *. h);
-  c##lineTo 0. (h /. 2.);
+  c##moveTo (Js.float w) (Js.float h);
+  c##lineTo (Js.float w) (Js.float (2. *. h));
+  c##lineTo (Js.float 0.) (Js.float (1.5 *. h));
+  c##lineTo (Js.float 0.) (Js.float (h /. 2.));
   c##fill
 
 let left_edges c =
   c##beginPath;
-  c##moveTo w h;
-  c##lineTo 0. (h /. 2.);
-  c##lineTo 0. (1.5 *. h);
+  c##moveTo (Js.float w) (Js.float h);
+  c##lineTo (Js.float 0.) (Js.float (h /. 2.));
+  c##lineTo (Js.float 0.) (Js.float (1.5 *. h));
   c##stroke
 
 let remaining_edges c =
   c##beginPath;
-  c##moveTo 0. (float n *. 1.5 *. h);
-  c##lineTo (float n *. w) (float n *. 2. *. h);
-  c##lineTo (float n *. 2. *. w) (float n *. 1.5 *. h);
-  c##lineTo (float n *. 2. *. w) (float n *. 0.5 *. h);
+  c##moveTo (Js.float 0.) (Js.float (float n *. 1.5 *. h));
+  c##lineTo (Js.float (float n *. w)) (Js.float (float n *. 2. *. h));
+  c##lineTo (Js.float (float n *. 2. *. w)) (Js.float (float n *. 1.5 *. h));
+  c##lineTo (Js.float (float n *. 2. *. w)) (Js.float (float n *. 0.5 *. h));
   c##stroke
 
 let tile c a (top, right, left) =
@@ -163,15 +163,31 @@ let create_canvas () =
 
 let redraw ctx canvas a =
   let c = canvas##getContext Html._2d_ in
-  c##setTransform 1. 0. 0. 1. 0. 0.;
-  c##clearRect 0. 0. (float canvas##.width) (float canvas##.height);
-  c##setTransform 1. 0. 0. 1. 0.5 0.5;
+  c##setTransform
+    (Js.float 1.)
+    (Js.float 0.)
+    (Js.float 0.)
+    (Js.float 1.)
+    (Js.float 0.)
+    (Js.float 0.);
+  c##clearRect
+    (Js.float 0.)
+    (Js.float 0.)
+    (Js.float (float canvas##.width))
+    (Js.float (float canvas##.height));
+  c##setTransform
+    (Js.float 1.)
+    (Js.float 0.)
+    (Js.float 0.)
+    (Js.float 1.)
+    (Js.float 0.5)
+    (Js.float 0.5);
   c##.globalCompositeOperation := Js.string "lighter";
   tile c a (draw_top, draw_right, draw_left);
   c##.globalCompositeOperation := Js.string "source-over";
   tile c a (top_edges, right_edges, left_edges);
   remaining_edges c;
-  ctx##drawImage_fromCanvas canvas 0. 0.
+  ctx##drawImage_fromCanvas canvas (Js.float 0.) (Js.float 0.)
 
 let ( >>= ) = Lwt.bind
 

examples/graph_viewer/viewer_js.ml

@@ -50,24 +50,38 @@ module Common = Viewer_common.F (struct
 
   let restore ctx = ctx##restore
 
-  let scale ctx ~sx ~sy = ctx##scale sx sy
+  let scale ctx ~sx ~sy = ctx##scale (Js.float sx) (Js.float sy)
 
-  let translate ctx ~tx ~ty = ctx##translate tx ty
+  let translate ctx ~tx ~ty = ctx##translate (Js.float tx) (Js.float ty)
 
   let begin_path ctx = ctx##beginPath
 
   let close_path ctx = ctx##closePath
 
-  let move_to ctx ~x ~y = ctx##moveTo x y
+  let move_to ctx ~x ~y = ctx##moveTo (Js.float x) (Js.float y)
 
-  let line_to ctx ~x ~y = ctx##lineTo x y
+  let line_to ctx ~x ~y = ctx##lineTo (Js.float x) (Js.float y)
 
-  let curve_to ctx ~x1 ~y1 ~x2 ~y2 ~x3 ~y3 = ctx##bezierCurveTo x1 y1 x2 y2 x3 y3
+  let curve_to ctx ~x1 ~y1 ~x2 ~y2 ~x3 ~y3 =
+    ctx##bezierCurveTo
+      (Js.float x1)
+      (Js.float y1)
+      (Js.float x2)
+      (Js.float y2)
+      (Js.float x3)
+      (Js.float y3)
 
   let arc ctx ~xc ~yc ~radius ~angle1 ~angle2 =
-    ctx##arc xc yc radius angle1 angle2 Js._true
+    ctx##arc
+      (Js.float xc)
+      (Js.float yc)
+      (Js.float radius)
+      (Js.float angle1)
+      (Js.float angle2)
+      Js._true
 
-  let rectangle ctx ~x ~y ~width ~height = ctx##rect x y width height
+  let rectangle ctx ~x ~y ~width ~height =
+    ctx##rect (Js.float x) (Js.float y) (Js.float width) (Js.float height)
 
   let fill ctx c =
     ctx##.fillStyle := c;
@@ -86,12 +100,12 @@ module Common = Viewer_common.F (struct
     (match fill_color with
     | Some c ->
         ctx##.fillStyle := c;
-        ctx##fillText txt x y
+        ctx##fillText txt (Js.float x) (Js.float y)
     | None -> ());
     match stroke_color with
     | Some c ->
         ctx##.strokeStyle := c;
-        ctx##strokeText txt x y
+        ctx##strokeText txt (Js.float x) (Js.float y)
     | None -> ()
 
   type window = Html.canvasElement Js.t
@@ -102,7 +116,7 @@ module Common = Viewer_common.F (struct
 
   let get_drawable w =
     let ctx = w##getContext Html._2d_ in
-    ctx##.lineWidth := 2.;
+    ctx##.lineWidth := Js.float 2.;
     w, ctx
 
   let make_pixmap _ width height =
@@ -126,14 +140,14 @@ module Common = Viewer_common.F (struct
       ((p, _) : pixmap) =
     c##drawImage_fullFromCanvas
       p
-      (float xsrc)
-      (float ysrc)
-      (float width)
-      (float height)
-      (float x)
-      (float y)
-      (float width)
-      (float height)
+      (Js.float (float xsrc))
+      (Js.float (float ysrc))
+      (Js.float (float width))
+      (Js.float (float height))
+      (Js.float (float x))
+      (Js.float (float y))
+      (Js.float (float width))
+      (Js.float (float height))
 
   (****)
 
@@ -353,7 +367,7 @@ Firebug.console##log_2(Js.string "update", Js.date##now());
       redraw_queued := true;
       let (_ : Html.animation_frame_request_id) =
         Html.window##requestAnimationFrame
-          (Js.wrap_callback (fun (_ : float) ->
+          (Js.wrap_callback (fun _ ->
                redraw_queued := false;
                redraw st (get_scale ()) hadj#value vadj#value canvas))
       in