Apply upstream patches

CONTRIBUTING.md

@@ -65,3 +65,18 @@ $ nix-build nix/ci/test.nix
 ```
 
 If that all passes, then congratulations! You are well on your way to becoming a contributor 🎉
+
+
+## Update JS Reserved Keywords Map
+
+The compiler sources include a list of reserved JS keywords in
+`jscomp/ext/js_reserved_map.ml` which includes all identifiers in global scope
+(`window` / `globalThis`). This list should be updated from time to time for
+newer browser versions.
+
+To update it, run:
+
+```sh
+npm install puppeteer
+node scripts/build_reserved.js
+```

jscomp/common/ast_utf8_string.ml

@@ -151,3 +151,15 @@ let transform loc s =
     Buffer.contents buf
   with Error (offset, error) ->
     Location.raise_errorf ~loc "Offset: %d, %a" offset pp_error error
+
+let rec check_no_escapes_or_unicode (s : string) (byte_offset : int) (s_len : int) =
+  if byte_offset = s_len then true
+  else
+    let current_char = s.[byte_offset] in
+    match Ext_utf8.classify current_char with
+    | Single 92 (* '\\' *) -> false
+    | Single _ -> check_no_escapes_or_unicode s (byte_offset + 1) s_len
+    | Invalid | Cont _ | Leading _ -> false
+
+let simple_comparison s =
+  check_no_escapes_or_unicode s 0 (String.length s)

jscomp/common/ast_utf8_string.mli

@@ -33,3 +33,6 @@ val pp_error : Format.formatter -> error -> unit
 (* end *)
 val transform_test : string -> string
 val transform : Location.t -> string -> string
+
+(* Check if the string is only == to itself (no unicode or escape tricks) *)
+val simple_comparison : string -> bool

jscomp/common/bs_ast_invariant.ml

@@ -100,10 +100,7 @@ let check_constant loc kind (const : Parsetree.constant) =
     *)
     (
       try
-        ignore (
-          if String.length s = 0 || s.[0] = '-' then
-            Int32.of_string s
-          else Int32.of_string ("-" ^ s))
+        ignore (Int32.of_string s)
       with _ ->
         Bs_warnings.warn_literal_overflow loc
     )

jscomp/common/ext_log.ml

@@ -26,7 +26,7 @@ type 'a logging = ('a, Format.formatter, unit, unit, unit, unit) format6 -> 'a
 
 (* TODO: add {[@.]} later for all *)
 let dwarn ?(__POS__ : (string * int * int * int) option) f =
-  if Js_config.get_diagnose () then
+  if !Js_config.diagnose then
     match __POS__ with
     | None -> Format.fprintf Format.err_formatter ("WARN: " ^^ f ^^ "@.")
     | Some (file, line, _, _) ->

jscomp/common/external_ffi_types.ml

@@ -283,12 +283,10 @@ let from_string s : t =
 
 let inline_string_primitive (s : string) (op : string option) : string list =
   let lam : Lam_constant.t =
-    match op with
-    | Some op
-    when Ast_utf8_string_interp.is_unicode_string op ->
-      Const_unicode s
-    | _ ->
-      (Const_string s) in
+    let unicode = match op with
+      | Some op -> Ast_utf8_string_interp.is_unicode_string op
+      | None -> false in
+    (Const_string { s; unicode }) in
   [""; to_string (Ffi_inline_const lam )]
 
 (* Let's only do it for string ATM

jscomp/common/js_config.cppo.ml

@@ -76,15 +76,7 @@ let stdlib_paths =
 let no_version_header = ref false
 
 let cross_module_inline = ref false
-
-
-
 let diagnose = ref false
-let get_diagnose () =
-    !diagnose
-#ifndef BS_RELEASE_BUILD
-  || Sys.getenv_opt "RES_DEBUG_FILE" <> None
-#endif
 
 let no_builtin_ppx = ref false
 

jscomp/common/js_config.mli

@@ -48,9 +48,6 @@ val cross_module_inline : bool ref
 val diagnose : bool ref
 (** diagnose option *)
 
-val get_diagnose : unit -> bool
-(* val set_diagnose : bool -> unit  *)
-
 val no_builtin_ppx : bool ref
 (** options for builtin ppx *)
 

jscomp/common/lam.ml

@@ -425,7 +425,8 @@ let switch lam (lam_switch : lambda_switch) : t =
 
 let stringswitch (lam : t) cases default : t =
   match lam with
-  | Lconst (Const_string a) -> Ext_list.assoc_by_string cases a default
+  | Lconst (Const_string { s; unicode = false }) ->
+      Ext_list.assoc_by_string cases s default
   | _ -> Lstringswitch (lam, cases, default)
 
 let true_ : t = Lconst Const_js_true
@@ -481,7 +482,7 @@ module Lift = struct
      Lconst ((Const_nativeint b)) *)
 
   let int64 b : t = Lconst (Const_int64 b)
-  let string b : t = Lconst (Const_string b)
+  let string s : t = Lconst (Const_string { s; unicode = false })
   let char b : t = Lconst (Const_char b)
 end
 
@@ -497,8 +498,8 @@ let prim ~primitive:(prim : Lam_primitive.t) ~args loc : t =
           Lift.int (Int32.of_float (float_of_string a))
       (* | Pnegfloat -> Lift.float (-. a) *)
       (* | Pabsfloat -> Lift.float (abs_float a) *)
-      | Pstringlength, Const_string a ->
-          Lift.int (Int32.of_int (String.length a))
+      | Pstringlength, Const_string { s; unicode = false } ->
+          Lift.int (Int32.of_int (String.length s))
       (* | Pnegbint Pnativeint, ( (Const_nativeint i)) *)
       (*   ->   *)
       (*   Lift.nativeint (Nativeint.neg i) *)
@@ -569,8 +570,13 @@ let prim ~primitive:(prim : Lam_primitive.t) ~args loc : t =
       | Psequor, Const_js_true, (Const_js_true | Const_js_false) -> true_
       | Psequor, Const_js_false, Const_js_true -> true_
       | Psequor, Const_js_false, Const_js_false -> false_
-      | Pstringadd, Const_string a, Const_string b -> Lift.string (a ^ b)
-      | (Pstringrefs | Pstringrefu), Const_string a, Const_int { i = b } -> (
+      | ( Pstringadd,
+          Const_string { s = a; unicode = false },
+          Const_string { s = b; unicode = false } ) ->
+          Lift.string (a ^ b)
+      | ( (Pstringrefs | Pstringrefu),
+          Const_string { s = a; unicode = false },
+          Const_int { i = b } ) -> (
           try Lift.char (String.get a (Int32.to_int b)) with _ -> default ())
       | _ -> default ())
   | _ -> (
@@ -647,7 +653,7 @@ let rec eval_const_as_bool (v : Lam_constant.t) : bool =
   | Const_js_false | Const_js_null | Const_module_alias | Const_js_undefined ->
       false
   | Const_js_true | Const_string _ | Const_pointer _ | Const_float _
-  | Const_unicode _ | Const_block _ | Const_float_array _ ->
+  | Const_block _ | Const_float_array _ ->
       true
   | Const_some b -> eval_const_as_bool b
 

jscomp/common/lam_constant.ml

@@ -43,8 +43,7 @@ type t =
   | Const_js_false
   | Const_int of { i : int32; comment : pointer_info }
   | Const_char of char
-  | Const_string of string (* use record later *)
-  | Const_unicode of string
+  | Const_string of { s : string; unicode : bool }
   | Const_float of string
   | Const_int64 of int64
   | Const_pointer of string
@@ -65,9 +64,10 @@ let rec eq_approx (x : t) (y : t) =
   | Const_js_false -> y = Const_js_false
   | Const_int ix -> ( match y with Const_int iy -> ix.i = iy.i | _ -> false)
   | Const_char ix -> ( match y with Const_char iy -> ix = iy | _ -> false)
-  | Const_string ix -> ( match y with Const_string iy -> ix = iy | _ -> false)
-  | Const_unicode ix -> (
-      match y with Const_unicode iy -> ix = iy | _ -> false)
+  | Const_string { s = sx; unicode = ux } -> (
+      match y with
+      | Const_string { s = sy; unicode = uy } -> sx = sy && ux = uy
+      | _ -> false)
   | Const_float ix -> ( match y with Const_float iy -> ix = iy | _ -> false)
   | Const_int64 ix -> ( match y with Const_int64 iy -> ix = iy | _ -> false)
   | Const_pointer ix -> (

jscomp/common/lam_constant.mli

@@ -39,8 +39,7 @@ type t =
   | Const_js_false
   | Const_int of { i : int32; comment : pointer_info }
   | Const_char of char
-  | Const_string of string (* use record later *)
-  | Const_unicode of string
+  | Const_string of { s : string; unicode : bool }
   | Const_float of string
   | Const_int64 of int64
   | Const_pointer of string

jscomp/core/js_dump.ml

@@ -691,7 +691,10 @@ and expression_desc cxt ~(level : int) x : cxt =
       expression ~level:13 cxt e
   | Bin
       ( Minus,
-        { expression_desc = Number (Int { i = 0l; _ } | Float { f = "0." }) },
+        {
+          expression_desc =
+            Number ((Int { i = 0l; _ } | Float { f = "0." }) as desc);
+        },
         e )
   (* TODO:
      Handle multiple cases like
@@ -700,7 +703,7 @@ and expression_desc cxt ~(level : int) x : cxt =
      {[ 0.000 - x ]}
   *) ->
       cond_paren_group cxt (level > 13) 1 (fun _ ->
-          string cxt "-";
+          string cxt (match desc with Float _ -> "- " | _ -> "-");
           expression ~level:13 cxt e)
   | Bin (op, e1, e2) ->
       let out, lft, rght = Js_op_util.op_prec op in

jscomp/core/js_exp_make.ml

@@ -495,6 +495,18 @@ let zero_float_lit : t = make_expression (Number (Float { f = "0." }))
 let float_mod ?loc ?comment e1 e2 : J.expression =
   make_expression ?loc ?comment (Bin (Mod, e1, e2))
 
+let str_equal (str0 : J.expression_desc) (str1 : J.expression_desc) =
+  match (str0, str1) with
+  | Str (_, txt0), Str (_, txt1) | Unicode txt0, Unicode txt1 ->
+      if Ext_string.equal txt0 txt1 then Some true
+      else if
+        Ast_utf8_string.simple_comparison txt0
+        && Ast_utf8_string.simple_comparison txt1
+      then Some false
+      else None
+  | Str _, Unicode _ | Unicode _, Str _ -> None
+  | _ -> None
+
 let rec triple_equal ?loc ?comment (e0 : t) (e1 : t) : t =
   match (e0.expression_desc, e1.expression_desc) with
   | ( (Null | Undefined),
@@ -507,9 +519,6 @@ let rec triple_equal ?loc ?comment (e0 : t) (e1 : t) : t =
       (Null | Undefined) )
     when no_side_effect e0 ->
       false_
-  | Str (_, x), Str (_, y) ->
-      (* CF*)
-      bool (Ext_string.equal x y)
   | Char_to_int a, Char_to_int b -> triple_equal ?comment a b
   | Char_to_int a, Number (Int { i = _; c = Some v })
   | Number (Int { i = _; c = Some v }), Char_to_int a ->
@@ -696,10 +705,9 @@ let rec float_equal ?loc ?comment (e0 : t) (e1 : t) : t =
 let int_equal = float_equal
 
 let string_equal ?loc ?comment (e0 : t) (e1 : t) : t =
-  match (e0.expression_desc, e1.expression_desc) with
-  | Str (_, a0), Str (_, b0) -> bool (Ext_string.equal a0 b0)
-  | Unicode a0, Unicode b0 -> bool (Ext_string.equal a0 b0)
-  | _, _ -> make_expression ?loc ?comment (Bin (EqEqEq, e0, e1))
+  match str_equal e0.expression_desc e1.expression_desc with
+  | Some b -> bool b
+  | None -> make_expression ?loc ?comment (Bin (EqEqEq, e0, e1))
 
 let is_type_number ?loc ?comment (e : t) : t =
   string_equal ?loc ?comment (typeof e) (str "number")
@@ -786,12 +794,9 @@ let uint32 ?loc ?comment n : J.expression =
   make_expression ?loc ?comment (Number (Uint n))
 
 let string_comp (cmp : J.binop) ?loc ?comment (e0 : t) (e1 : t) =
-  match (e0.expression_desc, e1.expression_desc) with
-  | Str (_, a0), Str (_, b0) | Unicode a0, Unicode b0 -> (
-      match cmp with
-      | EqEqEq -> bool (a0 = b0)
-      | NotEqEq -> bool (a0 <> b0)
-      | _ -> bin ?loc ?comment cmp e0 e1)
+  match (cmp, str_equal e0.expression_desc e1.expression_desc) with
+  | EqEqEq, Some b -> bool b
+  | NotEqEq, Some b -> bool (b = false)
   | _ -> bin ?loc ?comment cmp e0 e1
 
 let obj_length ?loc ?comment e : t =

jscomp/core/js_pass_debug.ml

@@ -35,7 +35,7 @@ let log_counter = ref 0
 let dump name (prog : J.program) =
   begin
     let () =
-      if Js_config.get_diagnose ()
+      if !Js_config.diagnose
       then
         begin
           incr log_counter ;

jscomp/core/lam_analysis.ml

@@ -206,7 +206,6 @@ and size_constant x =
   | Const_js_null | Const_js_undefined | Const_module_alias | Const_js_true
   | Const_js_false ->
       1
-  | Const_unicode _ (* TODO: this seems to be not good heurisitives*)
   | Const_string _ ->
       1
   | Const_some s -> size_constant s

jscomp/core/lam_compile_const.ml

@@ -1,5 +1,5 @@
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
- * 
+ *
  * 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, either version 3 of the License, or
@@ -17,7 +17,7 @@
  * 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. *)
@@ -62,16 +62,16 @@ and translate (x : Lam_constant.t) : J.expression =
          Int64.(to_float max_int);;
          - : float = 9.22337203685477581e+18
        ]}
-       Note we should compile it to Int64 as JS's 
-       speical representation -- 
+       Note we should compile it to Int64 as JS's
+       speical representation --
        it is not representatble in JS number
     *)
       (* E.float (Int64.to_string i) *)
       Js_long.of_const i
       (* https://github.com/google/closure-library/blob/master/closure%2Fgoog%2Fmath%2Flong.js *)
   | Const_float f -> E.float f (* TODO: preserve float *)
-  | Const_string i (*TODO: here inline js*) -> E.str i
-  | Const_unicode i -> E.unicode i
+  | Const_string { s; unicode = false } -> E.str s
+  | Const_string { s; unicode = true } -> E.unicode s
   | Const_pointer name -> E.str name
   | Const_block (tag, tag_info, xs) ->
       Js_of_lam_block.make_block NA tag_info (E.small_int tag)

jscomp/core/lam_compile_main.ml

@@ -208,7 +208,7 @@ let compile
 #ifndef BS_RELEASE_BUILD
 let () =
   Ext_log.dwarn ~__POS__ "After coercion: %a@." Lam_stats.print meta ;
-  if Js_config.get_diagnose () then
+  if !Js_config.diagnose then
     let f =
       Ext_filename.new_extension !Location.input_name  ".lambda" in
     Ext_fmt.with_file_as_pp f (fun fmt ->

jscomp/core/lam_constant_convert.ml

@@ -43,17 +43,19 @@ let rec convert_constant (const : Lambda.structured_constant) : Lam_constant.t =
       | Pt_variant { name } -> Const_pointer name
       | Pt_na -> Const_int { i = Int32.of_int i; comment = None })
   | Const_base (Const_char i, _) -> Const_char i
-  | Const_base (Const_string (i, _, opt), _) -> (
-      match opt with
-      | Some opt when Ast_utf8_string_interp.is_unicode_string opt ->
-          Const_unicode i
-      | _ -> Const_string i)
+  | Const_base (Const_string (s, _, opt), _) ->
+      let unicode =
+        match opt with
+        | Some opt -> Ast_utf8_string_interp.is_unicode_string opt
+        | _ -> false
+      in
+      Const_string { s; unicode }
   | Const_base (Const_float i, _) -> Const_float i
   | Const_base (Const_int32 i, _) -> Const_int { i; comment = None }
   | Const_base (Const_int64 i, _) -> Const_int64 i
   | Const_base (Const_nativeint _, _) -> assert false
   | Const_float_array s -> Const_float_array s
-  | Const_immstring s -> Const_string s
+  | Const_immstring s -> Const_string { s; unicode = false }
   | Const_block (i, t, xs) -> (
       match t with
       | Blk_some_not_nested ->
@@ -75,7 +77,12 @@ let rec convert_constant (const : Lambda.structured_constant) : Lam_constant.t =
           match xs with
           | [ _; value ] ->
               let t : Lam_tag_info.t = Blk_poly_var in
-              Const_block (i, t, [ Const_string s; convert_constant value ])
+              Const_block
+                ( i,
+                  t,
+                  [
+                    Const_string { s; unicode = false }; convert_constant value;
+                  ] )
           | _ -> assert false)
       | Blk_record s ->
           let t : Lam_tag_info.t = Blk_record s in