Skip to content

Commit 15936ab

Browse files
cristianocclaude
andcommitted
Make a function's locally abstract types part of the function node
Replace the Pexp_newtype wrapper chains that the parser built for (type t, x) => ... arrow syntax with a structural field on the function node: Pexp_fun.newtypes carries each newtype name with its own attributes, hoisted in front of the value parameters as before. Pexp_newtype remains solely as the desugaring of [let f: type a. ...] annotations and for PPX-authored trees. Fidelity fixes visible in the formatter: - Attributes keep their association with their type parameter group: (@attr type t, x, @attr2 type s, y) round-trips as written instead of printing @attr @attr2 on the function. - Comments written next to a type parameter travel with it to the hoisted group instead of migrating onto the following value parameter. - Attributes written in front of the arrow now live on the function node, so built-in attribute processing (e.g. @this) sees them on type-first functions; previously they sat inert on the wrapper node. Typing follows the upstream OCaml 5.x design: the newtype machinery is extracted into a reusable type_newtype helper (mirroring OCaml's helper of the same name) and the function case peels one newtype at a time, mimicking the typing of the former wrapper chain; the typedtree output is bit-identical to before. The v0 PPX bridge expands the field back into a wrapper chain around Function$: each wrapper carries its own newtype's attributes, and the outermost wrapper separates function-node attributes from the first newtype's attributes with an internal _res.newtype_attrs marker (no marker means node attributes only, matching the historical wire). Newtype-free programs are wire byte-identical; for functions with newtypes the deltas are confined to wrapper-node locations and, for the rare attributed groups, per-wrapper attribute placement. Identity-PPX round-trips are AST-exact, verified against the previous compiler. Also: jsx_v4 and bs_builtin_ppx now carry newtypes (and their attributes) through their function rebuilds instead of dropping them, the sexp AST debugger emits the field, and dead parser plumbing (fundef param attrs/p_pos, arrow_start_pos, make_newtypes ~attrs) is removed. Signed-Off-By: Cristiano Calcagno <cristianoc@users.noreply.github.com> Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
1 parent 36b14d6 commit 15936ab

28 files changed

Lines changed: 423 additions & 254 deletions

CHANGELOG.md

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -29,6 +29,7 @@
2929

3030
- Fix argument evaluation order when a function call is inlined: the beta reducer stacked argument bindings in reverse parameter order, so the last argument was evaluated first when arguments could not be substituted directly. https://github.com/rescript-lang/rescript/pull/8572
3131
- Preserve parentheses around multiplication, division, and modulo expressions used as exponents. https://github.com/rescript-lang/rescript/pull/8550
32+
- Make a function's locally abstract types (`(type t, x) => ...`) part of the function AST node instead of a chain of wrapper nodes. Fixes the formatter dropping the association of attributes with their `type` group (`(@attr type t, x, @attr2 type s, y)` used to print as `@attr @attr2` on the function) and comments written next to a type parameter migrating onto the following value parameter. https://github.com/rescript-lang/rescript/pull/8574
3233
- Enforce function arity in interface/module inclusion and type coercion. Previously a curried implementation (e.g. `int => int => int`) could satisfy an uncurried interface (`(int, int) => int`) or be coerced to it, which could miscompile calls made through the interface type. Such mismatches are now compile errors with an explanatory hint. https://github.com/rescript-lang/rescript/pull/8559
3334
- Fix termination-analysis false positives for functions whose progress flows through un-annotated helpers: collecting the callees of a function binding was accidentally disabled in 2024 (the collection guard required a node shape that uncurried code never produces), so helpers calling `@progress` functions were no longer added to the function table. https://github.com/rescript-lang/rescript/pull/8568
3435
- Fix default values of optional parameters being computed at the wrong time for curried functions: in `(~x=default, y) => (~z=default, w) => ...`, `x`'s default was only computed when the *inner* function was applied. Each default is now computed when its own parameter group is applied. https://github.com/rescript-lang/rescript/pull/8568

compiler/frontend/bs_ast_mapper.ml

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -325,8 +325,12 @@ module E = struct
325325
sub vbs)
326326
(sub.expr sub e)
327327
(* #end *)
328-
| Pexp_fun {params; body; async} ->
328+
| Pexp_fun {newtypes; params; body; async} ->
329329
fun_ ~loc ~attrs ~async
330+
~newtypes:
331+
(List.map
332+
(fun (name, attrs) -> (map_loc sub name, sub.attributes sub attrs))
333+
newtypes)
330334
(List.map
331335
(fun (param : Parsetree.fun_param) ->
332336
{

compiler/frontend/bs_builtin_ppx.ml

Lines changed: 18 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -95,7 +95,7 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
9595
| Pexp_newtype (s, body) ->
9696
let res = self.expr self body in
9797
{e with pexp_desc = Pexp_newtype (s, res)}
98-
| Pexp_fun {params; body; async} -> (
98+
| Pexp_fun {newtypes; params; body; async} -> (
9999
match Ast_attributes.process_attributes_rev e.pexp_attributes with
100100
| Nothing, _ ->
101101
(* Handle @async x => y => ... is in async context *)
@@ -116,19 +116,29 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
116116
mapper did (GH #7974). *)
117117
let body = self.expr self body in
118118
in_function_def := saved_in_function_def;
119+
let newtypes =
120+
Ext_list.map newtypes (fun (name, nt_attrs) ->
121+
(name, self.attributes self nt_attrs))
122+
in
119123
let mapped =
120-
Ast_helper.Exp.fun_ ~loc:e.pexp_loc ~attrs ~async params body
124+
Ast_helper.Exp.fun_ ~loc:e.pexp_loc ~attrs ~async ~newtypes params body
121125
in
122126
Ast_async.make_function_async ~async mapped
123127
| Meth_callback _, pexp_attributes ->
124128
(* FIXME: does it make sense to have a label for [this] ? *)
125129
async_context := false;
126-
{
127-
e with
128-
pexp_desc =
129-
Ast_uncurry_gen.to_method_callback ~async e.pexp_loc self params body;
130-
pexp_attributes;
131-
})
130+
let callback =
131+
{
132+
e with
133+
pexp_desc =
134+
Ast_uncurry_gen.to_method_callback ~async e.pexp_loc self params
135+
body;
136+
pexp_attributes;
137+
}
138+
in
139+
(* Keep the locally abstract types in scope around the callback. *)
140+
Ext_list.fold_right newtypes callback (fun (name, nt_attrs) acc ->
141+
Ast_helper.Exp.newtype ~loc:e.pexp_loc ~attrs:nt_attrs name acc))
132142
| Pexp_apply _ -> Ast_exp_apply.app_exp_mapper e self
133143
| Pexp_match
134144
( b,

compiler/ml/ast_helper.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -158,9 +158,9 @@ module Exp = struct
158158
let ident ?loc ?attrs a = mk ?loc ?attrs (Pexp_ident a)
159159
let constant ?loc ?attrs a = mk ?loc ?attrs (Pexp_constant a)
160160
let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_let (a, b, c))
161-
let fun_ ?loc ?attrs ?(async = false) params body =
161+
let fun_ ?loc ?attrs ?(async = false) ?(newtypes = []) params body =
162162
assert (params <> []);
163-
mk ?loc ?attrs (Pexp_fun {params; body; async})
163+
mk ?loc ?attrs (Pexp_fun {newtypes; params; body; async})
164164

165165
let fun_param ?(attrs = []) ?default lbl pat =
166166
{p_attrs = attrs; p_lbl = lbl; p_default = default; p_pat = pat}

compiler/ml/ast_helper.mli

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -134,6 +134,7 @@ module Exp : sig
134134
?loc:loc ->
135135
?attrs:attrs ->
136136
?async:bool ->
137+
?newtypes:(str * attrs) list ->
137138
fun_param list ->
138139
expression ->
139140
expression

compiler/ml/ast_iterator.ml

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -289,7 +289,12 @@ module E = struct
289289
| Pexp_let (_r, vbs, e) ->
290290
List.iter (sub.value_binding sub) vbs;
291291
sub.expr sub e
292-
| Pexp_fun {params; body} ->
292+
| Pexp_fun {newtypes; params; body} ->
293+
List.iter
294+
(fun (name, attrs) ->
295+
iter_loc sub name;
296+
sub.attributes sub attrs)
297+
newtypes;
293298
List.iter
294299
(fun {p_default; p_pat} ->
295300
iter_opt (sub.expr sub) p_default;

compiler/ml/ast_mapper.ml

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -288,8 +288,12 @@ module E = struct
288288
| Pexp_constant x -> constant ~loc ~attrs x
289289
| Pexp_let (r, vbs, e) ->
290290
let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.expr sub e)
291-
| Pexp_fun {params; body; async} ->
291+
| Pexp_fun {newtypes; params; body; async} ->
292292
fun_ ~loc ~attrs ~async
293+
~newtypes:
294+
(List.map
295+
(fun (name, attrs) -> (map_loc sub name, sub.attributes sub attrs))
296+
newtypes)
293297
(List.map
294298
(fun param ->
295299
{

compiler/ml/ast_mapper_from0.ml

Lines changed: 51 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -706,7 +706,8 @@ module E = struct
706706
in
707707
{
708708
e1 with
709-
pexp_desc = Pexp_fun {params; body; async = f.async};
709+
pexp_desc =
710+
Pexp_fun {newtypes = []; params; body; async = f.async};
710711
pexp_attributes = e1.pexp_attributes @ node_attrs;
711712
})
712713
| _ -> exp1)
@@ -779,8 +780,55 @@ module E = struct
779780
| Pexp_lazy _ -> failwith "Pexp_lazy is no longer present in ReScript"
780781
| Pexp_poly _ -> failwith "Pexp_poly is no longer present in ReScript"
781782
| Pexp_object () -> assert false
782-
| Pexp_newtype (s, e) ->
783-
newtype ~loc ~attrs (map_loc sub s) (sub.expr sub e)
783+
| Pexp_newtype (s, e) -> (
784+
(* Fuse a chain of newtype wrappers over a Function$ node into the
785+
function's [newtypes] field. Each wrapper's attributes are its
786+
newtype's attributes, except on this outermost wrapper:
787+
attributes before the internal [_res.newtype_attrs] marker (or
788+
all of them, when there is no marker) are function-node
789+
attributes, the ones after the marker belong to the first
790+
newtype. Chains over anything else (e.g. the
791+
[let f: type t. ...] sugar) keep their [Pexp_newtype] nodes. *)
792+
let node_attrs, first_nt_attrs =
793+
let rec split acc = function
794+
| ({txt = "_res.newtype_attrs"}, _) :: rest -> (List.rev acc, rest)
795+
| a :: rest -> split (a :: acc) rest
796+
| [] -> (List.rev acc, [])
797+
in
798+
split [] attrs
799+
in
800+
let rec gather acc (e0 : Parsetree0.expression) =
801+
match e0.pexp_desc with
802+
| Pexp_newtype (s1, body) ->
803+
gather
804+
((map_loc sub s1, sub.attributes sub e0.pexp_attributes) :: acc)
805+
body
806+
| Pexp_construct ({txt = Longident.Lident "Function$"}, Some _) ->
807+
Some (List.rev acc, e0)
808+
| _ -> None
809+
in
810+
match gather [(map_loc sub s, first_nt_attrs)] e with
811+
| Some (newtypes, base) -> (
812+
let base1 = sub.expr sub base in
813+
match base1.pexp_desc with
814+
| Pexp_fun ({newtypes = []} as f) ->
815+
{
816+
Pt.pexp_desc = Pexp_fun {f with newtypes};
817+
pexp_attributes = base1.pexp_attributes @ node_attrs;
818+
pexp_loc = loc;
819+
}
820+
| _ -> (
821+
(* PPX-mangled Function$: keep the wrapper chain as-is. *)
822+
match newtypes with
823+
| [] -> assert false
824+
| (n0, _) :: rest ->
825+
let inner =
826+
List.fold_right
827+
(fun (n, a) acc -> newtype ~loc ~attrs:a n acc)
828+
rest base1
829+
in
830+
newtype ~loc ~attrs n0 inner))
831+
| None -> newtype ~loc ~attrs (map_loc sub s) (sub.expr sub e))
784832
| Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me)
785833
| Pexp_open (ovf, lid, e) ->
786834
open_ ~loc ~attrs ovf (map_loc sub lid) (sub.expr sub e)

compiler/ml/ast_mapper_to0.ml

Lines changed: 43 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -405,11 +405,12 @@ module E = struct
405405
| Pexp_constant x -> constant ~loc ~attrs (map_constant x)
406406
| Pexp_let (r, vbs, e) ->
407407
let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.expr sub e)
408-
| Pexp_fun {params; body; async} ->
408+
| Pexp_fun {newtypes; params; body; async} -> (
409409
(* Re-curry the n-ary function into the v0 chain of unary funs, and
410410
wrap it in Function$ carrying the arity as a res.arity attribute.
411-
The head carries the function node's own attributes (and the
412-
res.async marker), matching what the old parser produced.
411+
Without newtypes the head carries the function node's own
412+
attributes (and the res.async marker), matching what the old parser
413+
produced; with newtypes they travel on the newtype wrapper instead.
413414
414415
v0 fun nodes have a single attribute slot for what the current
415416
parsetree splits into node attributes and parameter attributes.
@@ -433,7 +434,10 @@ module E = struct
433434
:: param_attrs
434435
in
435436
if is_head then
436-
let base = attrs @ marked_param_attrs in
437+
let base =
438+
if newtypes = [] then attrs @ marked_param_attrs
439+
else marked_param_attrs
440+
in
437441
if async then
438442
({txt = "res.async"; loc = Location.none}, Pt.PStr []) :: base
439443
else base
@@ -457,9 +461,41 @@ module E = struct
457461
(Pconst_integer (string_of_int arity, None)));
458462
] )
459463
in
460-
Ast_helper0.Exp.construct ~attrs:[arity_attr]
461-
(Location.mkloc (Longident.Lident "Function$") e.pexp_loc)
462-
(Some e)
464+
let fn =
465+
Ast_helper0.Exp.construct ~attrs:[arity_attr]
466+
(Location.mkloc (Longident.Lident "Function$") e.pexp_loc)
467+
(Some e)
468+
in
469+
(* Expand the newtypes back into the v0 wrapper chain around the
470+
Function$ node. Each wrapper carries its own newtype's attributes.
471+
The outermost wrapper is the whole expression in v0, so it also
472+
carries the function node's attributes: when the first newtype has
473+
attributes of its own, an internal [_res.newtype_attrs] marker
474+
separates node attributes (before) from the first newtype's
475+
attributes (after); without a marker every attribute on the
476+
outermost wrapper is a function-node attribute, which is also how
477+
wrapper attributes behaved before newtypes became a field. *)
478+
match newtypes with
479+
| [] -> fn
480+
| (first_name, first_attrs) :: rest_newtypes ->
481+
let inner =
482+
List.fold_right
483+
(fun (name, nt_attrs) acc ->
484+
Ast_helper0.Exp.newtype ~loc
485+
~attrs:(sub.attributes sub nt_attrs)
486+
(map_loc sub name) acc)
487+
rest_newtypes fn
488+
in
489+
let first_attrs = sub.attributes sub first_attrs in
490+
let outer_attrs =
491+
if first_attrs = [] then attrs
492+
else
493+
attrs
494+
@ ({txt = "_res.newtype_attrs"; loc = Location.none}, Pt.PStr [])
495+
:: first_attrs
496+
in
497+
Ast_helper0.Exp.newtype ~loc ~attrs:outer_attrs (map_loc sub first_name)
498+
inner)
463499
| Pexp_apply {funct = e; args; partial} ->
464500
let e =
465501
match (e.pexp_desc, args) with

compiler/ml/parsetree.ml

Lines changed: 10 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -232,10 +232,18 @@ and expression_desc =
232232
(* let P1 = E1 and ... and Pn = EN in E (flag = Nonrecursive)
233233
let rec P1 = E1 and ... and Pn = EN in E (flag = Recursive)
234234
*)
235-
| Pexp_fun of {params: fun_param list; body: expression; async: bool}
236-
(* (P1, ~l:P2, ?l:P3=E0) => E n-ary uncurried function.
235+
| Pexp_fun of {
236+
newtypes: (string loc * attributes) list;
237+
params: fun_param list;
238+
body: expression;
239+
async: bool;
240+
}
241+
(* (type t, P1, ~l:P2, ?l:P3=E0) => E n-ary uncurried function.
237242
The function's arity is [List.length params]; a function returning
238243
another function is a nested [Pexp_fun] in [body].
244+
[newtypes] are the function's locally abstract types, each with its
245+
own attributes; the parser hoists them in front of the value
246+
parameters.
239247
240248
Notes:
241249
- A default expression is only allowed on Optional parameters.

0 commit comments

Comments
 (0)