Normalize ordinary string literals at the frontend

CHANGELOG.md

@@ -14,6 +14,7 @@
 
 #### :boom: Breaking Change
 
+- Reject tagged template literals in patterns. Patterns cannot invoke their tag; previously their raw payload was compiled as a plain string comparison. https://github.com/rescript-lang/rescript/pull/8603
 - Remove runtime APIs that were deprecated for removal in ReScript 13, including the `Char` module, unsafe `Obj` operations, legacy `Pervasives` helpers, and `Array.unsafe_get`. https://github.com/rescript-lang/rescript/pull/8564
 - Remove the deprecated `Js` namespace and its runtime modules. https://github.com/rescript-lang/rescript/pull/8531
 - Move Belt into the separately installed `@rescript/belt` package. Projects using Belt must install the package and list it in their `rescript.json` dependencies. https://github.com/rescript-lang/rescript/pull/8554
@@ -25,6 +26,7 @@
 
 #### :rocket: New Feature
 
+- Support UTF-16 surrogate-pair escapes such as `"\uD83D\uDE00"` in ordinary string literals. https://github.com/rescript-lang/rescript/pull/8603
 - Support dynamic imports of external bindings annotated with `@scope`; the generated import follows the complete property path. These imports were previously rejected. https://github.com/rescript-lang/rescript/pull/8582
 - Add `@res.hoistedFunction` for emitting nested module functions as flat JavaScript exports. https://github.com/rescript-lang/rescript/pull/8402
 - Add source map support with linked, inline, and hidden modes. https://github.com/rescript-lang/rescript/pull/8393
@@ -33,6 +35,7 @@
 #### :bug: Bug fix
 
 - Object typing errors now describe fields directly: assigning to a field without `@set` reports that the field is not settable and suggests the annotation, and missing-property errors name the field instead of a phantom `"x#="` member. https://github.com/rescript-lang/rescript/pull/8597
+- Fix pattern matching for string literals with equivalent runtime values but different escape spellings, preserving source order and reporting redundant patterns. https://github.com/rescript-lang/rescript/pull/8603
 - Fix signature inclusion rejecting equivalent object externals after type-alias expansion. https://github.com/rescript-lang/rescript/pull/8581
 - Fix externals whose result type is an alias of `unit` so they use the same unit-return behavior as externals declared to return `unit`. https://github.com/rescript-lang/rescript/pull/8581
 - Fix dynamic imports of external bindings that require FFI argument or result conversions, including `@variadic`, `@unwrap`, polymorphic variant encodings, `@as` phantom arguments, optional labeled arguments, and `@return` wrappers. The imported value now applies the same conversions as a direct external call. https://github.com/rescript-lang/rescript/pull/8582

compiler/core/j.ml

@@ -72,7 +72,7 @@ and exception_ident = ident
 and for_ident = ident
 and for_direction = Js_op.direction_flag
 and property_map = (property_name * expression) list
-and delim = External_arg_spec.delim = DNone | DStarJ | DNoQuotes | DBackQuotes
+and delim = External_arg_spec.delim = DNone | DNoQuotes | DBackQuotes
 
 and record_rest_field = {
   record_rest_label: string;

compiler/core/js_dump.ml

@@ -771,7 +771,6 @@ and expression_desc cxt ~(level : int) f x : cxt =
     *)
     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 ^ "`")

compiler/core/js_exp_make.ml

@@ -1353,7 +1353,7 @@ let rec float_equal ?comment (e0 : t) (e1 : t) : t =
 let int_equal = float_equal
 
 let tag_type = function
-  | Variant_runtime.String s -> str s ~delim:DStarJ
+  | Variant_runtime.String s -> str s
   | Int i -> small_int i
   | Float f -> float f
   | BigInt i ->

compiler/frontend/ast_utf8_string_interp.ml

@@ -279,11 +279,16 @@ module Delim = struct
     | "js" -> if is_template then BackQuotes else Js
     | _ -> Unrecognized
 
-  let escaped_j_delimiter = "*j" (* not user level syntax allowed *)
   let some_escaped_back_quote_delimiter = Some "bq"
-  let some_escaped_j_delimiter = Some escaped_j_delimiter
 end
 
+(* Scanner string payloads still contain JavaScript escape spelling. Decode an
+   ordinary string exactly once here, before it reaches typing and matching. *)
+let semantic_string loc s =
+  match String_literal.decode_js_escapes s with
+  | Some decoded -> decoded
+  | None -> Location.raise_errorf ~loc "Invalid string escape sequence"
+
 let transform_exp (e : Parsetree.expression) s delim : Parsetree.expression =
   let is_template =
     Ext_list.exists e.pexp_attributes (fun ({txt}, _) ->
@@ -293,12 +298,8 @@ let transform_exp (e : Parsetree.expression) s delim : Parsetree.expression =
   in
   match Delim.parse_unprocessed is_template delim with
   | Js ->
-    let js_str = Ast_utf8_string.transform e.pexp_loc s in
-    {
-      e with
-      pexp_desc =
-        Pexp_constant (Pconst_string (js_str, Delim.some_escaped_j_delimiter));
-    }
+    let semantic = semantic_string e.pexp_loc s in
+    {e with pexp_desc = Pexp_constant (Pconst_string (semantic, None))}
   | BackQuotes ->
     {
       e with
@@ -311,19 +312,18 @@ let transform_exp (e : Parsetree.expression) s delim : Parsetree.expression =
 let transform_pat (p : Parsetree.pattern) s delim : Parsetree.pattern =
   match Delim.parse_unprocessed false delim with
   | Js ->
-    let js_str = Ast_utf8_string.transform p.ppat_loc s in
-    {
-      p with
-      ppat_desc =
-        Ppat_constant (Pconst_string (js_str, Delim.some_escaped_j_delimiter));
-    }
+    let semantic = semantic_string p.ppat_loc s in
+    {p with ppat_desc = Ppat_constant (Pconst_string (semantic, None))}
   | BackQuotes ->
     {
       p with
       ppat_desc =
         Ppat_constant
           (Pconst_string (s, Delim.some_escaped_back_quote_delimiter));
     }
-  | Unrecognized -> p
+  | Unrecognized when delim = "INTERNAL_RES_CHAR_CONTENTS" -> p
+  | Unrecognized ->
+    Location.raise_errorf ~loc:p.ppat_loc
+      "Tagged template literals are not supported in patterns"
 
 let parse_processed_delim = External_arg_spec.parse_processed_delim

compiler/gentype/emit_text.ml

@@ -8,6 +8,26 @@ let generics_string ~type_vars =
   | true -> ""
   | false -> "<" ^ String.concat "," type_vars ^ ">"
 
+(* Escape a semantic string as JavaScript/TypeScript string-literal contents.
+   [String.escaped] cannot be used for this: its decimal byte escapes follow
+   OCaml syntax and change non-ASCII UTF-8 text in JavaScript. *)
+let escape_string_contents x =
+  let buf = Buffer.create (String.length x) in
+  String.iter
+    (function
+      | '"' -> Buffer.add_string buf "\\\""
+      | '\\' -> Buffer.add_string buf "\\\\"
+      | '\b' -> Buffer.add_string buf "\\b"
+      | '\012' -> Buffer.add_string buf "\\f"
+      | '\n' -> Buffer.add_string buf "\\n"
+      | '\r' -> Buffer.add_string buf "\\r"
+      | '\t' -> Buffer.add_string buf "\\t"
+      | c when Char.code c < 0x20 || Char.code c = 0x7f ->
+        Buffer.add_string buf (Printf.sprintf "\\x%02x" (Char.code c))
+      | c -> Buffer.add_char buf c)
+    x;
+  Buffer.contents buf
+
 let quotes x = "\"" ^ x ^ "\""
 
 let field_access ~label value = value ^ "." ^ label

compiler/gentype/import_path.ml

@@ -29,4 +29,41 @@ let to_cmt ~(config : Config.t) ~output_file_relative (dir, s) =
     | Some name -> "-" ^ name)
   ^ ".cmt"
 
-let emit (dir, s) = (dir, s) |> dump
+(* Import paths are emitted inside single-quoted JavaScript/TypeScript string
+   literals and also repeated in line comments. The AST stores their semantic
+   value, so restore source escapes at this final output boundary. Escaping the
+   Unicode line separators keeps them from terminating those comments. *)
+let escape_for_single_quotes s =
+  let buf = Buffer.create (String.length s) in
+  let len = String.length s in
+  let rec loop i =
+    if i < len then
+      (* The UTF-8 encodings of U+2028 and U+2029 differ only in their final
+         byte. Preserve all other UTF-8 text verbatim. *)
+      if
+        i + 2 < len
+        && s.[i] = '\226'
+        && s.[i + 1] = '\128'
+        && (s.[i + 2] = '\168' || s.[i + 2] = '\169')
+      then (
+        Buffer.add_string buf
+          (if s.[i + 2] = '\168' then "\\u2028" else "\\u2029");
+        loop (i + 3))
+      else (
+        (match s.[i] with
+        | '\'' -> Buffer.add_string buf "\\'"
+        | '\\' -> Buffer.add_string buf "\\\\"
+        | '\b' -> Buffer.add_string buf "\\b"
+        | '\012' -> Buffer.add_string buf "\\f"
+        | '\n' -> Buffer.add_string buf "\\n"
+        | '\r' -> Buffer.add_string buf "\\r"
+        | '\t' -> Buffer.add_string buf "\\t"
+        | c when Char.code c < 0x20 || Char.code c = 0x7f ->
+          Buffer.add_string buf (Printf.sprintf "\\x%02x" (Char.code c))
+        | c -> Buffer.add_char buf c);
+        loop (i + 1))
+  in
+  loop 0;
+  Buffer.contents buf
+
+let emit path = path |> dump |> escape_for_single_quotes

compiler/gentype/import_path.mli

@@ -5,6 +5,9 @@ type t
 val bs_curry_path : config:Config.t -> t
 val chop_extension_safe : t -> t [@@live]
 val dump : t -> string
+
+(* Escape a semantic import path for a single-quoted JavaScript/TypeScript
+   string literal. The returned string does not include the quotes. *)
 val emit : t -> string
 val from_module : dir:string -> import_extension:string -> Module_name.t -> t
 val from_string_unsafe : string -> t

compiler/gentype/translate_core_type.ml

@@ -183,7 +183,8 @@ and translateCoreType_ ~config ~type_vars_gen
             let label_js =
               if as_string then
                 match attributes |> Annotation.get_as_string with
-                | Some label_renamed -> StringLabel label_renamed
+                | Some label_renamed ->
+                  StringLabel (Emit_text.escape_string_contents label_renamed)
                 | None ->
                   if is_number label then IntLabel label else StringLabel label
               else if as_int then (

compiler/gentype/translate_type_declarations.ml

@@ -35,12 +35,14 @@ let create_polyvariant_case (label, attributes) =
       | Some (_, BoolPayload b) -> BoolLabel b
       | Some (_, FloatPayload s) -> FloatLabel s
       | Some (_, IntPayload i) -> IntLabel i
-      | Some (_, StringPayload as_label) -> StringLabel as_label
+      | Some (_, StringPayload as_label) ->
+        StringLabel (Emit_text.escape_string_contents as_label)
       | _ -> if is_number label then IntLabel label else StringLabel label);
   }
 
 let create_variant_case label = function
-  | Some (Variant_runtime.String label) -> {label_js = StringLabel label}
+  | Some (Variant_runtime.String label) ->
+    {label_js = StringLabel (Emit_text.escape_string_contents label)}
   | Some (Variant_runtime.Int label) ->
     {label_js = IntLabel (string_of_int label)}
   | Some (Variant_runtime.Float label) -> {label_js = FloatLabel label}
@@ -62,7 +64,7 @@ let create_variant_case label = function
 let rename_record_field ~attributes ~name =
   attributes |> Annotation.check_unsupported_gentype_as_renaming;
   match attributes |> Annotation.get_as_string with
-  | Some s -> s |> String.escaped
+  | Some s -> Emit_text.escape_string_contents s
   | None -> name |> Ext_ident.unwrap_uppercase_exotic
 
 let traslate_declaration_kind ~config ~loc ~output_file_relative ~resolver

compiler/ml/ast_mapper_from0.ml

@@ -82,12 +82,61 @@ let map_tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z)
 let map_opt f = function
   | None -> None
   | Some x -> Some (f x)
-let map_constant = function
+let is_template attrs =
+  Ext_list.exists attrs (fun ({txt}, _) ->
+      match txt with
+      | "res.template" | "res.taggedTemplate" -> true
+      | _ -> false)
+
+let decode_js_string ~loc s =
+  match String_literal.decode_js_escapes s with
+  | Some s -> s
+  | None -> Location.raise_errorf ~loc "Invalid string escape sequence"
+
+let map_constant ~loc ~is_template = function
   | Pconst_integer (s, suffix) -> Pt.Pconst_integer (s, suffix)
   | Pconst_char c -> Pconst_char c
+  | Pconst_string (s, Some "js") when is_template -> Pconst_string (s, Some "bq")
+  | Pconst_string (s, Some ("js" | "*j")) ->
+    Pconst_string (decode_js_string ~loc s, None)
   | Pconst_string (s, q) -> Pconst_string (s, q)
   | Pconst_float (s, suffix) -> Pconst_float (s, suffix)
 
+let is_raw_source_extension = function
+  | "raw" | "ffi" | "re" -> true
+  | _ -> false
+
+let map_raw_source_payload sub = function
+  | PStr
+      [
+        {
+          pstr_desc =
+            Pstr_eval
+              ( {
+                  pexp_desc = Pexp_constant (Pconst_string (s, delim));
+                  pexp_loc;
+                  pexp_attributes;
+                },
+                eval_attributes );
+          pstr_loc;
+        };
+      ] ->
+    let expression =
+      Ast_helper.Exp.constant
+        ~loc:(sub.location sub pexp_loc)
+        ~attrs:(sub.attributes sub pexp_attributes)
+        (Pt.Pconst_string (s, delim))
+    in
+    Some
+      (Pt.PStr
+         [
+           Ast_helper.Str.eval
+             ~loc:(sub.location sub pstr_loc)
+             ~attrs:(sub.attributes sub eval_attributes)
+             expression;
+         ])
+  | _ -> None
+
 let for_of_attr_name = "_res.for_of"
 let for_await_of_attr_name = "_res.for_await_of"
 
@@ -511,7 +560,9 @@ module E = struct
       let inner = sub.expr sub {e with pexp_attributes = inner_attrs0} in
       await ~loc ~attrs:(sub.attributes sub await_attrs0) inner
     | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x)
-    | Pexp_constant x -> constant ~loc ~attrs (map_constant x)
+    | Pexp_constant x ->
+      constant ~loc ~attrs
+        (map_constant ~loc ~is_template:(is_template attrs) x)
     | Pexp_let (r, vbs, e) ->
       let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.expr sub e)
     | Pexp_fun (lab, def, p, e) ->
@@ -879,9 +930,12 @@ module P = struct
     | Ppat_any -> any ~loc ~attrs ()
     | Ppat_var s -> var ~loc ~attrs (map_loc sub s)
     | Ppat_alias (p, s) -> alias ~loc ~attrs (sub.pat sub p) (map_loc sub s)
-    | Ppat_constant c -> constant ~loc ~attrs (map_constant c)
+    | Ppat_constant c ->
+      constant ~loc ~attrs (map_constant ~loc ~is_template:false c)
     | Ppat_interval (c1, c2) ->
-      interval ~loc ~attrs (map_constant c1) (map_constant c2)
+      interval ~loc ~attrs
+        (map_constant ~loc ~is_template:false c1)
+        (map_constant ~loc ~is_template:false c2)
     | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub.pat sub) pl)
     | Ppat_construct (l, p) ->
       construct ~loc ~attrs (map_loc sub l) (map_opt (sub.pat sub) p)
@@ -1061,7 +1115,16 @@ let default_mapper =
           pc_rhs = this.expr this pc_rhs;
         });
     location = (fun _this l -> l);
-    extension = (fun this (s, e) -> (map_loc this s, this.payload this e));
+    extension =
+      (fun this (s, payload) ->
+        let payload =
+          if is_raw_source_extension s.txt then
+            match map_raw_source_payload this payload with
+            | Some payload -> payload
+            | None -> this.payload this payload
+          else this.payload this payload
+        in
+        (map_loc this s, payload));
     attribute = (fun this (s, e) -> (map_loc this s, this.payload this e));
     attributes = (fun this l -> List.map (this.attribute this) l);
     payload =

compiler/ml/ast_mapper_to0.ml

@@ -79,6 +79,9 @@ let map_opt f = function
 let map_constant = function
   | Pconst_integer (s, suffix) -> Pt.Pconst_integer (s, suffix)
   | Pconst_char c -> Pconst_char c
+  (* The PPX bridge uses parser-form ast0, where template segments are [js]
+     strings distinguished by a template attribute. *)
+  | Pconst_string (s, Some "bq") -> Pconst_string (s, Some "js")
   | Pconst_string (s, q) -> Pconst_string (s, q)
   | Pconst_float (s, suffix) -> Pconst_float (s, suffix)
 

compiler/ml/external_arg_spec.ml

@@ -24,12 +24,11 @@
 
 (** type definitions for arguments to a function declared external *)
 
-type delim = DNone | DStarJ | DNoQuotes | DBackQuotes
+type delim = DNone | DNoQuotes | DBackQuotes
 
 let parse_processed_delim = function
   | None -> Some DNone
   | Some "json" -> Some DNoQuotes
-  | Some "*j" -> Some DStarJ
   | Some "bq" -> Some DBackQuotes
   | _ -> None
 

compiler/ml/external_arg_spec.mli

@@ -22,7 +22,7 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
-type delim = DNone | DStarJ | DNoQuotes | DBackQuotes
+type delim = DNone | DNoQuotes | DBackQuotes
 
 val parse_processed_delim : string option -> delim option