Clean up string processing

cknitt · cknitt · commit c8c1654da5a4 · 2025-09-06T12:14:52.000+02:00
diff --git a/compiler/core/j.ml b/compiler/core/j.ml
@@ -75,7 +75,7 @@ and for_ident = ident
 and for_direction = Js_op.direction_flag
 and property_map = (property_name * expression) list
 and length_object = Js_op.length_object
-and delim = External_arg_spec.delim = DNone | DStarJ | DNoQuotes | DBackQuotes
+and string_kind = String_kind.t = Standard | Verbatim | RawJs | Template
 
 and expression_desc =
   | Length of expression * length_object
@@ -139,7 +139,7 @@ and expression_desc =
       async: bool;
       directive: string option;
     }
-  | Str of {delim: delim; txt: string}
+  | Str of {kind: string_kind; txt: string}
   (* A string is UTF-8 encoded, and may contain
      escape sequences.
   *)
diff --git a/compiler/core/js_analyzer.ml b/compiler/core/js_analyzer.ml
@@ -201,9 +201,9 @@ let rec eq_expression ({expression_desc = x0} : J.expression)
     | Bin (op1, a1, b1) ->
       op0 = op1 && eq_expression a0 a1 && eq_expression b0 b1
     | _ -> false)
-  | Str {delim = a0; txt = b0} -> (
+  | Str {kind = a0; txt = b0} -> (
     match y0 with
-    | Str {delim = a1; txt = b1} -> a0 = a1 && b0 = b1
+    | Str {kind = a1; txt = b1} -> a0 = a1 && b0 = b1
     | _ -> false)
   | Static_index (e0, p0, off0) -> (
     match y0 with
diff --git a/compiler/core/js_dump.ml b/compiler/core/js_dump.ml
@@ -720,16 +720,16 @@ and expression_desc cxt ~(level : int) f x : cxt =
         P.string f L.code_point_at;
         (* FIXME: use code_point_at *)
         P.paren_group f 1 (fun _ -> expression ~level:0 cxt f b))
-  | Str {delim; txt} ->
+  | Str {kind; txt} ->
     (*TODO --
        when utf8-> it will not escape '\\' which is definitely not we want
     *)
     let () =
-      match delim with
-      | DStarJ -> P.string f ("\"" ^ txt ^ "\"")
-      | DNoQuotes -> P.string f txt
-      | DNone -> Js_dump_string.pp_string f txt
-      | DBackQuotes -> P.string f ("`" ^ txt ^ "`")
+      match kind with
+      | Verbatim -> P.string f ("\"" ^ txt ^ "\"")
+      | RawJs -> P.string f txt
+      | Standard -> Js_dump_string.pp_string f txt
+      | Template -> P.string f ("`" ^ txt ^ "`")
     in
     cxt
   | Raw_js_code {code = s; code_info = info} -> (
diff --git a/compiler/core/js_exp_make.ml b/compiler/core/js_exp_make.ml
@@ -156,8 +156,8 @@ let pure_runtime_call module_name fn_name args =
 
 let runtime_ref module_name fn_name = runtime_var_dot module_name fn_name
 
-let str ?(delim = J.DNone) ?comment txt : t =
-  {expression_desc = Str {txt; delim}; comment}
+let str ?(kind = J.Standard) ?comment txt : t =
+  {expression_desc = Str {txt; kind}; comment}
 
 let raw_js_code ?comment info s : t =
   {
@@ -209,7 +209,7 @@ let instanceof ?comment (e0 : t) (e1 : t) : t =
   {expression_desc = Bin (InstanceOf, e0, e1); comment}
 
 let is_array (e0 : t) : t =
-  let f = str "Array.isArray" ~delim:DNoQuotes in
+  let f = str "Array.isArray" ~kind:RawJs in
   {expression_desc = Call (f, [e0], Js_call_info.ml_full_call); comment = None}
 
 let new_ ?comment e0 args : t = {expression_desc = New (e0, Some args); comment}
@@ -548,7 +548,8 @@ let array_length ?comment (e : t) : t =
 
 let string_length ?comment (e : t) : t =
   match e.expression_desc with
-  | Str {txt; delim = DNone} -> int ?comment (Int32.of_int (String.length txt))
+  | Str {txt; kind = Standard} ->
+    int ?comment (Int32.of_int (String.length txt))
   (* No optimization for {j||j}*)
   | _ -> {expression_desc = Length (e, String); comment}
 
@@ -566,31 +567,31 @@ let function_length ?comment (e : t) : t =
 *)
 
 let rec string_append ?comment (e : t) (el : t) : t =
-  let concat a b ~delim = {e with expression_desc = Str {txt = a ^ b; delim}} in
+  let concat a b ~kind = {e with expression_desc = Str {txt = a ^ b; kind}} in
   match (e.expression_desc, el.expression_desc) with
   | Str {txt = ""}, _ -> el
   | _, Str {txt = ""} -> e
-  | ( Str {txt = a; delim},
-      String_append ({expression_desc = Str {txt = b; delim = delim_}}, c) )
-    when delim = delim_ ->
-    string_append ?comment (concat a b ~delim) c
-  | ( String_append (c, {expression_desc = Str {txt = b; delim}}),
-      Str {txt = a; delim = delim_} )
-    when delim = delim_ ->
-    string_append ?comment c (concat b a ~delim)
-  | ( String_append (a, {expression_desc = Str {txt = b; delim}}),
-      String_append ({expression_desc = Str {txt = c; delim = delim_}}, d) )
-    when delim = delim_ ->
-    string_append ?comment (string_append a (concat b c ~delim)) d
-  | Str {txt = a; delim}, Str {txt = b; delim = delim_} when delim = delim_ ->
-    {(concat a b ~delim) with comment}
+  | ( Str {txt = a; kind},
+      String_append ({expression_desc = Str {txt = b; kind = kind_}}, c) )
+    when kind = kind_ ->
+    string_append ?comment (concat a b ~kind) c
+  | ( String_append (c, {expression_desc = Str {txt = b; kind}}),
+      Str {txt = a; kind = kind_} )
+    when kind = kind_ ->
+    string_append ?comment c (concat b a ~kind)
+  | ( String_append (a, {expression_desc = Str {txt = b; kind}}),
+      String_append ({expression_desc = Str {txt = c; kind = kind_}}, d) )
+    when kind = kind_ ->
+    string_append ?comment (string_append a (concat b c ~kind)) d
+  | Str {txt = a; kind}, Str {txt = b; kind = kind_} when kind = kind_ ->
+    {(concat a b ~kind) with comment}
   | _, _ -> {comment; expression_desc = String_append (e, el)}
 
 let obj ?comment ?dup properties : t =
   {expression_desc = Object (dup, properties); comment}
 
-let str_equal (txt0 : string) (delim0 : External_arg_spec.delim) txt1 delim1 =
-  if delim0 = delim1 then
+let str_equal (txt0 : string) (kind0 : String_kind.t) txt1 kind1 =
+  if kind0 = kind1 then
     if Ext_string.equal txt0 txt1 then Some true
     else if
       Ast_utf8_string.simple_comparison txt0
@@ -1242,7 +1243,7 @@ let rec float_equal ?comment (e0 : t) (e1 : t) : t =
 let int_equal = float_equal
 
 let tag_type = function
-  | Ast_untagged_variants.String s -> str s ~delim:DStarJ
+  | Ast_untagged_variants.String s -> str s ~kind:Verbatim
   | Int i -> small_int i
   | Float f -> float f
   | BigInt i ->
@@ -1258,7 +1259,7 @@ let tag_type = function
   | Untagged FunctionType -> str "function"
   | Untagged StringType -> str "string"
   | Untagged (InstanceType i) ->
-    str (Ast_untagged_variants.Instance.to_string i) ~delim:DNoQuotes
+    str (Ast_untagged_variants.Instance.to_string i) ~kind:RawJs
   | Untagged ObjectType -> str "object"
   | Untagged UnknownType ->
     (* TODO: this should not happen *)
@@ -1280,7 +1281,7 @@ let rec emit_check (check : t Ast_untagged_variants.DynamicChecks.t) =
   | IsInstanceOf (Array, x) -> is_array (emit_check x)
   | IsInstanceOf (instance, x) ->
     let instance_name = Ast_untagged_variants.Instance.to_string instance in
-    instanceof (emit_check x) (str instance_name ~delim:DNoQuotes)
+    instanceof (emit_check x) (str instance_name ~kind:RawJs)
   | Not x -> not (emit_check x)
   | Expr x -> x
 
@@ -1343,8 +1344,8 @@ let to_int32 ?comment (e : J.expression) : J.expression =
 
 let string_comp (cmp : Lam_compat.comparison) ?comment (e0 : t) (e1 : t) =
   match (e0.expression_desc, e1.expression_desc) with
-  | Str {txt = a0; delim = d0}, Str {txt = a1; delim = d1} -> (
-    match (cmp, str_equal a0 d0 a1 d1) with
+  | Str {txt = a0; kind = k0}, Str {txt = a1; kind = k1} -> (
+    match (cmp, str_equal a0 k0 a1 k1) with
     | Ceq, Some b -> bool b
     | Cneq, Some b -> bool (b = false)
     | _ -> bin ?comment (Lam_compile_util.jsop_of_comp cmp) e0 e1)
diff --git a/compiler/core/js_exp_make.mli b/compiler/core/js_exp_make.mli
@@ -95,7 +95,7 @@ val pure_runtime_call :
 
 val runtime_ref : string -> string -> t
 
-val str : ?delim:J.delim -> ?comment:string -> string -> t
+val str : ?kind:J.string_kind -> ?comment:string -> string -> t
 
 val ocaml_fun :
   ?comment:string ->
diff --git a/compiler/core/lam.ml b/compiler/core/lam.ml
@@ -430,7 +430,7 @@ let switch lam (lam_switch : lambda_switch) : t =
 
 let stringswitch (lam : t) cases default : t =
   match lam with
-  | Lconst (Const_string {s; delim = None | Some DNoQuotes}) ->
+  | Lconst (Const_string {s; kind = RawJs}) ->
     Ext_list.assoc_by_string cases s default
   | _ -> Lstringswitch (lam, cases, default)
 
@@ -471,7 +471,7 @@ module Lift = struct
 
   let bool b = if b then true_ else false_
 
-  let string s : t = Lconst (Const_string {s; delim = None})
+  let string s : t = Lconst (Const_string {s; kind = Standard})
 
   let char b : t = Lconst (Const_char b)
 end
@@ -488,7 +488,7 @@ 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 {s; delim = None} ->
+    | Pstringlength, Const_string {s; kind = Standard} ->
       Lift.int (Int32.of_int (String.length s))
     (* | Pnegbint Pnativeint, ( (Const_nativeint i)) *)
     (*   ->   *)
@@ -537,11 +537,11 @@ let prim ~primitive:(prim : Lam_primitive.t) ~args loc : t =
     | Psequor, Const_js_false, Const_js_true -> true_
     | Psequor, Const_js_false, Const_js_false -> false_
     | ( Pstringadd,
-        Const_string {s = a; delim = None},
-        Const_string {s = b; delim = None} ) ->
+        Const_string {s = a; kind = Standard},
+        Const_string {s = b; kind = Standard} ) ->
       Lift.string (a ^ b)
     | ( (Pstringrefs | Pstringrefu),
-        Const_string {s = a; delim = None},
+        Const_string {s = a; kind = Standard},
         Const_int {i = b} ) -> (
       try Lift.char (Char.code (String.get a (Int32.to_int b)))
       with _ -> default ())
diff --git a/compiler/core/lam_compile_const.ml b/compiler/core/lam_compile_const.ml
@@ -61,8 +61,8 @@ and translate (x : Lam_constant.t) : J.expression =
   | Const_char i -> Js_of_lam_string.const_char i
   | Const_bigint (sign, i) -> E.bigint sign i
   | Const_float f -> E.float f (* TODO: preserve float *)
-  | Const_string {s; delim = None | Some DNoQuotes} -> E.str s
-  | Const_string {s; delim = Some delim} -> E.str ~delim s
+  | Const_string {s; kind = RawJs} -> E.str s
+  | Const_string {s; kind} -> E.str ~kind 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)
@@ -79,4 +79,4 @@ and translate (x : Lam_constant.t) : J.expression =
 let translate_arg_cst (cst : External_arg_spec.cst) =
   match cst with
   | Arg_int_lit i -> E.int (Int32.of_int i)
-  | Arg_string_lit (s, delim) -> E.str s ~delim
+  | Arg_string_lit (s, kind) -> E.str s ~kind
diff --git a/compiler/core/lam_constant_convert.ml b/compiler/core/lam_constant_convert.ml
@@ -27,8 +27,8 @@ let rec convert_constant (const : Lambda.structured_constant) : Lam_constant.t =
   | 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 (s, opt)) ->
-    let delim = Ast_utf8_string_interp.parse_processed_delim opt in
-    Const_string {s; delim}
+    let kind = Ast_utf8_string_interp.parse_processed_delim opt in
+    Const_string {s; kind = Option.value ~default:Standard kind}
   | Const_base (Const_float i) -> Const_float i
   | Const_base (Const_int32 i) -> Const_int {i; comment = None}
   | Const_base (Const_int64 _) -> assert false
@@ -59,7 +59,7 @@ let rec convert_constant (const : Lambda.structured_constant) : Lam_constant.t =
       if Ext_string.is_valid_hash_number name then
         Const_int {i = Ext_string.hash_number_as_i32_exn name; comment = None}
       else Const_pointer name)
-  | Const_immstring s -> Const_string {s; delim = None}
+  | Const_immstring s -> Const_string {s; kind = Standard}
   | Const_block (t, xs) -> (
     let tag = Lambda.tag_of_tag_info t in
     match t with
@@ -76,7 +76,7 @@ let rec convert_constant (const : Lambda.structured_constant) : Lam_constant.t =
         let tag_val : 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; delim = None}
+          else Const_string {s; kind = Standard}
         in
         Const_block (tag, t, [tag_val; convert_constant value])
       | _ -> assert false))
diff --git a/compiler/core/lam_convert.ml b/compiler/core/lam_convert.ml
@@ -184,7 +184,7 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args loc : Lam.t =
         let tag_val : 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; delim = None}
+          else Const_string {s; kind = Standard}
         in
         prim
           ~primitive:(Pmakeblock (tag, info, mutable_flag))
@@ -465,7 +465,7 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) :
     | Lprim (Pgetglobal id, args, _) ->
       let args = Ext_list.map args convert_aux in
       if Ident.is_predef_exn id then
-        Lam.const (Const_string {s = id.name; delim = None})
+        Lam.const (Const_string {s = id.name; kind = Standard})
       else (
         may_depend may_depends (Lam_module_ident.of_ml ~dynamic_import id);
         assert (args = []);
diff --git a/compiler/core/lam_pass_lets_dce.ml b/compiler/core/lam_pass_lets_dce.ml
@@ -63,7 +63,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; delim = None}) ->
+      | _, Lconst (Const_string {s; kind = Standard}) ->
         (* only "" added for later inlining *)
         Hash_ident.add string_table v s;
         Lam.let_ Alias v l1 (simplif l2)
@@ -112,7 +112,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t =
         | _ -> (
           let l1 = simplif l1 in
           match l1 with
-          | Lconst (Const_string {s; delim = None}) ->
+          | Lconst (Const_string {s; kind = Standard}) ->
             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)
@@ -127,7 +127,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t =
         let l1 = simplif l1 in
 
         match (kind, l1) with
-        | Strict, Lconst (Const_string {s; delim = None}) ->
+        | Strict, Lconst (Const_string {s; kind = Standard}) ->
           Hash_ident.add string_table v s;
           Lam.let_ Alias v l1 (simplif l2)
         | _ -> Lam_util.refine_let ~kind v l1 (simplif l2))
@@ -157,7 +157,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 {s = ls; delim = None}) -> Some ls
+        | Lconst (Const_string {s = ls; kind = Standard}) -> Some ls
         | Lvar i -> Hash_ident.find_opt string_table i
         | _ -> None
       in
@@ -166,13 +166,14 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t =
       | Some l_s -> (
         let opt_r =
           match r' with
-          | Lconst (Const_string {s = rs; delim = None}) -> Some rs
+          | Lconst (Const_string {s = rs; kind = Standard}) -> Some rs
           | Lvar i -> Hash_ident.find_opt string_table i
           | _ -> None
         in
         match opt_r with
         | None -> Lam.prim ~primitive:Pstringadd ~args:[l'; r'] loc
-        | Some r_s -> Lam.const (Const_string {s = l_s ^ r_s; delim = None})))
+        | Some r_s -> Lam.const (Const_string {s = l_s ^ r_s; kind = Standard}))
+      )
     | Lglobal_module _ -> lam
     | Lprim {primitive; args; loc} ->
       Lam.prim ~primitive ~args:(Ext_list.map args simplif) loc
diff --git a/compiler/frontend/ast_attributes.ml b/compiler/frontend/ast_attributes.ml
@@ -220,7 +220,7 @@ let iter_process_bs_int_as (attrs : t) =
       | _ -> ());
   !st
 
-type as_const_payload = Int of int | Str of string * External_arg_spec.delim
+type as_const_payload = Int of int | Str of string * String_kind.t
 
 let iter_process_bs_string_or_int_as (attrs : Parsetree.attributes) =
   let st = ref None in
@@ -248,13 +248,13 @@ let iter_process_bs_string_or_int_as (attrs : Parsetree.attributes) =
                 ]
               when Ast_utf8_string_interp.parse_processed_delim delim_ <> None
               -> (
-              let delim =
+              let kind =
                 match Ast_utf8_string_interp.parse_processed_delim delim_ with
                 | None -> assert false
-                | Some delim -> delim
+                | Some kind -> kind
               in
-              st := Some (Str (s, delim));
-              if delim = DNoQuotes then
+              st := Some (Str (s, kind));
+              if kind = RawJs then
                 (* check that it is a valid object literal *)
                 match
                   Classify_function.classify
diff --git a/compiler/frontend/ast_attributes.mli b/compiler/frontend/ast_attributes.mli
@@ -50,7 +50,7 @@ val has_unwrap_attr : t -> bool
 
 val iter_process_bs_int_as : t -> int option
 
-type as_const_payload = Int of int | Str of string * External_arg_spec.delim
+type as_const_payload = Int of int | Str of string * String_kind.t
 val iter_process_bs_string_or_int_as : t -> as_const_payload option
 
 val process_derive_type : t -> derive_attr * t
diff --git a/compiler/frontend/ast_external_process.ml b/compiler/frontend/ast_external_process.ml
@@ -89,7 +89,7 @@ let refine_arg_type ~(nolabel : bool) (ptyp : Ast_core_type.t) :
       | Int i ->
         (* This type is used in obj only to construct obj type*)
         Arg_cst (External_arg_spec.cst_int i)
-      | Str (i, delim) -> Arg_cst (External_arg_spec.cst_string i delim))
+      | Str (i, kind) -> Arg_cst (External_arg_spec.cst_string i kind))
   else (* ([`a|`b] [@string]) *)
     spec_of_ptyp nolabel ptyp
 
diff --git a/compiler/frontend/ast_utf8_string_interp.ml b/compiler/frontend/ast_utf8_string_interp.ml
@@ -272,10 +272,10 @@ let transform_test s =
 
 module Delim = struct
   let parse_processed = function
-    | None -> Some External_arg_spec.DNone
-    | Some "json" -> Some DNoQuotes
-    | Some "*j" -> Some DStarJ
-    | Some "bq" -> Some DBackQuotes
+    | None -> Some String_kind.Standard
+    | Some "json" -> Some RawJs
+    | Some "*j" -> Some Verbatim
+    | Some "bq" -> Some Template
     | _ -> None
 
   type interpolation =
diff --git a/compiler/frontend/ast_utf8_string_interp.mli b/compiler/frontend/ast_utf8_string_interp.mli
diff --git a/compiler/frontend/external_arg_spec.ml b/compiler/frontend/external_arg_spec.ml
diff --git a/compiler/frontend/external_arg_spec.mli b/compiler/frontend/external_arg_spec.mli
diff --git a/compiler/frontend/external_ffi_types.ml b/compiler/frontend/external_ffi_types.ml
diff --git a/compiler/frontend/lam_constant.ml b/compiler/frontend/lam_constant.ml
diff --git a/compiler/frontend/lam_constant.mli b/compiler/frontend/lam_constant.mli
diff --git a/compiler/frontend/string_kind.ml b/compiler/frontend/string_kind.ml
