diff --git a/ppx/ast_external_process.ml b/ppx/ast_external_process.ml index a8b5f5f6b9..40b45d3467 100644 --- a/ppx/ast_external_process.ml +++ b/ppx/ast_external_process.ml @@ -327,14 +327,14 @@ let parse_external_attributes (prim_name_check : string) } | _ -> Location.raise_errorf ~loc - "`[@mel.module ..]' expects, at most, a tuple of two strings \ - (module name, variable name)") + "`[%@mel.module ..]' expects, at most, a tuple of two \ + strings (module name, variable name)") | "mel.scope" | "scope" -> ( Ast_attributes.warn_if_non_namespaced ~loc txt; match Ast_payload.assert_strings loc payload with | [] -> Location.raise_errorf ~loc - "`[@mel.scope ..]' expects a tuple of strings in its payload" + "`[%@mel.scope ..]' expects a tuple of strings in its payload" (* We need err on empty scope, so we can tell the difference between unset/set *) | scopes -> { st with scopes }) @@ -353,8 +353,8 @@ let parse_external_attributes (prim_name_check : string) | PTyp x -> Some x | _ -> Location.raise_errorf ~loc - "expected a type after `[@mel.send.pipe]', e.g. \ - `[@mel.send.pipe: t]'"); + "expected a type after `[%@mel.send.pipe]', e.g. \ + `[%@mel.send.pipe: t]'"); } | "mel.set" | "set" -> Ast_attributes.warn_if_non_namespaced ~loc txt; @@ -369,15 +369,15 @@ let parse_external_attributes (prim_name_check : string) Ast_attributes.warn_if_non_namespaced ~loc txt; if String.length prim_name_check <> 0 then Location.raise_errorf ~loc - "%@set_index this particular external's name needs to be a \ - placeholder empty string"; + "`%@mel.set_index' requires its `external' payload to be the \ + empty string"; { st with set_index = true } | "mel.get_index" | "get_index" -> Ast_attributes.warn_if_non_namespaced ~loc txt; if String.length prim_name_check <> 0 then Location.raise_errorf ~loc - "%@get_index this particular external's name needs to be a \ - placeholder empty string"; + "`%@mel.get_index' requires its `external' payload to be the \ + empty string"; { st with get_index = true } | "mel.obj" | "obj" -> Ast_attributes.warn_if_non_namespaced ~loc txt; @@ -511,8 +511,12 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string) param_type :: arg_types, result_types ) | _ -> - Location.raise_errorf ~loc - "expect label, optional, or unit here") + Location.raise_errorf ~loc:ty.ptyp_loc + "`[%@mel.obj]' external declaration arguments must \ + be one of:\n\ + - a labelled argument\n\ + - an optionally labelled argument\n\ + - `unit' as the final argument") | Labelled name -> ( let obj_arg_type = refine_obj_arg_type ~nolabel:false ty @@ -563,14 +567,15 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string) [%type: string] :: result_types ) | Fn_uncurry_arity _ -> - Location.raise_errorf ~loc - "The combination of @obj, @uncurry is not \ - supported yet" + Location.raise_errorf ~loc:ty.ptyp_loc + "`[%@mel.uncurry]' can't be used within \ + `[@mel.obj]'" | Extern_unit -> assert false | Poly_var _ -> raise (Location.raise_errorf ~loc - "%@obj label %s does not support such arg type" + "`%@mel.obj' must not be used with labelled \ + polymorphic variants carrying payloads" name)) | Optional name -> ( let obj_arg_type = get_opt_arg_type ~nolabel:false ty in @@ -625,16 +630,18 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string) :: result_types ) | Arg_cst _ -> Location.raise_errorf ~loc - "@as is not supported with optional yet" + "`%@mel.as' is not supported within optionally \ + labelled arguments yet" | Fn_uncurry_arity _ -> Location.raise_errorf ~loc - "The combination of @obj, @uncurry is not \ - supported yet" + "`[%@mel.uncurry]' can't be used within \ + `[@mel.obj]'" | Extern_unit -> assert false | Poly_var _ -> Location.raise_errorf ~loc - "%@obj label %s does not support such arg type" name - ) + "`%@mel.obj' must not be used with optionally \ + labelled polymorphic variants carrying payloads" + name) in (new_arg_label :: arg_labels, new_arg_types, output_tys)) arg_types_ty ~init:([], [], []) @@ -652,8 +659,10 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string) External_ffi_types.ffi_obj_create arg_kinds ) | _n -> Location.raise_errorf ~loc - "@obj expect external names to be empty string") - | _ -> Location.raise_errorf ~loc "Attribute found that conflicts with @obj" + "`%@mel.obj requires its `external' payload to be the empty string") + | _ -> + Location.raise_errorf ~loc + "Found an attribute that conflicts with `%@mel.obj'" let external_desc_of_non_obj (loc : Location.t) (st : external_desc) (prim_name_or_pval_prim : bundle_source) (arg_type_specs_length : int) @@ -680,11 +689,12 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc) Js_set_index { js_set_index_scopes = scopes } else Location.raise_errorf ~loc - "Ill defined attribute %@set_index (arity of 3)" + "`%@mel.set_index' requires a function of 3 arguments: `'t -> 'key \ + -> 'value -> unit'" | { set_index = true; _ } -> Error.err ~loc (Conflict_ffi_attribute - "Attribute found that conflicts with %@set_index") + "Found an attribute that conflicts with `@mel.set_index'") | { get_index = true; external_module_name = None; @@ -705,12 +715,12 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc) Js_get_index { js_get_index_scopes = scopes } else Location.raise_errorf ~loc - "Ill defined attribute %@get_index (arity expected 2 : while %d)" - arg_type_specs_length + "`%@mel.get_index' requires a function of 2 arguments: `'t -> 'key \ + -> 'value'" | { get_index = true; _ } -> Error.err ~loc (Conflict_ffi_attribute - "Attribute found that conflicts with %@get_index") + "Found an attribute that conflicts with `@mel.get_index'") | { module_as_val = Some external_module_name; get_index = false; @@ -734,18 +744,17 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc) | _, `Nm_external _ -> Js_module_as_class external_module_name | _, `Nm_payload _ -> Location.raise_errorf ~loc - "Incorrect FFI attribute found: (%@new should not carry a payload \ - here)") + "`%@mel.new' doesn't expect an attribute payload") | { module_as_val = Some _; get_index; val_send; _ } -> let reason = match (get_index, val_send) with | true, _ -> - "@module is for imports from a module, @get_index does not need \ - import a module " + "`@mel.get_index' doesn't import from a module. `@mel.module' is \ + not necessary here." | _, #bundle_source -> - "@module is for imports from a module, @send does not need import \ - a module " - | _ -> "Attribute found that conflicts with @module." + "`@mel.send' doesn't import from a module. `@mel.module` is not \ + necessary here." + | _ -> "Found an attribute that conflicts with `@mel.module'." in Error.err ~loc (Conflict_ffi_attribute reason) | { @@ -846,15 +855,13 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc) match (arg_type_specs, new_name) with | [], _ -> Location.raise_errorf ~loc - "Ill defined attribute %@send(the external needs to be a regular \ - function call with at least one argument)" + "`%@mel.send` requires a function with at least one argument" | { arg_type = Arg_cst _; arg_label = _ } :: _, _ -> Location.raise_errorf ~loc - "Ill defined attribute %@send(first argument can't be const)" + "`%@mel.send`'s first argument must not be a constant" | _, `Nm_payload _ -> Location.raise_errorf ~loc - "Incorrect FFI attribute found: (%@new should not carry a payload \ - here)" + "`%@mel.new' doesn't expect an attribute payload" | _ :: _, `Nm_na -> Js_send { @@ -870,7 +877,7 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc) ) | { val_send = #bundle_source; _ } -> Location.raise_errorf ~loc - "You used a FFI attribute that can't be used with %@send" + "Found an attribute that can't be used with `%@mel.send'" | { val_send_pipe = Some _; (* splice = (false as splice); *) @@ -891,8 +898,7 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc) match new_name with | `Nm_payload _ -> Location.raise_errorf ~loc - "Incorrect FFI attribute found: (%@new should not carry a payload \ - here)" + "`%@mel.new' doesn't expect an attribute payload" | `Nm_na -> (* can be one argument *) Js_send @@ -914,7 +920,7 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc) }) | { val_send_pipe = Some _; _ } -> Location.raise_errorf ~loc - "conflict attributes found with [%@%@mel.send.pipe]" + "Found an attribute that can't be used with `%@mel.send.pipe'" | { new_name = `Nm_external (lazy name) | `Nm_payload name; external_module_name; @@ -934,7 +940,8 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc) Js_new { name; external_module_name; splice; scopes } | { new_name = #bundle_source; _ } -> Error.err ~loc - (Conflict_ffi_attribute "Attribute found that conflicts with %@new") + (Conflict_ffi_attribute + "Found an attribute that can't be used with `@mel.new'") | { set_name = `Nm_external (lazy name) | `Nm_payload name; call_name = `Nm_na; @@ -955,9 +962,10 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc) Js_set { js_set_scopes = scopes; js_set_name = name } else Location.raise_errorf ~loc - "Ill defined attribute %@set (two args required)" + "`%@mel.set' requires a function of two arguments" | { set_name = #bundle_source; _ } -> - Location.raise_errorf ~loc "conflict attributes found with %@set" + Location.raise_errorf ~loc + "Found an attribute that can't be used with `%@mel.set'" | { get_name = `Nm_external (lazy name) | `Nm_payload name; call_name = `Nm_na; @@ -978,9 +986,10 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc) Js_get { js_get_name = name; js_get_scopes = scopes } else Location.raise_errorf ~loc - "Ill defined attribute %@mel.get (only one argument)" + "`%@mel.get' requires a function of only one argument" | { get_name = #bundle_source; _ } -> - Location.raise_errorf ~loc "Attribute found that conflicts with %@mel.get" + Location.raise_errorf ~loc + "Found an attribute that conflicts with %@mel.get" let list_of_arrow (ty : Parsetree.core_type) : Parsetree.core_type * param_type list = @@ -1008,7 +1017,7 @@ let handle_attributes (loc : Location.t) (type_annotation : Parsetree.core_type) It does not make sense *) if has_mel_uncurry type_annotation.ptyp_attributes then Location.raise_errorf ~loc - "@uncurry can not be applied to the whole definition" + "`%@mel.uncurry' must not be applied to the entire annotation" else let prim_name_or_pval_name = if String.length prim_name = 0 then @@ -1025,7 +1034,7 @@ let handle_attributes (loc : Location.t) (type_annotation : Parsetree.core_type) in if has_mel_uncurry result_type.ptyp_attributes then Location.raise_errorf ~loc - "@uncurry can not be applied to tailed position" + "`%@mel.uncurry' cannot be applied to the return type" else let unused_attrs, external_desc = parse_external_attributes prim_name prim_name_or_pval_name @@ -1046,7 +1055,8 @@ let handle_attributes (loc : Location.t) (type_annotation : Parsetree.core_type) match refine_arg_type ~nolabel:true obj with | Arg_cst _ -> Location.raise_errorf ~loc - "@as is not supported in @send type " + "`%@mel.as' must not be used in the payload for \ + `[@mel.send.pipe]'" | arg_type -> (* more error checking *) ( [ { External_arg_spec.arg_label = Arg_empty; arg_type } ], @@ -1069,12 +1079,13 @@ let handle_attributes (loc : Location.t) (type_annotation : Parsetree.core_type) match arg_label with | Optional _ -> Location.raise_errorf ~loc - "@mel.variadic expects the last type to be a non \ - optional" + "`%@mel.variadic' cannot be applied to an optionally \ + labelled argument" | Labelled _ | Nolabel -> ( if ty.ptyp_desc = Ptyp_any then Location.raise_errorf - "@mel.variadic expect the last type to be an array" + "`%@mel.variadic' expects its last argument to be an \ + array" else match spec_of_ptyp true ty with | Nothing -> ( @@ -1083,23 +1094,23 @@ let handle_attributes (loc : Location.t) (type_annotation : Parsetree.core_type) () | _ -> Location.raise_errorf ~loc - "@mel.variadic expect the last type to be an \ - array") + "`%@mel.variadic' expects its last argument \ + to be an array") | _ -> Location.raise_errorf ~loc - "%@variadic expect the last type to be an array")); + "`%@mel.variadic' expects its last argument to be \ + an array")); let ( (arg_label : External_arg_spec.label_noname), arg_type, new_arg_types ) = match arg_label with - | Optional s -> ( + | Optional _ -> ( match get_opt_arg_type ~nolabel:false ty with | Poly_var _ -> (* ?x:([`x of int ] [@string]) does not make sense *) - Location.raise_errorf ~loc - "%@mel.string does not work with optional when it \ - has arities in label %s" - s + Location.raise_errorf ~loc:param_type.ty.ptyp_loc + "`[%@mel.as ..]' must not be used with an optionally \ + labelled polymorphic variant" | arg_type -> (Arg_optional, arg_type, param_type :: arg_types)) | Labelled _ -> ( diff --git a/ppx/error.ml b/ppx/error.ml index b2488d0969..17d92a54fe 100644 --- a/ppx/error.ml +++ b/ppx/error.ml @@ -87,8 +87,8 @@ let pp_error fmt err = "Expected an integer, string or JSON literal (`{json|text here|json}')" | Unhandled_poly_type -> "Unhandled polymorphic variant type" | Invalid_underscore_type_in_external -> - "`_' is not allowed in an `external' declaration's optionally labelled \ - argument type" + "`_' is not allowed in an `external' declaration's (optionally) \ + labelled argument type" | Invalid_mel_string_type -> "Invalid type for `@mel.string'" | Invalid_mel_int_type -> "Invalid type for `@mel.int'" | Invalid_mel_unwrap_type -> diff --git a/test/blackbox-tests/ffi-error-debug.t b/test/blackbox-tests/ffi-error-debug.t index bd0c2abea2..ff16bdbe72 100644 --- a/test/blackbox-tests/ffi-error-debug.t +++ b/test/blackbox-tests/ffi-error-debug.t @@ -9,7 +9,8 @@ File "x.ml", lines 2-3, characters 2-11: 2 | ..hi_should_error:([`a of int | `b of string ] [@mel.string]) -> 3 | unit -> _................. - Error: @obj label hi_should_error does not support such arg type + Error: `@mel.obj' must not be used with labelled polymorphic variants + carrying payloads [2] $ cat > x.ml < 3 | unit -> _................. - Error: @obj label hi_should_error does not support such arg type + Error: `@mel.obj' must not be used with optionally labelled polymorphic + variants carrying payloads [2] $ cat > x.ml < unit -> unit = "err" > EOF $ melc -ppx melppx x.ml - File "x.ml", lines 1-3, characters 0-22: - 1 | external err : + File "x.ml", line 2, characters 20-47: 2 | ?hi_should_error:([`a of int | `b of string ] [@mel.string]) -> - 3 | unit -> unit = "err" - Error: @mel.string does not work with optional when it has arities in label - hi_should_error + ^^^^^^^^^^^^^^^^^^^^^^^^^^^ + Error: `[@mel.as ..]' must not be used with an optionally labelled + polymorphic variant [2] Each [@mel.unwrap] variant constructor requires an argument diff --git a/test/blackbox-tests/legacy-ounit-cmd.t b/test/blackbox-tests/legacy-ounit-cmd.t index 0367551164..a436923ee6 100644 --- a/test/blackbox-tests/legacy-ounit-cmd.t +++ b/test/blackbox-tests/legacy-ounit-cmd.t @@ -17,7 +17,7 @@ 5 | = "" 6 | [@@mel.send.pipe:int] 7 | [@@mel.splice] - Error: @mel.variadic expect the last type to be an array + Error: `@mel.variadic' expects its last argument to be an array [2] $ cat > x.ml < (_ [@mel.as "x"]) -> int -> unit = 3 | "x" [@@mel.set] - Error: Ill defined attribute @set (two args required) + Error: `@mel.set' requires a function of two arguments [2] $ cat > x.ml < int -> int [@mel.uncurry]) = "" ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - Error: @uncurry can not be applied to the whole definition + Error: `@mel.uncurry' must not be applied to the entire annotation [2] $ melc -ppx melppx -bs-eval '{js| \uFFF|js}' 2>&1 | grep -v File @@ -228,7 +228,7 @@ Skip over the temporary file name printed in the error trace 3 | string -> 4 | string = "bar" 5 | [@@mel.send] - Error: Ill defined attribute @send(first argument can't be const) + Error: `@mel.send`'s first argument must not be a constant [2] $ melc -ppx melppx -bs-eval 'let bla4 foo x y = foo##(method1 x y [@u])' 2>&1 | grep -v File diff --git a/test/blackbox-tests/ppx-errors.t b/test/blackbox-tests/ppx-errors.t index c2997b4366..cd4933c6ab 100644 --- a/test/blackbox-tests/ppx-errors.t +++ b/test/blackbox-tests/ppx-errors.t @@ -231,3 +231,203 @@ Demonstrate PPX error messages Error: `[@mel.scope ..]' expects a tuple of strings in its payload [1] + $ cat > x.ml < type 'a t + > external set : 'a t -> string -> 'a -> unit = "payload" [@@mel.set_index] + > EOF + $ dune build @melange + File "x.ml", line 2, characters 59-72: + 2 | external set : 'a t -> string -> 'a -> unit = "payload" [@@mel.set_index] + ^^^^^^^^^^^^^ + Error: `@mel.set_index' requires its `external' payload to be the empty string + [1] + + $ cat > x.ml < type 'a t + > external get : 'a t -> string -> 'a = "payload" [@@mel.get_index] + > EOF + $ dune build @melange + File "x.ml", line 2, characters 51-64: + 2 | external get : 'a t -> string -> 'a = "payload" [@@mel.get_index] + ^^^^^^^^^^^^^ + Error: `@mel.get_index' requires its `external' payload to be the empty string + [1] + + $ cat > x.ml < external mk : foo:string -> unit -> _ Js.t = "payload" [@@mel.obj] + > EOF + $ dune build @melange + File "x.ml", line 1, characters 0-66: + 1 | external mk : foo:string -> unit -> _ Js.t = "payload" [@@mel.obj] + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + Error: `@mel.obj requires its `external' payload to be the empty string + [1] + + $ cat > x.ml < external mk : foo:string -> string -> _ Js.t = "" [@@mel.obj] + > EOF + $ dune build @melange + File "x.ml", line 1, characters 28-34: + 1 | external mk : foo:string -> string -> _ Js.t = "" [@@mel.obj] + ^^^^^^ + Error: `[@mel.obj]' external declaration arguments must be one of: + - a labelled argument + - an optionally labelled argument + - `unit' as the final argument + [1] + + $ cat > x.ml < external mk : foo:(string -> string [@mel.uncurry]) -> unit -> _ Js.t = "" + > [@@mel.obj] + > EOF + $ dune build @melange + File "x.ml", line 1, characters 19-35: + 1 | external mk : foo:(string -> string [@mel.uncurry]) -> unit -> _ Js.t = "" + ^^^^^^^^^^^^^^^^ + Error: `[@mel.uncurry]' can't be used within `[@mel.obj]' + [1] + + $ cat > x.ml < type 'a t + > external set : 'a t -> string -> 'a -> 'a -> unit = "" [@@mel.set_index] + > EOF + $ dune build @melange + File "x.ml", line 2, characters 0-72: + 2 | external set : 'a t -> string -> 'a -> 'a -> unit = "" [@@mel.set_index] + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + Error: `@mel.set_index' requires a function of 3 arguments: `'t -> 'key -> 'value -> unit' + [1] + + $ cat > x.ml < type 'a t + > external get : 'a t -> 'a = "" [@@mel.get_index] + > EOF + $ dune build @melange + File "x.ml", line 2, characters 0-48: + 2 | external get : 'a t -> 'a = "" [@@mel.get_index] + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + Error: `@mel.get_index' requires a function of 2 arguments: `'t -> 'key -> 'value' + [1] + + $ cat > x.ml < type t + > external red : string -> t = "some-module" + > [@@mel.new "payload"] [@@mel.module] + > EOF + $ dune build @melange + File "x.ml", lines 2-3, characters 0-36: + 2 | external red : string -> t = "some-module" + 3 | [@@mel.new "payload"] [@@mel.module] + Error: `@mel.new' doesn't expect an attribute payload + [1] + + $ cat > x.ml < external get : string = "some-fn" [@@mel.send] + > EOF + $ dune build @melange + File "x.ml", line 1, characters 0-46: + 1 | external get : string = "some-fn" [@@mel.send] + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + Error: `@mel.send` requires a function with at least one argument + [1] + + $ cat > x.ml < external get : (_ [@mel.as {json|{}|json}]) -> string = "some-fn" [@@mel.send] + > EOF + $ dune build @melange + File "x.ml", line 1, characters 0-78: + 1 | external get : (_ [@mel.as {json|{}|json}]) -> string = "some-fn" [@@mel.send] + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + Error: `@mel.send`'s first argument must not be a constant + [1] + + $ cat > x.ml < type t + > external get : t -> string = "some-fn" [@@mel.send] [@@mel.new "hi"] + > EOF + $ dune build @melange + File "x.ml", line 2, characters 0-68: + 2 | external get : t -> string = "some-fn" [@@mel.send] [@@mel.new "hi"] + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + Error: `@mel.new' doesn't expect an attribute payload + [1] + + $ cat > x.ml < type t + > external get : string = "some-fn" [@@mel.send.pipe: t] [@@mel.new "hi"] + > EOF + $ dune build @melange + File "x.ml", line 2, characters 0-71: + 2 | external get : string = "some-fn" [@@mel.send.pipe: t] [@@mel.new "hi"] + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + Error: `@mel.new' doesn't expect an attribute payload + [1] + + $ cat > x.ml < type t + > external setX1 : t -> unit = "set" + > [@@mel.set] [@@mel.scope "a0"] + > EOF + $ dune build @melange + File "x.ml", lines 2-3, characters 0-30: + 2 | external setX1 : t -> unit = "set" + 3 | [@@mel.set] [@@mel.scope "a0"] + Error: `@mel.set' requires a function of two arguments + [1] + + $ cat > x.ml < type t + > external f: t -> int -> unit [@mel.uncurry] = "set" + > [@@mel.send] + > EOF + $ dune build @melange + File "x.ml", lines 2-3, characters 0-12: + 2 | external f: t -> int -> unit [@mel.uncurry] = "set" + 3 | [@@mel.send] + Error: `@mel.uncurry' must not be applied to the entire annotation + [1] + + $ cat > x.ml < type t + > external f: t -> int -> (unit [@mel.uncurry]) = "set" + > [@@mel.send] + > EOF + $ dune build @melange + File "x.ml", lines 2-3, characters 0-12: + 2 | external f: t -> int -> (unit [@mel.uncurry]) = "set" + 3 | [@@mel.send] + Error: `@mel.uncurry' cannot be applied to the return type + [1] + + $ cat > x.ml < type t + > external f: int -> unit = "set" + > [@@mel.send.pipe: (_ [@mel.as "x"])] + > EOF + $ dune build @melange + File "x.ml", lines 2-3, characters 0-36: + 2 | external f: int -> unit = "set" + 3 | [@@mel.send.pipe: (_ [@mel.as "x"])] + Error: `@mel.as' must not be used in the payload for `[@mel.send.pipe]' + [1] + + $ cat > x.ml < external join : ?foo:string array -> string = "join" + > [@@mel.module "path"] [@@mel.variadic] + > EOF + $ dune build @melange + File "x.ml", lines 1-2, characters 0-38: + 1 | external join : ?foo:string array -> string = "join" + 2 | [@@mel.module "path"] [@@mel.variadic] + Error: `@mel.variadic' cannot be applied to an optionally labelled argument + [1] + + $ cat > x.ml < external join : ?foo:[ | \`foo of int [@mel.as "hi"] ] -> string = "join" + > EOF + $ dune build @melange + File "x.ml", line 1, characters 21-53: + 1 | external join : ?foo:[ | `foo of int [@mel.as "hi"] ] -> string = "join" + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + Error: `[@mel.as ..]' must not be used with an optionally labelled polymorphic variant + [1]