Add support for tagged template literals

.github/workflows/ci.yml

@@ -4,7 +4,7 @@ on:
   push:
     branches: [ master ]
   pull_request:
-    branches: [ master ]
+    branches: [ master, merge-syntax ]
 
 jobs:
   test-syntax:

jscomp/core/j.ml

@@ -120,6 +120,7 @@ and expression_desc =
       some primitive  call is translated
       into a plain call, it's better to keep them
   *)
+  | TaggedTemplate of expression * expression list * expression list
   | String_index of expression * expression
   (* str.[i])*)
   | Array_index of expression * expression

jscomp/core/js_analyzer.ml

@@ -103,6 +103,12 @@ 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
+  (**  
+    TODO: we should check look at each of the expressions in the 'values' list/array
+    to determine if any of them have side-effects.  For now we'll just return false
+    to make the compiler happy.
+   *)
+  | TaggedTemplate _ -> false
   | Js_not _ | Cond _ | FlatCall _ | Call _ | New _ | Raw_js_code _
   (* | Caml_block_set_tag _  *)
   (* actually true? *) ->
@@ -204,7 +210,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 _ | Unicode _ | Raw_js_code _ | Array _
-  | Caml_block_tag _ | Object _
+  | Caml_block_tag _ | Object _ | TaggedTemplate _
   | Number (Uint _) ->
       false
 

jscomp/core/js_dump.ml

@@ -149,6 +149,8 @@ let exp_need_paren (e : J.expression) =
   match e.expression_desc with
   (* | Caml_uninitialized_obj _  *)
   | Call ({ expression_desc = Fun _ | Raw_js_code _ }, _, _) -> true
+  (* TODO: implement this *)
+  | TaggedTemplate _ -> false
   | Raw_js_code { code_info = Exp _ }
   | Fun _
   | Caml_block
@@ -579,6 +581,32 @@ and expression_desc cxt ~(level : int) f x : cxt =
               P.string f L.null;
               comma_sp f;
               expression ~level:1 cxt f el))
+  | TaggedTemplate (callExpr, stringArgs, valueArgs) ->
+    let cxt = expression cxt ~level f callExpr in
+    P.string f "`";
+    let rec aux cxt xs ys = match xs, ys with
+    | [], [] -> ()
+    | x_head :: x_rest, ys ->
+      let cxt = (match x_head with
+      | {J.expression_desc = Unicode str} ->
+        P.string f str;
+        cxt
+      | {J.expression_desc = Str (_, str)} ->
+        P.string f str;
+        cxt
+      | _ -> 
+        P.string f "${";
+        let cxt = expression cxt ~level f x_head in
+        P.string f "}";
+        cxt
+      )
+      in
+      aux cxt ys x_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

@@ -74,6 +74,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 = TaggedTemplate (callExpr, stringArgs, valueArgs); comment }
+
 let runtime_var_dot ?comment (x : string) (e1 : string) : J.expression =
   {
     expression_desc =

jscomp/core/js_exp_make.mli

@@ -269,6 +269,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,8 @@ class fold =
           let _self = _self#expression _x0 in
           let _self = list (fun _self -> _self#expression) _self _x1 in
           _self
+      | TaggedTemplate (_, _, _) ->
+          _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,9 @@ 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
+  | TaggedTemplate (_, _, _) -> 
+      (* TODO: implement this *)
+      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,9 @@ let expression_desc : expression_desc fn =
   | Call (_x0, _x1, _x2) ->
       _self.expression _self _x0;
       list _self.expression _self _x1
+  | TaggedTemplate (exprCall, _, _) ->
+      (* TODO: implement this *)
+      _self.expression _self exprCall;
   | String_index (_x0, _x1) ->
       _self.expression _self _x0;
       _self.expression _self _x1

jscomp/core/js_record_map.ml

@@ -130,6 +130,9 @@ 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)
+  | TaggedTemplate (callExpr, stringsArray, valuesArray) -> 
+      (* TODO: implement this *)
+      TaggedTemplate (callExpr, stringsArray, valuesArray)
   | String_index (_x0, _x1) ->
       let _x0 = _self.expression _self _x0 in
       let _x1 = _self.expression _self _x1 in

jscomp/core/lam.ml

@@ -29,6 +29,7 @@ type apply_status = App_na | App_infer_full | App_uncurry
 type ap_info = {
   ap_loc : Location.t;
   ap_inlined : Lambda.inline_attribute;
+  ap_tagged_template : bool;
   ap_status : apply_status;
 }
 

jscomp/core/lam.mli

@@ -27,6 +27,7 @@ type apply_status = App_na | App_infer_full | App_uncurry
 type ap_info = {
   ap_loc : Location.t;
   ap_inlined : Lambda.inline_attribute;
+  ap_tagged_template : bool;
   ap_status : apply_status;
 }
 

jscomp/core/lam_analysis.ml

@@ -98,7 +98,7 @@ let rec no_side_effects (lam : Lam.t) : bool =
           true
       | Pjs_apply | Pjs_runtime_apply | Pjs_call _ | Pinit_mod | Pupdate_mod
       | Pjs_unsafe_downgrade _ | Pdebugger | Pvoid_run | Pfull_apply
-      | Pjs_fn_method
+      | Pjs_fn_method | Pjs_tagged_template _
       (* TODO *)
       | Praw_js_code _ | Pbytessetu | Pbytessets
       (* Operations on boxed integers (Nativeint.t, Int32.t, Int64.t) *)

jscomp/core/lam_compile.ml

@@ -1476,6 +1476,7 @@ and compile_prim (prim_info : Lam.prim_info)
                {
                  ap_loc = loc;
                  ap_inlined = Default_inline;
+                 ap_tagged_template = false;
                  ap_status = App_uncurry;
                })
       (*FIXME: should pass info down: `f a [@bs][@inlined]`*)

jscomp/core/lam_compile_external_call.mli

@@ -36,6 +36,12 @@ val translate_ffi :
   J.expression list ->
   J.expression
 
+val translate_scoped_module_val :
+  External_ffi_types.external_module_name option -> 
+  string -> 
+  string list -> 
+  J.expression
+
 (** TODO: document supported attributes
     Attributes starting with `js` are reserved
     examples: "variadic"

jscomp/core/lam_compile_main.ml

@@ -127,7 +127,7 @@ let _j = Js_pass_debug.dump
 let compile  
     (output_prefix : string) 
     export_idents
-    (lam : Lambda.lambda)  = 
+    (lam : Lambda.lambda) = 
   let export_ident_sets = Set_ident.of_list export_idents in 
   (* To make toplevel happy - reentrant for js-demo *)
   let () = 

jscomp/core/lam_compile_main.pp.ml

@@ -124,7 +124,7 @@ let _j = Js_pass_debug.dump
 let compile  
     (output_prefix : string) 
     export_idents
-    (lam : Lambda.lambda)  = 
+    (lam : Lambda.lambda) = 
   let export_ident_sets = Set_ident.of_list export_idents in 
   (* To make toplevel happy - reentrant for js-demo *)
   let () = 

jscomp/core/lam_compile_primitive.ml

@@ -284,6 +284,21 @@ let translate loc (cxt : Lam_compile_context.t) (prim : Lam_primitive.t)
   | Pjs_object_create _ -> assert false
   | Pjs_call { arg_types; ffi } ->
       Lam_compile_external_call.translate_ffi cxt arg_types ffi args
+  | Pjs_tagged_template { ffi } -> (
+      (* TODO: extract this into lam_compile_external_call.ml *)
+      let fn = match ffi with
+      | Js_call { external_module_name; name; scopes } ->
+        Lam_compile_external_call.translate_scoped_module_val external_module_name name scopes
+      | _ -> assert false
+      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)
   (* FIXME, this can be removed later *)
   | Pisint -> E.is_type_number (Ext_list.singleton_exn args)
   | Pis_poly_var_block -> E.is_type_object (Ext_list.singleton_exn args)

jscomp/core/lam_convert.ml

@@ -512,11 +512,11 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) :
     match lam with
     | Lvar x -> Lam.var (Hash_ident.find_default alias_tbl x x)
     | Lconst x -> Lam.const (Lam_constant_convert.convert_constant x)
-    | Lapply { ap_func = fn; ap_args = args; ap_loc = loc; ap_inlined } ->
+    | Lapply { ap_func = fn; ap_args = args; ap_loc = loc; ap_inlined; ap_tagged_template } ->
         (* we need do this eargly in case [aux fn] add some wrapper *)
         Lam.apply (convert_aux fn)
           (Ext_list.map args convert_aux)
-          { ap_loc = loc; ap_inlined; ap_status = App_na }
+          { ap_loc = loc; ap_inlined; ap_tagged_template; ap_status = App_na }
     | Lfunction { params; body; attr } ->
         let new_map, body =
           rename_optional_parameters Map_ident.empty params body
@@ -685,13 +685,15 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) :
           {
             ap_loc = outer_loc;
             ap_inlined = ap_info.ap_inlined;
+            ap_tagged_template = ap_info.ap_tagged_template;
             ap_status = App_na;
           }
     | _ ->
         Lam.apply f [ x ]
           {
             ap_loc = outer_loc;
             ap_inlined = Default_inline;
+            ap_tagged_template = false;
             ap_status = App_na;
           }
   and convert_switch (e : Lambda.lambda) (s : Lambda.lambda_switch) =

jscomp/core/lam_eta_conversion.ml

@@ -111,7 +111,7 @@ let transform_under_supply n ap_info fn args =
 let unsafe_adjust_to_arity loc ~(to_ : int) ?(from : int option) (fn : Lam.t) :
     Lam.t =
   let ap_info : Lam.ap_info =
-    { ap_loc = loc; ap_inlined = Default_inline; ap_status = App_na }
+    { ap_loc = loc; ap_inlined = Default_inline; ap_tagged_template = false; ap_status = App_na }
   in
   match (from, fn) with
   | Some from, _ | None, Lfunction { arity = from } -> (

jscomp/core/lam_pass_remove_alias.ml

@@ -190,7 +190,7 @@ let simplify_alias (meta : Lam_stats.t) (lam : Lam.t) : Lam.t =
                   Lam_closure.is_closed_with_map meta.export_idents params body
                 in
                 let is_export_id = Set_ident.mem meta.export_idents v in
-                match (is_export_id, param_map) with
+                let result = match (is_export_id, param_map) with
                 | false, (_, param_map) | true, (true, param_map) -> (
                     match rec_flag with
                     | Lam_rec ->
@@ -208,6 +208,18 @@ let simplify_alias (meta : Lam_stats.t) (lam : Lam.t) : Lam.t =
                             (Lam_beta_reduce.propogate_beta_reduce_with_map meta
                                param_map params body ap_args))
                 | _ -> normal ()
+                in
+                let result = (match result with
+                | Lprim {primitive; args; loc} -> (match primitive with
+                  (* Converts Pjs_calls to Pjs_tagged_templates if ap_tagged_template is true *)
+                  | Pjs_call {prim_name; ffi} when ap_info.ap_tagged_template ->
+                    let prim = Lam_primitive.Pjs_tagged_template {prim_name; ffi} in
+                    Lam.prim ~primitive:prim ~args loc
+                  | _ -> result
+                  )
+                | _ -> result)
+                in
+                result
               else normal ()
             else normal ()
         | Some _ | None -> normal ())

jscomp/core/lam_primitive.ml

@@ -50,6 +50,10 @@ type t =
       arg_types : External_arg_spec.params;
       ffi : External_ffi_types.external_spec;
     }
+  | Pjs_tagged_template of { 
+      prim_name : string;
+      ffi : External_ffi_types.external_spec;
+    }
   | Pjs_object_create of External_arg_spec.obj_params
   (* Exceptions *)
   | Praise
@@ -258,6 +262,11 @@ let eq_primitive_approx (lhs : t) (rhs : t) =
       match rhs with
       | Pjs_object_create obj_create1 -> obj_create = obj_create1
       | _ -> false)
+  | Pjs_tagged_template { prim_name; ffi } -> (
+      match rhs with
+      | Pjs_tagged_template rhs ->
+          prim_name = rhs.prim_name && ffi = rhs.ffi
+      | _ -> false)
   | Pintcomp comparison -> (
       match rhs with
       | Pintcomp comparison1 -> Lam_compat.eq_comparison comparison comparison1

jscomp/core/lam_primitive.mli

@@ -45,6 +45,10 @@ type t =
       arg_types : External_arg_spec.params;
       ffi : External_ffi_types.external_spec;
     }
+  | Pjs_tagged_template of {
+      prim_name : string;
+      ffi : External_ffi_types.external_spec;
+    }
   | Pjs_object_create of External_arg_spec.obj_params
   | Praise
   | Psequand

jscomp/core/lam_print.ml

@@ -93,6 +93,7 @@ let primitive ppf (prim : Lam_primitive.t) =
   | Plazyforce -> fprintf ppf "force"
   | Pccall p -> fprintf ppf "%s" p.prim_name
   | Pjs_call { prim_name } -> fprintf ppf "%s[js]" prim_name
+  | Pjs_tagged_template { prim_name } -> fprintf ppf "%s[js.tagged_template]" prim_name
   | Pjs_object_create _ -> fprintf ppf "[js.obj]"
   | Praise -> fprintf ppf "raise"
   | Psequand -> fprintf ppf "&&"
@@ -263,12 +264,13 @@ let lambda ppf v =
     | Lvar id -> Ident.print ppf id
     | Lglobal_module id -> fprintf ppf "global %a" Ident.print id
     | Lconst cst -> struct_const ppf cst
-    | Lapply { ap_func; ap_args; ap_info = { ap_inlined } } ->
+    | Lapply { ap_func; ap_args; ap_info = { ap_inlined; ap_tagged_template } } ->
         let lams ppf args =
           List.iter (fun l -> fprintf ppf "@ %a" lam l) args
         in
-        fprintf ppf "@[<2>(apply%s@ %a%a)@]"
+        fprintf ppf "@[<2>(apply%s%s@ %a%a)@]"
           (match ap_inlined with Always_inline -> "%inlned" | _ -> "")
+          (match ap_tagged_template with true -> "%tagged_template" | _ -> "")
           lam ap_func lams ap_args
     | Lfunction { params; body; _ } ->
         let pr_params ppf params =