support tagged templates (#6250)

* support tagged template in rescript and allow to bind to JS
tagged templates using @taggedTemplate annotation

* Set version to 11.1.0

* add tagged templates to changelog

This work was originally based on kevinbarabash#2

CHANGELOG.md

@@ -10,7 +10,11 @@
 > - :house: [Internal]
 > - :nail_care: [Polish]
 
-# 11.0.2 (Unreleased)
+# 11.1.0 (Unreleased)
+
+#### :rocket: New Feature
+
+- experimental support of tagged template literals, eg ```sql`select * from ${table}```. https://github.com/rescript-lang/rescript-compiler/pull/6250
 
 # 11.0.1
 

jscomp/common/bs_version.ml

@@ -21,6 +21,6 @@
  * You should have received a copy of the GNU Lesser General Public License
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
-let version = "11.0.2"
+let version = "11.1.0"
 let header = "// Generated by ReScript, PLEASE EDIT WITH CARE"
 let package_name = ref "rescript"

jscomp/core/j.ml

@@ -115,6 +115,7 @@ and expression_desc =
      This can be constructed either in a static way [E.array_index_by_int] or a dynamic way
      [E.array_index]
   *)
+  | Tagged_template of expression * expression list * expression list
   | Static_index of expression * string * int32 option
   (* The third argument bool indicates whether we should
      print it as

jscomp/core/js_analyzer.ml

@@ -103,6 +103,8 @@ let rec no_side_effect_expression_desc (x : J.expression_desc) =
   | String_append (a, b) | Seq (a, b) -> no_side_effect a && no_side_effect b
   | Length (e, _) | Caml_block_tag (e, _) | Typeof e -> no_side_effect e
   | Bin (op, a, b) -> op <> Eq && no_side_effect a && no_side_effect b
+  | Tagged_template (call_expr, strings, values) -> no_side_effect call_expr &&
+      Ext_list.for_all strings no_side_effect && Ext_list.for_all values no_side_effect
   | Js_not _ | Cond _ | FlatCall _ | Call _ | New _ | Raw_js_code _
   (* actually true? *) ->
       false
@@ -204,7 +206,7 @@ let rec eq_expression ({ expression_desc = x0 } : J.expression)
       | _ -> false)
   | Length _ | Is_null_or_undefined _ | String_append _ | Typeof _ | Js_not _
   | Cond _ | FlatCall _ | New _ | Fun _ | Raw_js_code _ | Array _
-  | Caml_block_tag _ | Object _
+  | Caml_block_tag _ | Object _ | Tagged_template _
   | Number (Uint _) ->
       false
   | Await _ -> false

jscomp/core/js_dump.ml

@@ -165,6 +165,7 @@ let exp_need_paren (e : J.expression) =
   | Js_not _ | Bool _ | New _ ->
       false
   | Await _ -> false
+  | Tagged_template _ -> false
 
 let comma_idents (cxt : cxt) f ls = iter_lst cxt f ls Ext_pp_scope.ident comma
 
@@ -596,6 +597,24 @@ and expression_desc cxt ~(level : int) f x : cxt =
               P.string f L.null;
               comma_sp f;
               expression ~level:1 cxt f el))
+  | Tagged_template (callExpr, stringArgs, valueArgs) ->
+    let cxt = expression cxt ~level f callExpr in
+    P.string f "`";
+    let rec aux cxt xs ys = match xs, ys with
+    | [], [] -> ()
+    | [{J.expression_desc = Str { txt; _ }}], [] ->  
+        P.string f txt
+    | {J.expression_desc = Str { txt; _ }} :: x_rest, y :: y_rest ->
+        P.string f txt;
+        P.string f "${";
+        let cxt = expression cxt ~level f y in
+        P.string f "}";
+        aux cxt x_rest y_rest
+    | _ -> assert false
+    in
+    aux cxt stringArgs valueArgs;
+    P.string f "`";
+    cxt
   | String_index (a, b) ->
       P.group f 1 (fun _ ->
           let cxt = expression ~level:15 cxt f a in

jscomp/core/js_exp_make.ml

@@ -72,6 +72,9 @@ let call ?comment ~info e0 args : t =
 let flat_call ?comment e0 es : t =
   { expression_desc = FlatCall (e0, es); comment }
 
+let tagged_template ?comment callExpr stringArgs valueArgs : t =
+  { expression_desc = Tagged_template (callExpr, stringArgs, valueArgs); comment }
+
 let runtime_var_dot ?comment (x : string) (e1 : string) : J.expression =
   {
     expression_desc =

jscomp/core/js_exp_make.mli

@@ -279,6 +279,8 @@ val call : ?comment:string -> info:Js_call_info.t -> t -> t list -> t
 
 val flat_call : ?comment:string -> t -> t -> t
 
+val tagged_template : ?comment:string -> t -> t list -> t list -> t
+
 val new_ : ?comment:string -> J.expression -> J.expression list -> t
 
 val array : ?comment:string -> J.mutable_flag -> J.expression list -> t

jscomp/core/js_fold.ml

@@ -124,6 +124,11 @@ class fold =
           let _self = _self#expression _x0 in
           let _self = list (fun _self -> _self#expression) _self _x1 in
           _self
+      | Tagged_template (_x0, _x1, _x2) ->
+          let _self = _self#expression _x0 in
+          let _self = list (fun _self -> _self#expression) _self _x1 in
+          let _self = list (fun _self -> _self#expression) _self _x2 in
+          _self
       | String_index (_x0, _x1) ->
           let _self = _self#expression _x0 in
           let _self = _self#expression _x1 in

jscomp/core/js_record_fold.ml

@@ -130,6 +130,11 @@ let expression_desc : 'a. ('a, expression_desc) fn =
       let st = _self.expression _self st _x0 in
       let st = list _self.expression _self st _x1 in
       st
+  | Tagged_template (_xo, _x1, _x2) -> 
+    let st = _self.expression _self st _xo in 
+    let st = list _self.expression _self st _x1 in 
+    let st = list _self.expression _self st _x2 in
+    st
   | String_index (_x0, _x1) ->
       let st = _self.expression _self st _x0 in
       let st = _self.expression _self st _x1 in

jscomp/core/js_record_iter.ml

@@ -107,6 +107,10 @@ let expression_desc : expression_desc fn =
   | Call (_x0, _x1, _x2) ->
       _self.expression _self _x0;
       list _self.expression _self _x1
+  | Tagged_template (_x0, _x1, _x2) ->
+    _self.expression _self _x0;
+    list _self.expression _self _x1;
+    list _self.expression _self _x2
   | String_index (_x0, _x1) ->
       _self.expression _self _x0;
       _self.expression _self _x1

jscomp/core/js_record_map.ml

@@ -130,6 +130,11 @@ let expression_desc : expression_desc fn =
       let _x0 = _self.expression _self _x0 in
       let _x1 = list _self.expression _self _x1 in
       Call (_x0, _x1, _x2)
+  | Tagged_template (_x0, _x1, _x2) -> 
+      let _x0 = _self.expression _self _x0 in
+      let _x1 = list _self.expression _self _x1 in
+      let _x2 = list _self.expression _self _x2 in
+      Tagged_template (_x0, _x1, _x2)
   | String_index (_x0, _x1) ->
       let _x0 = _self.expression _self _x0 in
       let _x1 = _self.expression _self _x1 in

jscomp/core/lam_compile_external_call.ml

@@ -252,7 +252,17 @@ let translate_scoped_access scopes obj =
 let translate_ffi (cxt : Lam_compile_context.t) arg_types
     (ffi : External_ffi_types.external_spec) (args : J.expression list) =
   match ffi with
-  | Js_call { external_module_name = module_name; name = fn; splice; scopes } ->
+  | Js_call { external_module_name; name; splice; scopes; tagged_template = true } -> 
+      let fn = translate_scoped_module_val external_module_name name scopes in 
+      (match args with
+      | [ stringArgs; valueArgs ] -> (
+          match (stringArgs, valueArgs) with
+          | ({expression_desc = Array (strings, _); _}, {expression_desc = Array (values, _); _}) ->
+              E.tagged_template fn strings values
+          | _ -> assert false
+          )
+      | _ -> assert false)
+  | Js_call { external_module_name = module_name; name = fn; splice; scopes; tagged_template = false } ->
       let fn = translate_scoped_module_val module_name fn scopes in
       if splice then
         let args, eff, dynamic = assemble_args_has_splice arg_types args in

jscomp/frontend/ast_external_process.ml

@@ -184,6 +184,7 @@ type external_desc = {
   get_name: bundle_source option;
   mk_obj: bool;
   return_wrapper: External_ffi_types.return_wrapper;
+  tagged_template: bool;
 }
 
 let init_st =
@@ -202,6 +203,7 @@ let init_st =
     get_name = None;
     mk_obj = false;
     return_wrapper = Return_unset;
+    tagged_template = false;
   }
 
 let return_wrapper loc (txt : string) : External_ffi_types.return_wrapper =
@@ -291,6 +293,7 @@ let parse_external_attributes (no_arguments : bool) (prim_name_check : string)
                between unset/set
             *)
             | scopes -> {st with scopes})
+          | "taggedTemplate" -> {st with splice = true; tagged_template = true}
           | "bs.splice" | "bs.variadic" | "variadic" -> {st with splice = true}
           | "bs.send" | "send" ->
             {st with val_send = Some (name_from_payload_or_prim ~loc payload)}
@@ -366,6 +369,7 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string)
    get_name = None;
    get_index = false;
    return_wrapper = Return_unset;
+   tagged_template = _;
    set_index = false;
    mk_obj = _;
    scopes =
@@ -564,6 +568,7 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc)
    get_name = None;
    return_wrapper = _;
    mk_obj = _;
+   tagged_template = _;
   } ->
     if arg_type_specs_length = 3 then
       Js_set_index {js_set_index_scopes = scopes}
@@ -588,6 +593,7 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc)
    set_index = false;
    mk_obj = _;
    return_wrapper = _;
+   tagged_template = _;
   } ->
     if arg_type_specs_length = 2 then
       Js_get_index {js_get_index_scopes = scopes}
@@ -614,6 +620,7 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc)
    set_index = false;
    return_wrapper = _;
    mk_obj = _;
+   tagged_template = _;
   } -> (
     match (arg_types_ty, new_name, val_name) with
     | [], None, _ -> Js_module_as_var external_module_name
@@ -655,6 +662,7 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc)
    mk_obj = _;
    (* mk_obj is always false *)
    return_wrapper = _;
+   tagged_template;
   } ->
     let name = prim_name_or_pval_prim.name in
     if arg_type_specs_length = 0 then
@@ -665,7 +673,9 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc)
          FIXME: splice is not supported here 
       *)
       Js_var {name; external_module_name = None; scopes}
-    else Js_call {splice; name; external_module_name = None; scopes}
+    else
+      Js_call
+        {splice; name; external_module_name = None; scopes; tagged_template}
   | {
    call_name = Some {name; source = _};
    splice;
@@ -681,6 +691,7 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc)
    get_name = None;
    mk_obj = _;
    return_wrapper = _;
+   tagged_template;
   } ->
     if arg_type_specs_length = 0 then
       (*
@@ -690,7 +701,7 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc)
         *)
       Js_var {name; external_module_name; scopes}
       (*FIXME: splice is not supported here *)
-    else Js_call {splice; name; external_module_name; scopes}
+    else Js_call {splice; name; external_module_name; scopes; tagged_template}
   | {call_name = Some _; _} ->
     Bs_syntaxerr.err loc
       (Conflict_ffi_attribute "Attribute found that conflicts with %@val")
@@ -709,6 +720,7 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc)
    return_wrapper = _;
    splice = false;
    scopes;
+   tagged_template = _;
   } ->
     (*
          if no_arguments -->
@@ -735,6 +747,7 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc)
    get_name = None;
    mk_obj = _;
    return_wrapper = _;
+   tagged_template;
   } ->
     let name = prim_name_or_pval_prim.name in
     if arg_type_specs_length = 0 then
@@ -744,7 +757,7 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc)
          ]}
       *)
       Js_var {name; external_module_name; scopes}
-    else Js_call {splice; name; external_module_name; scopes}
+    else Js_call {splice; name; external_module_name; scopes; tagged_template}
   | {
    val_send = Some {name; source = _};
    splice;
@@ -760,6 +773,7 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc)
    external_module_name = None;
    mk_obj = _;
    return_wrapper = _;
+   tagged_template = _;
   } -> (
     (* PR #2162 - since when we assemble arguments the first argument in
        [@@send] is ignored
@@ -791,6 +805,7 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc)
    scopes;
    mk_obj = _;
    return_wrapper = _;
+   tagged_template = _;
   } ->
     Js_new {name; external_module_name; splice; scopes}
   | {new_name = Some _; _} ->
@@ -811,6 +826,7 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc)
    mk_obj = _;
    return_wrapper = _;
    scopes;
+   tagged_template = _;
   } ->
     if arg_type_specs_length = 2 then
       Js_set {js_set_scopes = scopes; js_set_name = name}
@@ -834,6 +850,7 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc)
    mk_obj = _;
    return_wrapper = _;
    scopes;
+   tagged_template = _;
   } ->
     if arg_type_specs_length = 1 then
       Js_get {js_get_name = name; js_get_scopes = scopes}

jscomp/frontend/external_ffi_types.ml

@@ -53,6 +53,7 @@ type external_spec =
       external_module_name: external_module_name option;
       splice: bool;
       scopes: string list;
+      tagged_template: bool;
     }
   | Js_send of {name: string; splice: bool; js_send_scopes: string list}
     (* we know it is a js send, but what will happen if you pass an ocaml objct *)
@@ -188,7 +189,9 @@ let check_ffi ?loc ffi : bool =
     upgrade (is_package_relative_path external_module_name.bundle);
     check_external_module_name external_module_name
   | Js_new {external_module_name; name; splice = _; scopes = _}
-  | Js_call {external_module_name; name; splice = _; scopes = _} ->
+  | Js_call
+      {external_module_name; name; splice = _; scopes = _; tagged_template = _}
+    ->
     Ext_option.iter external_module_name (fun external_module_name ->
         upgrade (is_package_relative_path external_module_name.bundle));
     Ext_option.iter external_module_name (fun name ->

jscomp/frontend/external_ffi_types.mli

@@ -50,6 +50,7 @@ type external_spec =
       external_module_name: external_module_name option;
       splice: bool;
       scopes: string list;
+      tagged_template: bool;
     }
   | Js_send of {name: string; splice: bool; js_send_scopes: string list}
     (* we know it is a js send, but what will happen if you pass an ocaml objct *)