Skip to content

Use Typ.arrows after the refactoring of arrow types. #7662

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
merged 8 commits into from
Jul 21, 2025
Merged

Use Typ.arrows after the refactoring of arrow types. #7662

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
749aec3
Use `Typ.arrows` after the refactoring of arrow types.
cristianoc Jul 18, 2025
7b3f43b
simplify
cristianoc Jul 18, 2025
df2a19b
rename
cristianoc Jul 18, 2025
46c8db4
Refactor maker and accessor generation in AST derive
cristianoc Jul 18, 2025
509396f
More Typ.arrows
cristianoc Jul 18, 2025
7b9604d
Use Typ.arrows in handle external.
cristianoc Jul 18, 2025
9d6b226
Refactor method callback and uncurry type handling
cristianoc Jul 20, 2025
9ce3b02
Update CHANGELOG.md
cristianoc Jul 21, 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
1 change: 1 addition & 0 deletions CHANGELOG.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -27,6 +27,7 @@
#### :house: Internal

- Add rust linting to CI with `clippy`. https://github.com/rescript-lang/rescript/pull/7675
- AST: use `Typ.arrows` for creation, after the refactoring of arrow types. https://github.com/rescript-lang/rescript/pull/7662

#### :bug: Bug fix

Expand Down
13 changes: 1 addition & 12 deletions compiler/frontend/ast_core_type.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -131,17 +131,6 @@ let get_curry_arity (ty : t) =

let is_arity_one ty = get_curry_arity ty = 1

let mk_fn_type ~loc (new_arg_types_ty : Parsetree.arg list) (result : t) : t =
let t =
Ext_list.fold_right new_arg_types_ty result (fun {lbl; typ; attrs} acc ->
Ast_helper.Typ.arrow ~loc ~attrs ~arity:None {attrs = []; lbl; typ} acc)
in
match t.ptyp_desc with
| Ptyp_arrow arr ->
let arity = List.length new_arg_types_ty in
{t with ptyp_desc = Ptyp_arrow {arr with arity = Some arity}}
| _ -> t

let list_of_arrow (ty : t) : t * Parsetree.arg list =
let rec aux (ty : t) acc =
match ty.ptyp_desc with
Expand All @@ -156,6 +145,6 @@ let list_of_arrow (ty : t) : t * Parsetree.arg list =

let add_last_obj (ty : t) (obj : t) =
let result, params = list_of_arrow ty in
mk_fn_type ~loc:obj.ptyp_loc
Typ.arrows ~loc:obj.ptyp_loc
(params @ [{lbl = Nolabel; typ = obj; attrs = []}])
result
2 changes: 0 additions & 2 deletions compiler/frontend/ast_core_type.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -47,8 +47,6 @@ val get_uncurry_arity : t -> int option
None -- means not a function
*)

val mk_fn_type : loc:Location.t -> Parsetree.arg list -> t -> t

val list_of_arrow : t -> t * Parsetree.arg list
(** fails when Ptyp_poly *)

Expand Down
11 changes: 5 additions & 6 deletions compiler/frontend/ast_core_type_class_type.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -67,17 +67,15 @@ let default_typ_mapper = Bs_ast_mapper.default_mapper.typ
let typ_mapper (self : Bs_ast_mapper.mapper) (ty : Parsetree.core_type) =
let loc = ty.ptyp_loc in
match ty.ptyp_desc with
| Ptyp_arrow {arg; ret = body}
| Ptyp_arrow {arity}
(* let it go without regard label names,
it will report error later when the label is not empty
*)
-> (
match fst (Ast_attributes.process_attributes_rev ty.ptyp_attributes) with
| Meth_callback _ ->
Ast_typ_uncurry.to_method_callback_type loc self arg.lbl arg.typ body
| Method _ ->
(* Treat @meth as making the type uncurried, for backwards compatibility *)
Ast_typ_uncurry.to_uncurry_type loc self arg.lbl arg.typ body
Ast_typ_uncurry.to_method_callback_type loc self ~arity ty
| Method _ -> Bs_ast_mapper.default_mapper.typ self ty
| Nothing -> Bs_ast_mapper.default_mapper.typ self ty)
| Ptyp_object (methods, closed_flag) ->
let ( +> ) attr (typ : Parsetree.core_type) =
Expand Down Expand Up @@ -107,7 +105,8 @@ let typ_mapper (self : Bs_ast_mapper.mapper) (ty : Parsetree.core_type) =
| Meth_callback attr, attrs -> (attrs, attr +> ty)
in
Ast_compatible.object_field name attrs
(Ast_typ_uncurry.to_uncurry_type loc self Nolabel core_type
(Ast_helper.Typ.arrows ~loc
[{attrs = []; lbl = Nolabel; typ = self.typ self core_type}]
(Ast_literal.type_unit ~loc ()))
in
let not_getter_setter ty =
Expand Down
124 changes: 73 additions & 51 deletions compiler/frontend/ast_derive_abstract.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -79,14 +79,16 @@ let handle_tdcl light (tdcl : Parsetree.type_declaration) :
Ext_list.exists label_declarations (fun x ->
Ast_attributes.has_bs_optional x.pld_attributes)
in
let setter_accessor, make_type, labels =
let setter_accessor, maker_args, labels =
Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Use Typ.arrows here. Understand the logic behind the arity, fix it if necessary, and pass the correct number of arguments at the right place so the arity ends up being right.

Read file: compiler/frontend/ast_derive_abstract.ml

Ran tool

Ran tool

Ran tool

Read file: compiler/ml/parsetree.ml

Read file: compiler/frontend/ast_derive_abstract.ml

Read file: compiler/frontend/ast_derive_abstract.ml

Ran tool

Ran tool

Ran tool

Ran tool

Read file: compiler/frontend/ast_derive_abstract.ml

I've replaced all ambiguous record literals with explicit Parsetree.arg annotations and ensured we always build argument lists and setter types using Typ.arrows. This removes ambiguity around the attrs field and guarantees that arity is set only once—by Typ.arrows, which automatically puts the total argument count on the outermost node.

Key updates:

  1. Initial maker-argument seed now uses an explicitly-typed unit argument list.
  2. Each field now adds an explicitly-typed Parsetree.arg to that list.
  3. The final make_type is built with a single Typ.arrows call, so arity equals the full argument count.
  4. Getter types stay at arity = 1 (single arrow), unchanged.
  5. Setter types for mutable fields rebuilt via Typ.arrows, giving arity = 2 and no manual inner arity flags.
  6. All record literals for arguments are annotated with : Parsetree.arg, resolving the previous “unbound record field attrs” errors.

With these changes, every place now relies on Typ.arrows, ensuring correct arity placement and cleaner code.

Ext_list.fold_right label_declarations
( [],
(if has_optional_field then
Ast_helper.Typ.arrow ~loc ~arity:None
{attrs = []; lbl = Nolabel; typ = Ast_literal.type_unit ()}
core_type
else core_type),
(* start with the implicit unit argument *)
[
({attrs = []; lbl = Nolabel; typ = Ast_literal.type_unit ()}
: Parsetree.arg);
]
else []),
[] )
(fun ({
pld_name = {txt = label_name; loc = label_loc} as pld_name;
Expand All @@ -106,61 +108,81 @@ let handle_tdcl light (tdcl : Parsetree.type_declaration) :
let prim = [prim_as_name] in
let is_optional = Ast_attributes.has_bs_optional pld_attributes in

let maker, acc =
let arity =
if List.length labels = List.length label_declarations - 1 then
(* toplevel type *)
Some ((if has_optional_field then 2 else 1) + List.length labels)
else None
in
(* build the argument representing this field *)
let field_arg =
if is_optional then
({attrs = []; lbl = Asttypes.Optional pld_name; typ = pld_type}
: Parsetree.arg)
else
({attrs = []; lbl = Asttypes.Labelled pld_name; typ = pld_type}
: Parsetree.arg)
in

(* prepend to the maker argument list *)
let maker_args = field_arg :: maker in

(* build accessor value description for this field *)
let accessor_type =
if is_optional then
let optional_type = Ast_core_type.lift_option_type pld_type in
( Ast_helper.Typ.arrow ~loc:pld_loc ~arity
{attrs = []; lbl = Asttypes.Optional pld_name; typ = pld_type}
maker,
Val.mk ~loc:pld_loc
(if light then pld_name
else {pld_name with txt = pld_name.txt ^ "Get"})
~attrs:get_optional_attrs ~prim
(Ast_helper.Typ.arrow ~loc ~arity:(Some 1)
{attrs = []; lbl = Nolabel; typ = core_type}
optional_type)
:: acc )
Ast_helper.Typ.arrows ~loc
[{attrs = []; lbl = Nolabel; typ = core_type}]
optional_type
else
( Ast_helper.Typ.arrow ~loc:pld_loc ~arity
{attrs = []; lbl = Asttypes.Labelled pld_name; typ = pld_type}
maker,
Val.mk ~loc:pld_loc
(if light then pld_name
else {pld_name with txt = pld_name.txt ^ "Get"})
~attrs:get_attrs
~prim:
((* Not needed actually*)
External_ffi_types.ffi_bs_as_prims
[External_arg_spec.dummy] Return_identity
(Js_get {js_get_name = prim_as_name; js_get_scopes = []}))
(Ast_helper.Typ.arrow ~loc ~arity:(Some 1)
{attrs = []; lbl = Nolabel; typ = core_type}
pld_type)
:: acc )
Ast_helper.Typ.arrows ~loc
[{attrs = []; lbl = Nolabel; typ = core_type}]
pld_type
in
let accessor_prim =
(* Not needed actually *)
if is_optional then prim
else
External_ffi_types.ffi_bs_as_prims [External_arg_spec.dummy]
Return_identity
(Js_get {js_get_name = prim_as_name; js_get_scopes = []})
in
let is_current_field_mutable = pld_mutable = Mutable in
let accessor_attrs =
if is_optional then get_optional_attrs else get_attrs
in

let accessor =
Val.mk ~loc:pld_loc
(if light then pld_name
else {pld_name with txt = pld_name.txt ^ "Get"})
~attrs:accessor_attrs ~prim:accessor_prim accessor_type
in

(* accumulate *)
let acc = accessor :: acc in

(* add setter for mutable fields *)
let acc =
if is_current_field_mutable then
if pld_mutable = Mutable then
let setter_type =
Ast_helper.Typ.arrow ~arity:(Some 2)
{attrs = []; lbl = Nolabel; typ = core_type}
(Ast_helper.Typ.arrow ~arity:None
{attrs = []; lbl = Nolabel; typ = pld_type} (* setter *)
(Ast_literal.type_unit ()))
Ast_helper.Typ.arrows ~loc:pld_loc
[
({attrs = []; lbl = Nolabel; typ = core_type}
: Parsetree.arg);
({attrs = []; lbl = Nolabel; typ = pld_type}
: Parsetree.arg);
]
(Ast_literal.type_unit ())
in
let setter =
Val.mk ~loc:pld_loc
{loc = label_loc; txt = label_name ^ "Set"}
~attrs:set_attrs ~prim setter_type
in
Val.mk ~loc:pld_loc
{loc = label_loc; txt = label_name ^ "Set"} (* setter *)
~attrs:set_attrs ~prim setter_type
:: acc
setter :: acc
else acc
in
(acc, maker, (is_optional, new_label) :: labels))
(acc, maker_args, (is_optional, new_label) :: labels))
in
(* build the final [make] function type from accumulated arguments *)
let make_type =
match maker_args with
| [] -> core_type
| args -> Ast_helper.Typ.arrows ~loc args core_type
in
( new_tdcl,
if is_private then setter_accessor
Expand Down
22 changes: 10 additions & 12 deletions compiler/frontend/ast_derive_js_mapper.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -69,9 +69,7 @@ let erase_type_str =
Str.primitive
(Val.mk ~prim:["%identity"]
{loc = noloc; txt = erase_type_lit}
(Ast_helper.Typ.arrow ~arity:(Some 1)
{attrs = []; lbl = Nolabel; typ = any}
any))
(Ast_helper.Typ.arrows [{attrs = []; lbl = Nolabel; typ = any}] any))

let unsafe_index = "_index"

Expand All @@ -81,11 +79,12 @@ let unsafe_index_get =
(Val.mk ~prim:[""]
{loc = noloc; txt = unsafe_index}
~attrs:[Ast_attributes.get_index]
(Ast_helper.Typ.arrow ~arity:None
{attrs = []; lbl = Nolabel; typ = any}
(Ast_helper.Typ.arrow ~arity:None
{attrs = []; lbl = Nolabel; typ = any}
any)))
(Ast_helper.Typ.arrows
[
{attrs = []; lbl = Nolabel; typ = any};
{attrs = []; lbl = Nolabel; typ = any};
]
any))

let unsafe_index_get_exp = Exp.ident {loc = noloc; txt = Lident unsafe_index}

Expand Down Expand Up @@ -136,8 +135,7 @@ let app1 = Ast_compatible.app1

let app2 = Ast_compatible.app2

let ( ->~ ) a b =
Ast_helper.Typ.arrow ~arity:(Some 1) {attrs = []; lbl = Nolabel; typ = a} b
let ( ->~ ) a b = Ast_helper.Typ.arrows [{attrs = []; lbl = Nolabel; typ = a}] b

let raise_when_not_found_ident =
Longident.Ldot (Lident Primitive_modules.util, "raiseWhenNotFound")
Expand Down Expand Up @@ -309,8 +307,8 @@ let init () =
let pat_from_js = {Asttypes.loc; txt = from_js} in
let to_js_type result =
Ast_comb.single_non_rec_val pat_to_js
(Ast_helper.Typ.arrow ~arity:(Some 1)
{attrs = []; lbl = Nolabel; typ = core_type}
(Ast_helper.Typ.arrows
[{attrs = []; lbl = Nolabel; typ = core_type}]
result)
in
let new_type, new_tdcl =
Expand Down
20 changes: 8 additions & 12 deletions compiler/frontend/ast_derive_projector.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -136,8 +136,8 @@ let init () =
| Ptype_record label_declarations ->
Ext_list.map label_declarations (fun {pld_name; pld_type} ->
Ast_comb.single_non_rec_val ?attrs:gentype_attrs pld_name
(Ast_helper.Typ.arrow ~arity:(Some 1)
{attrs = []; lbl = Nolabel; typ = core_type}
(Ast_helper.Typ.arrows
[{attrs = []; lbl = Nolabel; typ = core_type}]
pld_type
(*arity will alwys be 1 since these are single param functions*)))
| Ptype_variant constructor_declarations ->
Expand All @@ -156,23 +156,19 @@ let init () =
| Pcstr_record _ ->
raise_unsupported_vaiant_record_arg pcd_loc
in
let arity = pcd_args |> List.length in
let annotate_type =
match pcd_res with
| Some x -> x
| None -> core_type
in
let add_arity ~arity t =
if arity > 0 then Ast_uncurried.uncurried_type ~arity t
else t
in
Ast_comb.single_non_rec_val ?attrs:gentype_attrs
{loc; txt = Ext_string.uncapitalize_ascii con_name}
(Ext_list.fold_right pcd_args annotate_type (fun x acc ->
Ast_helper.Typ.arrow ~arity:None
{attrs = []; lbl = Nolabel; typ = x}
acc)
|> add_arity ~arity))
(let args =
Ext_list.map pcd_args (fun x ->
({attrs = []; lbl = Nolabel; typ = x}
: Parsetree.arg))
in
Ast_helper.Typ.arrows ~loc args annotate_type))
| Ptype_open | Ptype_abstract ->
Ast_derive_util.not_applicable tdcl.ptype_loc deriving_name;
[]
Expand Down
41 changes: 17 additions & 24 deletions compiler/frontend/ast_exp_handle_external.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -42,8 +42,8 @@ let handle_external loc (x : string) : Parsetree.expression =
pexp_desc =
Ast_external_mk.local_external_apply loc ~pval_prim:["#raw_expr"]
~pval_type:
(Ast_helper.Typ.arrow ~arity:(Some 1)
{attrs = []; lbl = Nolabel; typ = Ast_helper.Typ.any ()}
(Ast_helper.Typ.arrows
[{attrs = []; lbl = Nolabel; typ = Ast_helper.Typ.any ()}]
(Ast_helper.Typ.any ()))
[str_exp];
}
Expand Down Expand Up @@ -71,8 +71,8 @@ let handle_debugger loc (payload : Ast_payload.t) =
| PStr [] ->
Ast_external_mk.local_external_apply loc ~pval_prim:["%debugger"]
~pval_type:
(Ast_helper.Typ.arrow ~arity:(Some 1)
{attrs = []; lbl = Nolabel; typ = Ast_helper.Typ.any ()}
(Ast_helper.Typ.arrows
[{attrs = []; lbl = Nolabel; typ = Ast_helper.Typ.any ()}]
(Ast_literal.type_unit ()))
[Ast_literal.val_unit ~loc ()]
| _ ->
Expand All @@ -98,8 +98,8 @@ let handle_raw ~kind loc payload =
pexp_desc =
Ast_external_mk.local_external_apply loc ~pval_prim:["#raw_expr"]
~pval_type:
(Ast_helper.Typ.arrow ~arity:(Some 1)
{attrs = []; lbl = Nolabel; typ = Ast_helper.Typ.any ()}
(Ast_helper.Typ.arrows
[{attrs = []; lbl = Nolabel; typ = Ast_helper.Typ.any ()}]
(Ast_helper.Typ.any ()))
[exp];
pexp_attributes =
Expand All @@ -125,20 +125,13 @@ let handle_ffi ~loc ~payload =
let wrap_type_constraint (e : Parsetree.expression) =
let loc = e.pexp_loc in
let any = Ast_helper.Typ.any ~loc:e.pexp_loc () in
let unit = Ast_literal.type_unit ~loc () in
let rec arrow ~arity =
if arity = 0 then
Ast_helper.Typ.arrow ~arity:None ~loc
{attrs = []; lbl = Nolabel; typ = unit}
any
else if arity = 1 then
Ast_helper.Typ.arrow ~arity:None ~loc
{attrs = []; lbl = Nolabel; typ = any}
any
else
Ast_helper.Typ.arrow ~loc ~arity:None
{attrs = []; lbl = Nolabel; typ = any}
(arrow ~arity:(arity - 1))
let arrow ~arity =
let effective_arity = if arity = 0 then 1 else arity in
let args =
Ext_list.init effective_arity (fun _ ->
({attrs = []; lbl = Nolabel; typ = any} : Parsetree.arg))
in
Ast_helper.Typ.arrows ~loc args any
in
match !is_function with
| Some arity ->
Expand All @@ -156,8 +149,8 @@ let handle_ffi ~loc ~payload =
pexp_desc =
Ast_external_mk.local_external_apply loc ~pval_prim:["#raw_expr"]
~pval_type:
(Ast_helper.Typ.arrow ~arity:(Some 1)
{attrs = []; lbl = Nolabel; typ = Ast_helper.Typ.any ()}
(Ast_helper.Typ.arrows
[{attrs = []; lbl = Nolabel; typ = Ast_helper.Typ.any ()}]
(Ast_helper.Typ.any ()))
[exp];
pexp_attributes =
Expand All @@ -175,8 +168,8 @@ let handle_raw_structure loc payload =
pexp_desc =
Ast_external_mk.local_external_apply loc ~pval_prim:["#raw_stmt"]
~pval_type:
(Ast_helper.Typ.arrow ~arity:(Some 1)
{attrs = []; lbl = Nolabel; typ = Ast_helper.Typ.any ()}
(Ast_helper.Typ.arrows
[{attrs = []; lbl = Nolabel; typ = Ast_helper.Typ.any ()}]
(Ast_helper.Typ.any ()))
[exp];
}
Expand Down
Loading