Stop mangling tagged templates and backquoted strings

CHANGELOG.md

@@ -25,6 +25,7 @@
 - Fix generation of interfaces for module types containing multiple type constraints. https://github.com/rescript-lang/rescript/pull/7825
 - JSX preserve mode: fix "make is not a valid component name". https://github.com/rescript-lang/rescript/pull/7831
 - Rewatch: include parser arguments of experimental features. https://github.com/rescript-lang/rescript/pull/7836
+- Stop mangling tagged templates and backquoted strings. https://github.com/rescript-lang/rescript/pull/7841
 
 #### :memo: Documentation
 

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
+and delim = External_arg_spec.delim = DNone | DStarJ | DNoQuotes | DBackQuotes
 
 and expression_desc =
   | Length of expression * length_object

compiler/core/js_dump.ml

@@ -729,6 +729,7 @@ and expression_desc cxt ~(level : int) f x : cxt =
       | DStarJ -> P.string f ("\"" ^ txt ^ "\"")
       | DNoQuotes -> P.string f txt
       | DNone -> Js_dump_string.pp_string f txt
+      | DBackQuotes -> P.string f ("`" ^ txt ^ "`")
     in
     cxt
   | Raw_js_code {code = s; code_info = info} -> (

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; unicode = false}) ->
+  | Lconst (Const_string {s; delim = None | Some DNoQuotes}) ->
     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; unicode = false})
+  let string s : t = Lconst (Const_string {s; delim = None})
 
   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; unicode = false} ->
+    | Pstringlength, Const_string {s; delim = None} ->
       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; unicode = false},
-        Const_string {s = b; unicode = false} ) ->
+        Const_string {s = a; delim = None},
+        Const_string {s = b; delim = None} ) ->
       Lift.string (a ^ b)
     | ( (Pstringrefs | Pstringrefu),
-        Const_string {s = a; unicode = false},
+        Const_string {s = a; delim = None},
         Const_int {i = b} ) -> (
       try Lift.char (Char.code (String.get a (Int32.to_int b)))
       with _ -> default ())

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; unicode = false} -> E.str s
-  | Const_string {s; unicode = true} -> E.str ~delim:DStarJ s
+  | Const_string {s; delim = None | Some DNoQuotes} -> E.str s
+  | Const_string {s; delim = Some delim} -> E.str ~delim 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)

compiler/core/lam_constant_convert.ml

@@ -27,12 +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 unicode =
-      match opt with
-      | Some opt -> Ast_utf8_string_interp.is_unicode_string opt
-      | _ -> false
-    in
-    Const_string {s; unicode}
+    let delim = Ast_utf8_string_interp.parse_processed_delim opt in
+    Const_string {s; delim}
   | Const_base (Const_float i) -> Const_float i
   | Const_base (Const_int32 i) -> Const_int {i; comment = None}
   | Const_base (Const_int64 _) -> assert false
@@ -63,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; unicode = false}
+  | Const_immstring s -> Const_string {s; delim = None}
   | Const_block (t, xs) -> (
     let tag = Lambda.tag_of_tag_info t in
     match t with
@@ -80,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; unicode = false}
+          else Const_string {s; delim = None}
         in
         Const_block (tag, t, [tag_val; convert_constant value])
       | _ -> assert false))

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; unicode = false}
+          else Const_string {s; delim = None}
         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; unicode = false})
+        Lam.const (Const_string {s = id.name; delim = None})
       else (
         may_depend may_depends (Lam_module_ident.of_ml ~dynamic_import id);
         assert (args = []);

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; unicode = false}) ->
+      | _, Lconst (Const_string {s; delim = None}) ->
         (* 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; unicode = false}) ->
+          | Lconst (Const_string {s; delim = None}) ->
             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; unicode = false}) ->
+        | Strict, Lconst (Const_string {s; delim = None}) ->
           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; unicode = false}) -> Some ls
+        | Lconst (Const_string {s = ls; delim = None}) -> Some ls
         | Lvar i -> Hash_ident.find_opt string_table i
         | _ -> None
       in
@@ -166,14 +166,13 @@ 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; unicode = false}) -> Some rs
+          | Lconst (Const_string {s = rs; delim = None}) -> 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; unicode = false}))
-      )
+        | Some r_s -> Lam.const (Const_string {s = l_s ^ r_s; delim = None})))
     | Lglobal_module _ -> lam
     | Lprim {primitive; args; loc} ->
       Lam.prim ~primitive ~args:(Ext_list.map args simplif) loc

compiler/frontend/ast_utf8_string_interp.ml

@@ -275,35 +275,69 @@ module Delim = struct
     | None -> Some External_arg_spec.DNone
     | Some "json" -> Some DNoQuotes
     | Some "*j" -> Some DStarJ
+    | Some "bq" -> Some DBackQuotes
     | _ -> None
 
   type interpolation =
-    | Js (* string interpolation *)
+    | BackQuotes (* string interpolation *)
+    | Js (* simple double quoted string *)
     | Unrecognized (* no interpolation: delimiter not recognized *)
-  let parse_unprocessed = function
-    | "js" -> Js
+  let parse_unprocessed is_template = function
+    | "js" -> if is_template then BackQuotes else Js
     | _ -> Unrecognized
 
   let escaped_j_delimiter = "*j" (* not user level syntax allowed *)
+  let escaped_back_quote_delimiter = "bq"
+  let some_escaped_back_quote_delimiter = Some "bq"
   let unescaped_js_delimiter = "js"
-  let escaped = Some escaped_j_delimiter
+  let some_escaped_j_delimiter = Some escaped_j_delimiter
 end
 
 let transform_exp (e : Parsetree.expression) s delim : Parsetree.expression =
-  match Delim.parse_unprocessed delim with
+  let is_template =
+    Ext_list.exists e.pexp_attributes (fun ({txt}, _) ->
+        match txt with
+        | "res.template" | "res.taggedTemplate" -> true
+        | _ -> false)
+  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.escaped))}
+    {
+      e with
+      pexp_desc =
+        Pexp_constant (Pconst_string (js_str, Delim.some_escaped_j_delimiter));
+    }
+  | BackQuotes ->
+    {
+      e with
+      pexp_desc =
+        Pexp_constant
+          (Pconst_string (s, Delim.some_escaped_back_quote_delimiter));
+    }
   | Unrecognized -> e
 
 let transform_pat (p : Parsetree.pattern) s delim : Parsetree.pattern =
-  match Delim.parse_unprocessed delim with
+  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.escaped))}
+    {
+      p with
+      ppat_desc =
+        Ppat_constant (Pconst_string (js_str, Delim.some_escaped_j_delimiter));
+    }
+  | BackQuotes ->
+    {
+      p with
+      ppat_desc =
+        Ppat_constant
+          (Pconst_string (s, Delim.some_escaped_back_quote_delimiter));
+    }
   | Unrecognized -> p
 
-let is_unicode_string opt = Ext_string.equal opt Delim.escaped_j_delimiter
+let is_unicode_string opt =
+  Ext_string.equal opt Delim.escaped_j_delimiter
+  || Ext_string.equal opt Delim.escaped_back_quote_delimiter
 
 let is_unescaped s = Ext_string.equal s Delim.unescaped_js_delimiter
 

compiler/frontend/external_arg_spec.ml

@@ -24,7 +24,7 @@
 
 (** type definitions for arguments to a function declared external *)
 
-type delim = DNone | DStarJ | DNoQuotes
+type delim = DNone | DStarJ | DNoQuotes | DBackQuotes
 
 type cst = Arg_int_lit of int | Arg_string_lit of string * delim
 

compiler/frontend/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
+type delim = DNone | DStarJ | DNoQuotes | DBackQuotes
 
 type cst = private Arg_int_lit of int | Arg_string_lit of string * delim
 

compiler/frontend/external_ffi_types.ml

@@ -273,12 +273,8 @@ let () =
       | _ -> false
 let inline_string_primitive (s : string) (op : string option) : string list =
   let lam : Lam_constant.t =
-    let unicode =
-      match op with
-      | Some op -> Ast_utf8_string_interp.is_unicode_string op
-      | None -> false
-    in
-    Const_string {s; unicode}
+    let delim = Ast_utf8_string_interp.parse_processed_delim op in
+    Const_string {s; delim}
   in
   [""; to_string (Ffi_inline_const lam)]
 

compiler/frontend/lam_constant.ml

@@ -47,7 +47,7 @@ type t =
   | Const_js_false
   | Const_int of {i: int32; comment: pointer_info}
   | Const_char of int
-  | Const_string of {s: string; unicode: bool}
+  | Const_string of {s: string; delim: External_arg_spec.delim option}
   | Const_float of string
   | Const_bigint of bool * string
   | Const_pointer of string
@@ -73,9 +73,9 @@ let rec eq_approx (x : t) (y : t) =
     match y with
     | Const_char iy -> ix = iy
     | _ -> false)
-  | Const_string {s = sx; unicode = ux} -> (
+  | Const_string {s = sx; delim = ux} -> (
     match y with
-    | Const_string {s = sy; unicode = uy} -> sx = sy && ux = uy
+    | Const_string {s = sy; delim = uy} -> sx = sy && ux = uy
     | _ -> false)
   | Const_float ix -> (
     match y with

compiler/frontend/lam_constant.mli

@@ -43,7 +43,7 @@ type t =
   | Const_js_false
   | Const_int of {i: int32; comment: pointer_info}
   | Const_char of int
-  | Const_string of {s: string; unicode: bool}
+  | Const_string of {s: string; delim: External_arg_spec.delim option}
   | Const_float of string
   | Const_bigint of bool * string
   | Const_pointer of string

packages/@rescript/runtime/lib/es6/Stdlib_Bool.js

@@ -29,7 +29,7 @@ function fromStringOrThrow(param) {
     default:
       throw {
         RE_EXN_ID: "Invalid_argument",
-        _1: "Bool.fromStringOrThrow: value is neither \"true\" nor \"false\"",
+        _1: `Bool.fromStringOrThrow: value is neither "true" nor "false"`,
         Error: new Error()
       };
   }

packages/@rescript/runtime/lib/es6/Stdlib_Error.js

@@ -23,7 +23,7 @@ let $$TypeError = {};
 let $$URIError = {};
 
 function panic(msg) {
-  throw new Error("Panic! " + msg);
+  throw new Error(`Panic! ` + msg);
 }
 
 export {

packages/@rescript/runtime/lib/es6/Stdlib_JsError.js

@@ -54,7 +54,7 @@ let $$URIError$1 = {
 };
 
 function panic(msg) {
-  throw new Error("Panic! " + msg);
+  throw new Error(`Panic! ` + msg);
 }
 
 export {

packages/@rescript/runtime/lib/js/Stdlib_Bool.js

@@ -29,7 +29,7 @@ function fromStringOrThrow(param) {
     default:
       throw {
         RE_EXN_ID: "Invalid_argument",
-        _1: "Bool.fromStringOrThrow: value is neither \"true\" nor \"false\"",
+        _1: `Bool.fromStringOrThrow: value is neither "true" nor "false"`,
         Error: new Error()
       };
   }

packages/@rescript/runtime/lib/js/Stdlib_Error.js

@@ -23,7 +23,7 @@ let $$TypeError = {};
 let $$URIError = {};
 
 function panic(msg) {
-  throw new Error("Panic! " + msg);
+  throw new Error(`Panic! ` + msg);
 }
 
 exports.fromException = fromException;

packages/@rescript/runtime/lib/js/Stdlib_JsError.js

@@ -54,7 +54,7 @@ let $$URIError$1 = {
 };
 
 function panic(msg) {
-  throw new Error("Panic! " + msg);
+  throw new Error(`Panic! ` + msg);
 }
 
 exports.$$EvalError = $$EvalError$1;

rewatch/testrepo/packages/with-ppx/src/FileWithPpx.mjs

@@ -6,7 +6,7 @@ let schema = S.schema(s => ({
   foo: s.m(S.string)
 }));
 
-let foo = S.parseOrThrow("{ \"foo\": \"bar\" }", schema);
+let foo = S.parseOrThrow(`{ "foo": "bar" }`, schema);
 
 console.log(foo);