Normalize string literal representation

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/8606
 - 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/8606
 - 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/8606
 - 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

analysis/reanalyze/src/annotation.ml

@@ -17,34 +17,38 @@ let tag_is_one_of_the_gentype_annotations s =
 
 let rec get_attribute_payload check_text (attributes : Typedtree.attributes) =
   let rec from_expr (expr : Parsetree.expression) =
-    match expr with
-    | {pexp_desc = Pexp_constant (Pconst_string (s, _))} ->
-      Some (StringPayload s)
-    | {pexp_desc = Pexp_constant (Pconst_integer (n, _))} -> Some (IntPayload n)
-    | {pexp_desc = Pexp_constant (Pconst_float (s, _))} -> Some (FloatPayload s)
-    | {
-     pexp_desc = Pexp_construct ({txt = Lident (("true" | "false") as s)}, _);
-     _;
-    } ->
-      Some (BoolPayload (s = "true"))
-    | {pexp_desc = Pexp_construct ({txt = Longident.Lident "[]"}, None)} -> None
-    | {pexp_desc = Pexp_construct ({txt = Longident.Lident "::"}, Some e)} ->
-      from_expr e
-    | {pexp_desc = Pexp_construct ({txt}, _); _} ->
-      Some (ConstructPayload (txt |> Longident.flatten |> String.concat "."))
-    | {pexp_desc = Pexp_tuple exprs | Pexp_array exprs} ->
-      let payloads =
-        exprs |> List.rev
-        |> List.fold_left
-             (fun payloads expr ->
-               match expr |> from_expr with
-               | Some payload -> payload :: payloads
-               | None -> payloads)
-             []
-      in
-      Some (TuplePayload payloads)
-    | {pexp_desc = Pexp_ident {txt}} -> Some (IdentPayload txt)
-    | _ -> None
+    match Ast_payload.semantic_string_of_expression expr with
+    | Some s -> Some (StringPayload s)
+    | None -> (
+      match expr with
+      | {pexp_desc = Pexp_constant (Pconst_integer (n, _))} ->
+        Some (IntPayload n)
+      | {pexp_desc = Pexp_constant (Pconst_float (s, _))} ->
+        Some (FloatPayload s)
+      | {
+       pexp_desc = Pexp_construct ({txt = Lident (("true" | "false") as s)}, _);
+       _;
+      } ->
+        Some (BoolPayload (s = "true"))
+      | {pexp_desc = Pexp_construct ({txt = Longident.Lident "[]"}, None)} ->
+        None
+      | {pexp_desc = Pexp_construct ({txt = Longident.Lident "::"}, Some e)} ->
+        from_expr e
+      | {pexp_desc = Pexp_construct ({txt}, _); _} ->
+        Some (ConstructPayload (txt |> Longident.flatten |> String.concat "."))
+      | {pexp_desc = Pexp_tuple exprs | Pexp_array exprs} ->
+        let payloads =
+          exprs |> List.rev
+          |> List.fold_left
+               (fun payloads expr ->
+                 match expr |> from_expr with
+                 | Some payload -> payload :: payloads
+                 | None -> payloads)
+               []
+        in
+        Some (TuplePayload payloads)
+      | {pexp_desc = Pexp_ident {txt}} -> Some (IdentPayload txt)
+      | _ -> None)
   in
   match attributes with
   | [] -> None

analysis/reanalyze/src/arnold.ml

@@ -535,7 +535,8 @@ module Find_functions_called = struct
     let super = Tast_mapper.default in
     let expr (self : Tast_mapper.mapper) (e : Typedtree.expression) =
       (match e.exp_desc with
-      | Texp_apply {funct = {exp_desc = Texp_ident (callee, _, _)}} ->
+      | Texp_apply {funct = {exp_desc = Texp_ident (callee, _, _)}}
+      | Texp_tagged_template {tag = {exp_desc = Texp_ident (callee, _, _)}} ->
         let function_name = Path.name callee in
         callees := !callees |> String_set.add function_name
       | _ -> ());
@@ -867,6 +868,13 @@ module Compile = struct
         | None -> expr |> expression ~ctx |> eval_args ~args ~ctx)
     | Texp_apply {funct = expr; args} ->
       expr |> expression ~ctx |> eval_args ~args ~ctx
+    | Texp_tagged_template {tag; values} ->
+      let args =
+        List.map (fun value -> (Asttypes.Nolabel, Some value)) values
+      in
+      tag |> expression ~ctx |> eval_args ~args ~ctx
+    | Texp_template {values} ->
+      values |> List.map (expression ~ctx) |> Command.sequence
     | Texp_let
         ( Recursive,
           [{vb_pat = {pat_desc = Tpat_var (id, _); pat_loc}; vb_expr}],

analysis/reanalyze/src/side_effects.ml

@@ -64,7 +64,8 @@ let rec expr_no_side_effects (expr : Typedtree.expression) =
   | Texp_for (_id, _pat, e1, e2, _dir, e3) ->
     e1 |> expr_no_side_effects && e2 |> expr_no_side_effects
     && e3 |> expr_no_side_effects
-  | Texp_for_of _ | Texp_for_await_of _ -> false
+  | Texp_template {values} -> values |> List.for_all expr_no_side_effects
+  | Texp_for_of _ | Texp_for_await_of _ | Texp_tagged_template _ -> false
   | Texp_object_literal fields ->
     fields |> List.for_all (fun (_name, e) -> e |> expr_no_side_effects)
   | Texp_object_get _ -> false

analysis/src/completion_front_end.ml

@@ -209,7 +209,17 @@ let find_arg_completables ~(args : arg list) ~end_pos ~pos_before_cursor
 let rec expr_to_context_path_inner ~(in_jsx_context : bool)
     (e : Parsetree.expression) =
   match e.pexp_desc with
-  | Pexp_constant (Pconst_string _) -> Some Completable.CPString
+  | Pexp_constant (Pconst_string _ | Pconst_json _ | Pconst_raw_source _) ->
+    Some Completable.CPString
+  | Pexp_template _ -> Some Completable.CPString
+  | Pexp_tagged_template {tag} -> (
+    match expr_to_context_path ~in_jsx_context tag with
+    | Some context_path ->
+      (* Tagged templates are typed like a call of the tag with the template
+         strings and interpolation values. Preserve that application context
+         now that the parser no longer represents it as [Pexp_apply]. *)
+      Some (CPApply (context_path, [Nolabel; Nolabel]))
+    | None -> None)
   | Pexp_constant (Pconst_integer _) -> Some CPInt
   | Pexp_constant (Pconst_float _) -> Some CPFloat
   | Pexp_construct ({txt = Lident ("true" | "false")}, None) -> Some CPBool
@@ -934,14 +944,22 @@ let completion_with_parser1 ~debug ~offset ~pos_cursor ~kind_file
              {
                pstr_desc =
                  Pstr_eval
-                   ( {pexp_loc; pexp_desc = Pexp_constant (Pconst_string (s, _))},
+                   ( ({
+                        pexp_loc;
+                        pexp_desc =
+                          ( Pexp_constant (Pconst_string _)
+                          | Pexp_template {source_segments = [_]; values = []} );
+                      } as expression),
                      _ );
              };
            ]
-         when loc_has_cursor pexp_loc ->
-         if Debug.verbose () then
-           print_endline "[decoratorCompletion] Found @module";
-         set_result (Completable.CdecoratorPayload (Module s))
+         when loc_has_cursor pexp_loc -> (
+         match Ast_payload.semantic_string_of_expression expression with
+         | Some s ->
+           if Debug.verbose () then
+             print_endline "[decoratorCompletion] Found @module";
+           set_result (Completable.CdecoratorPayload (Module s))
+         | None -> ())
        | PStr
            [
              {
@@ -968,11 +986,14 @@ let completion_with_parser1 ~debug ~offset ~pos_cursor ~kind_file
              Completion_expressions.is_expr_hole from_expr,
              from_expr )
          with
-         | true, _, _, {pexp_desc = Pexp_constant (Pconst_string (s, _))} ->
-           if Debug.verbose () then
-             print_endline
-               "[decoratorCompletion] @module `from` payload was string";
-           set_result (Completable.CdecoratorPayload (Module s))
+         | true, _, _, from_expr -> (
+           match Ast_payload.semantic_string_of_expression from_expr with
+           | Some s ->
+             if Debug.verbose () then
+               print_endline
+                 "[decoratorCompletion] @module `from` payload was string";
+             set_result (Completable.CdecoratorPayload (Module s))
+           | None -> ())
          | false, true, true, _ ->
            if Debug.verbose () then
              print_endline
@@ -1176,7 +1197,7 @@ let completion_with_parser1 ~debug ~offset ~pos_cursor ~kind_file
           args =
             [
               (* sh`echo "meh"` *)
-              (_, ({pexp_desc = Pexp_apply _} as inner_expr));
+              (_, ({pexp_desc = Pexp_tagged_template _} as inner_expr));
               (* recovery inserted node *)
               (_, {pexp_desc = Pexp_extension ({txt = "rescript.exprhole"}, _)});
             ];
@@ -1206,7 +1227,7 @@ let completion_with_parser1 ~debug ~offset ~pos_cursor ~kind_file
           args =
             [
               (*  sh`echo "meh"` *)
-              (_, ({pexp_desc = Pexp_apply _} as inner_expr));
+              (_, ({pexp_desc = Pexp_tagged_template _} as inner_expr));
               (* foo *)
               (_, {pexp_desc = Pexp_ident {txt = Lident field_name}});
             ];

analysis/src/completion_jsx.ml

@@ -303,7 +303,7 @@ let is_regexp_jsx_heuristic_expr expr =
             {
               pstr_desc =
                 Pstr_eval
-                  ({pexp_desc = Pexp_constant (Pconst_string ("//", _))}, _);
+                  ({pexp_desc = Pexp_constant (Pconst_raw_source "//")}, _);
             };
           ] )
     when expr.pexp_loc |> Loc.end_ = (Location.none |> Loc.end_) ->

analysis/src/document_symbol.ml

@@ -19,7 +19,9 @@ let get_symbols ~source ~kind_file =
     match exp.pexp_desc with
     | Pexp_fun _ -> Lsp.Types.SymbolKind.Function
     | Pexp_constraint (e, _) -> expr_kind e
-    | Pexp_constant (Pconst_string _) -> Lsp.Types.SymbolKind.String
+    | Pexp_constant (Pconst_string _ | Pconst_json _ | Pconst_raw_source _) ->
+      Lsp.Types.SymbolKind.String
+    | Pexp_template _ -> Lsp.Types.SymbolKind.String
     | Pexp_constant (Pconst_float _ | Pconst_integer _) ->
       Lsp.Types.SymbolKind.Number
     | Pexp_constant _ -> Lsp.Types.SymbolKind.Constant

analysis/src/dump_ast.ml

@@ -42,14 +42,13 @@ let print_attributes attributes =
 let print_constant const =
   match const with
   | Parsetree.Pconst_integer (s, _) -> "Pconst_integer(" ^ s ^ ")"
-  | Pconst_char c -> "Pconst_char(" ^ String.make 1 (Char.chr c) ^ ")"
-  | Pconst_string (s, delim) ->
-    let delim =
-      match delim with
-      | None -> ""
-      | Some delim -> delim ^ " "
-    in
-    "Pconst_string(" ^ delim ^ s ^ delim ^ ")"
+  | Pconst_char {source; semantic} ->
+    "Pconst_char(source=" ^ source ^ ", semantic=" ^ string_of_int semantic
+    ^ ")"
+  | Pconst_string {source; semantic} ->
+    "Pconst_string(source=" ^ source ^ ", semantic=" ^ semantic ^ ")"
+  | Pconst_json source -> "Pconst_json(" ^ source ^ ")"
+  | Pconst_raw_source source -> "Pconst_raw_source(" ^ source ^ ")"
   | Pconst_float (s, _) -> "Pconst_float(" ^ s ^ ")"
 
 let print_core_type typ ~pos =
@@ -264,6 +263,21 @@ and print_expr_item expr ~pos ~indentation =
     ^ ")"
   | Pexp_extension (({txt} as loc), _) ->
     "Pexp_extension(%" ^ (loc |> print_loc_denominator_loc ~pos) ^ txt ^ ")"
+  | Pexp_template {source_segments; values} ->
+    "Pexp_template(source_segments=["
+    ^ String.concat ", " source_segments
+    ^ "], values=["
+    ^ String.concat ", "
+        (List.map (fun value -> print_expr_item value ~pos ~indentation) values)
+    ^ "])"
+  | Pexp_tagged_template {tag; raw_sources; values} ->
+    "Pexp_tagged_template(tag="
+    ^ print_expr_item tag ~pos ~indentation
+    ^ ", sources="
+    ^ string_of_int (List.length raw_sources)
+    ^ ", values="
+    ^ string_of_int (List.length values)
+    ^ ")"
   | Pexp_assert expr ->
     "Pexp_assert(" ^ print_expr_item expr ~pos ~indentation ^ ")"
   | Pexp_field (exp, loc) ->

analysis/src/process_attributes.ml

@@ -2,45 +2,38 @@ open Shared_types
 
 (* TODO should I hang on to location? *)
 let rec find_doc_attribute attributes =
-  let open Parsetree in
   match attributes with
   | [] -> None
-  | ( {Asttypes.txt = "ocaml.doc" | "ocaml.text" | "ns.doc" | "res.doc"},
-      PStr
-        [
-          {
-            pstr_desc =
-              Pstr_eval ({pexp_desc = Pexp_constant (Pconst_string (doc, _))}, _);
-          };
-        ] )
-    :: _ ->
-    Some doc
+  | ({Asttypes.txt = "ocaml.doc" | "ocaml.text" | "ns.doc" | "res.doc"}, payload)
+    :: rest -> (
+    match Ast_payload.semantic_string_of_payload payload with
+    | Some doc -> Some doc
+    | None -> find_doc_attribute rest)
   | _ :: rest -> find_doc_attribute rest
 
 let rec find_deprecated_attribute attributes =
   let open Parsetree in
   match attributes with
   | [] -> None
-  | ( {Asttypes.txt = "deprecated"},
-      PStr [{pstr_desc = Pstr_eval ({pexp_desc = expr}, _)}] )
+  | ({Asttypes.txt = "deprecated"}, PStr [{pstr_desc = Pstr_eval (expr, _)}])
     :: _ -> (
-    match expr with
-    (* Simple deprecated attr @deprecated("message") *)
-    | Pexp_constant (Pconst_string (_msg, _)) -> Some _msg
-    (* deprecated attr with record *)
-    | Pexp_record (fields, _) ->
-      let reason = ref "" in
-
-      fields
-      |> List.iter (fun {lid = {txt}; x} ->
-          match (txt, x) with
-          | ( Lident "reason",
-              {pexp_desc = Pexp_constant (Pconst_string (msg, _))} ) ->
-            reason := msg
-          | _ -> ());
-
-      Some !reason
-    | _ -> None)
+    match Ast_payload.semantic_string_of_expression expr with
+    | Some msg -> Some msg
+    | None -> (
+      match expr.pexp_desc with
+      (* deprecated attr with record *)
+      | Pexp_record (fields, _) ->
+        let reason = ref "" in
+        fields
+        |> List.iter (fun {lid = {txt}; x} ->
+            match txt with
+            | Lident "reason" -> (
+              match Ast_payload.semantic_string_of_expression x with
+              | Some msg -> reason := msg
+              | None -> ())
+            | _ -> ());
+        Some !reason
+      | _ -> None))
   | ({Asttypes.txt = "deprecated"}, _) :: _ -> Some ""
   | _ :: rest -> find_deprecated_attribute rest
 

analysis/src/type_utils.ml

@@ -1009,7 +1009,7 @@ module Codegen = struct
   let mk_fail_with_exp () =
     Ast_helper.Exp.apply
       (Ast_helper.Exp.ident {txt = Lident "failwith"; loc = Location.none})
-      [(Nolabel, Ast_helper.Exp.constant (Pconst_string ("TODO", None)))]
+      [(Nolabel, Ast_helper.Exp.constant (Ast_helper.Const.string "TODO"))]
 
   let mk_construct_pat ?payload name =
     Ast_helper.Pat.construct