Skip to content

feat: add [@mel.spread] for polyvariants with payload #1404

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 2 commits into from
Apr 6, 2025
Merged

feat: add [@mel.spread] for polyvariants with payload #1404

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
dd23fe1
feat: add `[@mel.spread]` for polyvariants with payload
anmonteiro Apr 6, 2025
946380e
chore: add changelog entry
anmonteiro Apr 6, 2025
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
2 changes: 2 additions & 0 deletions Changes.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,8 @@ Unreleased
- Upgrade the Melange JS parser to [Flow
v0.266.0](https://github.com/facebook/flow/releases/tag/v0.266.0)
([#1380](https://github.com/melange-re/melange/pull/1380))
- Add `[@mel.spread]` in `external`s to spread polymorphic variants with
payloads ([#1404](https://github.com/melange-re/melange/pull/1404))

5.1.0-53 2025-03-23
---------------
Expand Down
27 changes: 11 additions & 16 deletions jscomp/common/external_arg_spec.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,9 @@

(** type definitions for external argument *)

type cst = Int of int | Str of string | Js_literal of string
module Arg_cst = struct
type t = Int of int | Str of string | Js_literal of string
end

module Arg_label = struct
type t = Arg_label | Arg_empty | Arg_optional
Expand All @@ -46,30 +48,23 @@ end
(* it will be ignored , side effect will be recorded *)

(* This type is used to give some meta info on each argument *)
type attr =
| Poly_var_string of {
descr : (string * string) list;
(* introduced by attributes @string
and @as
*)
}
type t =
| Poly_var of {
descr : (string * string) list option;
(* introduced by attributes @string
and @as
*)
(* introduced by attributes `@mel.string`, `@mel.spread` *)
descr : (string * Arg_cst.t) list;
has_payload : bool;
}
(* `a does not have any value*)
| Int of (string * int) list (* ([`a | `b ] [@int])*)
| Arg_cst of cst (* Constant argument *)
| Int of (string * Arg_cst.t) list (* ([`a | `b ] [@int])*)
| Arg_cst of Arg_cst.t (* 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
| Nothing
| Ignore
| Unwrap of attr
| Unwrap of t

type 'a param = { arg_type : attr; arg_label : 'a }
type 'a param = { arg_type : t; arg_label : 'a }

let empty_kind obj_arg_type =
{ arg_label = Obj_label.empty; arg_type = obj_arg_type }
Expand Down
23 changes: 14 additions & 9 deletions jscomp/common/external_arg_spec.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -22,20 +22,25 @@
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)

type cst = Int of int | Str of string | Js_literal of string
module Arg_cst : sig
type t = Int of int | Str of string | Js_literal of string
end

type attr =
| Poly_var_string of { descr : (string * string) list }
| Poly_var of { descr : (string * string) list option }
| Int of (string * int) list (* ([`a | `b ] [@mel.int])*)
| Arg_cst of cst
type t =
| Poly_var of {
(* introduced by attributes `@mel.string`, `@mel.spread` *)
descr : (string * Arg_cst.t) list;
has_payload : bool;
}
| Int of (string * Arg_cst.t) list (* ([`a | `b ] [@int])*)
| Arg_cst of Arg_cst.t
| Fn_uncurry_arity of int
(** annotated with [@mel.uncurry ] or [@mel.uncurry 2]*)
(* maybe we can improve it as a combination of {!Asttypes.constant} and tuple *)
| Extern_unit
| Nothing
| Ignore
| Unwrap of attr
| Unwrap of t

module Arg_label : sig
type t = Arg_label | Arg_empty | Arg_optional
Expand All @@ -53,7 +58,7 @@ module Obj_label : sig
val optional : for_sure_no_nested_option:bool -> string -> t
end

type 'a param = { arg_type : attr; arg_label : 'a }
type 'a param = { arg_type : t; arg_label : 'a }

val empty_kind : attr -> Obj_label.t param
val empty_kind : t -> Obj_label.t param
val dummy : Arg_label.t param
2 changes: 1 addition & 1 deletion jscomp/common/external_ffi_types.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -40,7 +40,7 @@ type external_module_name = {
module_bind_name : module_bind_name;
}

type arg_type = External_arg_spec.attr
type arg_type = External_arg_spec.t
(* TODO: information between [arg_type] and [arg_label] are duplicated,
design a more compact representation so that it is also easy to seralize by
hand *)
Expand Down
2 changes: 1 addition & 1 deletion jscomp/common/external_ffi_types.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -37,7 +37,7 @@ type external_module_name = {
module_bind_name : module_bind_name;
}

type arg_type = External_arg_spec.attr
type arg_type = External_arg_spec.t
type arg_label = External_arg_spec.Obj_label.t

type external_spec =
Expand Down
110 changes: 44 additions & 66 deletions jscomp/core/js_of_lam_variant.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -29,32 +29,34 @@ module S = Js_stmt_make
type arg_expression = Splice0 | Splice1 of E.t | Splice2 of E.t * E.t

(* we need destruct [undefined] when input is optional *)
let eval (arg : J.expression) (dispatches : (string * string) list) : E.t =
let eval (arg : J.expression)
(dispatches : (string * Melange_ffi.External_arg_spec.Arg_cst.t) list) : E.t
=
if arg == E.undefined then E.undefined
else
match arg.expression_desc with
| Str s -> E.str (List.assoc s dispatches)
| Str s -> Lam_compile_const.translate_arg_cst (List.assoc s dispatches)
| _ ->
E.of_block
[
S.string_switch arg
(List.map
~f:(fun (i, r) ->
( Lambda.String i,
J.
{
switch_body = [ S.return_stmt (E.str r) ];
should_break = false;
(* FIXME: if true, still print break*)
comment = None;
} ))
{
J.switch_body =
[
S.return_stmt (Lam_compile_const.translate_arg_cst r);
];
should_break = false;
(* FIXME: if true, still print break*)
comment = None;
} ))
dispatches);
]

(* invariant: optional is not allowed in this case *)
(* arg is a polyvar *)
let eval_as_event (arg : J.expression)
(dispatches : (string * string) list option) =
let eval_descr (arg : J.expression)
(dispatches : (string * Melange_ffi.External_arg_spec.Arg_cst.t) list) =
match arg.expression_desc with
| Caml_block
{
Expand All @@ -65,36 +67,36 @@ let eval_as_event (arg : J.expression)
when Js_analyzer.no_side_effect_expression cb ->
let v =
match dispatches with
| Some dispatches -> List.assoc s dispatches
| None -> s
| [] -> Melange_ffi.External_arg_spec.Arg_cst.Str s
| dispatches -> (
match List.assoc_opt s dispatches with Some r -> r | None -> Str s)
in
Splice2 (E.str v, cb)
| _ ->
Splice2
( (match dispatches with
| Some dispatches ->
E.of_block
[
S.string_switch
(E.poly_var_tag_access arg)
(List.map
~f:(fun (i, r) ->
( Lambda.String i,
J.
{
switch_body = [ S.return_stmt (E.str r) ];
should_break = false;
(* FIXME: if true, still print break*)
comment = None;
} ))
dispatches);
]
| None -> E.poly_var_tag_access arg),
(* TODO: improve, one dispatch later,
the problem is that we can not create bindings
due to the
*)
E.poly_var_value_access arg )
Splice2 (Lam_compile_const.translate_arg_cst v, cb)
| _ -> (
match dispatches with
| [] -> Splice2 (E.poly_var_tag_access arg, E.poly_var_value_access arg)
| dispatches ->
let k =
E.of_block
[
S.string_switch
(E.poly_var_tag_access arg)
(List.map
~f:(fun (i, r) ->
let r = Lam_compile_const.translate_arg_cst r in
( Lambda.String i,
J.
{
switch_body = [ S.return_stmt r ];
should_break = false;
(* FIXME: if true, still print break*)
comment = None;
} ))
dispatches);
]
in
Splice2 (k, E.poly_var_value_access arg))

(* FIXME:
1. duplicated evaluation of expressions arg
Solution: calcuate the arg once in the beginning
Expand All @@ -103,30 +105,6 @@ let eval_as_event (arg : J.expression)
a === 444? "a" : a==222? "b"
*)

(* we need destruct [undefined] when input is optional *)
let eval_as_int (arg : J.expression) (dispatches : (string * int) list) : E.t =
if arg == E.undefined then E.undefined
else
match arg.expression_desc with
| Str i -> E.int (Int32.of_int (List.assoc i dispatches))
| _ ->
E.of_block
[
S.string_switch arg
(List.map
~f:(fun (i, r) ->
( Lambda.String i,
J.
{
switch_body =
[ S.return_stmt (E.int (Int32.of_int r)) ];
should_break = false;
(* FIXME: if true, still print break*)
comment = None;
} ))
dispatches);
]

let eval_as_unwrap (arg : J.expression) : E.t =
match arg.expression_desc with
| Caml_block { fields = [ { expression_desc = Number _; _ }; cb ]; _ } -> cb
Expand Down
16 changes: 10 additions & 6 deletions jscomp/core/js_of_lam_variant.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
*
*
* This program is free software: you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, either version 3 of the License, or
Expand All @@ -17,7 +17,7 @@
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
Expand All @@ -29,10 +29,14 @@ type arg_expression =
| Splice1 of J.expression
| Splice2 of J.expression * J.expression

val eval : J.expression -> (string * string) list -> J.expression
val eval :
J.expression ->
(string * Melange_ffi.External_arg_spec.Arg_cst.t) list ->
J.expression

val eval_as_event :
J.expression -> (string * string) list option -> arg_expression
val eval_descr :
J.expression ->
(string * Melange_ffi.External_arg_spec.Arg_cst.t) list ->
arg_expression

val eval_as_int : J.expression -> (string * int) list -> J.expression
val eval_as_unwrap : J.expression -> J.expression
2 changes: 1 addition & 1 deletion jscomp/core/lam_compile_const.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -102,7 +102,7 @@ and translate (x : Lam.Constant.t) : J.expression =
match s with
| Const_js_undefined -> E.optional_block (translate s) *)

let translate_arg_cst (cst : Melange_ffi.External_arg_spec.cst) =
let translate_arg_cst (cst : Melange_ffi.External_arg_spec.Arg_cst.t) =
match cst with
| Int i -> E.int (Int32.of_int i)
| Str i -> E.str i
Expand Down
2 changes: 1 addition & 1 deletion jscomp/core/lam_compile_const.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -25,4 +25,4 @@
(** Compile lambda constant to JS *)

val translate : Lam.Constant.t -> J.expression
val translate_arg_cst : Melange_ffi.External_arg_spec.cst -> J.expression
val translate_arg_cst : Melange_ffi.External_arg_spec.Arg_cst.t -> J.expression
21 changes: 8 additions & 13 deletions jscomp/core/lam_compile_external_call.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -104,7 +104,7 @@ let append_list x xs =
This would not work with [NonNullString]
*)
let rec ocaml_to_js_eff ~(arg_label : External_arg_spec.Arg_label.t)
~(arg_type : External_arg_spec.attr) (raw_arg : E.t) :
~(arg_type : External_arg_spec.t) (raw_arg : E.t) :
arg_expression * E.t list =
let arg =
match arg_label with
Expand All @@ -123,23 +123,18 @@ let rec ocaml_to_js_eff ~(arg_label : External_arg_spec.Arg_label.t)
| Ignore ->
( Splice0,
if Js_analyzer.no_side_effect_expression arg then [] else [ arg ] )
| Poly_var_string { descr } -> (Splice1 (Js_of_lam_variant.eval arg descr), [])
| Poly_var { descr } ->
(Js_of_lam_variant.eval_as_event arg descr, [])
(* FIXME: encode invariant below in the signature*)
(* length of 2
- the poly var tag
- the value
*)
| Int dispatches ->
(Splice1 (Js_of_lam_variant.eval_as_int arg dispatches), [])
| Poly_var { descr; has_payload } ->
( (if has_payload then Js_of_lam_variant.eval_descr arg descr
else Splice1 (Js_of_lam_variant.eval arg descr)),
[] )
| Int dispatches -> (Splice1 (Js_of_lam_variant.eval arg dispatches), [])
| Unwrap polyvar -> (
match (polyvar, raw_arg.expression_desc) with
| (Poly_var_string _ | Poly_var _ | Int _), Caml_block _ ->
| (Poly_var { has_payload = false; _ } | Int _), Caml_block _ ->
Location.raise_errorf ?loc:raw_arg.loc
"`[@mel.as ..]' can only be used with `[@mel.unwrap]' variants \
without a payload."
| (Poly_var_string _ | Poly_var _ | Int _), _ ->
| (Poly_var { has_payload = false; _ } | Int _), _ ->
ocaml_to_js_eff ~arg_label ~arg_type:polyvar raw_arg
| Nothing, _ ->
let single_arg =
Expand Down
2 changes: 1 addition & 1 deletion jscomp/core/lam_compile_external_call.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,7 @@

val ocaml_to_js_eff :
arg_label:Melange_ffi.External_arg_spec.Arg_label.t ->
arg_type:Melange_ffi.External_arg_spec.attr ->
arg_type:Melange_ffi.External_arg_spec.t ->
J.expression ->
Js_of_lam_variant.arg_expression * J.expression list
(** Compile ocaml external function call to JS IR. *)
Expand Down
Loading