fix: allow skipping over [@mel.as ".."] constant args in @mel.send (

#1329)

* fix: allow skipping over `[@mel.as ".."]` constant args in `@mel.send`

* chore: add changelog entry

Changes.md

@@ -6,6 +6,9 @@ Unreleased
 - Fix `[@mel.send]` and `[@mel.this]` interaction in the presence of constant
   `[@mel.as ".."]` arguments
   ([#1328](https://github.com/melange-re/melange/pull/1328))
+- Allow skipping over `[@mel.as ".."]` constant arguments in `[@mel.send]` in
+  the absence of `@mel.this`
+  ([#1328](https://github.com/melange-re/melange/pull/1328))
 
 5.0.0-53
 ---------------

ppx/ast_external_process.ml

@@ -661,26 +661,36 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string)
       Location.raise_errorf ~loc
         "Found an attribute that conflicts with `[%@mel.obj]'"
 
-let mel_send_this_index arg_types =
+let mel_send_this_index arg_type_specs arg_types =
   let find_index ~f:p =
     let rec aux i = function
       | [] -> None
       | a :: l -> if p a then Some i else aux (i + 1) l
     in
     aux 0
   in
-  find_index
-    ~f:(fun { attrs; _ } ->
-      List.exists
-        ~f:(fun ({ attr_name = { txt; _ }; _ } as attr) ->
-          match txt with
-          | "mel.this" ->
-              Mel_ast_invariant.mark_used_mel_attribute attr;
-              true
-          | _ -> false)
-        attrs)
-    arg_types
-  |> Option.value ~default:0
+  let mel_this_idx =
+    find_index
+      ~f:(fun { attrs; _ } ->
+        List.exists
+          ~f:(fun ({ attr_name = { txt; _ }; _ } as attr) ->
+            match txt with
+            | "mel.this" ->
+                Mel_ast_invariant.mark_used_mel_attribute attr;
+                true
+            | _ -> false)
+          attrs)
+      arg_types
+  in
+  match mel_this_idx with
+  | Some self_idx -> self_idx
+  | None ->
+      (* find the first non-constant argument *)
+      find_index
+        ~f:(function
+          | { External_arg_spec.arg_type = Arg_cst _; _ } -> false | _ -> true)
+        arg_type_specs
+      |> Option.get
 
 let external_desc_of_non_obj (loc : Location.t) (st : external_desc)
     (prim_name_or_pval_prim : bundle_source) (arg_type_specs_length : int)
@@ -886,7 +896,7 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc)
               variadic;
               name;
               scopes;
-              kind = Send (mel_send_this_index arg_types_ty);
+              kind = Send (mel_send_this_index arg_type_specs arg_types_ty);
               new_ = not (new_name = `Nm_na);
             })
   | { val_send = #bundle_source; _ } ->

test/blackbox-tests/legacy-ounit-cmd.t

@@ -216,17 +216,6 @@ Skip over the temporary file name printed in the error trace
       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
   Error: The `%identity' primitive type must take a single argument ('a -> 'b)
 
-  $ cat > x.ml <<EOF
-  > external foo_bar :
-  >  (_ [@mel.as "foo"]) ->
-  >  string ->
-  >  string = "bar"
-  >  [@@mel.send]
-  > EOF
-  $ melc -ppx melppx -alert -unprocessed x.ml
-  // Generated by Melange
-  /* This output is empty. Its source's type definitions, externals and/or unused code got optimized away. */
-
   $ melc -ppx melppx -bs-eval 'let bla4 foo x y = foo##(method1 x y [@u])' 2>&1 | grep -v File
   1 | let bla4 foo x y = foo##(method1 x y [@u])
                                              ^

test/blackbox-tests/mel-send-constant.t

@@ -68,3 +68,23 @@ Test `@mel.send` + `@mel.this` in the presence of `[@mel.as ".."]` constant args
       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
   Error: `[@mel.send]`'s must have at least a non-constant argument
   [2]
+
+Works without `[@mel.this]` too, assuming the first non-constant argument is
+the self arg
+
+  $ cat > x.ml <<EOF
+  > external foo_bar :
+  >  (_ [@mel.as "foo"]) -> string -> string = "bar" [@@mel.send]
+  > let s = foo_bar "hello"
+  > EOF
+  $ melc -ppx melppx -alert -unprocessed x.ml
+  // Generated by Melange
+  'use strict';
+  
+  
+  const s = "hello".bar("foo");
+  
+  module.exports = {
+    s,
+  }
+  /* s Not a pure module */