From 73823b593ab7207b611fea0377f1e7ea3beb6d1e Mon Sep 17 00:00:00 2001 From: Hugo Heuzard Date: Fri, 3 Apr 2020 22:21:23 +0200 Subject: [PATCH 1/4] Compiler: use-js-string enabled by default --- compiler/lib/config.ml | 2 +- compiler/tests-check-prim/main.output | 2 ++ compiler/tests-check-prim/main.output5 | 2 ++ compiler/tests-check-prim/unix-unix.output | 2 ++ compiler/tests-check-prim/unix-unix.output5 | 2 ++ compiler/tests-check-prim/unix-win32.output | 2 ++ 6 files changed, 11 insertions(+), 1 deletion(-) diff --git a/compiler/lib/config.ml b/compiler/lib/config.ml index c775eaaef3..f07b28dedc 100644 --- a/compiler/lib/config.ml +++ b/compiler/lib/config.ml @@ -88,7 +88,7 @@ module Flag = struct let safe_string = o ~name:"safestring" ~default:true - let use_js_string = o ~name:"use-js-string" ~default:false + let use_js_string = o ~name:"use-js-string" ~default:true let check_magic = o ~name:"check-magic-number" ~default:true diff --git a/compiler/tests-check-prim/main.output b/compiler/tests-check-prim/main.output index 245c78a497..a03ed9cbfd 100644 --- a/compiler/tests-check-prim/main.output +++ b/compiler/tests-check-prim/main.output @@ -162,10 +162,12 @@ caml_marshal_constants From +mlBytes.js: caml_array_of_bytes caml_array_of_string +caml_bytes_of_utf16_jsstring caml_new_string caml_string_set16 caml_string_set32 caml_string_set64 +caml_string_unsafe_set caml_to_js_string From +nat.js: diff --git a/compiler/tests-check-prim/main.output5 b/compiler/tests-check-prim/main.output5 index 0575452bfd..cf70e73a71 100644 --- a/compiler/tests-check-prim/main.output5 +++ b/compiler/tests-check-prim/main.output5 @@ -145,9 +145,11 @@ caml_marshal_constants From +mlBytes.js: caml_array_of_bytes caml_array_of_string +caml_bytes_of_utf16_jsstring caml_string_set16 caml_string_set32 caml_string_set64 +caml_string_unsafe_set caml_to_js_string From +nat.js: diff --git a/compiler/tests-check-prim/unix-unix.output b/compiler/tests-check-prim/unix-unix.output index 734cb90a5d..cfe5e214a8 100644 --- a/compiler/tests-check-prim/unix-unix.output +++ b/compiler/tests-check-prim/unix-unix.output @@ -271,10 +271,12 @@ caml_marshal_constants From +mlBytes.js: caml_array_of_bytes caml_array_of_string +caml_bytes_of_utf16_jsstring caml_new_string caml_string_set16 caml_string_set32 caml_string_set64 +caml_string_unsafe_set caml_to_js_string From +nat.js: diff --git a/compiler/tests-check-prim/unix-unix.output5 b/compiler/tests-check-prim/unix-unix.output5 index 59ec885cdc..8fb04d02b1 100644 --- a/compiler/tests-check-prim/unix-unix.output5 +++ b/compiler/tests-check-prim/unix-unix.output5 @@ -254,9 +254,11 @@ caml_marshal_constants From +mlBytes.js: caml_array_of_bytes caml_array_of_string +caml_bytes_of_utf16_jsstring caml_string_set16 caml_string_set32 caml_string_set64 +caml_string_unsafe_set caml_to_js_string From +nat.js: diff --git a/compiler/tests-check-prim/unix-win32.output b/compiler/tests-check-prim/unix-win32.output index 317c706f66..5aa553eca7 100644 --- a/compiler/tests-check-prim/unix-win32.output +++ b/compiler/tests-check-prim/unix-win32.output @@ -236,10 +236,12 @@ caml_marshal_constants From +mlBytes.js: caml_array_of_bytes caml_array_of_string +caml_bytes_of_utf16_jsstring caml_new_string caml_string_set16 caml_string_set32 caml_string_set64 +caml_string_unsafe_set caml_to_js_string From +nat.js: From 30beca9b91c4a0451cdb95258c51e0b3e7bd45fb Mon Sep 17 00:00:00 2001 From: Hugo Heuzard Date: Wed, 9 Nov 2022 11:35:35 +0100 Subject: [PATCH 2/4] Changes --- CHANGES.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGES.md b/CHANGES.md index 0df8024ecb..796a84fcfa 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -63,6 +63,7 @@ Runtime: fix caml_read_file_content * 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 * Runtime: Implements Parsing.set_trace (#1308) +* Runtime: ocaml string are represented as javascript ones. * Test: track external used in the stdlib and unix ## Bug fixes From 2b96ea001ef96858eeda0154c70f03a582f22a2a Mon Sep 17 00:00:00 2001 From: Hugo Heuzard Date: Sat, 4 Apr 2020 17:30:23 +0200 Subject: [PATCH 3/4] string-concat --- compiler/lib/generate.ml | 6 ++ compiler/lib/specialize_js.ml | 28 +++++++ compiler/lib/var_printer.ml | 1 + compiler/tests-check-prim/main.output | 2 + compiler/tests-check-prim/unix-unix.output | 2 + compiler/tests-compiler/dune.inc | 16 ++++ compiler/tests-compiler/test_string.ml | 91 ++++++++++++++++++++++ runtime/mlBytes.js | 17 ++++ 8 files changed, 163 insertions(+) create mode 100644 compiler/tests-compiler/test_string.ml diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml index e4aab5fabf..18f3cb2798 100644 --- a/compiler/lib/generate.ml +++ b/compiler/lib/generate.ml @@ -1440,6 +1440,11 @@ let rec translate_expr ctx queue loc in_tail_position e level : _ * J.statement_ let prim = Share.get_prim (runtime_fun ctx) name ctx.Ctx.share in let prim_kind = kind (Primitive.kind name) in ecall prim [] loc, prim_kind, queue + | Extern "%string_concat", [ a; b ] when Config.Flag.use_js_string () -> + let (_pa, ca), queue = access_queue' ~ctx queue a in + let (_pb, cb), queue = access_queue' ~ctx queue b in + let e = J.EBin (J.Plus, ca, cb) in + e, const_p, queue | Extern name, l -> ( let name = Primitive.resolve name in match internal_prim name with @@ -2129,6 +2134,7 @@ let init () = [ "%int_mul", "caml_mul" ; "%int_div", "caml_div" ; "%int_mod", "caml_mod" + ; "%string_concat", "caml_string_concat" ; "caml_int32_neg", "%int_neg" ; "caml_int32_add", "%int_add" ; "caml_int32_sub", "%int_sub" diff --git a/compiler/lib/specialize_js.ml b/compiler/lib/specialize_js.ml index fca94bbaf8..e16bdaf14f 100644 --- a/compiler/lib/specialize_js.ml +++ b/compiler/lib/specialize_js.ml @@ -147,10 +147,38 @@ let specialize_instr info i = | _ -> i) | _ -> i +let all_equal = function + | [] -> true + | x :: xs -> List.for_all xs ~f:(fun y -> Var.equal x y) + let specialize_instrs info l = let rec aux info checks l acc = match l with | [] -> List.rev acc + | Let (alen, Prim (Extern "caml_ml_string_length", [ Pv a ])) + :: Let (blen, Prim (Extern "caml_ml_string_length", [ Pv b ])) + :: Let (len, Prim (Extern "%int_add", [ Pv alen'; Pv blen' ])) + :: Let (bytes, Prim (Extern "caml_create_bytes", [ Pv len' ])) + :: Let + ( _ + , Prim + ( Extern "caml_blit_string" + , [ Pv a'; Pc (Int 0l); Pv bytes'; Pc (Int 0l); Pv alen'' ] ) ) + :: Let + ( _ + , Prim + ( Extern "caml_blit_string" + , [ Pv b'; Pc (Int 0l); Pv bytes''; Pv alen'''; Pv blen'' ] ) ) + :: Let (res, Prim (Extern "caml_string_of_bytes", [ Pv bytes''' ])) + :: rest + when all_equal [ a; a' ] + && all_equal [ b; b' ] + && all_equal [ len; len' ] + && all_equal [ alen; alen'; alen''; alen''' ] + && all_equal [ blen; blen'; blen'' ] + && all_equal [ bytes; bytes'; bytes''; bytes''' ] -> + Let (res, Prim (Extern "%string_concat", [ Pv a; Pv b ])) + :: aux info checks rest acc | i :: r -> ( (* We make bound checking explicit. Then, we can remove duplicated bound checks. Also, it appears to be more efficient to inline diff --git a/compiler/lib/var_printer.ml b/compiler/lib/var_printer.ml index 5c5f662d44..4036e46d6a 100644 --- a/compiler/lib/var_printer.ml +++ b/compiler/lib/var_printer.ml @@ -99,6 +99,7 @@ let name t v nm_orig = match str, nm_orig with | "", ">>=" -> "symbol_bind" | "", ">>|" -> "symbol_map" + | "", "^" -> "symbol_concat" | "", _ -> "symbol" | str, _ -> str in diff --git a/compiler/tests-check-prim/main.output b/compiler/tests-check-prim/main.output index a03ed9cbfd..b7a005605c 100644 --- a/compiler/tests-check-prim/main.output +++ b/compiler/tests-check-prim/main.output @@ -162,8 +162,10 @@ caml_marshal_constants From +mlBytes.js: caml_array_of_bytes caml_array_of_string +caml_bytes_concat caml_bytes_of_utf16_jsstring caml_new_string +caml_string_concat caml_string_set16 caml_string_set32 caml_string_set64 diff --git a/compiler/tests-check-prim/unix-unix.output b/compiler/tests-check-prim/unix-unix.output index cfe5e214a8..c451769e12 100644 --- a/compiler/tests-check-prim/unix-unix.output +++ b/compiler/tests-check-prim/unix-unix.output @@ -271,8 +271,10 @@ caml_marshal_constants From +mlBytes.js: caml_array_of_bytes caml_array_of_string +caml_bytes_concat caml_bytes_of_utf16_jsstring caml_new_string +caml_string_concat caml_string_set16 caml_string_set32 caml_string_set64 diff --git a/compiler/tests-compiler/dune.inc b/compiler/tests-compiler/dune.inc index 8996d8bc4c..ae52f00d41 100644 --- a/compiler/tests-compiler/dune.inc +++ b/compiler/tests-compiler/dune.inc @@ -639,6 +639,22 @@ (preprocess (pps ppx_expect))) +(library + ;; compiler/tests-compiler/test_string.ml + (name test_string_15) + (enabled_if true) + (modules test_string) + (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper) + (inline_tests + (enabled_if true) + (flags -allow-output-patterns) + (deps + (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe) + (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe))) + (flags (:standard -open Jsoo_compiler_expect_tests_helper)) + (preprocess + (pps ppx_expect))) + (library ;; compiler/tests-compiler/unix_fs.ml (name unix_fs_15) diff --git a/compiler/tests-compiler/test_string.ml b/compiler/tests-compiler/test_string.ml new file mode 100644 index 0000000000..37682c3822 --- /dev/null +++ b/compiler/tests-compiler/test_string.ml @@ -0,0 +1,91 @@ +(* Js_of_ocaml tests + * http://www.ocsigen.org/js_of_ocaml/ + * Copyright (C) 2019 Ty Overby + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 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. + *) + +open Util + +let%expect_test _ = + let program = + compile_and_parse + ~debug:false + ~flags:[ "--enable"; "use-js-string" ] + {| +external string_length : string -> int = "%string_length" +external bytes_create : int -> bytes = "caml_create_bytes" +external string_blit : string -> int -> bytes -> int -> int -> unit + = "caml_blit_string" [@@noalloc] +external bytes_unsafe_to_string : bytes -> string = "%bytes_to_string" + +let ( ^ ) s1 s2 = + let l1 = string_length s1 and l2 = string_length s2 in + let s = bytes_create (l1 + l2) in + string_blit s1 0 s 0 l1; + string_blit s2 0 s l1 l2; + bytes_unsafe_to_string s + +let here () = + let a = "a" in + let b = "b" in + a ^ a ^ b ^ b + +let (_ : string) = here () + |} + in + print_fun_decl program None; + [%expect + {| + function _b_(_c_) + {return caml_string_concat + (cst_a,caml_string_concat(cst_a,caml_string_concat(cst_b,cst_b)))} + //end |}] + +let%expect_test _ = + let program = + compile_and_parse + ~debug:false + ~flags:[ "--disable"; "use-js-string" ] + {| +external string_length : string -> int = "%string_length" +external bytes_create : int -> bytes = "caml_create_bytes" +external string_blit : string -> int -> bytes -> int -> int -> unit + = "caml_blit_string" [@@noalloc] + +external bytes_unsafe_to_string : bytes -> string = "%bytes_to_string" + +let ( ^ ) s1 s2 = + let l1 = string_length s1 and l2 = string_length s2 in + let s = bytes_create (l1 + l2) in + string_blit s1 0 s 0 l1; + string_blit s2 0 s l1 l2; + bytes_unsafe_to_string s + +let here () = + let a = "a" in + let b = "b" in + a ^ a ^ b ^ b + +let (_ : string) = here () + |} + in + print_fun_decl program None; + [%expect + {| + function _b_(_c_) + {return caml_string_concat + (cst_a,caml_string_concat(cst_a,caml_string_concat(cst_b,cst_b)))} + //end |}] diff --git a/runtime/mlBytes.js b/runtime/mlBytes.js index c6dbf95e3e..087e28f8bb 100644 --- a/runtime/mlBytes.js +++ b/runtime/mlBytes.js @@ -438,6 +438,14 @@ MlBytes.prototype.slice = function (){ return new MlBytes(this.t,content,this.l); } +//Provides: caml_bytes_concat +//Requires: caml_convert_string_to_bytes, MlBytes +function caml_bytes_concat(s1,s2){ + (s1.t & 6) && caml_convert_string_to_bytes(s1); + (s2.t & 6) && caml_convert_string_to_bytes(s2); + return new MlBytes(s1.t,s1.c+s2.c,s1.l+s2.l) +} + //Provides: caml_convert_string_to_bytes //Requires: caml_str_repeat, caml_subarray_to_jsbytes function caml_convert_string_to_bytes (s) { @@ -645,6 +653,15 @@ function caml_blit_string(a,b,c,d,e) { //Provides: caml_ml_bytes_length const function caml_ml_bytes_length(s) { return s.l } +//Provides: caml_string_concat +//If: js-string +function caml_string_concat(a,b) { return a + b } + +//Provides: caml_string_concat +//Requires: caml_bytes_concat +//If: !js-string +function caml_string_concat(a,b) { return caml_bytes_concat(a,b) } + //Provides: caml_string_unsafe_get const //If: js-string function caml_string_unsafe_get (s, i) { From 564f81d74ee2406f6e854273ecce1854801c63a5 Mon Sep 17 00:00:00 2001 From: Hugo Heuzard Date: Fri, 13 Jan 2023 00:59:03 +0100 Subject: [PATCH 4/4] WIP --- compiler/lib/specialize_js.ml | 18 ++++++---- compiler/tests-compiler/test_string.ml | 46 ++++++++++++++++++++------ 2 files changed, 48 insertions(+), 16 deletions(-) diff --git a/compiler/lib/specialize_js.ml b/compiler/lib/specialize_js.ml index e16bdaf14f..f5b603ff65 100644 --- a/compiler/lib/specialize_js.ml +++ b/compiler/lib/specialize_js.ml @@ -155,17 +155,17 @@ let specialize_instrs info l = let rec aux info checks l acc = match l with | [] -> List.rev acc - | Let (alen, Prim (Extern "caml_ml_string_length", [ Pv a ])) - :: Let (blen, Prim (Extern "caml_ml_string_length", [ Pv b ])) - :: Let (len, Prim (Extern "%int_add", [ Pv alen'; Pv blen' ])) + | (Let (alen, Prim (Extern "caml_ml_string_length", [ Pv a ])) as len1) + :: (Let (blen, Prim (Extern "caml_ml_string_length", [ Pv b ])) as len2) + :: (Let (len, Prim (Extern "%int_add", [ Pv alen'; Pv blen' ])) as len3) :: Let (bytes, Prim (Extern "caml_create_bytes", [ Pv len' ])) :: Let - ( _ + ( u1 , Prim ( Extern "caml_blit_string" , [ Pv a'; Pc (Int 0l); Pv bytes'; Pc (Int 0l); Pv alen'' ] ) ) :: Let - ( _ + ( u2 , Prim ( Extern "caml_blit_string" , [ Pv b'; Pc (Int 0l); Pv bytes''; Pv alen'''; Pv blen'' ] ) ) @@ -177,7 +177,13 @@ let specialize_instrs info l = && all_equal [ alen; alen'; alen''; alen''' ] && all_equal [ blen; blen'; blen'' ] && all_equal [ bytes; bytes'; bytes''; bytes''' ] -> - Let (res, Prim (Extern "%string_concat", [ Pv a; Pv b ])) + len1 + :: len2 + :: len3 + :: Let (u1, Constant (Int 0l)) + :: Let (u2, Constant (Int 0l)) + :: Let (res, Prim (Extern "%string_concat", [ Pv a; Pv b ])) + :: Let (bytes, Prim (Extern "caml_bytes_of_string", [ Pv res ])) :: aux info checks rest acc | i :: r -> ( (* We make bound checking explicit. Then, we can remove duplicated diff --git a/compiler/tests-compiler/test_string.ml b/compiler/tests-compiler/test_string.ml index 37682c3822..ca8bfa5b90 100644 --- a/compiler/tests-compiler/test_string.ml +++ b/compiler/tests-compiler/test_string.ml @@ -23,7 +23,7 @@ let%expect_test _ = let program = compile_and_parse ~debug:false - ~flags:[ "--enable"; "use-js-string" ] + ~use_js_string:true {| external string_length : string -> int = "%string_length" external bytes_create : int -> bytes = "caml_create_bytes" @@ -46,19 +46,30 @@ let here () = let (_ : string) = here () |} in - print_fun_decl program None; + print_program program; [%expect {| - function _b_(_c_) - {return caml_string_concat - (cst_a,caml_string_concat(cst_a,caml_string_concat(cst_b,cst_b)))} + (function(globalThis) + {"use strict"; + var + runtime=globalThis.jsoo_runtime, + cst_a="a", + cst_b="b", + caml_string_concat=runtime.caml_string_concat, + _a_=caml_string_concat; + function _b_(_c_){return cst_a + (cst_a + (cst_b + cst_b))} + _b_(0); + var Test=[0,_a_,_b_]; + runtime.caml_register_global(2,Test,"Test"); + return} + (globalThis)); //end |}] let%expect_test _ = let program = compile_and_parse ~debug:false - ~flags:[ "--disable"; "use-js-string" ] + ~use_js_string:false {| external string_length : string -> int = "%string_length" external bytes_create : int -> bytes = "caml_create_bytes" @@ -82,10 +93,25 @@ let here () = let (_ : string) = here () |} in - print_fun_decl program None; + print_program program; [%expect {| - function _b_(_c_) - {return caml_string_concat - (cst_a,caml_string_concat(cst_a,caml_string_concat(cst_b,cst_b)))} + (function(globalThis) + {"use strict"; + var + runtime=globalThis.jsoo_runtime, + caml_string_concat=runtime.caml_string_concat, + caml_string_of_jsbytes=runtime.caml_string_of_jsbytes, + cst_a=caml_string_of_jsbytes("a"), + cst_b=caml_string_of_jsbytes("b"), + _a_=caml_string_concat; + function _b_(_c_) + {return caml_string_concat + (cst_a, + caml_string_concat(cst_a,caml_string_concat(cst_b,cst_b)))} + _b_(0); + var Test=[0,_a_,_b_]; + runtime.caml_register_global(2,Test,"Test"); + return} + (globalThis)); //end |}]