first pass at tagged templates

basically kevinbarabash#2 rebased on master

Author: tsnobip

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,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.
+   *)
+  | Tagged_template _ -> false
   | Js_not _ | Cond _ | FlatCall _ | Call _ | New _ | Raw_js_code _
   (* actually true? *) ->
       false
@@ -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 _ | Raw_js_code _ | Array _
-  | Caml_block_tag _ | Object _
+  | Caml_block_tag _ | Object _ | Tagged_template _
   | Number (Uint _) ->
       false
   | Await _ -> false

jscomp/core/js_dump.ml

@@ -147,6 +147,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 *)
+  | Tagged_template _ -> false
   | Raw_js_code { code_info = Exp _ }
   | Fun _
   | Caml_block
@@ -586,6 +588,29 @@ 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
+    | [], [] -> ()
+    | x_head :: x_rest, ys ->
+      let cxt = (match x_head with
+      | {J.expression_desc = Str { txt; _ }} ->
+        P.string f txt;
+        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

@@ -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,8 @@ class fold =
           let _self = _self#expression _x0 in
           let _self = list (fun _self -> _self#expression) _self _x1 in
           _self
+      | Tagged_template (_, _, _) ->
+          _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
+  | Tagged_template (_, _, _) -> 
+    (* 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
+  | Tagged_template (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)
+  | Tagged_template (callExpr, stringsArray, valuesArray) -> 
+    (* TODO: implement this *)
+    Tagged_template (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

@@ -28,6 +28,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

@@ -1598,6 +1598,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_primitive.ml

@@ -339,6 +339,21 @@ let translate output_prefix loc (cxt : Lam_compile_context.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
@@ -686,13 +686,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
   let is_async_fn = match fn with
     | Lfunction { attr = {async}} -> async 

jscomp/core/lam_pass_remove_alias.ml

@@ -198,7 +198,8 @@ let simplify_alias (meta : Lam_stats.t) (lam : Lam.t) : Lam.t =
 
         (* Ext_log.dwarn __LOC__ "%s/%d" v.name v.stamp;     *)
         let ap_args = Ext_list.map ap_args simpl in
-        let[@local] normal () = Lam.apply (simpl fn) ap_args ap_info in
+        (* todo bring back local inlining *)
+        let normal () = Lam.apply (simpl fn) ap_args ap_info in
         match Hash_ident.find_opt meta.ident_tbl v with
         | Some
             (FunctionId
@@ -238,7 +239,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 ->
@@ -256,6 +257,18 @@ let simplify_alias (meta : Lam_stats.t) (lam : Lam.t) : Lam.t =
                             (Lam_beta_reduce.propagate_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

@@ -49,6 +49,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
@@ -259,6 +263,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

@@ -44,6 +44,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, dynamic_import) -> fprintf ppf (if dynamic_import then "dynamic global %a" else "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 =

jscomp/ml/lambda.ml

@@ -307,6 +307,7 @@ and lambda_apply =
     ap_args : lambda list;
     ap_loc : Location.t;
     ap_inlined : inline_attribute;
+    ap_tagged_template : bool;
     }
 
 and lambda_switch =
@@ -641,12 +642,13 @@ let rec map f lam =
     | Lvar _ -> lam
     | Lconst _ -> lam
     | Lapply { ap_func; ap_args; ap_loc; 
-          ap_inlined;  } ->
+          ap_inlined; ap_tagged_template; } ->
         Lapply {
           ap_func = map f ap_func;
           ap_args = List.map (map f) ap_args;
           ap_loc;
-          ap_inlined;
+          ap_inlined; 
+          ap_tagged_template ;
         }
     | Lfunction {  params; body; attr; loc; } ->
         Lfunction {  params; body = map f body; attr; loc; }

jscomp/ml/lambda.mli

@@ -309,6 +309,7 @@ and lambda_apply =
     ap_args : lambda list;
     ap_loc : Location.t;
     ap_inlined : inline_attribute; (* specified with the [@inlined] attribute *)
+    ap_tagged_template : bool;
     }
 
 and lambda_switch =

jscomp/ml/matching.ml

@@ -1514,7 +1514,13 @@ let code_force =
 
 
 let inline_lazy_force arg loc =
-    Lapply { ap_func = Lazy.force code_force; ap_inlined = Default_inline;  ap_args = [arg]; ap_loc = loc}
+  Lapply {
+    ap_func = Lazy.force code_force; 
+    ap_inlined = Default_inline;
+    ap_tagged_template = false;
+    ap_args = [arg];
+    ap_loc = loc;
+  }
 let make_lazy_matching def = function
     [] -> fatal_error "Matching.make_lazy_matching"
   | (arg,_mut) :: argl ->