Many fixes and update for jsoo 5

dune

@@ -12,11 +12,11 @@
            (ocamlopt_flags)
            (js_of_ocaml
             (compilation_mode whole_program)
-            (flags :standard --no-sourcemap --pretty)
-            (build_runtime_flags :standard --no-sourcemap --pretty --enable=effects)))
+            (flags --no-source-map --opt=2 --enable=use-js-string --target-env=browser)))
 
   (dev     (flags (:standard -safe-string -w -32 -warn-error -a+8))
            (js_of_ocaml
             (compilation_mode whole_program)
+            (flags --source-map-inline --pretty --enable=use-js-string --target-env=browser)
             ))
 )

learn-ocaml-client.opam.locked

@@ -51,7 +51,7 @@ depends: [
   "cppo" {= "1.6.8"}
   "csexp" {= "1.5.1"}
   "cstruct" {= "6.2.0"}
-  "digestif" {= "1.1.0"}
+  "digestif" {= "1.2.0"}
   "domain-name" {= "0.4.0"}
   "dune" {= "3.16.0"}
   "dune-configurator" {= "2.9.3"}
@@ -70,9 +70,9 @@ depends: [
   "ipaddr" {= "5.6.0"}
   "ipaddr-sexp" {= "5.6.0"}
   "jane-street-headers" {= "v0.16.0"}
-  "js_of_ocaml" {= "5.1.1"}
-  "js_of_ocaml-compiler" {= "5.1.1"}
-  "js_of_ocaml-ppx" {= "5.1.1"}
+  "js_of_ocaml" {= "5.8.2"}
+  "js_of_ocaml-compiler" {= "5.8.2"}
+  "js_of_ocaml-ppx" {= "5.8.2"}
   "json-data-encoding" {= "1.0.1"}
   "jsonm" {= "1.0.1"}
   "jst-config" {= "v0.16.0"}

learn-ocaml.opam

@@ -29,7 +29,7 @@ depends: [
   "cohttp-lwt-unix" {>= "2.0.0"}
   "conf-git"
   "decompress" {= "0.8.1"}
-  "digestif" {>= "0.7.1"}
+  "digestif" {>= "1.2.0"}
   "dune" {>= "2.3.0"}
   "easy-format" {>= "1.3.0" }
   "ezjsonm"

learn-ocaml.opam.locked

@@ -53,7 +53,7 @@ depends: [
   "csexp" {= "1.5.1"}
   "cstruct" {= "6.2.0"}
   "decompress" {= "0.8.1"}
-  "digestif" {= "1.1.0"}
+  "digestif" {= "1.2.0"}
   "domain-name" {= "0.4.0"}
   "dune" {= "3.16.0"}
   "dune-configurator" {= "2.9.3"}
@@ -72,12 +72,12 @@ depends: [
   "ipaddr" {= "5.6.0"}
   "ipaddr-sexp" {= "5.6.0"}
   "jane-street-headers" {= "v0.16.0"}
-  "js_of_ocaml" {= "5.1.1"}
-  "js_of_ocaml-compiler" {= "5.1.1"}
-  "js_of_ocaml-lwt" {= "5.1.1"}
-  "js_of_ocaml-ppx" {= "5.1.1"}
-  "js_of_ocaml-toplevel" {= "5.1.1"}
-  "js_of_ocaml-tyxml" {= "5.1.1"}
+  "js_of_ocaml" {= "5.8.2"}
+  "js_of_ocaml-compiler" {= "5.8.2"}
+  "js_of_ocaml-lwt" {= "5.8.2"}
+  "js_of_ocaml-ppx" {= "5.8.2"}
+  "js_of_ocaml-toplevel" {= "5.8.2"}
+  "js_of_ocaml-tyxml" {= "5.8.2"}
   "json-data-encoding" {= "1.0.1"}
   "json-data-encoding-browser" {= "1.0.1"}
   "jsonm" {= "1.0.1"}

src/ace-lib/ace.ml

@@ -287,7 +287,7 @@ let define_mode name helpers =
         js_helpers##.autoOutdent := Js.wrap_callback auto_outdent
   end;
   Js.Unsafe.fun_call
-    (Js.Unsafe.variable "define_ocaml_mode")
+    (Js.Unsafe.pure_js_expr "define_ocaml_mode")
     [| Js.Unsafe.inject (Js.string ("ace/mode/" ^ name)) ;
        Js.Unsafe.inject js_helpers |]
 

src/app/learnocaml_playground_main.ml

@@ -7,7 +7,6 @@
  * included LICENSE file for details. *)
 
 open Js_of_ocaml
-open Js_of_ocaml_tyxml
 open Js_utils
 open Lwt.Infix
 open Learnocaml_common

src/grader/dune

@@ -55,7 +55,7 @@
 (rule
  (target testing_dyn.js)
  (deps testing_dyn.cma)
- (action (run js_of_ocaml %{deps} --wrap-with dynload)))
+ (action (run js_of_ocaml --no-source-map --opt=2 --enable=use-js-string --target-env=browser %{deps})))
 
 (rule
  (targets test_lib.odoc)
@@ -141,11 +141,6 @@
        %{ocaml-config:standard_library}/camlinternalLazy.cmi
        %{ocaml-config:standard_library}/camlinternalMod.cmi
        %{ocaml-config:standard_library}/camlinternalOO.cmi
-       %{ocaml-config:standard_library}/arith_status.cmi
-       %{ocaml-config:standard_library}/big_int.cmi
-       %{ocaml-config:standard_library}/nat.cmi
-       %{ocaml-config:standard_library}/num.cmi
-       %{ocaml-config:standard_library}/ratio.cmi
        %{ocaml-config:standard_library}/std_exit.cmi
        %{ocaml-config:standard_library}/compiler-libs/topdirs.cmi)
     (:local_cmis

src/grader/grader_jsoo_worker.ml

@@ -18,7 +18,6 @@ let get_grade ?callback exo solution =
         List.iter (rec_mount (name::path)) children
     | OCamlRes.Res.File (name, content) ->
         let name = "/" ^ String.concat "/" (List.rev (name::path)) in
-        Js.Unsafe.set content (Js.string "t") 9 ; (* XXX hack *)
         Sys_js.create_file ~name ~content
     | OCamlRes.Res.Error _ -> ()
   in

src/grader/test_lib.ml

@@ -372,7 +372,6 @@ module Intro = Pre_test.Introspection
   (*----------------------------------------------------------------------------*)
 
   module Test_functions_types = struct
-    open Pre_test
 
     let compatible_type ~expected:exp got =
       let open Learnocaml_report in
@@ -676,7 +675,6 @@ module Intro = Pre_test.Introspection
   (*----------------------------------------------------------------------------*)
 
   module Test_functions_generic = struct
-    open Pre_test
     open Tester
 
     let sigalrm_handler time =

src/ppx-metaquot/genlifter.ml

@@ -261,4 +261,5 @@ module Main : sig end = struct
       Printf.eprintf "** fatal error: %s\n%!" (Printexc.to_string exn)
 
 end
-open Main
+
+let _ = let module _ = Main in ()

src/repo/learnocaml_precompile_exercise.ml

@@ -57,7 +57,13 @@ let ocamlc ?(dir=Sys.getcwd ()) ?(opn=[]) ?(ppx=[]) ~source ~target args =
 let jsoo ?(dir=Sys.getcwd ()) ~source ~target args =
   let d = Filename.concat dir in
   if is_fresh ~dir target [source] then Lwt.return_unit else
-  let args = "--wrap-with=dynload" :: args in
+  let args =
+    "--no-source-map" ::
+    "--opt=2" ::
+    "--enable=use-js-string" ::
+    "--target-env=browser" ::
+    args
+  in
   let args = args @ [d source; "-o"; d target] in
   run "js_of_ocaml" args
 

src/toplevel/learnocaml_toplevel_worker_main.ml

@@ -282,7 +282,6 @@ let () =
         List.iter (rec_mount (name::path)) children
     | OCamlRes.Res.File (name, content) ->
         let name = "/" ^ String.concat "/" (List.rev (name::path)) in
-        Js.Unsafe.set content (Js.string "t") 9 ; (* XXX hack *)
         Sys_js.create_file ~name ~content
     | OCamlRes.Res.Error _ -> ()
   in

src/toploop/toploop_jsoo.ml

@@ -7,76 +7,100 @@
  * included LICENSE file for details. *)
 
 open Js_of_ocaml
-open Js_of_ocaml_compiler
-
-let split_primitives p =
-  let len = String.length p in
-  let rec split beg cur =
-    if cur >= len then []
-    else if p.[cur] = '\000' then
-      String.sub p beg (cur - beg) :: split (cur + 1) (cur + 1)
-    else
-      split beg (cur + 1) in
-  Array.of_list(split 0 0)
+
+module Jsoo_compiler_dynlink () = struct
+  (* XXX Copy-pasted from js_of_ocaml_compiler_dynlink.ml (at 5.8.2-27-gccdb2ac69b), because we need to delay initialization *)
+
+  open Js_of_ocaml_compiler.Stdlib
+  open Js_of_ocaml_compiler
+  module J = Jsoo_runtime.Js
+
+  type bytecode_sections =
+    { symb : Ocaml_compiler.Symtable.GlobalMap.t
+    ; crcs : (string * Digest.t option) list
+    ; prim : string list
+    ; dlpt : string list
+    }
+  [@@ocaml.warning "-unused-field"]
+
+  external get_bytecode_sections : unit -> bytecode_sections = "jsoo_get_bytecode_sections"
+
+  let normalize_bytecode code =
+    match Ocaml_version.compare Ocaml_version.current [ 5; 2 ] < 0 with
+    | true -> code
+    | false ->
+        (* starting with ocaml 5.2, The toplevel no longer append [RETURN 1] *)
+        let { Instr.opcode; _ } = Instr.find Instr.RETURN in
+        let len = String.length code in
+        let b = Bytes.create (len + 8) in
+        Bytes.blit_string ~src:code ~src_pos:0 ~dst:b ~dst_pos:0 ~len;
+        Bytes.set_int32_le b len (Int32.of_int opcode);
+        Bytes.set_int32_le b (len + 4) 1l;
+        Bytes.to_string b
+
+  let init () = (* <Learn-ocaml patched/> *)
+    let global = J.pure_js_expr "globalThis" in
+    Config.Flag.set "use-js-string" (Jsoo_runtime.Sys.Config.use_js_string ());
+    Config.Flag.set "effects" (Jsoo_runtime.Sys.Config.effects ());
+    (* <Learn-ocaml patched>  -- @LG: are these still needed ? *)
+    (* Workaround Marshal bug triggered by includemod.ml:607 *)
+    Clflags.error_size := 0 ;
+    (* Disable inlining of JSOO which may blow the JS stack *)
+    Config.Flag.disable "inline" ;
+    Topdirs.dir_directory "/cmis";
+    (* </Learn-ocaml patched> *)
+    (* this needs to stay synchronized with toplevel.js *)
+    let toplevel_compile (s : string) (debug : Instruct.debug_event list array) :
+      unit -> J.t =
+      let s = normalize_bytecode s in
+      let prims = Array.of_list (Ocaml_compiler.Symtable.all_primitives ()) in
+      let b = Buffer.create 100 in
+      let fmt = Pretty_print.to_buffer b in
+      Driver.configure fmt;
+      Driver.from_string ~prims ~debug s fmt;
+      Format.(pp_print_flush std_formatter ());
+      Format.(pp_print_flush err_formatter ());
+      flush stdout;
+      flush stderr;
+      let js = Buffer.contents b in
+      let res : string -> unit -> J.t =
+        Obj.magic (J.get global (J.string "toplevelEval"))
+      in
+      res (js : string)
+    in
+    let toplevel_eval (x : string) : unit -> J.t =
+      let f : J.t = J.eval_string x in
+      fun () ->
+        let res = J.fun_call f [| global |] in
+        Format.(pp_print_flush std_formatter ());
+        Format.(pp_print_flush err_formatter ());
+        flush stdout;
+        flush stderr;
+        res
+    in
+    let toc = get_bytecode_sections () in
+    let sym =
+      let t : Ocaml_compiler.Symtable.GlobalMap.t = toc.symb in
+      Ocaml_compiler.Symtable.GlobalMap.fold
+        (fun i n acc -> StringMap.add (Ocaml_compiler.Symtable.Global.name i) n acc)
+        t
+        StringMap.empty
+    in
+    let toplevel_reloc (name : J.t) : int =
+      let name = J.to_string name in
+      match StringMap.find_opt name sym with
+      | Some i -> i
+      | None -> Js_of_ocaml_compiler.Ocaml_compiler.Symtable.reloc_ident name
+    in
+    J.set global (J.string "toplevelCompile") (Obj.magic toplevel_compile) (*XXX HACK!*);
+    J.set global (J.string "toplevelEval") (Obj.magic toplevel_eval);
+    J.set global (J.string "toplevelReloc") (Obj.magic toplevel_reloc)
+end
 
 let setup = lazy (
-  let info = Toploop.{section="Learn-OCaml specific"; doc=""} in
-  Toploop.add_directive "enable"
-    (Toploop.Directive_string Config.Flag.enable) info;
-  Toploop.add_directive "disable"
-    (Toploop.Directive_string Config.Flag.disable) info;
-  Toploop.add_directive "debug_on"
-    (Toploop.Directive_string Debug.enable) info;
-  Toploop.add_directive "debug_off"
-    (Toploop.Directive_string Debug.disable) info;
-  Toploop.add_directive "tailcall"
-    (Toploop.Directive_string (Config.Param.set "tc")) info;
-  (* Workaround Marshal bug triggered by includemod.ml:607 *)
-  Clflags.error_size := 0 ;
-  (* Disable inlining of JSOO which may blow the JS stack *)
-  Config.Flag.disable "inline" ;
-  Topdirs.dir_directory "/cmis";
-  let initial_primitive_count =
-    Array.length (split_primitives (Symtable.data_primitive_names ())) in
-
-  let compile s =
-    let s = String.concat "" (Array.to_list s) in
-    let prims =
-      split_primitives (Symtable.data_primitive_names ()) in
-    let unbound_primitive p =
-      try ignore (Js.Unsafe.eval_string p); false with _ -> true in
-    let stubs = ref [] in
-    Array.iteri
-      (fun i p ->
-         if i >= initial_primitive_count && unbound_primitive p then
-           stubs :=
-             Format.sprintf
-               "function %s(){caml_failwith(\"%s not implemented\")}" p p
-             :: !stubs)
-      prims;
-    let output_program = Driver.from_string ~prims s in
-    let b = Buffer.create 100 in
-    output_program ~debug:[||] (Pretty_print.to_buffer b);
-    Format.(pp_print_flush std_formatter ());
-    Format.(pp_print_flush err_formatter ());
-    flush stdout; flush stderr;
-    let res = Buffer.contents b in
-    let res = String.concat "" !stubs ^ res in
-    Js.Unsafe.global##(toplevelEval res)
-  in
-  Js.Unsafe.global##.toplevelCompile := compile (*XXX HACK!*);
-  Js.Unsafe.global##.toplevelEval := (fun x ->
-      let f : < .. > Js.t -> < .. > Js.t = Js.Unsafe.eval_string x in
-      (fun () ->
-         let res = f Js.Unsafe.global in
-         Format.(pp_print_flush std_formatter ());
-         Format.(pp_print_flush err_formatter ());
-         flush stdout; flush stderr;
-         res));
-  Js.Unsafe.global##.toplevelReloc := Js.Unsafe.callback (fun name ->
-      let name = Js.to_string name in
-      Js_of_ocaml_compiler.Ocaml_compiler.Symtable.reloc_ident name);
-  ())
+  let module M = Jsoo_compiler_dynlink() in
+  M.init ()
+)
 
 let initialize cmi_dirs  =
   List.iter Topdirs.dir_directory cmi_dirs;
@@ -131,21 +155,7 @@ let stop_channel_redirection redir =
     fail ()
 
 let use_compiled_string code =
-  (* jsoo supports dynload, but relies on expectations on the parent object that
-     are no longer valid when running from a web-worker. Thus we compile with
-     `jsoo --wrap-with` and apply explicitely to the global object *)
-  let clean_code =
-    let b = Buffer.create (String.length code + 2) in
-    let i = String.rindex code '}' in
-    (* jsoo >=4 adds garbage after the fun def with --wrap-with *)
-    Buffer.add_char b '(';
-    Buffer.add_substring b code 0 (i+1);
-    Buffer.add_char b ')';
-    Buffer.contents b
-  in
-  ignore @@
-  Js.Unsafe.fun_call (Js.Unsafe.eval_string clean_code)
-    [|Js.Unsafe.inject Js.Unsafe.global|];
+  ignore (Js.Unsafe.eval_string code);
   Toploop_ext.register_pending_printers ()
 
 let () = Toploop_ext.set_inject_global_hook @@ fun id ->