Clean up str const

jscomp/core/lam.ml

@@ -23,7 +23,6 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
 type ident = Ident.t
-
 type apply_status = App_na | App_infer_full | App_uncurry
 
 type ap_info = {
@@ -414,13 +413,12 @@ 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
-
 let false_ : t = Lconst Const_js_false
-
 let unit : t = Lconst Const_js_undefined
 
 let rec seq (a : t) b : t =
@@ -436,28 +434,19 @@ let rec seq (a : t) b : t =
   | _ -> Lsequence (a, b)
 
 let var id : t = Lvar id
-
 let global_module id = Lglobal_module id
-
 let const ct : t = Lconst ct
 
 let function_ ~attr ~arity ~params ~body : t =
   Lfunction { arity; params; body; attr }
 
 let let_ kind id e body : t = Llet (kind, id, e, body)
-
 let letrec bindings body : t = Lletrec (bindings, body)
-
 let while_ a b : t = Lwhile (a, b)
-
 let try_ body id handler : t = Ltrywith (body, id, handler)
-
 let for_ v e1 e2 dir e3 : t = Lfor (v, e1, e2, dir, e3)
-
 let assign v l : t = Lassign (v, l)
-
 let staticcatch a b c : t = Lstaticcatch (a, b, c)
-
 let staticraise a b : t = Lstaticraise (a, b)
 
 module Lift = struct
@@ -478,9 +467,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
 
@@ -496,8 +483,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) *)
@@ -568,8 +555,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 ())
   | _ -> (
@@ -646,7 +638,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/core/lam_analysis.ml

@@ -197,7 +197,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

@@ -70,8 +70,8 @@ and translate (x : Lam_constant.t) : J.expression =
       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.str ~delim:(Some "j") i
+  | Const_string { s; unicode = false } -> E.str s
+  | Const_string { s; unicode = true } -> E.str ~delim:(Some "j") 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_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/core/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/lam_constant_convert.ml

@@ -26,11 +26,13 @@ let rec convert_constant (const : Lambda.structured_constant) : Lam_constant.t =
   match const with
   | Const_base (Const_int i) -> 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
@@ -58,7 +60,7 @@ let rec convert_constant (const : Lambda.structured_constant) : Lam_constant.t =
               { i = Ext_string.hash_number_as_i32_exn name; comment = None }
           else Const_pointer name)
   | Const_float_array s -> Const_float_array s
-  | Const_immstring s -> Const_string s
+  | Const_immstring s -> Const_string { s; unicode = false }
   | Const_block (t, xs) -> (
       let tag = Lambda.tag_of_tag_info t in
       match t with
@@ -76,7 +78,7 @@ let rec convert_constant (const : Lambda.structured_constant) : Lam_constant.t =
                 if Ext_string.is_valid_hash_number s then
                   Const_int
                     { i = Ext_string.hash_number_as_i32_exn s; comment = None }
-                else Const_string s
+                else Const_string { s; unicode = false }
               in
               Const_block (tag, t, [ tag_val; convert_constant value ])
           | _ -> assert false)

jscomp/core/lam_convert.ml

@@ -26,7 +26,6 @@ let caml_id_field_info : Lambda.field_dbg_info =
   Fld_record { name = Literals.exception_id; mutable_flag = Immutable }
 
 let lam_caml_id : Lam_primitive.t = Pfield (0, caml_id_field_info)
-
 let prim = Lam.prim
 
 let lam_extension_id loc (head : Lam.t) =
@@ -112,7 +111,6 @@ let exception_id_destructed (l : Lam.t) (fv : Ident.t) : bool =
   hit l
 
 let abs_int x = if x < 0 then -x else x
-
 let no_over_flow x = abs_int x < 0x1fff_ffff
 
 let lam_is_var (x : Lam.t) (y : Ident.t) =
@@ -129,7 +127,7 @@ let happens_to_be_diff (sw_consts : (int * Lambda.lambda) list) : int option =
     :: ( b,
          Lconst
            (Const_pointer (b0, Pt_constructor _) | Const_base (Const_int b0)) )
-       :: rest
+    :: rest
     when no_over_flow a && no_over_flow a0 && no_over_flow b && no_over_flow b0
     ->
       let diff = a0 - a in
@@ -188,7 +186,7 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args loc : Lam.t =
                 if Ext_string.is_valid_hash_number s then
                   Const_int
                     { i = Ext_string.hash_number_as_i32_exn s; comment = None }
-                else Const_string s
+                else Const_string { s; unicode = false }
               in
               prim
                 ~primitive:(Pmakeblock (tag, info, mutable_flag))
@@ -544,7 +542,8 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) :
     | Lprim (Pccall a, args, loc) -> convert_ccall a args loc
     | Lprim (Pgetglobal id, args, _) ->
         let args = Ext_list.map args convert_aux in
-        if Ident.is_predef_exn id then Lam.const (Const_string id.name)
+        if Ident.is_predef_exn id then
+          Lam.const (Const_string { s = id.name; unicode = false })
         else (
           may_depend may_depends (Lam_module_ident.of_ml id);
           assert (args = []);

jscomp/core/lam_eta_conversion.ml

@@ -42,7 +42,7 @@ let transform_under_supply n ap_info fn args =
         match lam with
         | Lvar _
         | Lconst
-            ( Const_int _ | Const_char _ | Const_string _ | Const_unicode _ | Const_float _
+            ( Const_int _ | Const_char _ | Const_string _ | Const_float _
             | Const_int64 _ | Const_pointer _ | Const_js_true | Const_js_false
             | Const_js_undefined )
         | Lprim { primitive = Pfield (_, Fld_module _); _ }

jscomp/core/lam_pass_lets_dce.ml

@@ -67,7 +67,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t =
           *)
           ->
           Hash_ident.add subst v (simplif l1); simplif l2
-        | _, Lconst (Const_string s ) -> 
+        | _, Lconst (Const_string {s; unicode = false} ) -> 
           (* only "" added for later inlining *)
           Hash_ident.add string_table v s;
           Lam.let_ Alias v l1 (simplif l2)
@@ -116,7 +116,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t =
           | _ -> 
             let l1 = simplif l1 in         
             begin match l1 with 
-              | Lconst(Const_string s) -> 
+              | Lconst(Const_string { s; unicode = false }) -> 
                 Hash_ident.add string_table v s; 
                 (* we need move [simplif lbody] later, since adding Hash does have side effect *)
                 Lam.let_ Alias v l1 (simplif lbody)
@@ -138,7 +138,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t =
         let l1 = (simplif l1) in 
 
         begin match kind, l1 with 
-          | Strict, Lconst((Const_string s))
+          | Strict, Lconst((Const_string { s; unicode = false }))
             -> 
             Hash_ident.add string_table v s;
             Lam.let_ Alias v l1 (simplif l2)
@@ -173,21 +173,21 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t =
         let r' = simplif r in
         let opt_l = 
           match l' with 
-          | Lconst((Const_string ls)) -> Some ls 
+          | Lconst(Const_string { s = ls; unicode = false }) -> Some ls 
           | Lvar i -> Hash_ident.find_opt string_table i 
           | _ -> None in 
         match opt_l with   
         | None -> Lam.prim ~primitive:Pstringadd ~args:[l';r'] loc 
         | Some l_s -> 
           let opt_r = 
             match r' with 
-            | Lconst ( (Const_string rs)) -> Some rs 
+            | Lconst (Const_string {s = rs; unicode = false}) -> Some rs 
             | Lvar i -> Hash_ident.find_opt string_table i 
             | _ -> None in 
           begin match opt_r with 
             | None -> Lam.prim ~primitive:Pstringadd ~args:[l';r'] loc 
             | Some r_s -> 
-              Lam.const (Const_string(l_s^r_s))
+              Lam.const (Const_string { s = l_s^r_s; unicode = false })
           end
       end
 
@@ -198,7 +198,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t =
       let r' = simplif r in 
       let opt_l =
         match l' with 
-        | Lconst (Const_string ls) -> 
+        | Lconst (Const_string { s = ls; unicode = false }) -> 
           Some ls 
         | Lvar i -> Hash_ident.find_opt string_table i 
         | _ -> None in 

jscomp/core/lam_pass_lets_dce.pp.ml

@@ -66,7 +66,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t =
           *)
           ->
           Hash_ident.add subst v (simplif l1); simplif l2
-        | _, Lconst (Const_string s ) -> 
+        | _, Lconst (Const_string {s; unicode = false} ) -> 
           (* only "" added for later inlining *)
           Hash_ident.add string_table v s;
           Lam.let_ Alias v l1 (simplif l2)
@@ -115,7 +115,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t =
           | _ -> 
             let l1 = simplif l1 in         
             begin match l1 with 
-              | Lconst(Const_string s) -> 
+              | Lconst(Const_string { s; unicode = false }) -> 
                 Hash_ident.add string_table v s; 
                 (* we need move [simplif lbody] later, since adding Hash does have side effect *)
                 Lam.let_ Alias v l1 (simplif lbody)
@@ -137,7 +137,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t =
         let l1 = (simplif l1) in 
 
         begin match kind, l1 with 
-          | Strict, Lconst((Const_string s))
+          | Strict, Lconst((Const_string { s; unicode = false }))
             -> 
             Hash_ident.add string_table v s;
             Lam.let_ Alias v l1 (simplif l2)
@@ -172,21 +172,21 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t =
         let r' = simplif r in
         let opt_l = 
           match l' with 
-          | Lconst((Const_string ls)) -> Some ls 
+          | Lconst(Const_string { s = ls; unicode = false }) -> Some ls 
           | Lvar i -> Hash_ident.find_opt string_table i 
           | _ -> None in 
         match opt_l with   
         | None -> Lam.prim ~primitive:Pstringadd ~args:[l';r'] loc 
         | Some l_s -> 
           let opt_r = 
             match r' with 
-            | Lconst ( (Const_string rs)) -> Some rs 
+            | Lconst (Const_string {s = rs; unicode = false}) -> Some rs 
             | Lvar i -> Hash_ident.find_opt string_table i 
             | _ -> None in 
           begin match opt_r with 
             | None -> Lam.prim ~primitive:Pstringadd ~args:[l';r'] loc 
             | Some r_s -> 
-              Lam.const (Const_string(l_s^r_s))
+              Lam.const (Const_string { s = l_s^r_s; unicode = false })
           end
       end
 
@@ -197,7 +197,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t =
       let r' = simplif r in 
       let opt_l =
         match l' with 
-        | Lconst (Const_string ls) -> 
+        | Lconst (Const_string { s = ls; unicode = false }) -> 
           Some ls 
         | Lvar i -> Hash_ident.find_opt string_table i 
         | _ -> None in 

jscomp/core/lam_print.ml

@@ -22,8 +22,7 @@ let rec struct_const ppf (cst : Lam_constant.t) =
   | Const_js_undefined -> fprintf ppf "#undefined"
   | Const_int { i } -> fprintf ppf "%ld" i
   | Const_char c -> fprintf ppf "%C" c
-  | Const_string s -> fprintf ppf "%S" s
-  | Const_unicode s -> fprintf ppf "%S" s
+  | Const_string { s } -> fprintf ppf "%S" s
   | Const_float f -> fprintf ppf "%s" f
   | Const_int64 n -> fprintf ppf "%LiL" n
   | Const_pointer name -> fprintf ppf "`%s" name

jscomp/frontend/external_ffi_types.ml

@@ -309,12 +309,10 @@ let () =
     )
 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