From 990079f7a43ece9589ea201c5afd28601073cb87 Mon Sep 17 00:00:00 2001 From: Patrick Ferris Date: Fri, 30 Aug 2024 11:41:45 +0100 Subject: [PATCH 1/7] Refactor ast_builder to add documentation comments Signed-off-by: Patrick Ferris --- src/ast_builder_intf.ml | 6 +- src/gen/gen_ast_builder.ml | 121 +++++++++++++++++++++++++++++++------ src/gen/import.ml | 9 +++ 3 files changed, 114 insertions(+), 22 deletions(-) diff --git a/src/ast_builder_intf.ml b/src/ast_builder_intf.ml index ef3bfaed4..0f7e46f3b 100644 --- a/src/ast_builder_intf.ml +++ b/src/ast_builder_intf.ml @@ -142,10 +142,6 @@ type 'a with_location = loc:Location.t -> 'a module type S = sig module Located : Located with type 'a with_loc := 'a without_location - - include module type of Ast_builder_generated.Make (struct - let loc = Location.none - end) - + include Ast_builder_generated.Intf_located include Additional_helpers with type 'a with_loc := 'a without_location end diff --git a/src/gen/gen_ast_builder.ml b/src/gen/gen_ast_builder.ml index 440ee1820..c57fdd141 100644 --- a/src/gen/gen_ast_builder.ml +++ b/src/gen/gen_ast_builder.ml @@ -11,8 +11,27 @@ end) = struct open Fixed_loc + let core_type_of_return_type (typ : type_declaration) = + let typ_name = typ.ptype_name.txt in + let typ_name = + match List.rev (String.split_on_char ~sep:'_' typ_name) with + | "desc" :: _ -> + String.sub ~pos:0 ~len:(String.length typ_name - 5) typ_name + | _ -> typ_name + in + match typ.ptype_params with + | [] -> M.ctyp "%s" typ_name + | params -> + let params = + List.fold_left params ~init:"" ~f:(fun acc (ctyp, _) -> + Format.asprintf "%a" A.ctyp ctyp ^ ", " ^ acc) + in + let params = String.sub params ~pos:0 ~len:(String.length params - 2) in + M.ctyp "(%s) %s" params typ_name + let gen_combinator_for_constructor - ~wrapper:(wpath, wprefix, has_attrs, has_loc_stack) path ~prefix cd = + ~wrapper:(wpath, wprefix, has_attrs, has_loc_stack) path ~prefix + return_type cd = match cd.pcd_args with | Pcstr_record _ -> (* TODO. *) @@ -66,31 +85,53 @@ struct let body = if fixed_loc then body else M.expr "fun ~loc -> %a" A.expr body in - M.stri "let %a = %a" A.patt - (pvar (function_name_of_id ~prefix cd.pcd_name.txt)) - A.expr body + let str = + M.stri "let %a = %a" A.patt + (pvar (function_name_of_id ~prefix cd.pcd_name.txt)) + A.expr body + in + let typ = + List.fold_right cd_args ~init:(core_type_of_return_type return_type) + ~f:(fun cty acc -> M.ctyp "%a -> %a" A.ctyp cty A.ctyp acc) + in + let typ = + if fixed_loc then typ else M.ctyp "loc:Location.t -> %a" A.ctyp typ + in + let doc_comment = + Format.asprintf "[%s] constructs an AST node for {! Parsetree.%s}" + (function_name_of_id ~prefix cd.pcd_name.txt) + cd.pcd_name.txt + in + let sign = + M.sigi "val %a : %a (** %s *)" A.patt + (pvar (function_name_of_id ~prefix cd.pcd_name.txt)) + A.ctyp typ doc_comment + in + (str, sign) - let gen_combinator_for_record path ~prefix lds = + let gen_combinator_for_record path ~prefix return_type lds = let fields = List.map lds ~f:(fun ld -> fqn_longident path ld.pld_name.txt) in let funcs = List.map lds ~f:(fun ld -> - map_keyword (without_prefix ~prefix ld.pld_name.txt)) + (ld.pld_type, map_keyword (without_prefix ~prefix ld.pld_name.txt))) in let body = Exp.record - (List.map2 fields funcs ~f:(fun field func -> + (List.map2 fields funcs ~f:(fun field (_, func) -> ( Loc.mk field, if func = "attributes" then M.expr "[]" else evar func ))) None in let body = - let l = List.filter funcs ~f:(fun f -> f <> "loc" && f <> "attributes") in + let l = + List.filter funcs ~f:(fun (_, f) -> f <> "loc" && f <> "attributes") + in match l with - | [ x ] -> Exp.fun_ Nolabel None (pvar x) body + | [ (_, x) ] -> Exp.fun_ Nolabel None (pvar x) body | _ -> - List.fold_right l ~init:body ~f:(fun func acc -> + List.fold_right l ~init:body ~f:(fun (_, func) acc -> Exp.fun_ (Labelled func) None (pvar func) acc) in (* let body = @@ -100,11 +141,35 @@ struct body in*) let body = - if List.mem "loc" ~set:funcs && not fixed_loc then + if List.mem "loc" ~set:(List.map ~f:snd funcs) && not fixed_loc then M.expr "fun ~loc -> %a" A.expr body else body in - M.stri "let %a = %a" A.patt (pvar (function_name_of_path path)) A.expr body + let return_type = core_type_of_return_type return_type in + let typ = + let l = + List.filter funcs ~f:(fun (_, f) -> f <> "loc" && f <> "attributes") + in + match l with + | [ (c, _) ] -> M.ctyp "%a -> %a" A.ctyp c A.ctyp return_type + | _ -> + List.fold_right l ~init:return_type ~f:(fun (typ, func) acc -> + M.ctyp "%s:%a -> %a" func A.ctyp typ A.ctyp acc) + in + let typ = + if List.mem "loc" ~set:(List.map ~f:snd funcs) && not fixed_loc then + M.ctyp "loc:Location.t -> %a" A.ctyp typ + else typ + in + let str = + M.stri "let %a = %a" A.patt + (pvar (function_name_of_path path)) + A.expr body + in + let sign = + M.sigi "val %a : %a" A.patt (pvar (function_name_of_path path)) A.ctyp typ + in + (str, sign) let gen_td ?wrapper path td = if is_loc path then [] @@ -117,11 +182,11 @@ struct let prefix = common_prefix (List.map cds ~f:(fun cd -> cd.pcd_name.txt)) in - List.map cds ~f:(fun cd -> - gen_combinator_for_constructor ~wrapper path ~prefix cd)) + List.map cds + ~f:(gen_combinator_for_constructor ~wrapper path ~prefix td)) | Ptype_record lds -> let prefix = prefix_of_record lds in - [ gen_combinator_for_record path ~prefix lds ] + [ gen_combinator_for_record path ~prefix td lds ] | Ptype_abstract | Ptype_open -> [] end @@ -196,10 +261,30 @@ let generate filename = path' td') |> List.flatten in + let mod_items b = items b |> List.map ~f:fst in + let mod_sig_items b = items b |> List.map ~f:snd in + let mk_intf ~name located = + let ident : label with_loc = { txt = name; loc } in + let longident = { txt = Lident name; loc } in + let items = + if located then M.sigi "val loc : Location.t" :: mod_sig_items located + else mod_sig_items located + in + let intf = Str.modtype (Mtd.mk ~typ:(Mty.signature items) ident) in + (longident, intf) + in + let intf_name, intf = mk_intf ~name:"Intf" false in + let intf_located_name, intf_located = mk_intf ~name:"Intf_located" true in let st = [ Str.open_ (Opn.mk (Mod.ident (Loc.lident "Import"))); - Str.module_ (Mb.mk (Loc.mk (Some "M")) (Mod.structure (items false))); + intf; + intf_located; + Str.module_ + (Mb.mk (Loc.mk (Some "M")) + (Mod.constraint_ + (Mod.structure (mod_items false)) + (Mty.ident intf_name))); Str.module_ (Mb.mk (Loc.mk (Some "Make")) (Mod.functor_ @@ -208,7 +293,9 @@ let generate filename = Mty.signature [ Sig.value (Val.mk (Loc.mk "loc") (M.ctyp "Location.t")) ] )) - (Mod.structure (M.stri "let loc = Loc.loc" :: items true)))); + (Mod.constraint_ + (Mod.structure (M.stri "let loc = Loc.loc" :: mod_items true)) + (Mty.ident intf_located_name)))); ] in dump "ast_builder_generated" Pprintast.structure st ~ext:".ml" diff --git a/src/gen/import.ml b/src/gen/import.ml index 544d95826..23ef1b8c2 100644 --- a/src/gen/import.ml +++ b/src/gen/import.ml @@ -120,6 +120,7 @@ module M = struct let patt fmt = parse Parse.pattern fmt let ctyp fmt = parse Parse.core_type fmt let str fmt = parse Parse.implementation fmt + let sign fmt = parse Parse.interface fmt let stri fmt = Format.kasprintf @@ -128,6 +129,14 @@ module M = struct | [ x ] -> x | _ -> assert false) fmt + + let sigi fmt = + Format.kasprintf + (fun s -> + match Parse.interface (Lexing.from_string s) with + | [ x ] -> x + | _ -> assert false) + fmt end (* Antiquotations *) From f5620762376aaaafc3bea7db8933d58d85d6b9cb Mon Sep 17 00:00:00 2001 From: Patrick Ferris Date: Fri, 30 Aug 2024 15:29:49 +0100 Subject: [PATCH 2/7] Add sections and parsetree docs to ast_builder Signed-off-by: Patrick Ferris --- src/gen/gen_ast_builder.ml | 89 +++++++++++++++++++++++++++++++------- 1 file changed, 73 insertions(+), 16 deletions(-) diff --git a/src/gen/gen_ast_builder.ml b/src/gen/gen_ast_builder.ml index c57fdd141..102820d87 100644 --- a/src/gen/gen_ast_builder.ml +++ b/src/gen/gen_ast_builder.ml @@ -1,6 +1,43 @@ open Import open Ast_helper open Printf +module Section_map = String.Map + +let section_map_of_assoc items = + List.fold_left + ~f:(fun acc (name, v) -> + match Section_map.find_opt name acc with + | None -> Section_map.add name [ v ] acc + | Some vs -> Section_map.add name (v :: vs) acc) + ~init:Section_map.empty items + +let doc_comment_from_attribue (attr : attribute) = + match attr.attr_name.txt with + | "ocaml.doc" -> ( + match attr.attr_payload with + | PStr + [ + { + pstr_desc = + Pstr_eval + ({ pexp_desc = Pexp_constant (Pconst_string (s, _, _)); _ }, _); + _; + }; + ] -> + Some s + | _ -> None) + | _ -> None + +let doc_comment ~node_name ~function_name attributes = + let parsetree_comment = + List.find_map ~f:doc_comment_from_attribue attributes + in + let pp_parsetree_comment ppf = function + | None -> () + | Some pc -> Format.fprintf ppf "{b Example OCaml}\n\n%s" pc + in + Format.asprintf "[%s] constructs an {! Ast.%s}\n\n%a" function_name node_name + pp_parsetree_comment parsetree_comment let prefix_of_record lds = common_prefix (List.map lds ~f:(fun ld -> ld.pld_name.txt)) @@ -90,26 +127,26 @@ struct (pvar (function_name_of_id ~prefix cd.pcd_name.txt)) A.expr body in + let return_type = core_type_of_return_type return_type in let typ = - List.fold_right cd_args ~init:(core_type_of_return_type return_type) - ~f:(fun cty acc -> M.ctyp "%a -> %a" A.ctyp cty A.ctyp acc) + List.fold_right cd_args ~init:return_type ~f:(fun cty acc -> + M.ctyp "%a -> %a" A.ctyp cty A.ctyp acc) in let typ = if fixed_loc then typ else M.ctyp "loc:Location.t -> %a" A.ctyp typ in - let doc_comment = - Format.asprintf "[%s] constructs an AST node for {! Parsetree.%s}" - (function_name_of_id ~prefix cd.pcd_name.txt) - cd.pcd_name.txt - in + let sign = M.sigi "val %a : %a (** %s *)" A.patt (pvar (function_name_of_id ~prefix cd.pcd_name.txt)) - A.ctyp typ doc_comment + A.ctyp typ + (doc_comment + ~function_name:(function_name_of_id ~prefix cd.pcd_name.txt) + ~node_name:cd.pcd_name.txt cd.pcd_attributes) in - (str, sign) + (str, (Format.asprintf "%a" A.ctyp return_type, sign)) - let gen_combinator_for_record path ~prefix return_type lds = + let gen_combinator_for_record path ~prefix return_type attrs lds = let fields = List.map lds ~f:(fun ld -> fqn_longident path ld.pld_name.txt) in @@ -167,9 +204,15 @@ struct A.expr body in let sign = - M.sigi "val %a : %a" A.patt (pvar (function_name_of_path path)) A.ctyp typ + M.sigi "val %a : %a (** %s *)" A.patt + (pvar (function_name_of_path path)) + A.ctyp typ + (doc_comment + ~function_name:(function_name_of_path path) + ~node_name:(Format.asprintf "%a" A.ctyp return_type) + attrs) in - (str, sign) + (str, (Format.asprintf "%a" A.ctyp return_type, sign)) let gen_td ?wrapper path td = if is_loc path then [] @@ -186,7 +229,7 @@ struct ~f:(gen_combinator_for_constructor ~wrapper path ~prefix td)) | Ptype_record lds -> let prefix = prefix_of_record lds in - [ gen_combinator_for_record path ~prefix td lds ] + [ gen_combinator_for_record path ~prefix td td.ptype_attributes lds ] | Ptype_abstract | Ptype_open -> [] end @@ -262,13 +305,27 @@ let generate filename = |> List.flatten in let mod_items b = items b |> List.map ~f:fst in - let mod_sig_items b = items b |> List.map ~f:snd in + let mod_sig_items b = items b |> List.map ~f:snd |> section_map_of_assoc in let mk_intf ~name located = let ident : label with_loc = { txt = name; loc } in let longident = { txt = Lident name; loc } in + let documented_items = + Section_map.fold + (fun label items acc -> + let label = + match String.split_on_char ~sep:'_' label with + | [] -> assert false + | l :: rest -> + let bs = Bytes.of_string l in + Bytes.set bs 0 (Char.uppercase_ascii @@ Bytes.get bs 0); + String.concat ~sep:" " (Bytes.to_string bs :: rest) + in + (M.sigi "(** {2 %s} *)" label :: items) @ acc) + (mod_sig_items located) [] + in let items = - if located then M.sigi "val loc : Location.t" :: mod_sig_items located - else mod_sig_items located + if located then M.sigi "val loc : Location.t" :: documented_items + else documented_items in let intf = Str.modtype (Mtd.mk ~typ:(Mty.signature items) ident) in (longident, intf) From b6c90088b9faeb252687c2a7321387b7566fd078 Mon Sep 17 00:00:00 2001 From: Patrick Ferris Date: Sat, 31 Aug 2024 10:53:22 +0100 Subject: [PATCH 3/7] Explicitly construct ast_builder floating comments Signed-off-by: Patrick Ferris --- src/gen/gen_ast_builder.ml | 22 +++++++++++++++++++++- src/gen/import.ml | 2 +- 2 files changed, 22 insertions(+), 2 deletions(-) diff --git a/src/gen/gen_ast_builder.ml b/src/gen/gen_ast_builder.ml index 102820d87..2397a2449 100644 --- a/src/gen/gen_ast_builder.ml +++ b/src/gen/gen_ast_builder.ml @@ -248,6 +248,26 @@ let dump fn ~ext printer x = Format.fprintf ppf "%a@." printer x; close_out oc +let floating_comment s = + let doc = + PStr + [ + { + pstr_desc = + Pstr_eval + ( { + pexp_desc = Pexp_constant (Pconst_string (s, loc, None)); + pexp_loc = loc; + pexp_loc_stack = []; + pexp_attributes = []; + }, + [] ); + pstr_loc = loc; + }; + ] + in + Sig.attribute (Attr.mk { txt = "ocaml.text"; loc } doc) + let generate filename = (* let fn = Misc.find_in_path_uncap !Config.load_path (unit ^ ".cmi") in*) let types = get_types ~filename in @@ -320,7 +340,7 @@ let generate filename = Bytes.set bs 0 (Char.uppercase_ascii @@ Bytes.get bs 0); String.concat ~sep:" " (Bytes.to_string bs :: rest) in - (M.sigi "(** {2 %s} *)" label :: items) @ acc) + (floating_comment (Format.asprintf "{2 %s}" label) :: items) @ acc) (mod_sig_items located) [] in let items = diff --git a/src/gen/import.ml b/src/gen/import.ml index 23ef1b8c2..5dea6d5d7 100644 --- a/src/gen/import.ml +++ b/src/gen/import.ml @@ -135,7 +135,7 @@ module M = struct (fun s -> match Parse.interface (Lexing.from_string s) with | [ x ] -> x - | _ -> assert false) + | _ -> failwith ("Failed to parse: " ^ s)) fmt end From 8c3bcea9b2ba70b6b4fc88a78dcb83ce1f580e4d Mon Sep 17 00:00:00 2001 From: Patrick Ferris Date: Sat, 31 Aug 2024 11:47:51 +0100 Subject: [PATCH 4/7] Changelog entry Signed-off-by: Patrick Ferris --- CHANGES.md | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 7fab6ae55..85bc97894 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -14,9 +14,6 @@ details. ### Other changes -- Support class type declarations in derivers with the new, optional arguments - `{str,sig}_class_type_decl` in `Deriving.add` (#538, @patricoferris) - - Fix `deriving_inline` round-trip check so that it works with 5.01 <-> 5.02 migrations (#519, @NathanReb) @@ -28,6 +25,11 @@ details. to what the compiler's `-dparsetree` is. (#530, @NathanReb) +- Add Parsetree documentation comments to `Ast_builder` functions (#518, @patricoferris) + +- Support class type declarations in derivers with the new, optional arguments + `{str,sig}_class_type_decl` in `Deriving.add` (#538, @patricoferris) + 0.33.0 (2024-07-22) ------------------- From cb22c1ced5f72402a8c5fc118bc195216e3b5aef Mon Sep 17 00:00:00 2001 From: Patrick Ferris Date: Tue, 3 Sep 2024 16:38:15 +0200 Subject: [PATCH 5/7] Simplify type variable reconstruction Signed-off-by: Patrick Ferris Co-authored-by: Nathan Rebours --- src/gen/gen_ast_builder.ml | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/gen/gen_ast_builder.ml b/src/gen/gen_ast_builder.ml index 2397a2449..5c2678a32 100644 --- a/src/gen/gen_ast_builder.ml +++ b/src/gen/gen_ast_builder.ml @@ -60,11 +60,9 @@ struct | [] -> M.ctyp "%s" typ_name | params -> let params = - List.fold_left params ~init:"" ~f:(fun acc (ctyp, _) -> - Format.asprintf "%a" A.ctyp ctyp ^ ", " ^ acc) + List.map params ~f:(fun (ctyp, _) -> Format.asprintf "%a" A.ctyp ctyp) in - let params = String.sub params ~pos:0 ~len:(String.length params - 2) in - M.ctyp "(%s) %s" params typ_name + M.ctyp "(%s) %s" (String.concat ~sep:", " params) typ_name let gen_combinator_for_constructor ~wrapper:(wpath, wprefix, has_attrs, has_loc_stack) path ~prefix From c29c2210c6072cc151812f1cda01646734678a5f Mon Sep 17 00:00:00 2001 From: Patrick Ferris Date: Tue, 3 Sep 2024 16:45:29 +0200 Subject: [PATCH 6/7] Only pass type declaration once to gen_combinator_for_record Signed-off-by: Patrick Ferris Co-authored-by: Nathan Rebours --- src/gen/gen_ast_builder.ml | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/gen/gen_ast_builder.ml b/src/gen/gen_ast_builder.ml index 5c2678a32..519931da4 100644 --- a/src/gen/gen_ast_builder.ml +++ b/src/gen/gen_ast_builder.ml @@ -144,7 +144,7 @@ struct in (str, (Format.asprintf "%a" A.ctyp return_type, sign)) - let gen_combinator_for_record path ~prefix return_type attrs lds = + let gen_combinator_for_record path ~prefix return_type lds = let fields = List.map lds ~f:(fun ld -> fqn_longident path ld.pld_name.txt) in @@ -180,15 +180,15 @@ struct M.expr "fun ~loc -> %a" A.expr body else body in - let return_type = core_type_of_return_type return_type in + let return_ctyp = core_type_of_return_type return_type in let typ = let l = List.filter funcs ~f:(fun (_, f) -> f <> "loc" && f <> "attributes") in match l with - | [ (c, _) ] -> M.ctyp "%a -> %a" A.ctyp c A.ctyp return_type + | [ (c, _) ] -> M.ctyp "%a -> %a" A.ctyp c A.ctyp return_ctyp | _ -> - List.fold_right l ~init:return_type ~f:(fun (typ, func) acc -> + List.fold_right l ~init:return_ctyp ~f:(fun (typ, func) acc -> M.ctyp "%s:%a -> %a" func A.ctyp typ A.ctyp acc) in let typ = @@ -207,10 +207,10 @@ struct A.ctyp typ (doc_comment ~function_name:(function_name_of_path path) - ~node_name:(Format.asprintf "%a" A.ctyp return_type) - attrs) + ~node_name:(Format.asprintf "%a" A.ctyp return_ctyp) + return_type.ptype_attributes) in - (str, (Format.asprintf "%a" A.ctyp return_type, sign)) + (str, (Format.asprintf "%a" A.ctyp return_ctyp, sign)) let gen_td ?wrapper path td = if is_loc path then [] @@ -227,7 +227,7 @@ struct ~f:(gen_combinator_for_constructor ~wrapper path ~prefix td)) | Ptype_record lds -> let prefix = prefix_of_record lds in - [ gen_combinator_for_record path ~prefix td td.ptype_attributes lds ] + [ gen_combinator_for_record path ~prefix td lds ] | Ptype_abstract | Ptype_open -> [] end From 0710e7b309f00208b0d057f21268bdcc669b3298 Mon Sep 17 00:00:00 2001 From: Patrick Ferris Date: Tue, 3 Sep 2024 16:56:18 +0200 Subject: [PATCH 7/7] Avoid duplication in gen_ast_builder Signed-off-by: Patrick Ferris Co-authored-by: Nathan Rebours --- src/gen/gen_ast_builder.ml | 37 ++++++++++++++----------------------- 1 file changed, 14 insertions(+), 23 deletions(-) diff --git a/src/gen/gen_ast_builder.ml b/src/gen/gen_ast_builder.ml index 519931da4..2275a61d2 100644 --- a/src/gen/gen_ast_builder.ml +++ b/src/gen/gen_ast_builder.ml @@ -120,11 +120,9 @@ struct let body = if fixed_loc then body else M.expr "fun ~loc -> %a" A.expr body in - let str = - M.stri "let %a = %a" A.patt - (pvar (function_name_of_id ~prefix cd.pcd_name.txt)) - A.expr body - in + let function_name = function_name_of_id ~prefix cd.pcd_name.txt in + let pvar_function_name = pvar function_name in + let str = M.stri "let %a = %a" A.patt pvar_function_name A.expr body in let return_type = core_type_of_return_type return_type in let typ = List.fold_right cd_args ~init:return_type ~f:(fun cty acc -> @@ -133,14 +131,10 @@ struct let typ = if fixed_loc then typ else M.ctyp "loc:Location.t -> %a" A.ctyp typ in - let sign = - M.sigi "val %a : %a (** %s *)" A.patt - (pvar (function_name_of_id ~prefix cd.pcd_name.txt)) - A.ctyp typ - (doc_comment - ~function_name:(function_name_of_id ~prefix cd.pcd_name.txt) - ~node_name:cd.pcd_name.txt cd.pcd_attributes) + M.sigi "val %a : %a (** %s *)" A.patt pvar_function_name A.ctyp typ + (doc_comment ~function_name ~node_name:cd.pcd_name.txt + cd.pcd_attributes) in (str, (Format.asprintf "%a" A.ctyp return_type, sign)) @@ -175,9 +169,11 @@ struct else body in*) + let has_loc_field = + List.exists ~f:(function _, "loc" -> true | _ -> false) funcs + in let body = - if List.mem "loc" ~set:(List.map ~f:snd funcs) && not fixed_loc then - M.expr "fun ~loc -> %a" A.expr body + if has_loc_field && not fixed_loc then M.expr "fun ~loc -> %a" A.expr body else body in let return_ctyp = core_type_of_return_type return_type in @@ -192,19 +188,14 @@ struct M.ctyp "%s:%a -> %a" func A.ctyp typ A.ctyp acc) in let typ = - if List.mem "loc" ~set:(List.map ~f:snd funcs) && not fixed_loc then + if has_loc_field && not fixed_loc then M.ctyp "loc:Location.t -> %a" A.ctyp typ else typ in - let str = - M.stri "let %a = %a" A.patt - (pvar (function_name_of_path path)) - A.expr body - in + let pvar_function_name = pvar (function_name_of_path path) in + let str = M.stri "let %a = %a" A.patt pvar_function_name A.expr body in let sign = - M.sigi "val %a : %a (** %s *)" A.patt - (pvar (function_name_of_path path)) - A.ctyp typ + M.sigi "val %a : %a (** %s *)" A.patt pvar_function_name A.ctyp typ (doc_comment ~function_name:(function_name_of_path path) ~node_name:(Format.asprintf "%a" A.ctyp return_ctyp)