From a441085ef526f0494c16ed56f4f5d38dadaa1b7f Mon Sep 17 00:00:00 2001 From: Hugo Heuzard Date: Wed, 7 Sep 2022 13:09:21 +0200 Subject: [PATCH 1/7] Misc: Removes bytes from dune files --- compiler/lib/dune | 1 - lib/deriving_json/dune | 2 +- lib/js_of_ocaml/dune | 2 +- toplevel/bin/dune | 1 - toplevel/examples/server/dune | 2 +- toplevel/lib/dune | 1 - 6 files changed, 3 insertions(+), 6 deletions(-) diff --git a/compiler/lib/dune b/compiler/lib/dune index 2fefafb3d0..87943f381c 100644 --- a/compiler/lib/dune +++ b/compiler/lib/dune @@ -5,7 +5,6 @@ (libraries compiler-libs.common compiler-libs.bytecomp - bytes menhirLib (select source_map_io.ml diff --git a/lib/deriving_json/dune b/lib/deriving_json/dune index 645f73e3bb..a6399bcb3d 100644 --- a/lib/deriving_json/dune +++ b/lib/deriving_json/dune @@ -2,7 +2,7 @@ (name js_of_ocaml_deriving) (public_name js_of_ocaml.deriving) (synopsis "Runtime library for the class Json.") - (libraries bytes) + (libraries) (wrapped false)) (ocamllex deriving_Json_lexer) diff --git a/lib/js_of_ocaml/dune b/lib/js_of_ocaml/dune index d17cc3568e..df22bcb59a 100644 --- a/lib/js_of_ocaml/dune +++ b/lib/js_of_ocaml/dune @@ -1,7 +1,7 @@ (library (name js_of_ocaml) (public_name js_of_ocaml) - (libraries bytes js_of_ocaml-compiler.runtime) + (libraries js_of_ocaml-compiler.runtime) (foreign_stubs (language c) (names js_of_ocaml_stubs)) diff --git a/toplevel/bin/dune b/toplevel/bin/dune index d816315fab..a236488243 100644 --- a/toplevel/bin/dune +++ b/toplevel/bin/dune @@ -3,7 +3,6 @@ (public_names jsoo_mkcmis jsoo_mktop jsoo_listunits) (package js_of_ocaml-toplevel) (libraries - bytes js_of_ocaml-compiler js_of_ocaml-compiler.findlib-support js_of_ocaml-compiler.runtime-files)) diff --git a/toplevel/examples/server/dune b/toplevel/examples/server/dune index 53bd782fd7..f91c10f68a 100644 --- a/toplevel/examples/server/dune +++ b/toplevel/examples/server/dune @@ -1,3 +1,3 @@ (executables (names server) - (libraries bytes findlib cohttp-lwt-unix)) + (libraries findlib cohttp-lwt-unix)) diff --git a/toplevel/lib/dune b/toplevel/lib/dune index 0e04061d35..c329279297 100644 --- a/toplevel/lib/dune +++ b/toplevel/lib/dune @@ -5,7 +5,6 @@ (libraries js_of_ocaml-compiler js_of_ocaml - bytes compiler-libs.bytecomp compiler-libs.toplevel) (preprocess From 6291094867fffe8e54a51883de35fb42b9bd30a0 Mon Sep 17 00:00:00 2001 From: Hugo Heuzard Date: Wed, 7 Sep 2022 14:30:02 +0200 Subject: [PATCH 2/7] Compiler: add support for primitive alias --- compiler/lib/annot_lexer.mll | 3 ++- compiler/lib/annot_parser.mly | 17 ++++++++--------- compiler/lib/linker.ml | 12 ++++++++++++ compiler/lib/parse_js.ml | 1 + compiler/lib/primitive.ml | 1 + compiler/lib/primitive.mli | 1 + 6 files changed, 25 insertions(+), 10 deletions(-) diff --git a/compiler/lib/annot_lexer.mll b/compiler/lib/annot_lexer.mll index 2c8eba287b..7f4a54862a 100644 --- a/compiler/lib/annot_lexer.mll +++ b/compiler/lib/annot_lexer.mll @@ -27,6 +27,7 @@ rule main = parse | "Weakdef" {TWeakdef} | "Always" {TAlways} | "If" {TIf} + | "Alias" {TAlias} | "pure" {TA_Pure } | "const" {TA_Const } | "mutable" {TA_Mutable } @@ -43,7 +44,7 @@ rule main = parse | "(" {LPARENT} | ")" {RPARENT} | "," {TComma} - | ":" {TSemi} + | ":" {TColon} | "<=" {LE} | "<" {LT} | ">" {GT} diff --git a/compiler/lib/annot_parser.mly b/compiler/lib/annot_parser.mly index 308b73ca1e..1e67629828 100644 --- a/compiler/lib/annot_parser.mly +++ b/compiler/lib/annot_parser.mly @@ -17,10 +17,10 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -%token TProvides TRequires TVersion TWeakdef TIf TAlways +%token TProvides TRequires TVersion TWeakdef TIf TAlways TAlias %token TA_Pure TA_Const TA_Mutable TA_Mutator TA_Shallow TA_Object_literal %token TIdent TVNum -%token TComma TSemi EOF EOL LE LT GE GT EQ LPARENT RPARENT +%token TComma TColon EOF EOL LE LT GE GT EQ LPARENT RPARENT %token TOTHER %token TBang @@ -30,20 +30,19 @@ %% annot: - | TProvides TSemi id=TIdent opt=option(prim_annot) + | TProvides TColon id=TIdent opt=option(prim_annot) args=option(delimited(LPARENT, separated_list(TComma,arg_annot),RPARENT)) endline { `Provides (id,(match opt with None -> `Mutator | Some k -> k),args) } - | TRequires TSemi l=separated_nonempty_list(TComma,TIdent) endline + | TRequires TColon l=separated_nonempty_list(TComma,TIdent) endline { `Requires (l) } - | TVersion TSemi l=separated_nonempty_list(TComma,version) endline + | TVersion TColon l=separated_nonempty_list(TComma,version) endline { `Version (l) } | TWeakdef endline { `Weakdef } | TAlways endline { `Always } - | TIf TSemi name=TIdent endline - { `If (name) } - | TIf TSemi TBang name=TIdent endline - { `Ifnot (name) } + | TAlias TColon name=TIdent endline { `Alias (name) } + | TIf TColon name=TIdent endline { `If (name) } + | TIf TColon TBang name=TIdent endline { `Ifnot (name) } prim_annot: | TA_Pure {`Pure} | TA_Const {`Pure} diff --git a/compiler/lib/linker.ml b/compiler/lib/linker.ml index 098664d2bd..652643b759 100644 --- a/compiler/lib/linker.ml +++ b/compiler/lib/linker.ml @@ -144,6 +144,7 @@ module Fragment = struct ; code : Javascript.program ; js_string : bool option ; fragment_target : Target_env.t option + ; aliases : StringSet.t } type t = @@ -227,6 +228,7 @@ module Fragment = struct ; code ; js_string = None ; fragment_target = None + ; aliases = StringSet.empty } in let fragment = @@ -255,6 +257,8 @@ module Fragment = struct } | `Weakdef -> { fragment with weakdef = true } | `Always -> { fragment with always = true } + | `Alias name -> + { fragment with aliases = StringSet.add name fragment.aliases } | (`Ifnot "js-string" | `If "js-string") as i -> let b = match i with @@ -391,6 +395,7 @@ let load_fragment ~target_env ~filename (f : Fragment.t) = ; code ; js_string ; fragment_target + ; aliases } -> ( let ignore_because_of_js_string = match js_string, Config.Flag.use_js_string () with @@ -402,6 +407,12 @@ let load_fragment ~target_env ~filename (f : Fragment.t) = else match provides with | None -> + if not (StringSet.is_empty aliases) + then + error + "Found JavaScript code with neither `//Alias` and not `//Provides` in \ + file %S@." + filename; if always then ( always_included := @@ -468,6 +479,7 @@ let load_fragment ~target_env ~filename (f : Fragment.t) = Hashtbl.add provided name { id; pi; weakdef; target_env = fragment_target }; Hashtbl.add provided_rev id (name, pi); Hashtbl.add code_pieces id (code, requires); + StringSet.iter (fun alias -> Primitive.alias alias name) aliases; `Ok) let get_provided () = diff --git a/compiler/lib/parse_js.ml b/compiler/lib/parse_js.ml index 18ef34edbb..ed51ea8e49 100644 --- a/compiler/lib/parse_js.ml +++ b/compiler/lib/parse_js.ml @@ -73,6 +73,7 @@ let parse_aux the_parser lexbuf = | `Always -> Some `Always | `If name -> Some (`If name) | `Ifnot name -> Some (`Ifnot name) + | `Alias name -> Some (`Alias name) with | Not_found -> None | _ -> None) diff --git a/compiler/lib/primitive.ml b/compiler/lib/primitive.ml index d628371aa0..8075c4da9e 100644 --- a/compiler/lib/primitive.ml +++ b/compiler/lib/primitive.ml @@ -49,6 +49,7 @@ type t = | `Version of ((int -> int -> bool) * string) list | `Weakdef | `Always + | `Alias of string | condition ] diff --git a/compiler/lib/primitive.mli b/compiler/lib/primitive.mli index 6f0aafb3ce..bca09fa0ad 100644 --- a/compiler/lib/primitive.mli +++ b/compiler/lib/primitive.mli @@ -47,6 +47,7 @@ type t = | `Version of ((int -> int -> bool) * string) list | `Weakdef | `Always + | `Alias of string | condition ] From 15c87c4c734a73a38dcea5e73e7035a1f861f02f Mon Sep 17 00:00:00 2001 From: Hugo Heuzard Date: Wed, 7 Sep 2022 14:47:27 +0200 Subject: [PATCH 3/7] Runtime: start using aliases --- compiler/tests-check-prim/main.output | 59 +++--- compiler/tests-check-prim/unix-unix.output | 36 +++- compiler/tests-check-prim/unix-win32.output | 32 ++- compiler/tests-compiler/unix_fs.ml | 20 +- runtime/io.js | 5 +- runtime/mlBytes.js | 5 +- runtime/sys.js | 4 - runtime/unix.js | 213 ++++++++++++-------- runtime/weak.js | 21 +- 9 files changed, 231 insertions(+), 164 deletions(-) diff --git a/compiler/tests-check-prim/main.output b/compiler/tests-check-prim/main.output index a640f7fce6..5a4200fc60 100644 --- a/compiler/tests-check-prim/main.output +++ b/compiler/tests-check-prim/main.output @@ -137,7 +137,6 @@ caml_mod From +io.js: caml_input_value_to_outside_heap -win_filedescr_of_channel From +jslib.js: caml_is_js @@ -205,35 +204,35 @@ caml_register_channel_for_spacetime caml_set_static_env caml_spacetime_enabled caml_spacetime_only_works_for_native_code -unix_inet_addr_of_string From +unix.js: -unix_closedir -unix_getpwuid -unix_gettimeofday -unix_getuid -unix_gmtime -unix_has_symlink -unix_isatty -unix_localtime -unix_lstat -unix_lstat_64 -unix_mkdir -unix_mktime -unix_opendir -unix_readdir -unix_readlink -unix_rewinddir -unix_rmdir -unix_stat -unix_stat_64 -unix_symlink -unix_time -unix_unlink -win_cleanup -win_findclose -win_findfirst -win_findnext -win_handle_fd -win_startup +caml_unix_cleanup +caml_unix_closedir +caml_unix_filedescr_of_fd +caml_unix_findclose +caml_unix_findfirst +caml_unix_findnext +caml_unix_getpwuid +caml_unix_gettimeofday +caml_unix_getuid +caml_unix_gmtime +caml_unix_has_symlink +caml_unix_inet_addr_of_string +caml_unix_isatty +caml_unix_localtime +caml_unix_lstat +caml_unix_lstat_64 +caml_unix_mkdir +caml_unix_mktime +caml_unix_opendir +caml_unix_readdir +caml_unix_readlink +caml_unix_rewinddir +caml_unix_rmdir +caml_unix_startup +caml_unix_stat +caml_unix_stat_64 +caml_unix_symlink +caml_unix_time +caml_unix_unlink diff --git a/compiler/tests-check-prim/unix-unix.output b/compiler/tests-check-prim/unix-unix.output index f748c435c8..45a8a9f953 100644 --- a/compiler/tests-check-prim/unix-unix.output +++ b/compiler/tests-check-prim/unix-unix.output @@ -246,7 +246,6 @@ caml_mod From +io.js: caml_input_value_to_outside_heap -win_filedescr_of_channel From +jslib.js: caml_is_js @@ -316,10 +315,33 @@ caml_spacetime_enabled caml_spacetime_only_works_for_native_code From +unix.js: -win_cleanup -win_findclose -win_findfirst -win_findnext -win_handle_fd -win_startup +caml_unix_cleanup +caml_unix_closedir +caml_unix_filedescr_of_fd +caml_unix_findclose +caml_unix_findfirst +caml_unix_findnext +caml_unix_getpwuid +caml_unix_gettimeofday +caml_unix_getuid +caml_unix_gmtime +caml_unix_has_symlink +caml_unix_inet_addr_of_string +caml_unix_isatty +caml_unix_localtime +caml_unix_lstat +caml_unix_lstat_64 +caml_unix_mkdir +caml_unix_mktime +caml_unix_opendir +caml_unix_readdir +caml_unix_readlink +caml_unix_rewinddir +caml_unix_rmdir +caml_unix_startup +caml_unix_stat +caml_unix_stat_64 +caml_unix_symlink +caml_unix_time +caml_unix_unlink diff --git a/compiler/tests-check-prim/unix-win32.output b/compiler/tests-check-prim/unix-win32.output index 1855d23780..0733201ac7 100644 --- a/compiler/tests-check-prim/unix-win32.output +++ b/compiler/tests-check-prim/unix-win32.output @@ -280,7 +280,33 @@ caml_spacetime_enabled caml_spacetime_only_works_for_native_code From +unix.js: -unix_getpwuid -unix_getuid -unix_rewinddir +caml_unix_cleanup +caml_unix_closedir +caml_unix_filedescr_of_fd +caml_unix_findclose +caml_unix_findfirst +caml_unix_findnext +caml_unix_getpwuid +caml_unix_gettimeofday +caml_unix_getuid +caml_unix_gmtime +caml_unix_has_symlink +caml_unix_inet_addr_of_string +caml_unix_isatty +caml_unix_localtime +caml_unix_lstat +caml_unix_lstat_64 +caml_unix_mkdir +caml_unix_mktime +caml_unix_opendir +caml_unix_readdir +caml_unix_readlink +caml_unix_rewinddir +caml_unix_rmdir +caml_unix_startup +caml_unix_stat +caml_unix_stat_64 +caml_unix_symlink +caml_unix_time +caml_unix_unlink diff --git a/compiler/tests-compiler/unix_fs.ml b/compiler/tests-compiler/unix_fs.ml index 349d8e3612..65f4814e21 100644 --- a/compiler/tests-compiler/unix_fs.ml +++ b/compiler/tests-compiler/unix_fs.ml @@ -136,7 +136,7 @@ in f (); Sys.chdir "/static"; f () |}; [%expect {| File size: 3 - Failure("unix_stat: not implemented")|}] + Failure("caml_unix_stat: not implemented")|}] let%expect_test "Unix.stat_dir" = compile_and_run @@ -153,7 +153,7 @@ in f (); Sys.chdir "/static"; f () |}; [%expect {| Found dir - Failure("unix_stat: not implemented")|}] + Failure("caml_unix_stat: not implemented")|}] let%expect_test "Unix.stat_symlink" = compile_and_run @@ -179,8 +179,8 @@ f (); Sys.chdir "/static"; f () |}; [%expect {| File size: 3 - Failure("unix_symlink: not implemented") - Failure("unix_stat: not implemented")|}] + Failure("caml_unix_symlink: not implemented") + Failure("caml_unix_stat: not implemented")|}] let%expect_test "Unix.symlink_Unix.readlink" = compile_and_run @@ -206,8 +206,8 @@ f (); Sys.chdir "/static"; f () |}; [%expect {| bbb - Failure("unix_symlink: not implemented") - Failure("unix_readlink: not implemented")|}] + Failure("caml_unix_symlink: not implemented") + Failure("caml_unix_readlink: not implemented")|}] let%expect_test "Unix.readlink_EINVAL" = compile_and_run @@ -225,7 +225,7 @@ in f (); Sys.chdir "/static"; f () |}; [%expect {| EXPECTED ERROR - Failure("unix_readlink: not implemented")|}] + Failure("caml_unix_readlink: not implemented")|}] let%expect_test "Unix.lstat_file" = compile_and_run @@ -247,7 +247,7 @@ in f (); Sys.chdir "/static"; f () |}; [%expect {| File size: 3 - Failure("unix_lstat: not implemented")|}] + Failure("caml_unix_lstat: not implemented")|}] let%expect_test "Unix.lstat_symlink" = compile_and_run @@ -270,8 +270,8 @@ f (); Sys.chdir "/static"; f () |}; [%expect {| Found link - Failure("unix_symlink: not implemented") - Failure("unix_lstat: not implemented")|}] + Failure("caml_unix_symlink: not implemented") + Failure("caml_unix_lstat: not implemented")|}] let%expect_test "Unix.opendir" = compile_and_run diff --git a/runtime/io.js b/runtime/io.js index ff85118ccd..7ce05a26ad 100644 --- a/runtime/io.js +++ b/runtime/io.js @@ -158,15 +158,12 @@ function caml_ml_open_descriptor_in (fd) { //Provides: caml_channel_descriptor //Requires: caml_ml_channels +//Alias: win_filedescr_of_channel function caml_channel_descriptor(chanid){ var chan = caml_ml_channels[chanid]; return chan.fd; } -//Provides: win_filedescr_of_channel -//Requires: caml_channel_descriptor -var win_filedescr_of_channel = caml_channel_descriptor - //Provides: caml_ml_set_binary_mode //Requires: caml_ml_channels function caml_ml_set_binary_mode(chanid,mode){ diff --git a/runtime/mlBytes.js b/runtime/mlBytes.js index 8ee7ff288d..c6dbf95e3e 100644 --- a/runtime/mlBytes.js +++ b/runtime/mlBytes.js @@ -583,6 +583,7 @@ function caml_bytes_greaterthan(s1, s2) { //Provides: caml_fill_bytes //Requires: caml_str_repeat, caml_convert_bytes_to_array +//Alias: caml_fill_string function caml_fill_bytes(s, i, l, c) { if (l > 0) { if (i == 0 && (l >= s.l || (s.t == 2 /* PARTIAL */ && l >= s.c.length))) { @@ -601,10 +602,6 @@ function caml_fill_bytes(s, i, l, c) { return 0; } -//Provides: caml_fill_string -//Requires: caml_fill_bytes -var caml_fill_string = caml_fill_bytes - //Provides: caml_blit_bytes //Requires: caml_subarray_to_jsbytes, caml_convert_bytes_to_array function caml_blit_bytes(s1, i1, s2, i2, len) { diff --git a/runtime/sys.js b/runtime/sys.js index 0bd91de58e..bf27215df5 100644 --- a/runtime/sys.js +++ b/runtime/sys.js @@ -301,10 +301,6 @@ function caml_runtime_parameters(_unit) { //Provides: caml_install_signal_handler const function caml_install_signal_handler(){return 0} -//Provides: unix_inet_addr_of_string -function unix_inet_addr_of_string () {return 0;} - - //Provides: caml_runtime_warnings var caml_runtime_warnings = 0; diff --git a/runtime/unix.js b/runtime/unix.js index 3fd2e66425..5371c02798 100644 --- a/runtime/unix.js +++ b/runtime/unix.js @@ -1,16 +1,19 @@ -//Provides: unix_gettimeofday -function unix_gettimeofday () { +//Provides: caml_unix_gettimeofday +//Alias: unix_gettimeofday +function caml_unix_gettimeofday () { return (new Date()).getTime() / 1000; } -//Provides: unix_time -//Requires: unix_gettimeofday -function unix_time () { - return Math.floor(unix_gettimeofday ()); +//Provides: caml_unix_time +//Requires: caml_unix_gettimeofday +//Alias: unix_time +function caml_unix_time () { + return Math.floor(caml_unix_gettimeofday ()); } -//Provides: unix_gmtime -function unix_gmtime (t) { +//Provides: caml_unix_gmtime +//Alias: unix_gmtime +function caml_unix_gmtime (t) { var d = new Date (t * 1000); var d_num = d.getTime(); var januaryfirst = (new Date(Date.UTC(d.getUTCFullYear(), 0, 1))).getTime(); @@ -21,8 +24,9 @@ function unix_gmtime (t) { false | 0 /* for UTC daylight savings time is false */) } -//Provides: unix_localtime -function unix_localtime (t) { +//Provides: caml_unix_localtime +//Alias: unix_localtime +function caml_unix_localtime (t) { var d = new Date (t * 1000); var d_num = d.getTime(); var januaryfirst = (new Date(d.getFullYear(), 0, 1)).getTime(); @@ -36,27 +40,31 @@ function unix_localtime (t) { (d.getTimezoneOffset() < stdTimezoneOffset) | 0 /* daylight savings time field. */) } -//Provides: unix_mktime -//Requires: unix_localtime -function unix_mktime(tm){ +//Provides: caml_unix_mktime +//Requires: caml_unix_localtime +//Alias: unix_mktime +function caml_unix_mktime(tm){ var d = (new Date(tm[6]+1900,tm[5],tm[4],tm[3],tm[2],tm[1])).getTime(); var t = Math.floor(d / 1000); - var tm2 = unix_localtime(t); + var tm2 = caml_unix_localtime(t); return BLOCK(0,t,tm2); } +//Provides: caml_unix_startup const +//Alias: win_startup +function caml_unix_startup() {} -//Provides: win_startup const -function win_startup() {} +//Provides: caml_unix_cleanup const +//Alias: win_cleanup +function caml_unix_cleanup() {} -//Provides: win_cleanup const -function win_cleanup() {} +//Provides: caml_unix_filedescr_of_fd const +//Alias: win_handle_fd +function caml_unix_filedescr_of_fd(x) {return x;} -//Provides: win_handle_fd const -function win_handle_fd(x) {return x;} - -//Provides: unix_isatty +//Provides: caml_unix_isatty //Requires: fs_node_supported -function unix_isatty(fileDescriptor) { +//Alias: unix_isatty +function caml_unix_isatty(fileDescriptor) { if(fs_node_supported()) { var tty = require('tty'); return tty.isatty(fileDescriptor)?1:0; @@ -66,9 +74,10 @@ function unix_isatty(fileDescriptor) { } -//Provides: unix_isatty +//Provides: caml_unix_isatty +//Alias: unix_isatty //If: browser -function unix_isatty(fileDescriptor) { +function caml_unix_isatty(fileDescriptor) { return 0; } @@ -109,124 +118,146 @@ function make_unix_err_args(code, syscall, path, errno) { return args; } -//Provides: unix_stat +//Provides: caml_unix_stat //Requires: resolve_fs_device, caml_failwith -function unix_stat(name) { +//Alias: unix_stat +function caml_unix_stat(name) { var root = resolve_fs_device(name); if (!root.device.stat) { - caml_failwith("unix_stat: not implemented"); + caml_failwith("caml_unix_stat: not implemented"); } return root.device.stat(root.rest, /* raise Unix_error */ true); } -//Provides: unix_stat_64 -//Requires: unix_stat -var unix_stat_64 = unix_stat; -//Provides: unix_lstat + +//Provides: caml_unix_stat_64 +//Requires: caml_unix_stat, caml_int64_of_int32 +//Alias: unix_stat_64 +function caml_unix_stat_64(name) { + var r = caml_unix_stat(name); + r[9] = caml_int64_of_int32(r[9]); +} + +//Provides: caml_unix_lstat //Requires: resolve_fs_device, caml_failwith -function unix_lstat(name) { +//Alias: unix_lstat +function caml_unix_lstat(name) { var root = resolve_fs_device(name); if (!root.device.lstat) { - caml_failwith("unix_lstat: not implemented"); + caml_failwith("caml_unix_lstat: not implemented"); } return root.device.lstat(root.rest, /* raise Unix_error */ true); } -//Provides: unix_lstat_64 -//Requires: unix_lstat -var unix_lstat_64 = unix_lstat; +//Provides: caml_unix_lstat_64 +//Requires: caml_unix_lstat, caml_int64_of_int32 +//Alias: unix_lstat_64 +function caml_unix_lstat_64(name) { + var r = caml_unix_lstat(name); + r[9] = caml_int64_of_int32(r[9]); +} -//Provides: unix_mkdir +//Provides: caml_unix_mkdir //Requires: resolve_fs_device, caml_failwith -function unix_mkdir(name, perm) { +//Alias: unix_mkdir +function caml_unix_mkdir(name, perm) { var root = resolve_fs_device(name); if (!root.device.mkdir) { - caml_failwith("unix_mkdir: not implemented"); + caml_failwith("caml_unix_mkdir: not implemented"); } return root.device.mkdir(root.rest, perm, /* raise Unix_error */ true); } -//Provides: unix_rmdir +//Provides: caml_unix_rmdir //Requires: resolve_fs_device, caml_failwith -function unix_rmdir(name) { +//Alias: unix_rmdir +function caml_unix_rmdir(name) { var root = resolve_fs_device(name); if (!root.device.rmdir) { - caml_failwith("unix_rmdir: not implemented"); + caml_failwith("caml_unix_rmdir: not implemented"); } return root.device.rmdir(root.rest, /* raise Unix_error */ true); } -//Provides: unix_symlink +//Provides: caml_unix_symlink //Requires: resolve_fs_device, caml_failwith -function unix_symlink(to_dir, src, dst) { +//Alias: unix_symlink +function caml_unix_symlink(to_dir, src, dst) { var src_root = resolve_fs_device(src); var dst_root = resolve_fs_device(dst); if(src_root.device != dst_root.device) - caml_failwith("unix_symlink: cannot symlink between two filesystems"); + caml_failwith("caml_unix_symlink: cannot symlink between two filesystems"); if (!src_root.device.symlink) { - caml_failwith("unix_symlink: not implemented"); + caml_failwith("caml_unix_symlink: not implemented"); } return src_root.device.symlink(to_dir, src_root.rest, dst_root.rest, /* raise Unix_error */ true); } -//Provides: unix_readlink +//Provides: caml_unix_readlink //Requires: resolve_fs_device, caml_failwith -function unix_readlink(name) { +//Alias: unix_readlink +function caml_unix_readlink(name) { var root = resolve_fs_device(name); if (!root.device.readlink) { - caml_failwith("unix_readlink: not implemented"); + caml_failwith("caml_unix_readlink: not implemented"); } return root.device.readlink(root.rest, /* raise Unix_error */ true); } -//Provides: unix_unlink +//Provides: caml_unix_unlink //Requires: resolve_fs_device, caml_failwith -function unix_unlink(name) { +//Alias: unix_unlink +function caml_unix_unlink(name) { var root = resolve_fs_device(name); if (!root.device.unlink) { - caml_failwith("unix_unlink: not implemented"); + caml_failwith("caml_unix_unlink: not implemented"); } return root.device.unlink(root.rest, /* raise Unix_error */ true); } -//Provides: unix_getuid +//Provides: caml_unix_getuid //Requires: caml_raise_not_found -function unix_getuid(unit) { +//Alias: unix_getuid +function caml_unix_getuid(unit) { if(globalThis.process && globalThis.process.getuid){ return globalThis.process.getuid(); } caml_raise_not_found(); } -//Provides: unix_getpwuid +//Provides: caml_unix_getpwuid //Requires: caml_raise_not_found -function unix_getpwuid(unit) { - caml_raise_not_found() +//Alias: unix_getpwuid +function caml_unix_getpwuid(unit) { + caml_raise_not_found(); } -//Provides: unix_has_symlink +//Provides: caml_unix_has_symlink //Requires: fs_node_supported -function unix_has_symlink(unit) { +//Alias: unix_has_symlink +function caml_unix_has_symlink(unit) { return fs_node_supported()?1:0 } -//Provides: unix_opendir +//Provides: caml_unix_opendir //Requires: resolve_fs_device, caml_failwith -function unix_opendir(path) { +//Alias: unix_opendir +function caml_unix_opendir(path) { var root = resolve_fs_device(path); if (!root.device.opendir) { - caml_failwith("unix_opendir: not implemented"); + caml_failwith("caml_unix_opendir: not implemented"); } var dir_handle = root.device.opendir(root.rest, /* raise Unix_error */ true); return { pointer : dir_handle, path: path } } -//Provides: unix_readdir +//Provides: caml_unix_readdir //Requires: caml_raise_end_of_file //Requires: caml_string_of_jsstring //Requires: make_unix_err_args, caml_raise_with_args, caml_named_value -function unix_readdir(dir_handle) { +//Alias: unix_readdir +function caml_unix_readdir(dir_handle) { var entry; try { entry = dir_handle.pointer.readSync(); @@ -241,9 +272,10 @@ function unix_readdir(dir_handle) { } } -//Provides: unix_closedir +//Provides: caml_unix_closedir //Requires: make_unix_err_args, caml_raise_with_args, caml_named_value -function unix_closedir(dir_handle) { +//Alias: unix_closedir +function caml_unix_closedir(dir_handle) { try { dir_handle.pointer.closeSync(); } catch (e) { @@ -252,38 +284,49 @@ function unix_closedir(dir_handle) { } } -//Provides: unix_rewinddir -//Requires: unix_closedir, unix_opendir -function unix_rewinddir(dir_handle) { - unix_closedir(dir_handle); - var new_dir_handle = unix_opendir(dir_handle.path); +//Provides: caml_unix_rewinddir +//Requires: caml_unix_closedir, caml_unix_opendir +//Alias: unix_rewinddir +function caml_unix_rewinddir(dir_handle) { + caml_unix_closedir(dir_handle); + var new_dir_handle = caml_unix_opendir(dir_handle.path); dir_handle.pointer = new_dir_handle.pointer; return 0; } -//Provides: win_findfirst +//Provides: caml_unix_findfirst //Requires: caml_jsstring_of_string, caml_string_of_jsstring -//Requires: unix_opendir, unix_readdir -function win_findfirst(path) { +//Requires: caml_unix_opendir, caml_unix_readdir +//Alias: win_findfirst +function caml_unix_findfirst(path) { // The Windows code adds this glob to the path, so we need to remove it var path_js = caml_jsstring_of_string(path); path_js = path_js.replace(/(^|[\\\/])\*\.\*$/, ""); path = caml_string_of_jsstring(path_js); // *.* is now stripped - var dir_handle = unix_opendir(path); - var first_entry = unix_readdir(dir_handle); + var dir_handle = caml_unix_opendir(path); + var first_entry = caml_unix_readdir(dir_handle); // The Windows bindings type dir_handle as an `int` but it's not in JS return [0, first_entry, dir_handle]; } -//Provides: win_findnext -//Requires: unix_readdir -function win_findnext(dir_handle) { - return unix_readdir(dir_handle); +//Provides: caml_unix_findnext +//Requires: caml_unix_readdir +//Alias: win_findnext +function caml_unix_findnext(dir_handle) { + return caml_unix_readdir(dir_handle); } -//Provides: win_findclose -//Requires: unix_closedir -function win_findclose(dir_handle) { - return unix_closedir(dir_handle); +//Provides: caml_unix_findclose +//Requires: caml_unix_closedir +//Alias: win_findclose +function caml_unix_findclose(dir_handle) { + return caml_unix_closedir(dir_handle); } + + +//Provides: caml_unix_inet_addr_of_string +//Alias: unix_inet_addr_of_string +function caml_unix_inet_addr_of_string () {return 0;} + + diff --git a/runtime/weak.js b/runtime/weak.js index f510cd4193..025aefd23b 100644 --- a/runtime/weak.js +++ b/runtime/weak.js @@ -88,6 +88,7 @@ function caml_weak_set(x, i, v) { } //Provides: caml_ephe_get_key //Requires: caml_ephe_key_offset, caml_invalid_argument +//Alias: caml_weak_get function caml_ephe_get_key(x, i) { if(i < 0 || caml_ephe_key_offset + i >= x.length) caml_invalid_argument ("Weak.get_key"); @@ -98,6 +99,7 @@ function caml_ephe_get_key(x, i) { //Provides: caml_ephe_get_key_copy //Requires: caml_ephe_get_key,caml_ephe_key_offset //Requires: caml_obj_dup, caml_invalid_argument +//Alias: caml_weak_get_copy function caml_ephe_get_key_copy(x, i) { if(i < 0 || caml_ephe_key_offset + i >= x.length) caml_invalid_argument ("Weak.get_copy"); @@ -110,6 +112,7 @@ function caml_ephe_get_key_copy(x, i) { //Provides: caml_ephe_check_key mutable //Requires: caml_ephe_key_offset +//Alias: caml_weak_check function caml_ephe_check_key(x, i) { var weak = x[caml_ephe_key_offset + i]; if(globalThis.WeakRef && weak instanceof globalThis.WeakRef) weak = weak.deref(); @@ -122,6 +125,7 @@ function caml_ephe_check_key(x, i) { //Provides: caml_ephe_blit_key //Requires: caml_array_blit //Requires: caml_ephe_key_offset +//Alias: caml_weak_blit function caml_ephe_blit_key(a1, i1, a2, i2, len) { // minus one because caml_array_blit works on ocaml array caml_array_blit(a1, caml_ephe_key_offset + i1 - 1, @@ -130,23 +134,6 @@ function caml_ephe_blit_key(a1, i1, a2, i2, len) { return 0; } -//Provides: caml_weak_blit -//Requires: caml_ephe_blit_key -var caml_weak_blit = caml_ephe_blit_key - -//Provides: caml_weak_get -//Requires: caml_ephe_get_key -var caml_weak_get = caml_ephe_get_key - - -//Provides: caml_weak_get_copy -//Requires: caml_ephe_get_key_copy -var caml_weak_get_copy = caml_ephe_get_key_copy - -//Provides: caml_weak_check -//Requires: caml_ephe_check_key -var caml_weak_check = caml_ephe_check_key - //Provides: caml_ephe_blit_data //Requires: caml_ephe_data_offset, caml_ephe_set_data, caml_ephe_unset_data function caml_ephe_blit_data(src, dst){ From 7ebea9da4edb77080fceb357c18e1c5f6bf1e6ce Mon Sep 17 00:00:00 2001 From: Hugo Heuzard Date: Thu, 8 Sep 2022 10:07:41 +0200 Subject: [PATCH 4/7] Runtime: improve ocaml 5 support --- .../js_of_ocaml_compiler_runtime_files.ml | 1 + compiler/lib-runtime-files/tests/all.ml | 2 ++ compiler/tests-check-prim/main.output | 13 ++++++- compiler/tests-check-prim/unix-unix.output | 13 ++++++- compiler/tests-check-prim/unix-win32.output | 13 ++++++- runtime/domain.js | 34 +++++++++++++++++++ runtime/effect.js | 25 ++++++++++++++ runtime/obj.js | 3 -- runtime/sync.js | 5 ++- runtime/sys.js | 1 - runtime/unix.js | 2 -- 11 files changed, 102 insertions(+), 10 deletions(-) create mode 100644 runtime/effect.js diff --git a/compiler/lib-runtime-files/js_of_ocaml_compiler_runtime_files.ml b/compiler/lib-runtime-files/js_of_ocaml_compiler_runtime_files.ml index becee7d368..4b4b883a84 100644 --- a/compiler/lib-runtime-files/js_of_ocaml_compiler_runtime_files.ml +++ b/compiler/lib-runtime-files/js_of_ocaml_compiler_runtime_files.ml @@ -55,6 +55,7 @@ let runtime = ; domain ; prng ; sync + ; effect ] include Files diff --git a/compiler/lib-runtime-files/tests/all.ml b/compiler/lib-runtime-files/tests/all.ml index 1ca63736aa..e4554ca7e0 100644 --- a/compiler/lib-runtime-files/tests/all.ml +++ b/compiler/lib-runtime-files/tests/all.ml @@ -21,6 +21,7 @@ let%expect_test _ = +compare.js +domain.js +dynlink.js + +effect.js +fail.js +format.js +fs.js @@ -62,6 +63,7 @@ let%expect_test _ = +bigstring.js +compare.js +domain.js + +effect.js +fail.js +format.js +fs.js diff --git a/compiler/tests-check-prim/main.output b/compiler/tests-check-prim/main.output index 5a4200fc60..ed5f58faf1 100644 --- a/compiler/tests-check-prim/main.output +++ b/compiler/tests-check-prim/main.output @@ -62,8 +62,20 @@ caml_atomic_load caml_domain_dls caml_domain_dls_get caml_domain_dls_set +caml_domain_id +caml_domain_spawn +caml_ml_domain_cpu_relax +caml_ml_domain_id caml_ml_domain_set_name caml_ml_domain_unique_token +caml_recommended_domain_count + +From +effect.js: +caml_alloc_stack +caml_ml_condition_broadcast +caml_ml_condition_new +caml_ml_condition_signal +caml_ml_condition_wait From +fail.js: caml_return_exn_constant @@ -166,7 +178,6 @@ caml_lazy_read_result caml_lazy_reset_to_lazy caml_lazy_update_to_forcing caml_lazy_update_to_forward -caml_ml_domain_id caml_obj_compare_and_swap caml_obj_is_block caml_obj_is_shared diff --git a/compiler/tests-check-prim/unix-unix.output b/compiler/tests-check-prim/unix-unix.output index 45a8a9f953..a949985a7c 100644 --- a/compiler/tests-check-prim/unix-unix.output +++ b/compiler/tests-check-prim/unix-unix.output @@ -171,8 +171,20 @@ caml_atomic_load caml_domain_dls caml_domain_dls_get caml_domain_dls_set +caml_domain_id +caml_domain_spawn +caml_ml_domain_cpu_relax +caml_ml_domain_id caml_ml_domain_set_name caml_ml_domain_unique_token +caml_recommended_domain_count + +From +effect.js: +caml_alloc_stack +caml_ml_condition_broadcast +caml_ml_condition_new +caml_ml_condition_signal +caml_ml_condition_wait From +fail.js: caml_return_exn_constant @@ -275,7 +287,6 @@ caml_lazy_read_result caml_lazy_reset_to_lazy caml_lazy_update_to_forcing caml_lazy_update_to_forward -caml_ml_domain_id caml_obj_compare_and_swap caml_obj_is_block caml_obj_is_shared diff --git a/compiler/tests-check-prim/unix-win32.output b/compiler/tests-check-prim/unix-win32.output index 0733201ac7..f7e7390124 100644 --- a/compiler/tests-check-prim/unix-win32.output +++ b/compiler/tests-check-prim/unix-win32.output @@ -136,8 +136,20 @@ caml_atomic_load caml_domain_dls caml_domain_dls_get caml_domain_dls_set +caml_domain_id +caml_domain_spawn +caml_ml_domain_cpu_relax +caml_ml_domain_id caml_ml_domain_set_name caml_ml_domain_unique_token +caml_recommended_domain_count + +From +effect.js: +caml_alloc_stack +caml_ml_condition_broadcast +caml_ml_condition_new +caml_ml_condition_signal +caml_ml_condition_wait From +fail.js: caml_return_exn_constant @@ -240,7 +252,6 @@ caml_lazy_read_result caml_lazy_reset_to_lazy caml_lazy_update_to_forcing caml_lazy_update_to_forward -caml_ml_domain_id caml_obj_compare_and_swap caml_obj_is_block caml_obj_is_shared diff --git a/runtime/domain.js b/runtime/domain.js index 163384681d..cc48c6f4fb 100644 --- a/runtime/domain.js +++ b/runtime/domain.js @@ -53,3 +53,37 @@ function caml_ml_domain_unique_token(unit) { function caml_ml_domain_set_name(_name) { return 0; } + +//Provides: caml_recommended_domain_count +function caml_recommended_domain_count(unit) { return 1 } + + +//Provides: caml_domain_id +var caml_domain_id = 0; + +//Provides: caml_domain_spawn +//Requires: caml_ml_mutex_unlock +//Requires: caml_domain_id +var caml_domain_latest_idx = 1 +function caml_domain_spawn(f,mutex){ + var id = caml_domain_latest_idx++; + var old = caml_domain_id; + caml_domain_id = id; + f(0); + caml_domain_id = old; + caml_ml_mutex_unlock(mutex); + return id; +} + + +//Provides: caml_ml_domain_id +//Requires: caml_domain_id +function caml_ml_domain_id(unit){ + return caml_domain_id; +} + + +//Provides: caml_ml_domain_cpu_relax +function caml_ml_domain_cpu_relax(unit){ + return 0; +} diff --git a/runtime/effect.js b/runtime/effect.js new file mode 100644 index 0000000000..7725fe07de --- /dev/null +++ b/runtime/effect.js @@ -0,0 +1,25 @@ +//Provides: caml_alloc_stack +function caml_alloc_stack(ret, exn, h) { + return {ret:ret, exn:exn, h:h}; +} + +//Provides: caml_ml_condition_new +function caml_ml_condition_new(unit){ + return {condition:1}; +} + +//Provides: caml_ml_condition_wait +function caml_ml_condition_wait(t,mutext){ + return 0; +} + +//Provides: caml_ml_condition_broadcast +function caml_ml_condition_broadcast(t){ + return 0; +} + +//Provides: caml_ml_condition_signal +function caml_ml_condition_signal(t){ + return 0; +} + diff --git a/runtime/obj.js b/runtime/obj.js index 31da642e18..727e3902b9 100644 --- a/runtime/obj.js +++ b/runtime/obj.js @@ -164,9 +164,6 @@ function caml_obj_update_tag(b,o,n) { return 0 } -//Provides: caml_ml_domain_id -function caml_ml_domain_id(unit) { return 0 } - //Provides: caml_lazy_update_to_forcing //Requires: caml_obj_tag, caml_obj_update_tag, caml_ml_domain_unique_token function caml_lazy_update_to_forcing(o) { diff --git a/runtime/sync.js b/runtime/sync.js index f197afda37..196510ac26 100644 --- a/runtime/sync.js +++ b/runtime/sync.js @@ -13,7 +13,10 @@ function caml_ml_mutex_new(unit) { //Provides: caml_ml_mutex_lock //Requires: caml_failwith function caml_ml_mutex_lock(t) { - caml_failwith("Mutex.lock is not implemented"); + if(t.locked) + caml_failwith("Mutex.lock: mutex already locked. Cannot wait."); + else t.locked = true; + return 0; } //Provides: caml_ml_mutex_try_lock diff --git a/runtime/sys.js b/runtime/sys.js index bf27215df5..238c458877 100644 --- a/runtime/sys.js +++ b/runtime/sys.js @@ -301,7 +301,6 @@ function caml_runtime_parameters(_unit) { //Provides: caml_install_signal_handler const function caml_install_signal_handler(){return 0} - //Provides: caml_runtime_warnings var caml_runtime_warnings = 0; diff --git a/runtime/unix.js b/runtime/unix.js index 5371c02798..05c2718767 100644 --- a/runtime/unix.js +++ b/runtime/unix.js @@ -129,8 +129,6 @@ function caml_unix_stat(name) { return root.device.stat(root.rest, /* raise Unix_error */ true); } - - //Provides: caml_unix_stat_64 //Requires: caml_unix_stat, caml_int64_of_int32 //Alias: unix_stat_64 From 3db0550bd8fdbb251e47d6393a50bff338b2dab0 Mon Sep 17 00:00:00 2001 From: Hugo Heuzard Date: Thu, 8 Sep 2022 10:22:04 +0200 Subject: [PATCH 5/7] Changes --- CHANGES.md | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index e7714b6dbd..8cef181266 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,6 +1,6 @@ # dev (2022-??) - ?? ## Features/Changes -* Compiler: initial support for OCaml 5 (#1265) +* Compiler: initial support for OCaml 5 (#1265,#1303) * Compiler: bump magic number to match the 5.0.0~alpha0 release (#1288) * Misc: switch to cmdliner.1.1.0 * Misc: remove old binaries jsoo_link, jsoo_fs @@ -8,14 +8,14 @@ * Misc: use 4.14 in the CI * Lib: add missing options for Intl.DateTimeFormat * Lib: add missing options for Intl.NumberFormat +* Lib: wheel event binding +* Lib: add normalize in js_string (ES6) * Runtime: Implement weak semantic for weak and ephemeron * Runtime: Implement Gc.finalise_last * Runtime: Implement buffer for in_channels -* Lib: wheel event binding -* Test: track external used in the stdlib and unix * Runtime: add support for unix_opendir, unix_readdir, unix_closedir, win_findfirst, win_findnext, win_findclose * Runtime: Dont use require when target-env is browser -* Lib: add normalize in js_string (ES6) +* Test: track external used in the stdlib and unix ## Bug fixes * Compiler: fix rewriter bug in share_constant (fix #1247) From 577a5dc7e575c3ea8b1943e077d3fb437a0e06bf Mon Sep 17 00:00:00 2001 From: Hugo Heuzard Date: Thu, 8 Sep 2022 11:46:59 +0200 Subject: [PATCH 6/7] Compiler: new predefined exception for ocaml 5 --- compiler/lib/parse_bytecode.ml | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/compiler/lib/parse_bytecode.ml b/compiler/lib/parse_bytecode.ml index 6e333cbf82..1818fb13b5 100644 --- a/compiler/lib/parse_bytecode.ml +++ b/compiler/lib/parse_bytecode.ml @@ -42,6 +42,19 @@ let predefined_exceptions = ; 10, "Assert_failure" ; 11, "Undefined_recursive_module" ] + @ + match Ocaml_version.v with + | `V4_04 + | `V4_06 + | `V4_07 + | `V4_08 + | `V4_09 + | `V4_10 + | `V4_11 + | `V4_12 + | `V4_13 + | `V4_14 -> [] + | `V5_00 -> [ 12, "Continuation_already_taken"; 13, "Unhandled" ] (* Read and manipulate debug section *) module Debug : sig From 15521c61334eda1a443b0a5b8ae78ec78bd2e957 Mon Sep 17 00:00:00 2001 From: Hugo Heuzard Date: Thu, 8 Sep 2022 11:49:26 +0200 Subject: [PATCH 7/7] Example: misc --- toplevel/examples/lwt_toplevel/dune | 1 + 1 file changed, 1 insertion(+) diff --git a/toplevel/examples/lwt_toplevel/dune b/toplevel/examples/lwt_toplevel/dune index f84db168a0..592c8d5ae1 100644 --- a/toplevel/examples/lwt_toplevel/dune +++ b/toplevel/examples/lwt_toplevel/dune @@ -67,6 +67,7 @@ stdlib graphics str + dynlink js_of_ocaml-compiler.runtime js_of_ocaml-lwt.graphics js_of_ocaml-ppx.as-lib