Merge branch 'master' of github.com:ocsigen/js_of_ocaml into jsoo-merge

Author: vouillon

.github/workflows/lint.yml

@@ -17,6 +17,9 @@ jobs:
         with:
           ocaml-compiler: "5.2"
           dune-cache: true
+      - name: Pin dune
+        run: |
+          opam pin add -n dune.3.17 https://github.com/ocaml/dune.git
       - uses: ocaml/setup-ocaml/lint-opam@v3
 
   lint-fmt:
@@ -29,6 +32,9 @@ jobs:
         with:
           ocaml-compiler: "5.2"
           dune-cache: true
+      - name: Pin dune
+        run: |
+          opam pin add -n dune.3.17 https://github.com/ocaml/dune.git
       - uses: ocaml/setup-ocaml/lint-fmt@v3
 
   lint-runtime:

CHANGES.md

@@ -1,16 +1,15 @@
-# dev
+# 5.9.0 (2024-11-22) - Lille
 
 ## Features/Changes
 * Misc: update testsuite to OCaml 5.2
 * Misc: CI uses opam.2.2 and no longer use sunset repo
 * Misc: yojson is no longer optional
 * Misc: reduce the diff with the wasm_of_ocaml fork
+* Misc: finalize support for OCaml 5.3
 * Compiler: speedup global_flow/global_deadcode pass on large bytecode
 * Compiler: improved global dead code elimination (#2206)
 * Compiler: speedup json parsing, relying on Yojson.Raw (#1640)
 * Compiler: Decode sourcemap mappings only when necessary (#1664)
-* Compiler: make indirect call using sequence instead of using the call method
-  [f.call(null, args)] becomes [(0,f)(args)]
 * Compiler: mark [TextEncoder] as reserved
 * Compiler: add support for the Wasm backend in parts of the pipeline, in
   prevision for the merge of wasm_of_ocaml
@@ -21,12 +20,15 @@
 * Compiler: Emit index source_map to avoid changing mappings (#1714, #1715)
 * Compiler: improved source map generation (#1716)
 * Runtime: change Sys.os_type on windows (Cygwin -> Win32)
-* Runtime: backtraces are really expensive, they need to be be explicitly
+* Runtime: backtraces are really expensive, they need to be explicitly
   requested at compile time (--enable with-js-error) or at startup (OCAMLRUNPARAM=b=1)
 * Runtime: allow dynlink of precompiled js with separate compilation (#1676)
 * Runtime: reimplement the runtime of weak and ephemeron (#1707)
 * Lib: Modify Typed_array API for compatibility with WebAssembly
+* Lib: add details element and toggle event (#1728)
 * Toplevel: no longer set globals for toplevel initialization
+* Runtime: precompute constants used in `caml_lxm_next` (#1730)
+* Runtime: cleanup runtime
 
 ## Bug fixes
 * Runtime: fix parsing of unsigned integers (0u2147483648) (#1633, #1666)

VERSION

@@ -1 +1 @@
-5.8.2
+5.9.0

biome.json

@@ -2,7 +2,7 @@
   "$schema": "https://biomejs.dev/schemas/1.9.1/schema.json",
   "files": {
     "include": ["runtime"],
-    "ignore": ["runtime/zstd.ts"]
+    "ignore": ["runtime/js/zstd.ts"]
   },
   "formatter": {
     "enabled": true,

compiler/bin-js_of_ocaml/cmd_arg.ml

@@ -130,7 +130,7 @@ let options =
   in
   let no_sourcemap =
     let doc =
-      "Don't generate source map. All other source map related flags will be be ignored."
+      "Don't generate source map. All other source map related flags will be ignored."
     in
     Arg.(value & flag & info [ "no-sourcemap"; "no-source-map" ] ~doc)
   in
@@ -395,7 +395,7 @@ let options_runtime_only =
   in
   let no_sourcemap =
     let doc =
-      "Don't generate source map. All other source map related flags will be be ignored."
+      "Don't generate source map. All other source map related flags will be ignored."
     in
     Arg.(value & flag & info [ "no-sourcemap"; "no-source-map" ] ~doc)
   in

compiler/bin-js_of_ocaml/link.ml

@@ -39,7 +39,7 @@ let options =
   in
   let no_sourcemap =
     let doc =
-      "Don't generate source map. All other source map related flags will be be ignored."
+      "Don't generate source map. All other source map related flags will be ignored."
     in
     Arg.(value & flag & info [ "no-sourcemap"; "no-source-map" ] ~doc)
   in

compiler/lib-runtime-files/dune

@@ -7,7 +7,7 @@
  (target files.ml)
  (deps
   gen/gen.exe
-  (glob_files ../../runtime/*.js))
+  (glob_files ../../runtime/js/*.js))
  (action
   (with-stdout-to
    %{target}

compiler/lib/flow_lexer.ml

@@ -832,9 +832,9 @@ let backquote env lexbuf =
 
 let wrap f =
   let f env =
-    let start, _ = Sedlexing.lexing_positions env.Lex_env.lex_lb in
+    let start = Sedlexing.lexing_position_start env.Lex_env.lex_lb in
     let t = f env env.Lex_env.lex_lb in
-    let _, stop = Sedlexing.lexing_positions env.Lex_env.lex_lb in
+    let stop = Sedlexing.lexing_position_curr env.Lex_env.lex_lb in
     t, Loc.create ~last_line:(Loc.line_end' !(env.lex_last_loc)) start stop
   in
   let rec helper comments env =

compiler/lib/generate.ml

@@ -898,7 +898,8 @@ let apply_fun_raw ctx f params exact trampolined loc =
     (* Make sure we are performing a regular call, not a (slower)
        method call *)
     match f with
-    | J.EAccess _ | J.EDot _ -> J.call (J.ESeq (int 0, f)) params loc
+    | J.EAccess _ | J.EDot _ ->
+        J.call (J.dot f (Utf8_string.of_string_exn "call")) (s_var "null" :: params) loc
     | _ -> J.call f params loc
   in
   let apply =

compiler/lib/parse_bytecode.ml

@@ -88,8 +88,6 @@ module Debug : sig
 
   val create : include_cmis:bool -> bool -> t
 
-  val fold : t -> (Code.Addr.t -> Instruct.debug_event -> 'a -> 'a) -> 'a -> 'a
-
   val paths : t -> units:StringSet.t -> StringSet.t
 end = struct
   open Instruct
@@ -315,9 +313,6 @@ end = struct
     | [], [] -> ()
     | _ -> assert false
 
-  let fold t f acc =
-    Int_table.fold (fun k { event; _ } acc -> f k event acc) t.events_by_pc acc
-
   let paths t ~units =
     let paths =
       Hashtbl.fold
@@ -333,66 +328,56 @@ end
 module Blocks : sig
   type t
 
-  val analyse : Debug.t -> bytecode -> t
-
-  val add : t -> int -> t
-
-  type u
-
-  val finish_analysis : t -> u
+  val analyse : bytecode -> t
 
-  val next : u -> int -> int
+  val next : t -> int -> int
 
-  val is_empty : u -> bool
+  val is_empty : t -> bool
 end = struct
-  type t = Addr.Set.t
-
-  type u = int array
+  type t = int array
 
   let add blocks pc = Addr.Set.add pc blocks
 
-  let rec scan debug blocks code pc len =
+  let rec scan blocks code pc len =
     if pc < len
     then
       match (get_instr_exn code pc).kind with
-      | KNullary -> scan debug blocks code (pc + 1) len
-      | KUnary -> scan debug blocks code (pc + 2) len
-      | KBinary -> scan debug blocks code (pc + 3) len
-      | KNullaryCall -> scan debug blocks code (pc + 1) len
-      | KUnaryCall -> scan debug blocks code (pc + 2) len
-      | KBinaryCall -> scan debug blocks code (pc + 3) len
+      | KNullary -> scan blocks code (pc + 1) len
+      | KUnary -> scan blocks code (pc + 2) len
+      | KBinary -> scan blocks code (pc + 3) len
+      | KNullaryCall -> scan blocks code (pc + 1) len
+      | KUnaryCall -> scan blocks code (pc + 2) len
+      | KBinaryCall -> scan blocks code (pc + 3) len
       | KJump ->
           let offset = gets code (pc + 1) in
           let blocks = Addr.Set.add (pc + offset + 1) blocks in
-          scan debug blocks code (pc + 2) len
+          scan blocks code (pc + 2) len
       | KCond_jump ->
           let offset = gets code (pc + 1) in
           let blocks = Addr.Set.add (pc + offset + 1) blocks in
-          scan debug blocks code (pc + 2) len
+          scan blocks code (pc + 2) len
       | KCmp_jump ->
           let offset = gets code (pc + 2) in
           let blocks = Addr.Set.add (pc + offset + 2) blocks in
-          scan debug blocks code (pc + 3) len
+          scan blocks code (pc + 3) len
       | KSwitch ->
           let sz = getu code (pc + 1) in
           let blocks = ref blocks in
           for i = 0 to (sz land 0xffff) + (sz lsr 16) - 1 do
             let offset = gets code (pc + 2 + i) in
             blocks := Addr.Set.add (pc + offset + 2) !blocks
           done;
-          scan debug !blocks code (pc + 2 + (sz land 0xffff) + (sz lsr 16)) len
+          scan !blocks code (pc + 2 + (sz land 0xffff) + (sz lsr 16)) len
       | KClosurerec ->
           let nfuncs = getu code (pc + 1) in
-          scan debug blocks code (pc + nfuncs + 3) len
-      | KClosure -> scan debug blocks code (pc + 3) len
-      | KStop n -> scan debug blocks code (pc + n + 1) len
+          scan blocks code (pc + nfuncs + 3) len
+      | KClosure -> scan blocks code (pc + 3) len
+      | KStop n -> scan blocks code (pc + n + 1) len
       | K_will_not_happen -> assert false
     else (
       assert (pc = len);
       blocks)
 
-  let finish_analysis blocks = Array.of_list (Addr.Set.elements blocks)
-
   (* invariant: a.(i) <= x < a.(j) *)
   let rec find a i j x =
     assert (i < j);
@@ -406,17 +391,13 @@ end = struct
 
   let is_empty x = Array.length x <= 1
 
-  let analyse debug_data code =
-    let debug_data =
-      if Debug.enabled debug_data
-      then debug_data
-      else Debug.create ~include_cmis:false false
-    in
+  let analyse code =
     let blocks = Addr.Set.empty in
     let len = String.length code / 4 in
     let blocks = add blocks 0 in
     let blocks = add blocks len in
-    scan debug_data blocks code 0 len
+    let blocks = scan blocks code 0 len in
+    Array.of_list (Addr.Set.elements blocks)
 end
 
 (* Parse constants *)
@@ -806,7 +787,7 @@ let method_cache_id = ref 1
 let clo_offset_3 = if new_closure_repr then 3 else 2
 
 type compile_info =
-  { blocks : Blocks.u
+  { blocks : Blocks.t
   ; code : string
   ; limit : int
   ; debug : Debug.t
@@ -1865,7 +1846,7 @@ and compile infos pc state (instrs : instr list) =
 
         if debug_parser ()
         then (
-          Format.printf "%a = ccal \"%s\" (" Var.print x prim;
+          Format.printf "%a = ccall \"%s\" (" Var.print x prim;
           for i = 0 to nargs - 1 do
             if i > 0 then Format.printf ", ";
             Format.printf "%a" Var.print (List.nth args i)
@@ -1885,7 +1866,7 @@ and compile infos pc state (instrs : instr list) =
 
         if debug_parser ()
         then (
-          Format.printf "%a = ccal \"%s\" (" Var.print x prim;
+          Format.printf "%a = ccall \"%s\" (" Var.print x prim;
           for i = 0 to nargs - 1 do
             if i > 0 then Format.printf ", ";
             Format.printf "%a" Var.print (List.nth args i)
@@ -1905,7 +1886,7 @@ and compile infos pc state (instrs : instr list) =
 
         if debug_parser ()
         then (
-          Format.printf "%a = ccal \"%s\" (" Var.print x prim;
+          Format.printf "%a = ccall \"%s\" (" Var.print x prim;
           for i = 0 to nargs - 1 do
             if i > 0 then Format.printf ", ";
             Format.printf "%a" Var.print (List.nth args i)
@@ -2465,14 +2446,7 @@ type one =
 let parse_bytecode code globals debug_data =
   let state = State.initial globals in
   Code.Var.reset ();
-  let blocks = Blocks.analyse debug_data code in
-  let blocks =
-    (* Disabled. [pc] might not be an appropriate place to split blocks *)
-    if false && Debug.enabled debug_data
-    then Debug.fold debug_data (fun pc _ blocks -> Blocks.add blocks pc) blocks
-    else blocks
-  in
-  let blocks' = Blocks.finish_analysis blocks in
+  let blocks' = Blocks.analyse code in
   let p =
     if not (Blocks.is_empty blocks')
     then (