Compiler: toplevel and dynlink, some cleanup

CHANGES.md

@@ -5,6 +5,9 @@
 * Compiler: complain when runtime and compiler built-in primitives disagree (#1312)
 * Compiler: more efficient implementation of Js_traverse.freevar
 * Compiler: more efficient implementation of Js_traverse.rename_variable
+* Compiler: --linkall now export all compilation units in addition to primitives (#1324)
+* Compiler: improve --dynlink, one no longer need to pass --toplevel to use Dynlink (#1324)
+* Compiler: toplevel runtime files "+toplevel.js" and "+dynlink.js" are added automatically (#1324)
 * Misc: switch to cmdliner.1.1.0
 * Misc: remove old binaries jsoo_link, jsoo_fs
 * Misc: remove uchar dep

compiler/bin-js_of_ocaml/build_fs.ml

@@ -77,7 +77,7 @@ function jsoo_create_file_extern(name,content){
         ~standalone:true
         ~wrap_with_fun:`Iife
         pfs_fmt
-        (Parse_bytecode.Debug.create ~toplevel:false false)
+        (Parse_bytecode.Debug.create ~include_cmis:false false)
         code)
 
 let info =

compiler/bin-js_of_ocaml/cmd_arg.ml

@@ -58,7 +58,7 @@ type t =
   ; linkall : bool
   ; toplevel : bool
   ; export_file : string option
-  ; nocmis : bool
+  ; no_cmis : bool
   ; (* filesystem *)
     include_dirs : string list
   ; fs_files : string list
@@ -180,22 +180,36 @@ let options =
       value & opt (enum options) Target_env.Isomorphic & info [ "target-env" ] ~docv ~doc)
   in
   let toplevel =
-    let doc = "Compile a toplevel." in
+    let doc =
+      "Compile a toplevel and embed necessary cmis (unless '--no-cmis' is provided). \
+       Exported compilation units can be configured with '--export'.  Note you you'll \
+       also need to link against js_of_ocaml-toplevel."
+    in
     Arg.(value & flag & info [ "toplevel" ] ~docs:toplevel_section ~doc)
   in
   let export_file =
-    let doc = "File containing the list of unit to export in a toplevel." in
+    let doc =
+      "File containing the list of unit to export in a toplevel, with Dynlink or with \
+       --linkall. If absent, all units will be exported."
+    in
     Arg.(value & opt (some string) None & info [ "export" ] ~docs:toplevel_section ~doc)
   in
-  let linkall =
-    let doc = "Link all primitives." in
-    Arg.(value & flag & info [ "linkall" ] ~doc)
-  in
   let dynlink =
-    let doc = "Enable dynlink." in
+    let doc =
+      "Enable dynlink of bytecode files.  Use this if you want to be able to use the \
+       Dynlink module. Note that you'll also need to link with \
+       'js_of_ocaml-compiler.dynlink'."
+    in
     Arg.(value & flag & info [ "dynlink" ] ~doc)
   in
-  let nocmis =
+  let linkall =
+    let doc =
+      "Link all primitives and compilation units. Exported compilation units can be \
+       configured with '--export'."
+    in
+    Arg.(value & flag & info [ "linkall" ] ~doc)
+  in
+  let no_cmis =
     let doc = "Do not include cmis when compiling toplevel." in
     Arg.(value & flag & info [ "nocmis"; "no-cmis" ] ~docs:toplevel_section ~doc)
   in
@@ -252,7 +266,7 @@ let options =
       fs_files
       fs_output
       fs_external
-      nocmis
+      no_cmis
       profile
       no_runtime
       runtime_only
@@ -273,8 +287,7 @@ let options =
       then runtime_files @ [ input_file ]
       else runtime_files
     in
-    let linkall = linkall || toplevel || runtime_only in
-    let fs_external = fs_external || (toplevel && nocmis) || runtime_only in
+    let fs_external = fs_external || (toplevel && no_cmis) || runtime_only in
     let input_file =
       match input_file, runtime_only with
       | "-", _ | _, true -> None
@@ -341,7 +354,7 @@ let options =
       ; fs_files
       ; fs_output
       ; fs_external
-      ; nocmis
+      ; no_cmis
       ; output_file
       ; input_file
       ; source_map
@@ -363,7 +376,7 @@ let options =
       $ fs_files
       $ fs_output
       $ fs_external
-      $ nocmis
+      $ no_cmis
       $ profile
       $ noruntime
       $ runtime_only
@@ -566,7 +579,7 @@ let options_runtime_only =
       ; fs_files
       ; fs_output
       ; fs_external
-      ; nocmis = true
+      ; no_cmis = true
       ; output_file
       ; input_file = None
       ; source_map

compiler/bin-js_of_ocaml/cmd_arg.mli

@@ -42,7 +42,7 @@ type t =
   ; linkall : bool
   ; toplevel : bool
   ; export_file : string option
-  ; nocmis : bool
+  ; no_cmis : bool
   ; (* filesystem *)
     include_dirs : string list
   ; fs_files : string list

compiler/bin-js_of_ocaml/compile.ml

@@ -43,7 +43,7 @@ let run
     ; linkall
     ; target_env
     ; toplevel
-    ; nocmis
+    ; no_cmis
     ; runtime_only
     ; include_dirs
     ; fs_files
@@ -52,7 +52,7 @@ let run
     ; export_file
     ; keep_unit_names
     } =
-  let dynlink = dynlink || toplevel || runtime_only in
+  let include_cmis = toplevel && not no_cmis in
   let custom_header = common.Jsoo_cmdline.Arg.custom_header in
   Jsoo_cmdline.Arg.eval common;
   (match output_file with
@@ -82,6 +82,13 @@ let run
         close_in ic;
         Some (Hashtbl.fold (fun cmi () acc -> cmi :: acc) t [])
   in
+  let runtime_files =
+    if toplevel || dynlink
+    then
+      let add_if_absent x l = if List.mem x ~set:l then l else x :: l in
+      runtime_files |> add_if_absent "+toplevel.js" |> add_if_absent "+dynlink.js"
+    else runtime_files
+  in
   let runtime_files, builtin =
     List.partition_map runtime_files ~f:(fun name ->
         match Builtins.find name with
@@ -114,7 +121,6 @@ let run
          %!"
   in
   let pseudo_fs_instr prim debug cmis =
-    let cmis = if nocmis then StringSet.empty else cmis in
     let paths =
       include_dirs @ StringSet.elements (Parse_bytecode.Debug.paths debug ~units:cmis)
     in
@@ -131,7 +137,7 @@ let run
           ; Let (Var.fresh (), Prim (Extern "caml_set_static_env", [ Pv var_k; Pv var_v ]))
           ])
   in
-  let output (one : Parse_bytecode.one) ~standalone output_file =
+  let output (one : Parse_bytecode.one) ~linkall ~standalone output_file =
     check_debug one;
     let init_pseudo_fs = fs_external && standalone in
     (match output_file with
@@ -150,7 +156,6 @@ let run
           ?profile
           ~linkall
           ~wrap_with_fun
-          ~dynlink
           ?source_map
           ?custom_header
           fmt
@@ -177,7 +182,6 @@ let run
               ?profile
               ~linkall
               ~wrap_with_fun
-              ~dynlink
               ?source_map
               ?custom_header
               fmt
@@ -198,15 +202,18 @@ let run
                   code)));
     if times () then Format.eprintf "compilation: %a@." Timer.print t
   in
+  let output_partial code output_file =
+    output code ~standalone:false ~linkall:false output_file
+  in
   (if runtime_only
   then
     let code : Parse_bytecode.one =
       { code = Parse_bytecode.predefined_exceptions ()
       ; cmis = StringSet.empty
-      ; debug = Parse_bytecode.Debug.create ~toplevel:false false
+      ; debug = Parse_bytecode.Debug.create ~include_cmis:false false
       }
     in
-    output code ~standalone:true (fst output_file)
+    output code ~standalone:true ~linkall:true (fst output_file)
   else
     let kind, ic, close_ic, include_dirs =
       match input_file with
@@ -220,17 +227,25 @@ let run
     (match kind with
     | `Exe ->
         let t1 = Timer.make () in
+        (* The OCaml compiler can generate code using the
+           "caml_string_greaterthan" primitive but does not use it
+           itself. This is (was at some point at least) the only primitive
+           in this case.  Ideally, Js_of_ocaml should parse the .mli files
+           for primitives as well as marking this primitive as potentially
+           used. But the -linkall option is probably good enough. *)
+        let linkall = linkall || toplevel || dynlink in
         let code =
           Parse_bytecode.from_exe
             ~includes:include_dirs
-            ~toplevel
+            ~include_cmis
+            ~link_info:(toplevel || dynlink)
+            ~linkall
             ?exported_unit
-            ~dynlink
             ~debug:need_debug
             ic
         in
         if times () then Format.eprintf "  parsing: %a@." Timer.print t1;
-        output code ~standalone:true (fst output_file)
+        output code ~standalone:true ~linkall (fst output_file)
     | `Cmo cmo ->
         let output_file =
           match output_file, keep_unit_names with
@@ -248,13 +263,13 @@ let run
         let code =
           Parse_bytecode.from_cmo
             ~includes:include_dirs
-            ~toplevel
+            ~include_cmis
             ~debug:need_debug
             cmo
             ic
         in
         if times () then Format.eprintf "  parsing: %a@." Timer.print t1;
-        output code ~standalone:false output_file
+        output_partial code output_file
     | `Cma cma when keep_unit_names ->
         List.iter cma.lib_units ~f:(fun cmo ->
             let output_file =
@@ -271,26 +286,26 @@ let run
             let code =
               Parse_bytecode.from_cmo
                 ~includes:include_dirs
-                ~toplevel
+                ~include_cmis
                 ~debug:need_debug
                 cmo
                 ic
             in
             if times ()
             then Format.eprintf "  parsing: %a (%s)@." Timer.print t1 cmo.cu_name;
-            output code ~standalone:false output_file)
+            output_partial code output_file)
     | `Cma cma ->
         let t1 = Timer.make () in
         let code =
           Parse_bytecode.from_cma
             ~includes:include_dirs
-            ~toplevel
+            ~include_cmis
             ~debug:need_debug
             cma
             ic
         in
         if times () then Format.eprintf "  parsing: %a@." Timer.print t1;
-        output code ~standalone:false (fst output_file));
+        output_partial code (fst output_file));
     close_ic ());
   Debug.stop_profiling ()
 

compiler/lib-dynlink/dune

@@ -0,0 +1,9 @@
+(library
+ (name js_of_ocaml_compiler_dynlink)
+ (public_name js_of_ocaml-compiler.dynlink)
+ (synopsis "Js_of_ocaml compiler dynlink support")
+ (library_flags (-linkall))
+ (libraries
+  js_of_ocaml-compiler
+  js_of_ocaml-compiler.runtime
+  compiler-libs.bytecomp))

compiler/lib-dynlink/js_of_ocaml_compiler_dynlink.ml

@@ -0,0 +1,70 @@
+open Js_of_ocaml_compiler.Stdlib
+open Js_of_ocaml_compiler
+module J = Jsoo_runtime.Js
+
+let split_primitives p =
+  let len = String.length p in
+  let rec split beg cur =
+    if cur >= len
+    then []
+    else if Char.equal p.[cur] '\000'
+    then String.sub p ~pos:beg ~len:(cur - beg) :: split (cur + 1) (cur + 1)
+    else split beg (cur + 1)
+  in
+  Array.of_list (split 0 0)
+
+let () =
+  let global = J.pure_js_expr "globalThis" in
+  let initial_primitive_count =
+    Array.length (split_primitives (Symtable.data_primitive_names ()))
+  in
+  (* this needs to stay synchronized with toplevel.js *)
+  let toplevel_compile (s : bytes array) : unit -> J.t =
+    let s = String.concat ~sep:"" (List.map ~f:Bytes.to_string (Array.to_list s)) in
+    let prims = split_primitives (Symtable.data_primitive_names ()) in
+    let unbound_primitive p =
+      try
+        ignore (J.eval_string p);
+        false
+      with _ -> true
+    in
+    let stubs = ref [] in
+    Array.iteri prims ~f:(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);
+    let output_program = Driver.from_string prims s in
+    let b = Buffer.create 100 in
+    output_program (Pretty_print.to_buffer b);
+    Format.(pp_print_flush std_formatter ());
+    Format.(pp_print_flush err_formatter ());
+    flush stdout;
+    flush stderr;
+    let js =
+      let s = Buffer.contents b in
+      String.concat ~sep:"" !stubs ^ s
+    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.t = J.eval_string x in
+    fun () ->
+      let res = f global in
+      Format.(pp_print_flush std_formatter ());
+      Format.(pp_print_flush err_formatter ());
+      flush stdout;
+      flush stderr;
+      res
+  in
+  let toplevel_reloc (name : J.t) : int =
+    let name = J.to_string name in
+    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)

compiler/lib-dynlink/js_of_ocaml_compiler_dynlink.mli

@@ -0,0 +1,20 @@
+(* Js_of_ocaml library
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2022 Hugo Heuzard
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+(** Deliberately empty *)