Merge pull request #4457 from BuckleScript/tweak

Fix #4456, specialize String.make

Author: bobzhang

jscomp/core/lam_analysis.ml

@@ -56,8 +56,7 @@ let rec no_side_effects (lam : Lam.t) : bool =
             (* non-observable side effect *)    
             | "caml_sys_get_config"
             | "caml_sys_get_argv" (* should be fine *)
-
-            | "caml_create_string" (* TODO: add more *)
+            | "caml_string_repeat"
             | "caml_make_vect"
             | "caml_create_bytes"
             | "caml_obj_dup"

jscomp/core/lam_dispatch_primitive.ml

@@ -380,6 +380,20 @@ let translate loc (prim_name : string)
           E.string_comp Ge  e0 e1
         | _ -> assert false 
       end
+    | "caml_string_repeat"
+      ->   
+      begin match args with 
+        | [ n ; {expression_desc = Number (Int {i})} ] ->   
+          let str = (String.make 1 (Char.chr (Int32.to_int i))) in
+          begin match n.expression_desc with 
+            | Number (Int {i = 1l}) -> E.str str 
+            | _ -> 
+              E.call (E.dot (E.str str) "repeat") [n]
+                ~info:Js_call_info.builtin_runtime_call
+          end
+        | _ ->     
+          E.runtime_call Js_runtime_modules.string "make" args
+      end
     | "caml_string_greaterthan"
       -> 
       begin match args with 
@@ -475,7 +489,7 @@ let translate loc (prim_name : string)
       | _ -> assert false 
       end 
     | "caml_create_bytes"  
-    | "caml_create_string" -> 
+       -> 
       (* Bytes.create *)
       (* Note that for invalid range, JS raise an Exception RangeError, 
          here in OCaml it's [Invalid_argument], we have to preserve this semantics.

jscomp/main/builtin_cmi_datasets.ml

@@ -103,36 +103,23 @@ function caml_lex_array(s) {
  * @returns {any}
  *)
 let caml_lex_engine_aux : lex_tables -> int -> lexbuf -> exn -> int = [%raw{|function (tbl, start_state, lexbuf, exn){
-    // Lexing.lexbuf
-    var lex_buffer = 'lex_buffer';
-    var lex_buffer_len = 'lex_buffer_len';
-    var lex_start_pos = 'lex_start_pos';
-    var lex_curr_pos = 'lex_curr_pos';
-    var lex_last_pos = 'lex_last_pos';
-    var lex_last_action = 'lex_last_action';
-    var lex_eof_reached = 'lex_eof_reached';
-    // Lexing.lex_tables
-    var lex_base = 'lex_base';
-    var lex_backtrk = 'lex_backtrk';
-    var lex_default = 'lex_default';
-    var lex_trans = 'lex_trans';
-    var lex_check = 'lex_check';
+
     if (!tbl.processed) {
-        tbl.lex_base = caml_lex_array(tbl[lex_base]);
-        tbl.lex_backtrk = caml_lex_array(tbl[lex_backtrk]);
-        tbl.lex_check = caml_lex_array(tbl[lex_check]);
-        tbl.lex_trans = caml_lex_array(tbl[lex_trans]);
-        tbl.lex_default = caml_lex_array(tbl[lex_default]);
+        tbl.lex_base = caml_lex_array(tbl.lex_base);
+        tbl.lex_backtrk = caml_lex_array(tbl.lex_backtrk);
+        tbl.lex_check = caml_lex_array(tbl.lex_check);
+        tbl.lex_trans = caml_lex_array(tbl.lex_trans);
+        tbl.lex_default = caml_lex_array(tbl.lex_default);
         tbl.processed = true;
     }
     var c;
     var state = start_state;
-    //var buffer = bytes_of_string(lexbuf[lex_buffer]);
-    var buffer = lexbuf[lex_buffer];
+    //var buffer = bytes_of_string(lexbuf.lex_buffer);
+    var buffer = lexbuf.lex_buffer;
     if (state >= 0) {
         /* First entry */
-        lexbuf[lex_last_pos] = lexbuf[lex_start_pos] = lexbuf[lex_curr_pos];
-        lexbuf[lex_last_action] = -1;
+        lexbuf.lex_last_pos = lexbuf.lex_start_pos = lexbuf.lex_curr_pos;
+        lexbuf.lex_last_action = -1;
     }
     else {
         /* Reentry after refill */
@@ -146,20 +133,20 @@ let caml_lex_engine_aux : lex_tables -> int -> lexbuf -> exn -> int = [%raw{|fun
         /* See if it's a backtrack point */
         var backtrk = tbl.lex_backtrk[state];
         if (backtrk >= 0) {
-            lexbuf[lex_last_pos] = lexbuf[lex_curr_pos];
-            lexbuf[lex_last_action] = backtrk;
+            lexbuf.lex_last_pos = lexbuf.lex_curr_pos;
+            lexbuf.lex_last_action = backtrk;
         }
         /* See if we need a refill */
-        if (lexbuf[lex_curr_pos] >= lexbuf[lex_buffer_len]) {
-            if (lexbuf[lex_eof_reached] === 0)
+        if (lexbuf.lex_curr_pos >= lexbuf.lex_buffer_len) {
+            if (lexbuf.lex_eof_reached === 0)
                 return -state - 1;
             else
                 c = 256;
         }
         else {
             /* Read next input char */
-            c = buffer[lexbuf[lex_curr_pos]];
-            lexbuf[lex_curr_pos]++;
+            c = buffer[lexbuf.lex_curr_pos];
+            lexbuf.lex_curr_pos++;
         }
         /* Determine next state */
         if (tbl.lex_check[base + c] === state) {
@@ -170,18 +157,18 @@ let caml_lex_engine_aux : lex_tables -> int -> lexbuf -> exn -> int = [%raw{|fun
         }
         /* If no transition on this char, return to last backtrack point */
         if (state < 0) {
-            lexbuf[lex_curr_pos] = lexbuf[lex_last_pos];
-            if (lexbuf[lex_last_action] == -1)
+            lexbuf.lex_curr_pos = lexbuf.lex_last_pos;
+            if (lexbuf.lex_last_action == -1)
                 throw exn
             else
-                return lexbuf[lex_last_action];
+                return lexbuf.lex_last_action;
         }
         else {
             /* Erase the EOF condition only if the EOF pseudo-character was
              consumed by the automaton (i.e. there was no backtrack above)
              */
             if (c == 256)
-                lexbuf[lex_eof_reached] = 0;
+                lexbuf.lex_eof_reached = 0;
         }
     }
 }    
@@ -252,47 +239,27 @@ function caml_lex_run_tag(s, i, mem) {
 
 
 let caml_new_lex_engine_aux : lex_tables -> int -> lexbuf -> exn -> int= [%raw{|function (tbl, start_state, lexbuf, exn) {
-    // Lexing.lexbuf
-    var lex_buffer = 'lex_buffer';
-    var lex_buffer_len = 'lex_buffer_len';
-    var lex_start_pos = 'lex_start_pos';
-    var lex_curr_pos = 'lex_curr_pos';
-    var lex_last_pos = 'lex_last_pos';
-    var lex_last_action = 'lex_last_action';
-    var lex_eof_reached = 'lex_eof_reached';
-    var lex_mem = 'lex_mem';
-    // Lexing.lex_tables
-    var lex_base = 'lex_base';
-    var lex_backtrk = 'lex_backtrk';
-    var lex_default = 'lex_default';
-    var lex_trans = 'lex_trans';
-    var lex_check = 'lex_check';
-    var lex_base_code = 'lex_base_code';
-    var lex_backtrk_code = 'lex_backtrk_code';
-    var lex_default_code = 'lex_default_code';
-    var lex_trans_code = 'lex_trans_code';
-    var lex_check_code = 'lex_check_code';
-    var lex_code = 'lex_code';
+
     if (!tbl.processed) {
-        tbl.lex_base = caml_lex_array(tbl[lex_base]);
-        tbl.lex_backtrk = caml_lex_array(tbl[lex_backtrk]);
-        tbl.lex_check = caml_lex_array(tbl[lex_check]);
-        tbl.lex_trans = caml_lex_array(tbl[lex_trans]);
-        tbl.lex_default = caml_lex_array(tbl[lex_default]);
-        tbl.lex_base_code = caml_lex_array(tbl[lex_base_code]);
-        tbl.lex_backtrk_code = caml_lex_array(tbl[lex_backtrk_code]);
-        tbl.lex_check_code = caml_lex_array(tbl[lex_check_code]);
-        tbl.lex_trans_code = caml_lex_array(tbl[lex_trans_code]);
-        tbl.lex_default_code = caml_lex_array(tbl[lex_default_code]);
+        tbl.lex_base = caml_lex_array(tbl.lex_base);
+        tbl.lex_backtrk = caml_lex_array(tbl.lex_backtrk);
+        tbl.lex_check = caml_lex_array(tbl.lex_check);
+        tbl.lex_trans = caml_lex_array(tbl.lex_trans);
+        tbl.lex_default = caml_lex_array(tbl.lex_default);
+        tbl.lex_base_code = caml_lex_array(tbl.lex_base_code);
+        tbl.lex_backtrk_code = caml_lex_array(tbl.lex_backtrk_code);
+        tbl.lex_check_code = caml_lex_array(tbl.lex_check_code);
+        tbl.lex_trans_code = caml_lex_array(tbl.lex_trans_code);
+        tbl.lex_default_code = caml_lex_array(tbl.lex_default_code);
         tbl.processed = true;
     }
     var c, state = start_state;
-    //var buffer = caml_bytes_of_string(lexbuf[lex_buffer]);
-    var buffer = lexbuf[lex_buffer];
+    //var buffer = caml_bytes_of_string(lexbuf.lex_buffer);
+    var buffer = lexbuf.lex_buffer;
     if (state >= 0) {
         /* First entry */
-        lexbuf[lex_last_pos] = lexbuf[lex_start_pos] = lexbuf[lex_curr_pos];
-        lexbuf[lex_last_action] = -1;
+        lexbuf.lex_last_pos = lexbuf.lex_start_pos = lexbuf.lex_curr_pos;
+        lexbuf.lex_last_action = -1;
     }
     else {
         /* Reentry after refill */
@@ -303,28 +270,28 @@ let caml_new_lex_engine_aux : lex_tables -> int -> lexbuf -> exn -> int= [%raw{|
         var base = tbl.lex_base[state];
         if (base < 0) {
             var pc_off = tbl.lex_base_code[state];
-            caml_lex_run_tag(tbl.lex_code, pc_off, lexbuf[lex_mem]);
+            caml_lex_run_tag(tbl.lex_code, pc_off, lexbuf.lex_mem);
             return -base - 1;
         }
         /* See if it's a backtrack point */
         var backtrk = tbl.lex_backtrk[state];
         if (backtrk >= 0) {
             var pc_off = tbl.lex_backtrk_code[state];
-            caml_lex_run_tag(tbl.lex_code, pc_off, lexbuf[lex_mem]);
-            lexbuf[lex_last_pos] = lexbuf[lex_curr_pos];
-            lexbuf[lex_last_action] = backtrk;
+            caml_lex_run_tag(tbl.lex_code, pc_off, lexbuf.lex_mem);
+            lexbuf.lex_last_pos = lexbuf.lex_curr_pos;
+            lexbuf.lex_last_action = backtrk;
         }
         /* See if we need a refill */
-        if (lexbuf[lex_curr_pos] >= lexbuf[lex_buffer_len]) {
-            if (lexbuf[lex_eof_reached] == 0)
+        if (lexbuf.lex_curr_pos >= lexbuf.lex_buffer_len) {
+            if (lexbuf.lex_eof_reached == 0)
                 return -state - 1;
             else
                 c = 256;
         }
         else {
             /* Read next input char */
-            c = buffer[lexbuf[lex_curr_pos]];
-            lexbuf[lex_curr_pos]++;
+            c = buffer[lexbuf.lex_curr_pos];
+            lexbuf.lex_curr_pos++;
         }
         /* Determine next state */
         var pstate = state;
@@ -334,11 +301,11 @@ let caml_new_lex_engine_aux : lex_tables -> int -> lexbuf -> exn -> int= [%raw{|
             state = tbl.lex_default[state];
         /* If no transition on this char, return to last backtrack point */
         if (state < 0) {
-            lexbuf[lex_curr_pos] = lexbuf[lex_last_pos];
-            if (lexbuf[lex_last_action] == -1)
+            lexbuf.lex_curr_pos = lexbuf.lex_last_pos;
+            if (lexbuf.lex_last_action == -1)
                 throw exn;
             else
-                return lexbuf[lex_last_action];
+                return lexbuf.lex_last_action;
         }
         else {
             /* If some transition, get and perform memory moves */
@@ -348,12 +315,12 @@ let caml_new_lex_engine_aux : lex_tables -> int -> lexbuf -> exn -> int= [%raw{|
             else
                 pc_off = tbl.lex_default_code[pstate];
             if (pc_off > 0)
-                caml_lex_run_mem(tbl.lex_code, pc_off, lexbuf[lex_mem], lexbuf[lex_curr_pos]);
+                caml_lex_run_mem(tbl.lex_code, pc_off, lexbuf.lex_mem, lexbuf.lex_curr_pos);
             /* Erase the EOF condition only if the EOF pseudo-character was
              consumed by the automaton (i.e. there was no backtrack above)
              */
             if (c == 256)
-                lexbuf[lex_eof_reached] = 0;
+                lexbuf.lex_eof_reached = 0;
         }
     }
     }

jscomp/main/builtin_cmj_datasets.ml

@@ -36,18 +36,8 @@ let get s i=
     raise (Invalid_argument "index out of bounds") 
   else Caml_string_extern.unsafe_get s i
 
-(* let caml_string_get16 s i = 
-  Caml_char.code (Caml_string_extern.unsafe_get s i) + Caml_char.code (Caml_string_extern.unsafe_get s (i+1)) lsl 8  
-
-let caml_string_get32 s i = 
-  Caml_char.code (Caml_string_extern.unsafe_get s i) + 
-  Caml_char.code (Caml_string_extern.unsafe_get s (i+1)) lsl 8  + 
-  Caml_char.code (Caml_string_extern.unsafe_get s (i+2)) lsl 16 + 
-  Caml_char.code (Caml_string_extern.unsafe_get s (i+3)) lsl 24 *)
-
-
-(* let get s i =
-  if i < 0 || i >= Caml_string_extern.length s then
-    raise (Invalid_argument "index out of bounds")
-  else Caml_string_extern.unsafe_get s i      
- *)
+let make n (ch : char) : string = 
+  (Caml_string_extern.of_char ch)   
+   |. Caml_string_extern.repeat   n
+   
+  

jscomp/runtime/caml_lexer.ml

@@ -24,3 +24,5 @@
 
 
 val get : string -> int -> char 
+
+val make : int -> char -> string

jscomp/runtime/caml_string.ml

@@ -24,7 +24,7 @@
 external length : string -> int = "%string_length"
 external get : string -> int -> char = "%string_safe_get"
 external set : bytes -> int -> char -> unit = "%bytes_safe_set"
-external create : int -> bytes = "caml_create_string"
+external create : int -> bytes = "caml_create_bytes"
 external unsafe_get : string -> int -> char = "%string_unsafe_get"
 external unsafe_set : bytes -> int -> char -> unit = "%bytes_unsafe_set"
 external unsafe_blit : string -> int ->  bytes -> int -> int -> unit
@@ -36,9 +36,9 @@ module B = Bytes
 
 let bts = B.unsafe_to_string
 let bos = B.unsafe_of_string
-(*-FIXME: replaced by Belt.String.repeat *)
-let make n c =
-  B.make n c |> bts
+
+external make : int -> char -> string = "caml_string_repeat"  
+
 let init n f =
   B.init n f |> bts
 let copy s =

jscomp/runtime/caml_string.mli

@@ -68,7 +68,7 @@ external set : bytes -> int -> char -> unit = "%bytes_safe_set"
 
    @deprecated This is a deprecated alias of {!Bytes.set}.[ ] *)
 
-external create : int -> bytes = "caml_create_string"
+external create : int -> bytes = "caml_create_bytes"
   [@@ocaml.deprecated "Use Bytes.create instead."]
 (** [String.create n] returns a fresh byte sequence of length [n].
    The sequence is uninitialized and contains arbitrary bytes.

jscomp/stdlib-406/string.ml

@@ -34,7 +34,7 @@ external set : bytes -> int -> char -> unit = "%bytes_safe_set"
 
    @deprecated This is a deprecated alias of {!BytesLabels.set}. *)
 
-external create : int -> bytes = "caml_create_string"
+external create : int -> bytes = "caml_create_bytes"
   [@@ocaml.deprecated "Use BytesLabels.create instead."]
 (** [String.create n] returns a fresh byte sequence of length [n].
    The sequence is uninitialized and contains arbitrary bytes.