Skip to content

feat: support @mel.unwrap in @mel.obj #724

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
anmonteiro merged 3 commits into from
Sep 6, 2023
Merged

feat: support @mel.unwrap in @mel.obj #724

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
ff9f8ca
feat: support `@mel.unwrap` in `@mel.obj`
anmonteiro Sep 6, 2023
d5c312e
remove now outdated test
anmonteiro Sep 6, 2023
5c7aaf8
chore: add changelog entry
anmonteiro Sep 6, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
7 changes: 5 additions & 2 deletions Changes.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -63,8 +63,11 @@ Unreleased
[#713](https://github.com/melange-re/melange/pull/713)).
- [melange]: Allow using `@mel.as` in external declarations without explicitly
annotating `@mel.{string,int}`
([#722](https://github.com/melange-re/melange/pull/714), fixes
[#578](https://github.com/melange-re/melange/pull/713)).
([#722](https://github.com/melange-re/melange/pull/722), fixes
[#578](https://github.com/melange-re/melange/issues/578)).
- [melange]: Allow using `@mel.unwrap` in external declarations with `@mel.obj`
([#724](https://github.com/melange-re/melange/pull/724), fixes
[#679](https://github.com/melange-re/melange/issues/679)).

1.0.0 2023-05-31
---------------
Expand Down
2 changes: 1 addition & 1 deletion jscomp/common/external_arg_spec.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -54,7 +54,7 @@ type attr =
}
(* `a does not have any value*)
| Int of (string * int) list (* ([`a | `b ] [@int])*)
| Arg_cst of cst
| Arg_cst of cst (* Constant argument *)
| Fn_uncurry_arity of int (* annotated with [@uncurry ] or [@uncurry 2]*)
(* maybe we can improve it as a combination of {!Asttypes.constant} and tuple *)
| Extern_unit
Expand Down
36 changes: 25 additions & 11 deletions ppx/ast_external_process.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -532,6 +532,17 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string)
{ Asttypes.txt = name; loc }
[%type: string]
:: result_types )
| Unwrap ->
let s = Lam_methname.translate name in
( {
obj_arg_label = External_arg_spec.obj_label s;
obj_arg_type;
},
param_type :: arg_types,
Ast_helper.Of.tag
{ Asttypes.txt = name; loc }
ty
:: result_types )
| Fn_uncurry_arity _ ->
Location.raise_errorf ~loc
"The combination of @obj, @uncurry is not \
Expand All @@ -542,12 +553,6 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string)
(Location.raise_errorf ~loc
"%@obj label %s does not support such arg \
type"
name)
| Unwrap ->
raise
(Location.raise_errorf ~loc
"%@obj label %s does not support %@unwrap \
arguments"
name)))
| Optional name -> (
match get_opt_arg_type ~nolabel:false ty with
Expand Down Expand Up @@ -604,6 +609,20 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string)
{ txt = Ast_literal.js_undefined; loc }
[ [%type: string] ])
:: result_types )
| Unwrap ->
let s = Lam_methname.translate name in
( {
obj_arg_label =
External_arg_spec.optional false s;
obj_arg_type;
},
param_type :: arg_types,
Ast_helper.Of.tag
{ Asttypes.txt = name; loc }
(Ast_helper.Typ.constr ~loc
{ txt = Ast_literal.js_undefined; loc }
[ ty ])
:: result_types )
| Arg_cst _ ->
Location.raise_errorf ~loc
"@as is not supported with optional yet"
Expand All @@ -615,11 +634,6 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string)
| Poly_var _ ->
Location.raise_errorf ~loc
"%@obj label %s does not support such arg type"
name
| Unwrap ->
Location.raise_errorf ~loc
"%@obj label %s does not support %@unwrap \
arguments"
name))
in
(new_arg_label :: arg_labels, new_arg_types, output_tys))
Expand Down
13 changes: 0 additions & 13 deletions test/blackbox-tests/ffi-error-debug.t
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -64,16 +64,3 @@ Each [@mel.unwrap] variant constructor requires an argument
and each constructor must have an argument.
[2]

[@mel.unwrap] args are not supported in [@@mel.obj] functions

$ cat > x.ml <<EOF
> external err :
> ?hi_should_error:([\`a of int] [@mel.unwrap]) -> unit -> _ = "" [@@mel.obj]
> EOF
$ melc -ppx melppx x.ml
File "x.ml", line 2, characters 2-59:
2 | ?hi_should_error:([`a of int] [@mel.unwrap]) -> unit -> _ = "" [@@mel.obj]
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: @obj label hi_should_error does not support @unwrap arguments
[2]

37 changes: 37 additions & 0 deletions test/blackbox-tests/mel-unwrap-for-obj.t
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,37 @@
Test `@mel.unwrap` in `@mel.obj`

$ . ./setup.sh
$ cat > x.ml <<EOF
> external func :
> param:string ->
> polyParam:([ \`Str of string | \`Int of int ][@mel.unwrap]) ->
> unit ->
> _ Js.t = ""
> [@@mel.obj]
> external funcOpt :
> param:string ->
> ?polyParam:([ \`Str of string | \`Int of int ][@mel.unwrap]) ->
> unit ->
> _ Js.t = ""
> [@@mel.obj]
> let x = func ~param:"x" ~polyParam:(\`Str "hi") ()
> let y = funcOpt ~param:"x" ~polyParam:(\`Str "hello") ()
> EOF
$ melc -ppx melppx x.ml
// Generated by Melange
'use strict';


var x = {
param: "x",
polyParam: "hi"
};

var y = {
param: "x",
polyParam: "hello"
};

exports.x = x;
exports.y = y;
/* No side effect */