Normalize string literals before matching

Signed-off-by: Christoph Knittel <ck@cca.io>

Author: cknitt

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

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,23 +312,16 @@ 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
-    (match String_literal.decode_js_escapes js_str with
-    | Some _ -> ()
-    | None ->
-      Location.raise_errorf ~loc:p.ppat_loc "Invalid string escape sequence");
-    {
-      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 when delim = "INTERNAL_RES_CHAR_CONTENTS" -> p
   | Unrecognized ->
     Location.raise_errorf ~loc:p.ppat_loc
       "Tagged template literals are not supported in patterns"

compiler/ml/ast_mapper_from0.ml

@@ -82,9 +82,23 @@ 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)
 
@@ -511,7 +525,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 +895,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)

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
 

compiler/ml/parmatch.ml

@@ -269,8 +269,7 @@ let const_compare x y =
     compare (float_of_string f1) (float_of_string f2)
   | Const_bigint (s1, b1), Const_bigint (s2, b2) ->
     Bigint_utils.compare (s1, b1) (s2, b2)
-  | Const_string (s1, delim1), Const_string (s2, delim2) ->
-    String_literal.compare (s1, delim1) (s2, delim2)
+  | Const_string (s1, _), Const_string (s2, _) -> String.compare s1 s2
   | _, _ -> compare x y
 
 let records_args l1 l2 =