From aafcb121c6a64ca2171e0bbf16444b2634b267b4 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 14 Aug 2026 16:57:10 +0200 Subject: [PATCH 1/3] Harden the Parsetree0 PPX bridge and add a round-trip corpus The v0 bridge (ast_mapper_to0 / ast_mapper_from0) had several fidelity bugs that surfaced whenever code passed through an external PPX: - the internal res.async marker leaked back into the program as a real attribute after decoding; - attributes on an arrow-type node were merged into the argument's attribute list on the way back, which crashed the formatter with a stack overflow; the two lists are now kept separable with an internal _res.arrow_node_attrs marker, and the arrow_type viewer additionally always consumes the head argument so it can never return its input as the "return type"; - the await node's own attributes were dropped entirely (losing e.g. @outer in "@outer await (@inner e)" and res.braces on async bodies); res.await now serves as the boundary between await-node attributes and inner-expression attributes; - JSX container elements were rebuilt without a closing tag, printing unclosed elements; a closing tag matching the opening tag is now synthesized; - PPX-emitted OCaml-style `function | p -> e` hit assert false; it is now desugared to `fun x -> match x with ...` like the OCaml parser would. Marshaled current-parsetree streams (-as-pp, res_parser -print binary, Ast_mapper.apply_lazy) now carry their own magic numbers (ResImpl01300/ResIntf01300); the Caml1999M022/N022 pair is reserved for the frozen Parsetree0 wire format that external PPXes rely on. Round-trip sweep over all 350 syntax test files: 37 diverging files before, 21 after, no regressions; every arrows/functions/async/await file now round-trips byte-identically. New ast-mapping corpus file FunctionsAndArrows.res pins the constructs, and a unit test covers the function-cases desugaring. Co-Authored-By: Claude Fable 5 Signed-off-by: Cristiano Calcagno --- CHANGELOG.md | 2 + compiler/core/js_implementation.ml | 4 +- compiler/ext/config.ml | 9 +++ compiler/ext/config.mli | 9 +++ compiler/ml/ast_mapper.ml | 6 +- compiler/ml/ast_mapper_from0.ml | 73 +++++++++++++++---- compiler/ml/ast_mapper_to0.ml | 25 ++++++- compiler/syntax/src/res_driver_binary.ml | 8 +- compiler/syntax/src/res_parsetree_viewer.ml | 6 ++ tests/ounit_tests/ounit_ast_mapper0_tests.ml | 33 +++++++++ .../data/ast-mapping/FunctionsAndArrows.res | 50 +++++++++++++ .../expected/ForAwaitOfExpressions.res.txt | 24 +++--- .../expected/FunctionsAndArrows.res.txt | 50 +++++++++++++ 13 files changed, 259 insertions(+), 40 deletions(-) create mode 100644 tests/syntax_tests/data/ast-mapping/FunctionsAndArrows.res create mode 100644 tests/syntax_tests/data/ast-mapping/expected/FunctionsAndArrows.res.txt diff --git a/CHANGELOG.md b/CHANGELOG.md index bbc9e88a8b9..07be5a378bb 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 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 - Prevent the developer playground from loading stale compiler and library assets after PR preview updates. https://github.com/rescript-lang/rescript/pull/8556 @@ -42,6 +43,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 - 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/core/js_implementation.ml b/compiler/core/js_implementation.ml index df6ab959d12..479860ff9cd 100644 --- a/compiler/core/js_implementation.ml +++ b/compiler/core/js_implementation.ml @@ -43,7 +43,7 @@ let after_parsing_sig ppf outputprefix ast = (* to support relocate to another directory *) ast); if !Js_config.as_pp then ( - output_string stdout Config.ast_intf_magic_number; + output_string stdout Config.res_ast_intf_magic_number; output_value stdout (!Location.input_name : string); output_value stdout ast); if !Js_config.syntax_only then Warnings.check_fatal () @@ -124,7 +124,7 @@ let after_parsing_impl ppf outputprefix (ast : Parsetree.structure) = ~output:(outputprefix ^ Literals.suffix_ast) ast); if !Js_config.as_pp then ( - output_string stdout Config.ast_impl_magic_number; + output_string stdout Config.res_ast_impl_magic_number; output_value stdout (!Location.input_name : string); output_value stdout ast); if !Js_config.syntax_only then Warnings.check_fatal () diff --git a/compiler/ext/config.ml b/compiler/ext/config.ml index d9f7bb64256..05da6896088 100644 --- a/compiler/ext/config.ml +++ b/compiler/ext/config.ml @@ -4,6 +4,15 @@ and ast_impl_magic_number = "Caml1999M022" and ast_intf_magic_number = "Caml1999N022" +(* Magic numbers for marshaled values of the *current* parsetree, whose layout + changes across compiler versions. The [ast_impl_magic_number] / + [ast_intf_magic_number] pair above identifies the frozen Parsetree0 (OCaml + 4.06) layout used on the external-PPX wire and must never be written in + front of a current-parsetree value. *) +and res_ast_impl_magic_number = "ResImpl01300" + +and res_ast_intf_magic_number = "ResIntf01300" + and cmt_magic_number = "Caml1999T022" let load_path = ref ([] : string list) diff --git a/compiler/ext/config.mli b/compiler/ext/config.mli index fe13a03c99b..6c85b26884d 100644 --- a/compiler/ext/config.mli +++ b/compiler/ext/config.mli @@ -27,5 +27,14 @@ val ast_intf_magic_number : string val ast_impl_magic_number : string (* Magic number for file holding an implementation syntax tree *) + +val res_ast_intf_magic_number : string +(* Magic number for a marshaled current-parsetree signature (layout changes + across compiler versions; distinct from the frozen Parsetree0 wire format) *) + +val res_ast_impl_magic_number : string +(* Magic number for a marshaled current-parsetree structure (layout changes + across compiler versions; distinct from the frozen Parsetree0 wire format) *) + val cmt_magic_number : string (* Magic number for compiled interface files *) diff --git a/compiler/ml/ast_mapper.ml b/compiler/ml/ast_mapper.ml index 5ec5c766030..a07a7cfdd74 100644 --- a/compiler/ml/ast_mapper.ml +++ b/compiler/ml/ast_mapper.ml @@ -744,7 +744,7 @@ let apply_lazy ~source ~target mapper = let ic = open_in_bin source in let magic = - really_input_string ic (String.length Config.ast_impl_magic_number) + really_input_string ic (String.length Config.res_ast_impl_magic_number) in let rewrite transform = @@ -762,9 +762,9 @@ let apply_lazy ~source ~target mapper = failwith "Ast_mapper: OCaml version mismatch or malformed input" in - if magic = Config.ast_impl_magic_number then + if magic = Config.res_ast_impl_magic_number then rewrite (implem : structure -> structure) - else if magic = Config.ast_intf_magic_number then + else if magic = Config.res_ast_intf_magic_number then rewrite (iface : signature -> signature) else fail () diff --git a/compiler/ml/ast_mapper_from0.ml b/compiler/ml/ast_mapper_from0.ml index 539833fb495..b11d5b151c8 100644 --- a/compiler/ml/ast_mapper_from0.ml +++ b/compiler/ml/ast_mapper_from0.ml @@ -141,8 +141,24 @@ module T = struct | Ptyp_var s -> Typ.var ~loc ~attrs s | Ptyp_arrow (lbl, t1, t2) -> let lbl = Asttypes.to_arg_label lbl in - Typ.arrow ~loc ~arity:None - {attrs; lbl; typ = sub.typ sub t1} + (* [Ast_mapper_to0] flattens the current parsetree's node/argument + attribute split into the v0 arrow's single attribute list, marking + the boundary with [_res.arrow_node_attrs] when node attributes are + present: node attributes come before the marker, argument attributes + after it. Without a marker, everything is an argument attribute. *) + let node_attrs, arg_attrs = + let rec split acc = function + | ({txt = "_res.arrow_node_attrs"}, _) :: rest -> + Some (List.rev acc, rest) + | a :: rest -> split (a :: acc) rest + | [] -> None + in + match split [] attrs with + | Some (node_attrs, arg_attrs) -> (node_attrs, arg_attrs) + | None -> ([], attrs) + in + Typ.arrow ~loc ~attrs:node_attrs ~arity:None + {attrs = arg_attrs; lbl; typ = sub.typ sub t1} (sub.typ sub t2) | Ptyp_tuple tyl -> Typ.tuple ~loc ~attrs (List.map (sub.typ sub) tyl) | Ptyp_constr (lid, tl) -> ( @@ -345,13 +361,6 @@ module E = struct | _ -> false) attrs - let remove_await_attribute attrs = - List.filter - (function - | {Location.txt = "res.await"}, _ -> false - | _ -> true) - attrs - let extract_for_of_attribute attrs = List.find_map (function @@ -468,9 +477,20 @@ module E = struct in match desc with | _ when has_await_attribute attrs -> - let attrs = remove_await_attribute e.pexp_attributes in - let e = sub.expr sub {e with pexp_attributes = attrs} in - await ~loc e + (* [Ast_mapper_to0] merges the await node's attributes and the inner + expression's attributes into the one v0 slot, with [res.await] as + the boundary: await-node attributes before it, inner attributes + after it. *) + let await_attrs0, inner_attrs0 = + let rec split acc = function + | ({Location.txt = "res.await"}, _) :: rest -> (List.rev acc, rest) + | a :: rest -> split (a :: acc) rest + | [] -> (List.rev acc, []) + in + split [] e.pexp_attributes + in + let inner = sub.expr sub {e with pexp_attributes = inner_attrs0} in + await ~loc ~attrs:(sub.attributes sub await_attrs0) inner | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x) | Pexp_constant x -> constant ~loc ~attrs (map_constant x) | Pexp_let (r, vbs, e) -> @@ -478,10 +498,25 @@ module E = struct | Pexp_fun (lab, def, p, e) -> let lab = Asttypes.to_arg_label lab in let async = Ext_list.exists attrs (fun ({txt}, _) -> txt = "res.async") in + (* [res.async] is bridge metadata added by [Ast_mapper_to0]; it is + decoded into the [async] flag and must not survive as a real + attribute. *) + let attrs = attrs |> List.filter (fun ({txt}, _) -> txt <> "res.async") in fun_ ~loc ~attrs ~async ~arity:None lab (map_opt (sub.expr sub) def) (sub.pat sub p) (sub.expr sub e) - | Pexp_function _ -> assert false + | Pexp_function cases -> + (* The current parsetree has no [function] construct; it can only come + from an external PPX emitting OCaml-style [function | p -> e]. + Desugar to [fun x -> match x with | p -> e] with an unshadowable + parameter name, as the OCaml parser would. *) + let param = "*function*" in + let pat = Pat.var ~loc (Location.mkloc param loc) in + let scrutinee = + ident ~loc (Location.mkloc (Longident.Lident param) loc) + in + let body = match_ ~loc scrutinee (sub.cases sub cases) in + fun_ ~loc ~attrs ~async:false ~arity:None Nolabel None pat body | Pexp_apply ({pexp_desc = Pexp_ident tag_name}, args) when has_jsx_attribute () -> ( let attrs = attrs |> List.filter (fun ({txt}, _) -> txt <> "JSX") in @@ -502,8 +537,18 @@ module E = struct match children with | None -> jsx_unary_element ~loc ~attrs jsx_tag_name props | Some children -> + (* The v0 encoding has no closing-tag information; synthesize one + matching the opening tag, otherwise the printer emits an element + that is never closed. *) + let closing_tag = + { + Pt.jsx_closing_container_tag_start = Lexing.dummy_pos; + jsx_closing_container_tag_name = jsx_tag_name; + jsx_closing_container_tag_end = Lexing.dummy_pos; + } + in jsx_container_element ~loc ~attrs jsx_tag_name props Lexing.dummy_pos - children None) + children (Some closing_tag)) | Pexp_apply (e, l) -> let e = match (e.pexp_desc, l) with diff --git a/compiler/ml/ast_mapper_to0.ml b/compiler/ml/ast_mapper_to0.ml index 3bd7bd0ad70..18a3cdc9fe1 100644 --- a/compiler/ml/ast_mapper_to0.ml +++ b/compiler/ml/ast_mapper_to0.ml @@ -124,10 +124,22 @@ module T = struct | Ptyp_var s -> var ~loc ~attrs s | Ptyp_arrow {arg; ret; arity} -> ( let lbl = Asttypes.to_noloc arg.lbl in + (* v0 arrows have a single attribute slot for what the current parsetree + splits into node attributes and argument attributes. Keep the split + recoverable: when node attributes are present, separate the two lists + with an internal marker that [Ast_mapper_from0] strips again. Without + node attributes (the common case) the encoding is unchanged. *) + let arg_attrs = sub.attributes sub arg.attrs in + let merged_attrs = + if attrs = [] then arg_attrs + else + attrs + @ ({txt = "_res.arrow_node_attrs"; loc = Location.none}, Pt.PStr []) + :: arg_attrs + in let typ0 = - arrow ~loc - ~attrs:(attrs @ sub.attributes sub arg.attrs) - lbl (sub.typ sub arg.typ) (sub.typ sub ret) + arrow ~loc ~attrs:merged_attrs lbl (sub.typ sub arg.typ) + (sub.typ sub ret) in match arity with | None -> typ0 @@ -526,11 +538,16 @@ module E = struct open_ ~loc ~attrs ovf (map_loc sub lid) (sub.expr sub e) | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x) | Pexp_await e -> + (* Single v0 attribute slot for two nodes: the await node's own + attributes go in front of the [res.await] marker, the inner + expression's attributes after it, so [Ast_mapper_from0] can split + them again. *) let e = sub.expr sub e in { e with pexp_attributes = - (Location.mknoloc "res.await", Pt.PStr []) :: e.pexp_attributes; + attrs + @ ((Location.mknoloc "res.await", Pt.PStr []) :: e.pexp_attributes); } | Pexp_jsx_element (Jsx_fragment diff --git a/compiler/syntax/src/res_driver_binary.ml b/compiler/syntax/src/res_driver_binary.ml index b6c9318d5cc..55fa069f510 100644 --- a/compiler/syntax/src/res_driver_binary.ml +++ b/compiler/syntax/src/res_driver_binary.ml @@ -3,22 +3,22 @@ let print_engine = { print_implementation = (fun ~width:_ ~filename ~comments:_ structure -> - output_string stdout Config.ast_impl_magic_number; + output_string stdout Config.res_ast_impl_magic_number; output_value stdout filename; output_value stdout structure); print_implementation_from_source = (fun ~width:_ ~source:_ ~comments:_ structure -> - output_string stdout Config.ast_impl_magic_number; + output_string stdout Config.res_ast_impl_magic_number; output_value stdout "source"; output_value stdout structure); print_interface = (fun ~width:_ ~filename ~comments:_ signature -> - output_string stdout Config.ast_intf_magic_number; + output_string stdout Config.res_ast_intf_magic_number; output_value stdout filename; output_value stdout signature); print_interface_from_source = (fun ~width:_ ~source:_ ~comments:_ signature -> - output_string stdout Config.ast_intf_magic_number; + output_string stdout Config.res_ast_intf_magic_number; output_value stdout "source"; output_value stdout signature); } diff --git a/compiler/syntax/src/res_parsetree_viewer.ml b/compiler/syntax/src/res_parsetree_viewer.ml index 508acba1e3f..4c4cac9850b 100644 --- a/compiler/syntax/src/res_parsetree_viewer.ml +++ b/compiler/syntax/src/res_parsetree_viewer.ml @@ -13,6 +13,12 @@ let arrow_type ?(max_arity = max_int) ct = | {ptyp_desc = Ptyp_arrow {arg = {lbl = Nolabel; attrs = []} as arg; ret}} -> process attrs_before (arg :: acc) ret (max_arity - 1) + | {ptyp_desc = Ptyp_arrow {arg = {lbl = Nolabel} as arg; ret}} when acc = [] + -> + (* The head argument is always consumed, attributes or not: returning + the input node itself as the "return type" would make the printer + recurse forever. *) + process attrs_before (arg :: acc) ret (max_arity - 1) | {ptyp_desc = Ptyp_arrow {arg = {lbl = Nolabel}}; ptyp_attributes = _attrs} as return_type -> let args = List.rev acc in diff --git a/tests/ounit_tests/ounit_ast_mapper0_tests.ml b/tests/ounit_tests/ounit_ast_mapper0_tests.ml index b1d902e34d0..450d6197406 100644 --- a/tests/ounit_tests/ounit_ast_mapper0_tests.ml +++ b/tests/ounit_tests/ounit_ast_mapper0_tests.ml @@ -67,6 +67,37 @@ let test_record_rest_roundtrips_through_ast0 _ = () | _ -> assert_failure "Expected record rest after ast0 roundtrip" +let map_expr0 e = + Ast_mapper_from0.default_mapper.expr Ast_mapper_from0.default_mapper e + +(* A PPX can emit OCaml-style [function | p -> e]; the bridge must desugar it + to [fun x -> match x with | p -> e] rather than crash. *) +let test_function_cases_desugar_to_fun_match _ = + let case0 = + { + Parsetree0.pc_lhs = Ast_helper0.Pat.any ~loc (); + pc_guard = None; + pc_rhs = + Ast_helper0.Exp.constant ~loc (Parsetree0.Pconst_integer ("1", None)); + } + in + let expr = map_expr0 (Ast_helper0.Exp.function_ ~loc [case0]) in + match expr.pexp_desc with + | Parsetree.Pexp_fun + { + arg_label = Nolabel; + default = None; + lhs = {ppat_desc = Ppat_var {txt = param}}; + rhs = + { + pexp_desc = + Pexp_match ({pexp_desc = Pexp_ident {txt = Lident scrutinee}}, [_]); + }; + } -> + OUnit.assert_equal ~msg:"scrutinee is the introduced parameter" param + scrutinee + | _ -> assert_failure "Expected fun x -> match x with ... after desugaring" + let suites = __FILE__ >::: [ @@ -76,4 +107,6 @@ let suites = >:: test_malformed_internal_record_rest_attr_fails; "record_rest_roundtrips_through_ast0" >:: test_record_rest_roundtrips_through_ast0; + "function_cases_desugar_to_fun_match" + >:: test_function_cases_desugar_to_fun_match; ] diff --git a/tests/syntax_tests/data/ast-mapping/FunctionsAndArrows.res b/tests/syntax_tests/data/ast-mapping/FunctionsAndArrows.res new file mode 100644 index 00000000000..75ff778dd51 --- /dev/null +++ b/tests/syntax_tests/data/ast-mapping/FunctionsAndArrows.res @@ -0,0 +1,50 @@ +// Round-trip coverage for functions and arrow types through the +// Parsetree0 bridge (ast_mapper_to0 / ast_mapper_from0). + +// n-ary functions and arity-1 sugar +let add = (a, b, c) => a + b + c +let id = x => x + +// labeled, optional, and default parameters +let labeled = (~x, ~y) => x - y +let optional = (~x=?, ~y=1, z) => { + switch x { + | Some(x) => x + y + z + | None => y + z + } +} + +// async functions, with and without newtypes +let fetch = async (url, ~timeout) => url ++ Int.toString(timeout) +let poly = async (type a, x: a) => x +let f = async (type a, ()) => await Promise.resolve() + +// await with attributes on both the await node and the inner expression +let g = async () => @outer await (@inner Promise.resolve(1)) + +// nested and curried-looking shapes must stay distinct +let curried = a => b => a + b +let nested = (a, b) => (c, d) => a + b + c + d + +// underscore apply sugar +let underscore = add(1, _, 3) + +// explicit partial application +let partial = add(1, ...) + +// arrow types: labeled, optional, uncurried groups, nested functions +type cb = (~x: int, ~y: float) => string +type opt = (~x: int=?, unit) => int +type nested2 = (int, int) => (string, string) => bool +type curriedAnnot = int => int => int + +// attributes on the arrow node vs on an argument +type nodeAttr = @attr (string => unit) +type argAttr = (@as("x") ~foo: string, int) => int + +// phantom @as arguments in externals (arity != arrow-chain length) +@val +external phantom: (~a: int, @as(json`false`) _, ~c: string) => unit = "phantom" + +// external with uncurried callback argument +@val external onEvent: (string, (~event: string) => unit) => unit = "on" diff --git a/tests/syntax_tests/data/ast-mapping/expected/ForAwaitOfExpressions.res.txt b/tests/syntax_tests/data/ast-mapping/expected/ForAwaitOfExpressions.res.txt index 113504d8853..de4ed562f6e 100644 --- a/tests/syntax_tests/data/ast-mapping/expected/ForAwaitOfExpressions.res.txt +++ b/tests/syntax_tests/data/ast-mapping/expected/ForAwaitOfExpressions.res.txt @@ -1,18 +1,16 @@ // Test for await..of AST mapping -let testForAwaitOf = - @res.async - async () => { - let iterable = asyncIterable +let testForAwaitOf = async () => { + let iterable = asyncIterable - // Basic for await..of - for await x of iterable { - Console.log(x) - } + // Basic for await..of + for await x of iterable { + Console.log(x) + } - // Nested async loop body - for await item of iterable { - let result = await Promise.resolve(item + 1) - Console.log(result) - } + // Nested async loop body + for await item of iterable { + let result = await Promise.resolve(item + 1) + Console.log(result) } +} diff --git a/tests/syntax_tests/data/ast-mapping/expected/FunctionsAndArrows.res.txt b/tests/syntax_tests/data/ast-mapping/expected/FunctionsAndArrows.res.txt new file mode 100644 index 00000000000..75ff778dd51 --- /dev/null +++ b/tests/syntax_tests/data/ast-mapping/expected/FunctionsAndArrows.res.txt @@ -0,0 +1,50 @@ +// Round-trip coverage for functions and arrow types through the +// Parsetree0 bridge (ast_mapper_to0 / ast_mapper_from0). + +// n-ary functions and arity-1 sugar +let add = (a, b, c) => a + b + c +let id = x => x + +// labeled, optional, and default parameters +let labeled = (~x, ~y) => x - y +let optional = (~x=?, ~y=1, z) => { + switch x { + | Some(x) => x + y + z + | None => y + z + } +} + +// async functions, with and without newtypes +let fetch = async (url, ~timeout) => url ++ Int.toString(timeout) +let poly = async (type a, x: a) => x +let f = async (type a, ()) => await Promise.resolve() + +// await with attributes on both the await node and the inner expression +let g = async () => @outer await (@inner Promise.resolve(1)) + +// nested and curried-looking shapes must stay distinct +let curried = a => b => a + b +let nested = (a, b) => (c, d) => a + b + c + d + +// underscore apply sugar +let underscore = add(1, _, 3) + +// explicit partial application +let partial = add(1, ...) + +// arrow types: labeled, optional, uncurried groups, nested functions +type cb = (~x: int, ~y: float) => string +type opt = (~x: int=?, unit) => int +type nested2 = (int, int) => (string, string) => bool +type curriedAnnot = int => int => int + +// attributes on the arrow node vs on an argument +type nodeAttr = @attr (string => unit) +type argAttr = (@as("x") ~foo: string, int) => int + +// phantom @as arguments in externals (arity != arrow-chain length) +@val +external phantom: (~a: int, @as(json`false`) _, ~c: string) => unit = "phantom" + +// external with uncurried callback argument +@val external onEvent: (string, (~event: string) => unit) => unit = "on" From ff375c22d3d65a1e5612b0675fc427877f0f5eb2 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Tue, 18 Aug 2026 14:28:58 +0200 Subject: [PATCH 2/3] Document native stacked pull requests Signed-off-by: Cristiano Calcagno --- AGENTS.md | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/AGENTS.md b/AGENTS.md index 9b5974bc0ff..2dcca5c6162 100644 --- a/AGENTS.md +++ b/AGENTS.md @@ -278,6 +278,14 @@ The compiler is designed for fast feedback loops and scales to large codebases: - Include appropriate tests with all changes - Build must pass before committing +### Stacked pull requests + +When a PR depends on another unmerged PR, create a native GitHub stack with +`gh stack` rather than only targeting the preceding feature branch. Keep the +branches linear and in the same repository, and list branches or PRs from +bottom to top. For existing PRs, use `gh stack link BOTTOM_PR [NEXT_PR...]`, +then verify that GitHub reports stack metadata and runs CI for every PR. + ### Code Quality - Follow existing patterns in the codebase From cbd02f1789b4bf300f778fe84b8c3b25c6a0667e Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Wed, 19 Aug 2026 09:30:30 +0200 Subject: [PATCH 3/3] Give the current parsetree the plain ast magic number names Rename the magic number constants so the current parsetree owns ast_impl_magic_number / ast_intf_magic_number (ResImpl01300 / ResIntf01300), while the frozen Parsetree0 external-PPX wire protocol moves to ast0_impl_magic_number / ast0_intf_magic_number (Caml1999M022 / Caml1999N022). Co-Authored-By: Claude Fable 5 Signed-off-by: Cristiano Calcagno --- compiler/common/ml_binary.ml | 8 ++++---- compiler/core/js_implementation.ml | 4 ++-- compiler/ext/config.ml | 18 +++++++++--------- compiler/ext/config.mli | 19 ++++++++++--------- compiler/ml/ast_mapper.ml | 6 +++--- compiler/syntax/src/res_driver_binary.ml | 8 ++++---- tools/bin/main.ml | 2 +- 7 files changed, 33 insertions(+), 32 deletions(-) diff --git a/compiler/common/ml_binary.ml b/compiler/common/ml_binary.ml index cfe96efcab3..0d3832bb256 100644 --- a/compiler/common/ml_binary.ml +++ b/compiler/common/ml_binary.ml @@ -27,8 +27,8 @@ type _ kind = Ml : Parsetree.structure kind | Mli : Parsetree.signature kind type ast0 = Impl of Parsetree0.structure | Intf of Parsetree0.signature let magic_of_ast0 : ast0 -> string = function - | Impl _ -> Config.ast_impl_magic_number - | Intf _ -> Config.ast_intf_magic_number + | Impl _ -> Config.ast0_impl_magic_number + | Intf _ -> Config.ast0_intf_magic_number let to_ast0 : type a. a kind -> a -> ast0 = fun kind ast -> @@ -59,5 +59,5 @@ let ast0_roundtrip : type a. a kind -> a -> a = | Mli -> ast |> to_ast0 Mli |> ast0_to_signature let magic_of_kind : type a. a kind -> string = function - | Ml -> Config.ast_impl_magic_number - | Mli -> Config.ast_intf_magic_number + | Ml -> Config.ast0_impl_magic_number + | Mli -> Config.ast0_intf_magic_number diff --git a/compiler/core/js_implementation.ml b/compiler/core/js_implementation.ml index 479860ff9cd..df6ab959d12 100644 --- a/compiler/core/js_implementation.ml +++ b/compiler/core/js_implementation.ml @@ -43,7 +43,7 @@ let after_parsing_sig ppf outputprefix ast = (* to support relocate to another directory *) ast); if !Js_config.as_pp then ( - output_string stdout Config.res_ast_intf_magic_number; + output_string stdout Config.ast_intf_magic_number; output_value stdout (!Location.input_name : string); output_value stdout ast); if !Js_config.syntax_only then Warnings.check_fatal () @@ -124,7 +124,7 @@ let after_parsing_impl ppf outputprefix (ast : Parsetree.structure) = ~output:(outputprefix ^ Literals.suffix_ast) ast); if !Js_config.as_pp then ( - output_string stdout Config.res_ast_impl_magic_number; + output_string stdout Config.ast_impl_magic_number; output_value stdout (!Location.input_name : string); output_value stdout ast); if !Js_config.syntax_only then Warnings.check_fatal () diff --git a/compiler/ext/config.ml b/compiler/ext/config.ml index 05da6896088..5dd67831b18 100644 --- a/compiler/ext/config.ml +++ b/compiler/ext/config.ml @@ -1,17 +1,17 @@ let cmi_magic_number = "Caml1999I022" -and ast_impl_magic_number = "Caml1999M022" +(* Magic numbers for marshaled values of the *current* parsetree, whose layout + changes across compiler versions. *) +and ast_impl_magic_number = "ResImpl01300" -and ast_intf_magic_number = "Caml1999N022" +and ast_intf_magic_number = "ResIntf01300" -(* Magic numbers for marshaled values of the *current* parsetree, whose layout - changes across compiler versions. The [ast_impl_magic_number] / - [ast_intf_magic_number] pair above identifies the frozen Parsetree0 (OCaml - 4.06) layout used on the external-PPX wire and must never be written in - front of a current-parsetree value. *) -and res_ast_impl_magic_number = "ResImpl01300" +(* Magic numbers of the frozen Parsetree0 (OCaml 4.06) layout used on the + external-PPX wire. They must never be written in front of a + current-parsetree value. *) +and ast0_impl_magic_number = "Caml1999M022" -and res_ast_intf_magic_number = "ResIntf01300" +and ast0_intf_magic_number = "Caml1999N022" and cmt_magic_number = "Caml1999T022" diff --git a/compiler/ext/config.mli b/compiler/ext/config.mli index 6c85b26884d..e96ab299ff4 100644 --- a/compiler/ext/config.mli +++ b/compiler/ext/config.mli @@ -19,22 +19,23 @@ val load_path : string list ref val cmi_magic_number : string - (* Magic number for compiled interface files *) -val ast_intf_magic_number : string - -(* Magic number for file holding an interface syntax tree *) -val ast_impl_magic_number : string - -(* Magic number for file holding an implementation syntax tree *) -val res_ast_intf_magic_number : string +val ast_intf_magic_number : string (* Magic number for a marshaled current-parsetree signature (layout changes across compiler versions; distinct from the frozen Parsetree0 wire format) *) -val res_ast_impl_magic_number : string +val ast_impl_magic_number : string (* Magic number for a marshaled current-parsetree structure (layout changes across compiler versions; distinct from the frozen Parsetree0 wire format) *) +val ast0_intf_magic_number : string +(* Magic number for a frozen Parsetree0 (OCaml 4.06) interface syntax tree, as + used on the external-PPX wire *) + +val ast0_impl_magic_number : string +(* Magic number for a frozen Parsetree0 (OCaml 4.06) implementation syntax + tree, as used on the external-PPX wire *) + val cmt_magic_number : string (* Magic number for compiled interface files *) diff --git a/compiler/ml/ast_mapper.ml b/compiler/ml/ast_mapper.ml index a07a7cfdd74..5ec5c766030 100644 --- a/compiler/ml/ast_mapper.ml +++ b/compiler/ml/ast_mapper.ml @@ -744,7 +744,7 @@ let apply_lazy ~source ~target mapper = let ic = open_in_bin source in let magic = - really_input_string ic (String.length Config.res_ast_impl_magic_number) + really_input_string ic (String.length Config.ast_impl_magic_number) in let rewrite transform = @@ -762,9 +762,9 @@ let apply_lazy ~source ~target mapper = failwith "Ast_mapper: OCaml version mismatch or malformed input" in - if magic = Config.res_ast_impl_magic_number then + if magic = Config.ast_impl_magic_number then rewrite (implem : structure -> structure) - else if magic = Config.res_ast_intf_magic_number then + else if magic = Config.ast_intf_magic_number then rewrite (iface : signature -> signature) else fail () diff --git a/compiler/syntax/src/res_driver_binary.ml b/compiler/syntax/src/res_driver_binary.ml index 55fa069f510..b6c9318d5cc 100644 --- a/compiler/syntax/src/res_driver_binary.ml +++ b/compiler/syntax/src/res_driver_binary.ml @@ -3,22 +3,22 @@ let print_engine = { print_implementation = (fun ~width:_ ~filename ~comments:_ structure -> - output_string stdout Config.res_ast_impl_magic_number; + output_string stdout Config.ast_impl_magic_number; output_value stdout filename; output_value stdout structure); print_implementation_from_source = (fun ~width:_ ~source:_ ~comments:_ structure -> - output_string stdout Config.res_ast_impl_magic_number; + output_string stdout Config.ast_impl_magic_number; output_value stdout "source"; output_value stdout structure); print_interface = (fun ~width:_ ~filename ~comments:_ signature -> - output_string stdout Config.res_ast_intf_magic_number; + output_string stdout Config.ast_intf_magic_number; output_value stdout filename; output_value stdout signature); print_interface_from_source = (fun ~width:_ ~source:_ ~comments:_ signature -> - output_string stdout Config.res_ast_intf_magic_number; + output_string stdout Config.ast_intf_magic_number; output_value stdout "source"; output_value stdout signature); } diff --git a/tools/bin/main.ml b/tools/bin/main.ml index bf4df8cecd4..0028d802563 100644 --- a/tools/bin/main.ml +++ b/tools/bin/main.ml @@ -224,7 +224,7 @@ let main () = | ["ppx"; file_in; file_out] -> let ic = open_in_bin file_in in let magic = - really_input_string ic (String.length Config.ast_impl_magic_number) + really_input_string ic (String.length Config.ast0_impl_magic_number) in let loc = input_value ic in let ast0 : Parsetree0.structure = input_value ic in