From f138a7288cf048d176974b5e879d0ffc9502d901 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 14 Aug 2026 17:08:05 +0200 Subject: [PATCH] Record written arrow arity before external lowering External arrow parsing used to subtract labelled phantom @as(...) _ parameters from the head arity, while the printer added them back. No downstream consumer needs that parser-level encoding: external lowering removes phantom parameters and rebuilds the type with the effective call arity. Record the written parameter count in the parsetree instead and remove the parser and printer compensation. Also assign arity 1 to bare labelled arrow types so they agree with their parenthesized spelling. Co-authored-by: Claude Fable 5 Signed-off-by: Cristiano Calcagno --- CHANGELOG.md | 2 + compiler/syntax/src/res_core.ml | 53 ++++++------------- compiler/syntax/src/res_parsetree_viewer.ml | 17 +----- .../data/ast-mapping/FunctionsAndArrows.res | 2 +- .../expected/FunctionsAndArrows.res.txt | 2 +- .../errors/typexpr/expected/arrow.res.txt | 2 +- .../grammar/typexpr/expected/es6Arrow.res.txt | 16 +++--- 7 files changed, 30 insertions(+), 64 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 07be5a378bb..0ad2b743bd4 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -28,6 +28,7 @@ - Preserve parentheses around multiplication, division, and modulo expressions used as exponents. https://github.com/rescript-lang/rescript/pull/8550 - 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 +- Fix bare labeled arrow types (`~x: int => string`) getting no arity: they printed identically to their parenthesized form (`(~x: int) => string`) but did not unify with it. https://github.com/rescript-lang/rescript/pull/8563 - Fix losses of fidelity when code passes through an external PPX: the internal `@res.async` marker no longer leaks into the program, attributes on an arrow type or on an `await` expression are no longer dropped or relocated (previously this could crash the formatter), JSX elements keep their closing tag, and PPX-emitted OCaml-style `function` is desugared instead of crashing the compiler. https://github.com/rescript-lang/rescript/pull/8561 - Preserve multibyte characters when wrapping long source lines in compiler code frames. https://github.com/rescript-lang/rescript/pull/8520 - Fix reanalyze optional-argument diagnostics for functions passed or returned as first-class values. https://github.com/rescript-lang/rescript/pull/8321 @@ -44,6 +45,7 @@ - Sync the platform npm package's compiler binaries (`packages/@rescript//bin`) via dune promotion on every `dune build`, instead of Makefile/CI copy steps that only ran when make did: a plain `dune build` can no longer leave `cli/*.js` and the test harnesses running a stale compiler. https://github.com/rescript-lang/rescript/pull/8560 - Remove unused compiler IR definitions, modules, helpers, error variants, and Typedtree fields. https://github.com/rescript-lang/rescript/pull/8551 https://github.com/rescript-lang/rescript/pull/8555 - Give marshaled current-parsetree streams (`-as-pp`, `res_parser -print binary`) their own magic numbers, distinct from the frozen Parsetree0 wire format used for external PPXes. https://github.com/rescript-lang/rescript/pull/8561 +- Record the written parameter count in parsed arrow arity for externals with phantom `@as(...) _` arguments. External processing recounts after erasing phantoms, so the parser no longer needs to pre-decrement the arity or the printer to compensate for it. https://github.com/rescript-lang/rescript/pull/8563 - Add the `-check-lam` compiler option, enable Lambda invariant checking in compiler tests, and remove build-profile-dependent checking. https://github.com/rescript-lang/rescript/pull/8534 - Replace `-bs-diagnose` with `-debug-ir` and make IR diagnostic artifacts deterministic, compilation-local, and easy to clean. https://github.com/rescript-lang/rescript/pull/8535 - Replace CPPO-based browser conditionals with Dune-selected native and playground compiler implementations. https://github.com/rescript-lang/rescript/pull/8541 diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml index cbdc8e319b4..fb0650355c9 100644 --- a/compiler/syntax/src/res_core.ml +++ b/compiler/syntax/src/res_core.ml @@ -263,10 +263,6 @@ module Error_messages = struct "Spreading JSX children is no longer supported." end -module In_external = struct - let status = ref false -end - let ternary_attr = (Location.mknoloc "res.ternary", Parsetree.PStr []) let if_let_attr = (Location.mknoloc "res.iflet", Parsetree.PStr []) let make_await_attr loc = (Location.mkloc "res.await" loc, Parsetree.PStr []) @@ -5057,7 +5053,11 @@ and parse_es6_arrow_type ?current_type_name_path ?inline_types_context ~attrs p ?inline_types_context p in let loc = mk_loc start_pos p.prev_end_pos in - Ast_helper.Typ.arrow ~loc ~arity:None {attrs; lbl; typ} return_type + (* A bare labeled arrow type [~x: t => u] is a complete one-parameter + arrow, exactly like its parenthesized form [(~x: t) => u]; it must + carry the same arity or the two spellings produce types that print + identically but do not unify. *) + Ast_helper.Typ.arrow ~loc ~arity:(Some 1) {attrs; lbl; typ} return_type | DocComment _ -> assert false | _ -> let parameters = @@ -5073,35 +5073,18 @@ and parse_es6_arrow_type ?current_type_name_path ?inline_types_context ~attrs p ?inline_types_context p in let end_pos = p.prev_end_pos in - let return_type_arity = 0 in - let _paramNum, typ, _arity = + let arity = List.length parameters in + let typ = List.fold_right - (fun {attrs; label = arg_lbl; typ; start_pos} (param_num, t, arity) -> + (fun {attrs; label = arg_lbl; typ; start_pos} t -> let loc = mk_loc start_pos end_pos in - let arity = - (* Workaround for ~lbl: @as(json`false`) _, which changes the arity *) - match arg_lbl with - | Labelled _s -> - let typ_is_any = - match typ.ptyp_desc with - | Ptyp_any -> true - | _ -> false - in - let has_as = - Ext_list.exists typ.ptyp_attributes (fun (x, _) -> x.txt = "as") - in - if !In_external.status && typ_is_any && has_as then arity - 1 - else arity - | _ -> arity - in - let t_arg = - Ast_helper.Typ.arrow ~loc ~arity:None {attrs; lbl = arg_lbl; typ} t - in - if param_num = 1 then - (param_num - 1, Ast_uncurried.uncurried_type ~arity t_arg, 1) - else (param_num - 1, t_arg, arity + 1)) - parameters - (List.length parameters, return_type, return_type_arity + 1) + Ast_helper.Typ.arrow ~loc ~arity:None {attrs; lbl = arg_lbl; typ} t) + parameters return_type + in + let typ = + match parameters with + | [] -> typ + | _ -> Ast_uncurried.uncurried_type ~arity typ in { typ with @@ -6638,13 +6621,9 @@ and parse_type_definition_or_extension ~attrs p = (* external value-name : typexp = external-declaration *) and parse_external_def ~attrs ~start_pos p = - let in_external = !In_external.status in - In_external.status := true; Parser.leave_breadcrumb p Grammar.External; Fun.protect - ~finally:(fun () -> - Parser.eat_breadcrumb p; - In_external.status := in_external) + ~finally:(fun () -> Parser.eat_breadcrumb p) (fun () -> Parser.expect Token.External p; let name, loc = parse_lident p in diff --git a/compiler/syntax/src/res_parsetree_viewer.ml b/compiler/syntax/src/res_parsetree_viewer.ml index 4c4cac9850b..795da837a7b 100644 --- a/compiler/syntax/src/res_parsetree_viewer.ml +++ b/compiler/syntax/src/res_parsetree_viewer.ml @@ -1,9 +1,6 @@ open Parsetree let arrow_type ?(max_arity = max_int) ct = - let has_as_attr attrs = - Ext_list.exists attrs (fun (x, _) -> x.Asttypes.txt = "as") - in let rec process attrs_before acc typ max_arity = match typ with | _ when max_arity < 0 -> (attrs_before, List.rev acc, typ) @@ -27,19 +24,7 @@ let arrow_type ?(max_arity = max_int) ct = ptyp_desc = Ptyp_arrow {arg = {lbl = Labelled _ | Optional _} as arg; ret}; ptyp_attributes = _attrs; } -> - (* Res_core.parse_es6_arrow_type has a workaround that removed an extra arity for the function if the - argument is a Ptyp_any with @as attribute i.e. ~x: @as(`{prop: value}`) _. - - When this case is encountered we add that missing arity so the arrow is printed properly. - *) - let arity = - match arg.typ with - | {ptyp_desc = Ptyp_any; ptyp_attributes = attrs1} - when has_as_attr attrs1 -> - max_arity - | _ -> max_arity - 1 - in - process attrs_before (arg :: acc) ret arity + process attrs_before (arg :: acc) ret (max_arity - 1) | typ -> (attrs_before, List.rev acc, typ) in match ct with diff --git a/tests/syntax_tests/data/ast-mapping/FunctionsAndArrows.res b/tests/syntax_tests/data/ast-mapping/FunctionsAndArrows.res index 75ff778dd51..782392229de 100644 --- a/tests/syntax_tests/data/ast-mapping/FunctionsAndArrows.res +++ b/tests/syntax_tests/data/ast-mapping/FunctionsAndArrows.res @@ -42,7 +42,7 @@ type curriedAnnot = int => int => int type nodeAttr = @attr (string => unit) type argAttr = (@as("x") ~foo: string, int) => int -// phantom @as arguments in externals (arity != arrow-chain length) +// phantom @as arguments: written arity differs from lowered call arity @val external phantom: (~a: int, @as(json`false`) _, ~c: string) => unit = "phantom" diff --git a/tests/syntax_tests/data/ast-mapping/expected/FunctionsAndArrows.res.txt b/tests/syntax_tests/data/ast-mapping/expected/FunctionsAndArrows.res.txt index 75ff778dd51..782392229de 100644 --- a/tests/syntax_tests/data/ast-mapping/expected/FunctionsAndArrows.res.txt +++ b/tests/syntax_tests/data/ast-mapping/expected/FunctionsAndArrows.res.txt @@ -42,7 +42,7 @@ type curriedAnnot = int => int => int type nodeAttr = @attr (string => unit) type argAttr = (@as("x") ~foo: string, int) => int -// phantom @as arguments in externals (arity != arrow-chain length) +// phantom @as arguments: written arity differs from lowered call arity @val external phantom: (~a: int, @as(json`false`) _, ~c: string) => unit = "phantom" diff --git a/tests/syntax_tests/data/parsing/errors/typexpr/expected/arrow.res.txt b/tests/syntax_tests/data/parsing/errors/typexpr/expected/arrow.res.txt index c621d68f7f0..31e172542b1 100644 --- a/tests/syntax_tests/data/parsing/errors/typexpr/expected/arrow.res.txt +++ b/tests/syntax_tests/data/parsing/errors/typexpr/expected/arrow.res.txt @@ -46,5 +46,5 @@ module Error3 = type nonrec observation = { observed: int ; - onStep: currentValue:unit -> [%rescript.typehole ] } + onStep: currentValue:unit -> [%rescript.typehole ] (a:1) } end \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/grammar/typexpr/expected/es6Arrow.res.txt b/tests/syntax_tests/data/parsing/grammar/typexpr/expected/es6Arrow.res.txt index 2de8c1b7878..de16403398b 100644 --- a/tests/syntax_tests/data/parsing/grammar/typexpr/expected/es6Arrow.res.txt +++ b/tests/syntax_tests/data/parsing/grammar/typexpr/expected/es6Arrow.res.txt @@ -12,15 +12,15 @@ let (t : a:int -> b:int -> int (a:2)) = xf let (t : ?a:int -> ?b:int -> int (a:2)) = xf let (t : int -> int -> int -> int (a:1) (a:1) (a:1)) = xf let (t : a:int -> b:int -> c:int -> int (a:1) (a:1) (a:1)) = xf -type nonrec t = f:int -> string -type nonrec t = ?f:int -> string -let (f : f:int -> string) = fx -let (f : ?f:int -> string) = fx type nonrec t = f:int -> string (a:1) -type nonrec t = f:int -> string +type nonrec t = ?f:int -> string (a:1) +let (f : f:int -> string (a:1)) = fx +let (f : ?f:int -> string (a:1)) = fx +type nonrec t = f:int -> string (a:1) +type nonrec t = f:int -> string (a:1) +type nonrec t = f:(int -> string (a:1)) -> float (a:1) type nonrec t = f:(int -> string (a:1)) -> float (a:1) -type nonrec t = f:(int -> string (a:1)) -> float -type nonrec t = f:int -> string -> float (a:1) +type nonrec t = f:int -> string -> float (a:1) (a:1) type nonrec t = a:int[@attrBeforeLblA ] -> b:int[@attrBeforeLblB ] -> ((float)[@attr ]) -> unit (a:3) @@ -28,7 +28,7 @@ type nonrec t = ((a:int -> ((b:int -> ((float)[@attr ]) -> unit (a:1) (a:1))[@attrBeforeLblB ]) (a:1)) [@attrBeforeLblA ]) -type nonrec t = a:int[@attr ] -> unit +type nonrec t = a:int[@attr ] -> unit (a:1) type nonrec 'a getInitialPropsFn = < query: string dict ;req: < .. > nullable > -> < .. > Promise.t (a:1) \ No newline at end of file