Keep @directive on @this functions

changes/this-function-directive.fix.md

@@ -0,0 +1 @@
+- Keep `@directive` on `@this` functions.

compiler/core/js_dump.ml

@@ -253,7 +253,6 @@ let pp_var_assign cxt f id =
 let pp_var_assign_this cxt f id =
   let cxt = pp_var_assign cxt f id in
   P.string f L.this;
-  P.space f;
   semi f;
   P.newline f;
   cxt
@@ -445,11 +444,14 @@ let rec pp_function ~return_unit ~async ~is_method ?directive cxt (f : P.t)
           in
           P.space f;
           P.brace_vgroup f 1 (fun _ ->
+              (* A directive must be the first statement of the body, so it
+                 comes before [let self = this] *)
+              print_directive f directive;
               let cxt =
                 if Js_fun_env.get_unused env 0 then cxt
                 else pp_var_assign_this cxt f this
               in
-              function_body ?directive ~return_unit cxt f b))
+              function_body ~return_unit cxt f b))
       else
         let cxt =
           match l with
@@ -1568,14 +1570,17 @@ and statement_desc top cxt f (s : J.statement_desc) : cxt =
           P.space f;
           brace_block cxt f b)
 
-and function_body ?directive (cxt : cxt) f ~return_unit (b : J.block) : unit =
-  (match directive with
+and print_directive f directive =
+  match directive with
   | None -> ()
   | Some directive ->
     P.newline f;
     P.string f directive;
     P.string f ";";
-    P.newline f);
+    P.newline f
+
+and function_body ?directive (cxt : cxt) f ~return_unit (b : J.block) : unit =
+  print_directive f directive;
   match b with
   | [] -> ()
   | [s] -> (

compiler/core/js_exp_make.ml

@@ -357,7 +357,7 @@ let ocaml_fun ?immutable_mask ?directive ~return_unit ~async ~one_unit_arg
     source_loc = None;
   }
 
-let method_ ~async ~return_unit params body : t =
+let method_ ?directive ~async ~return_unit params body : t =
   let len = List.length params in
   {
     expression_desc =
@@ -369,7 +369,7 @@ let method_ ~async ~return_unit params body : t =
           env = Js_fun_env.make len;
           return_unit;
           async;
-          directive = None;
+          directive;
         };
     comment = None;
     source_loc = None;

compiler/core/js_exp_make.mli

@@ -95,7 +95,13 @@ val ocaml_fun :
   J.block ->
   t
 
-val method_ : async:bool -> return_unit:bool -> J.ident list -> J.block -> t
+val method_ :
+  ?directive:string ->
+  async:bool ->
+  return_unit:bool ->
+  J.ident list ->
+  J.block ->
+  t
 
 val econd : ?comment:string -> t -> t -> t -> t
 

compiler/core/lam_compile.ml

@@ -1885,10 +1885,11 @@ let compile output_prefix =
     | {primitive = Pjs_object_get _ | Pjs_object_set _} -> assert false
     | {primitive = Pjs_fn_method; args = args_lambda} -> (
       match args_lambda with
-      | [Lfunction {params; body; attr = {return_unit; async}; loc}] ->
+      | [Lfunction {params; body; attr = {return_unit; async; directive}; loc}]
+        ->
         Js_output.output_of_block_and_expression lambda_cxt.continuation []
           (with_source_loc loc
-             (E.method_ ~async ~return_unit params
+             (E.method_ ?directive ~async ~return_unit params
                 (* Invariant:  jmp_table can not across function boundary,
                    here we share env
                 *)

compiler/frontend/ast_uncurry_gen.ml

@@ -25,8 +25,9 @@
 open Ast_helper
 
 (* Handling `fun [@this]` used in `object [@bs] end` *)
-let to_method_callback ~async ~newtypes loc (self : Ast_mapper.mapper)
-    (params : Parsetree.fun_param list) body : Parsetree.expression_desc =
+let to_method_callback ~async ~newtypes ~fun_attrs loc
+    (self : Ast_mapper.mapper) (params : Parsetree.fun_param list) body :
+    Parsetree.expression_desc =
   match params with
   | [] -> assert false
   | {p_lbl = label; p_pat = self_pat} :: rest ->
@@ -53,7 +54,8 @@ let to_method_callback ~async ~newtypes loc (self : Ast_mapper.mapper)
     let arity = List.length mapped_params in
     let body =
       Ast_async.make_function_async ~async
-        (Ast_helper.Exp.fun_ ~loc ~async ~newtypes mapped_params result)
+        (Ast_helper.Exp.fun_ ~loc ~attrs:fun_attrs ~async ~newtypes
+           mapped_params result)
     in
     let arity_s = string_of_int arity in
     Stack.pop (Js_config.current ()).self_stack |> ignore;

compiler/frontend/ast_uncurry_gen.mli

@@ -25,6 +25,7 @@
 val to_method_callback :
   async:bool ->
   newtypes:(string Asttypes.loc * Parsetree.attributes) list ->
+  fun_attrs:Parsetree.attributes ->
   Location.t ->
   Ast_mapper.mapper ->
   Parsetree.fun_param list ->

compiler/frontend/bs_builtin_ppx.ml

@@ -190,12 +190,19 @@ let expr_mapper ~async_context (self : mapper) (e : Parsetree.expression) =
     | Meth_callback _, pexp_attributes ->
       (* FIXME: does it make sense to have a label for [this] ? *)
       async_context := false;
+      (* [@directive] belongs to the JS function, which is the inner function
+         passed to [unsafe_to_method], where translcore reads it *)
+      let fun_attrs, pexp_attributes =
+        List.partition
+          (fun ({Location.txt}, _) -> txt = "directive")
+          pexp_attributes
+      in
       let callback =
         {
           e with
           pexp_desc =
-            Ast_uncurry_gen.to_method_callback ~async ~newtypes e.pexp_loc self
-              params body;
+            Ast_uncurry_gen.to_method_callback ~async ~newtypes ~fun_attrs
+              e.pexp_loc self params body;
           pexp_attributes;
         }
       in

tests/tests/src/ThisPpxBridge.mjs

@@ -2,12 +2,12 @@
 
 
 function methodThroughPpxBridge() {
-  let $$this = this ;
+  let $$this = this;
   return 1 + $$this | 0;
 }
 
 function bracedMethodThroughPpxBridge() {
-  let $$this = this ;
+  let $$this = this;
   return 1 + $$this | 0;
 }
 

tests/tests/src/UncurriedExternals.mjs

@@ -31,14 +31,14 @@ let tcr = {};
 
 function tsiC(c) {
   c.increment = function (amount) {
-    let me = this ;
+    let me = this;
     console.log(me);
   };
 }
 
 function tsiU(c) {
   c.increment = function (amount) {
-    let me = this ;
+    let me = this;
     console.log(me);
   };
 }
@@ -65,13 +65,13 @@ let StandardNotation = {
 };
 
 function methodWithAsync() {
-  let $$this = this ;
+  let $$this = this;
   return async arg => $$this + arg | 0;
 }
 
 let p1 = {
   watch: async function (name, ev) {
-    let pc = this ;
+    let pc = this;
     console.log(pc);
   }
 };

tests/tests/src/test_bs_this.mjs

@@ -2,18 +2,18 @@
 
 
 function uux_this(x, y) {
-  let o = this ;
+  let o = this;
   return (o.length + x | 0) + y | 0;
 }
 
 function even(x) {
-  let o = this ;
+  let o = this;
   return x + o | 0;
 }
 
 function bark() {
   return function (x, y) {
-    let o = this ;
+    let o = this;
     console.log([
       o.length,
       o.x,
@@ -27,19 +27,19 @@ function bark() {
 
 let js_obj = {
   bark: function (x, y) {
-    let o = this ;
+    let o = this;
     console.log(o);
     return x + y | 0;
   }
 };
 
 function f(x) {
   x.onload = function () {
-    let o = this ;
+    let o = this;
     console.log(o);
   };
   return x.addEventListener("onload", function () {
-    let o = this ;
+    let o = this;
     console.log(o.response);
   });
 }

tests/tests/src/this_directive.mjs

@@ -0,0 +1,26 @@
+// Generated by ReScript, PLEASE EDIT WITH CARE
+
+
+function plain(x) {
+  'use cache';
+  let self = this;
+  return self + x | 0;
+}
+
+async function action(x) {
+  'use server';
+  let self = this;
+  return self + x | 0;
+}
+
+function unusedSelf(x) {
+  'use cache';
+  return x + 1 | 0;
+}
+
+export {
+  plain,
+  action,
+  unusedSelf,
+}
+/* plain Not a pure module */

tests/tests/src/this_directive.res

@@ -0,0 +1,8 @@
+// A directive on a @this function is the first statement of its body, before
+// the binding of `this`
+
+let plain = @this @directive("'use cache'") (self, x) => self + x
+
+let action = @this @directive("'use server'") async (self, x) => self + x
+
+let unusedSelf = @this @directive("'use cache'") (_self: int, x) => x + 1