From a87483146f930bfb2680b65012dd5e394daffb95 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Tue, 8 Apr 2025 09:57:31 +0200 Subject: [PATCH] See how far an agent gets when asked to add module await ast. --- compiler/ml/ast_helper.ml | 1 + compiler/ml/ast_mapper.ml | 4 ++ compiler/ml/ast_mapper_from0.ml | 87 +++++++++++++++++++++++++++------ compiler/ml/ast_mapper_to0.ml | 20 ++------ compiler/ml/parsetree.ml | 1 + compiler/ml/parsetree0.ml | 1 + compiler/ml/printast.ml | 3 ++ compiler/syntax/src/res_core.ml | 15 ++++-- 8 files changed, 97 insertions(+), 35 deletions(-) diff --git a/compiler/ml/ast_helper.ml b/compiler/ml/ast_helper.ml index d4de7ff0e9..75d304e0d8 100644 --- a/compiler/ml/ast_helper.ml +++ b/compiler/ml/ast_helper.ml @@ -262,6 +262,7 @@ module Mod = struct let apply ?loc ?attrs m1 m2 = mk ?loc ?attrs (Pmod_apply (m1, m2)) let constraint_ ?loc ?attrs m mty = mk ?loc ?attrs (Pmod_constraint (m, mty)) let unpack ?loc ?attrs e = mk ?loc ?attrs (Pmod_unpack e) + let await ?loc ?attrs m = mk ?loc ?attrs (Pmod_await m) let extension ?loc ?attrs a = mk ?loc ?attrs (Pmod_extension a) end diff --git a/compiler/ml/ast_mapper.ml b/compiler/ml/ast_mapper.ml index 992d1a9816..f4d7e6aed3 100644 --- a/compiler/ml/ast_mapper.ml +++ b/compiler/ml/ast_mapper.ml @@ -239,6 +239,10 @@ module M = struct | Pmod_constraint (m, mty) -> constraint_ ~loc ~attrs (sub.module_expr sub m) (sub.module_type sub mty) | Pmod_unpack e -> unpack ~loc ~attrs (sub.expr sub e) + | Pmod_await m -> + { pmod_desc = Pmod_await (sub.module_expr sub m); + pmod_loc = sub.location sub loc; + pmod_attributes = sub.attributes sub attrs } | Pmod_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_structure_item sub {pstr_loc = loc; pstr_desc = desc} = diff --git a/compiler/ml/ast_mapper_from0.ml b/compiler/ml/ast_mapper_from0.ml index 2b09726757..1001c9b3d1 100644 --- a/compiler/ml/ast_mapper_from0.ml +++ b/compiler/ml/ast_mapper_from0.ml @@ -250,23 +250,82 @@ end module M = struct (* Value expressions for the module language *) - let map sub {pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} = - let open Mod in + let rec map sub ({Parsetree0.pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} : Parsetree0.module_expr) = let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in + let has_await_attribute = + List.exists (fun (attr : Parsetree.attribute) -> + match attr with + | ({Location.txt = "res.await"}, _) -> true + | _ -> false + ) attrs + in + let attrs_without_await = + List.filter (fun (attr : Parsetree.attribute) -> + match attr with + | ({Location.txt = "res.await"}, _) -> false + | _ -> true + ) attrs + in match desc with - | Pmod_ident x -> ident ~loc ~attrs (map_loc sub x) - | Pmod_structure str -> structure ~loc ~attrs (sub.structure sub str) - | Pmod_functor (arg, arg_ty, body) -> - functor_ ~loc ~attrs (map_loc sub arg) - (Misc.may_map (sub.module_type sub) arg_ty) - (sub.module_expr sub body) - | Pmod_apply (m1, m2) -> - apply ~loc ~attrs (sub.module_expr sub m1) (sub.module_expr sub m2) - | Pmod_constraint (m, mty) -> - constraint_ ~loc ~attrs (sub.module_expr sub m) (sub.module_type sub mty) - | Pmod_unpack e -> unpack ~loc ~attrs (sub.expr sub e) - | Pmod_extension x -> extension ~loc ~attrs (sub.extension sub x) + | Parsetree0.Pmod_ident x when has_await_attribute -> + let inner_mod = { + Parsetree.pmod_loc = loc; + pmod_desc = Parsetree.Pmod_ident (map_loc sub x); + pmod_attributes = [] + } in + { + Parsetree.pmod_loc = loc; + pmod_desc = Parsetree.Pmod_await inner_mod; + pmod_attributes = attrs_without_await + } + | Parsetree0.Pmod_ident x -> + { + Parsetree.pmod_loc = loc; + pmod_desc = Parsetree.Pmod_ident (map_loc sub x); + pmod_attributes = attrs + } + | Parsetree0.Pmod_structure s -> + { + Parsetree.pmod_loc = loc; + pmod_desc = Parsetree.Pmod_structure (sub.structure sub s); + pmod_attributes = attrs + } + | Parsetree0.Pmod_functor (arg, arg_type, body) -> + { + Parsetree.pmod_loc = loc; + pmod_desc = Parsetree.Pmod_functor ( + map_loc sub arg, + Option.map (sub.module_type sub) arg_type, + map sub body + ); + pmod_attributes = attrs + } + | Parsetree0.Pmod_apply (me1, me2) -> + { + Parsetree.pmod_loc = loc; + pmod_desc = Parsetree.Pmod_apply (map sub me1, map sub me2); + pmod_attributes = attrs + } + | Parsetree0.Pmod_constraint (me, mt) -> + { + Parsetree.pmod_loc = loc; + pmod_desc = Parsetree.Pmod_constraint (map sub me, sub.module_type sub mt); + pmod_attributes = attrs + } + | Parsetree0.Pmod_unpack e -> + { + Parsetree.pmod_loc = loc; + pmod_desc = Parsetree.Pmod_unpack (sub.expr sub e); + pmod_attributes = attrs + } + | Parsetree0.Pmod_extension x -> + { + Parsetree.pmod_loc = loc; + pmod_desc = Parsetree.Pmod_extension (sub.extension sub x); + pmod_attributes = attrs + } + | _ -> assert false let map_structure_item sub {pstr_loc = loc; pstr_desc = desc} = let open Str in diff --git a/compiler/ml/ast_mapper_to0.ml b/compiler/ml/ast_mapper_to0.ml index 0f5494bb23..f19e3ac6f7 100644 --- a/compiler/ml/ast_mapper_to0.ml +++ b/compiler/ml/ast_mapper_to0.ml @@ -257,6 +257,10 @@ module M = struct | Pmod_constraint (m, mty) -> constraint_ ~loc ~attrs (sub.module_expr sub m) (sub.module_type sub mty) | Pmod_unpack e -> unpack ~loc ~attrs (sub.expr sub e) + | Pmod_await m -> + let m1 = sub.module_expr sub m in + let attrs = (Location.mknoloc "res.await", PStr []) :: attrs in + ident ~loc ~attrs (Location.mknoloc (Longident.Lident "Await")) | Pmod_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_structure_item sub {pstr_loc = loc; pstr_desc = desc} = @@ -517,22 +521,6 @@ module E = struct (Asttypes.Noloc.Labelled "children", children_expr); (Asttypes.Noloc.Nolabel, unit_expr); ]) - | Pexp_jsx_element - (Jsx_container_element - { - jsx_container_element_tag_name_start = tag_name; - jsx_container_element_props = props; - jsx_container_element_children = children; - }) -> - let tag_ident = map_loc sub tag_name in - let props = map_jsx_props sub props in - let children_expr = map_jsx_children sub loc children in - apply ~loc ~attrs:(jsx_attr sub :: attrs) (ident tag_ident) - (props - @ [ - (Asttypes.Noloc.Labelled "children", children_expr); - (Asttypes.Noloc.Nolabel, jsx_unit_expr); - ]) end module P = struct diff --git a/compiler/ml/parsetree.ml b/compiler/ml/parsetree.ml index 5c47210630..fbc8353f98 100644 --- a/compiler/ml/parsetree.ml +++ b/compiler/ml/parsetree.ml @@ -610,6 +610,7 @@ and module_expr_desc = | Pmod_apply of module_expr * module_expr (* ME1(ME2) *) | Pmod_constraint of module_expr * module_type (* (ME : MT) *) | Pmod_unpack of expression (* (val E) *) + | Pmod_await of module_expr (* @await M *) | Pmod_extension of extension (* [%id] *) diff --git a/compiler/ml/parsetree0.ml b/compiler/ml/parsetree0.ml index ef786dfd25..37ee962295 100644 --- a/compiler/ml/parsetree0.ml +++ b/compiler/ml/parsetree0.ml @@ -546,6 +546,7 @@ and module_expr_desc = | Pmod_apply of module_expr * module_expr (* ME1(ME2) *) | Pmod_constraint of module_expr * module_type (* (ME : MT) *) | Pmod_unpack of expression (* (val E) *) + | Pmod_await of module_expr (* @await ME *) | Pmod_extension of extension (* [%id] *) diff --git a/compiler/ml/printast.ml b/compiler/ml/printast.ml index 380939b15b..b4cba75d1e 100644 --- a/compiler/ml/printast.ml +++ b/compiler/ml/printast.ml @@ -587,6 +587,9 @@ and module_expr i ppf x = | Pmod_unpack e -> line i ppf "Pmod_unpack\n"; expression i ppf e + | Pmod_await me -> + line i ppf "Pmod_await\n"; + module_expr i ppf me | Pmod_extension (s, arg) -> line i ppf "Pmod_extension \"%s\"\n" s.txt; payload i ppf arg diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml index 03ed02f450..3cd35a2944 100644 --- a/compiler/syntax/src/res_core.ml +++ b/compiler/syntax/src/res_core.ml @@ -157,7 +157,6 @@ 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 []) let suppress_fragile_match_warning_attr = ( Location.mknoloc "warning", Parsetree.PStr @@ -6028,10 +6027,16 @@ and parse_module_expr p = if is_es6_arrow_functor p then parse_functor_module_expr p else parse_primary_mod_expr p in - { - mod_expr with - pmod_attributes = List.concat [mod_expr.pmod_attributes; attrs]; - } + let mod_expr = + if has_await then + { pmod_desc = Pmod_await mod_expr; + pmod_loc = loc_await; + pmod_attributes = attrs } + else + { mod_expr with + pmod_attributes = List.concat [mod_expr.pmod_attributes; attrs] } + in + mod_expr and parse_constrained_mod_expr p = let mod_expr = parse_module_expr p in