diff --git a/ocaml/parsing/jane_syntax_parsing.ml b/ocaml/parsing/jane_syntax_parsing.ml index 2c8c05c2d82..47e53da003b 100644 --- a/ocaml/parsing/jane_syntax_parsing.ml +++ b/ocaml/parsing/jane_syntax_parsing.ml @@ -569,18 +569,15 @@ module Make_with_extension_node (AST_syntactic_category : sig include AST_syntactic_category - (** How to construct an extension node for this AST (something of the - shape [[%name]]). Should just be [Ast_helper.CAT.extension] for the - appropriate syntactic category [CAT]. (This means that [?loc] should - default to [!Ast_helper.default_loc.].) *) - val make_extension_node : - ?loc:Location.t -> ?attrs:attributes -> extension -> ast - - (** Given an extension node (as created by [make_extension_node]) with an - appropriately-formed name and a body, combine them into the special - syntactic form we use for novel syntactic features in this syntactic - category. Partial inverse of [match_extension_use]. *) - val make_extension_use : extension_node:ast -> ast -> ast + (** Combine information about a construct into the special syntactic form + we use for novel syntactic features in this syntactic category. The + form should contain an extension_node of the shape [[%name]], + constructed by [Ast_helper.CAT.extension] for the appropriate + syntactic category [CAT], so that [?loc] defaults to + [!Ast_helper.default_loc]. + Partial inverse of [match_extension_use]. *) + val make_extension_use : + ?loc:Location.t -> ?attrs:attributes -> extension -> ast -> ast (** Given an AST node, check if it's of the special syntactic form indicating that this is one of our novel syntactic features (as @@ -597,12 +594,10 @@ module Make_with_extension_node let make_jane_syntax name ast = make_extension_use + ( { txt = Embedded_name.to_string name + ; loc = !Ast_helper.default_loc } + , PStr []) ast - ~extension_node: - (make_extension_node - ({ txt = Embedded_name.to_string name - ; loc = !Ast_helper.default_loc }, - PStr [])) let match_jane_syntax ast = match match_extension_use ast with @@ -659,8 +654,8 @@ module Expression0 = Make_with_attribute (struct let with_attributes expr pexp_attributes = { expr with pexp_attributes } end) -(** Cases; embedded using an attribute on the rhs. *) -module Case0 = Make_with_attribute (struct +(** Cases; embedded using an extension node. *) +module Case0 = Make_with_extension_node (struct type ast = case let plural = "cases" @@ -669,10 +664,15 @@ module Case0 = Make_with_attribute (struct let pc_rhs = { case.pc_rhs with pexp_loc = l } in { case with pc_rhs } - let attributes case = case.pc_rhs.pexp_attributes - let with_attributes case pexp_attributes = - let pc_rhs = { case.pc_rhs with pexp_attributes = pexp_attributes } in - { case with pc_rhs } + let make_extension_use ?loc ?attrs extension ast = + let ext = Ast_helper.Exp.extension ?loc ?attrs extension in + { ast with pc_rhs = Ast_helper.Exp.apply ext [ Nolabel, ast.pc_rhs ] } + + let match_extension_use case = + match case.pc_rhs.pexp_desc with + | Pexp_apply ({ pexp_desc = Pexp_extension ext }, [ Nolabel, pc_rhs ]) -> + Some (ext, { case with pc_rhs }) + | _ -> None end) (** Patterns; embedded using an attribute on the pattern. *) @@ -723,9 +723,8 @@ module Signature_item0 = Make_with_extension_node (struct let location sigi = sigi.psig_loc let with_location sigi l = { sigi with psig_loc = l } - let make_extension_node = Ast_helper.Sig.extension - - let make_extension_use ~extension_node sigi = + let make_extension_use ?loc ?attrs extension sigi = + let extension_node = Ast_helper.Sig.extension ?loc ?attrs extension in Ast_helper.Sig.include_ { pincl_mod = Ast_helper.Mty.signature [extension_node; sigi] ; pincl_loc = !Ast_helper.default_loc @@ -758,9 +757,8 @@ module Structure_item0 = Make_with_extension_node (struct let location stri = stri.pstr_loc let with_location stri l = { stri with pstr_loc = l } - let make_extension_node = Ast_helper.Str.extension - - let make_extension_use ~extension_node stri = + let make_extension_use ?loc ?attrs extension stri = + let extension_node = Ast_helper.Str.extension ?loc ?attrs extension in Ast_helper.Str.include_ { pincl_mod = Ast_helper.Mod.structure [extension_node; stri] ; pincl_loc = !Ast_helper.default_loc