From 0e6c6c3405525a1153505d0acb9e0b9277bfe28a Mon Sep 17 00:00:00 2001 From: Blaine Bublitz Date: Sat, 28 May 2022 18:21:19 -0700 Subject: [PATCH 1/5] chore(compiler): Add export ident to export_declarations --- compiler/src/typed/typedtree.re | 1 + compiler/src/typed/typedtree.rei | 1 + compiler/src/typed/typemod.re | 5 ++++- 3 files changed, 6 insertions(+), 1 deletion(-) diff --git a/compiler/src/typed/typedtree.re b/compiler/src/typed/typedtree.re index 15e1e21783..84b71564ef 100644 --- a/compiler/src/typed/typedtree.re +++ b/compiler/src/typed/typedtree.re @@ -509,6 +509,7 @@ type import_declaration = { [@deriving sexp] type export_declaration = { + tex_id: Ident.t, tex_path: Path.t, [@sexp_drop_if sexp_locs_disabled] tex_loc: Location.t, diff --git a/compiler/src/typed/typedtree.rei b/compiler/src/typed/typedtree.rei index bb26fec1db..9648ea3e00 100644 --- a/compiler/src/typed/typedtree.rei +++ b/compiler/src/typed/typedtree.rei @@ -472,6 +472,7 @@ type import_declaration = { [@deriving sexp] type export_declaration = { + tex_id: Ident.t, tex_path: Path.t, [@sexp_drop_if sexp_locs_disabled] tex_loc: Location.t, diff --git a/compiler/src/typed/typemod.re b/compiler/src/typed/typemod.re index fbf164313e..8c30063179 100644 --- a/compiler/src/typed/typemod.re +++ b/compiler/src/typed/typemod.re @@ -602,7 +602,10 @@ let type_module = (~toplevel=false, funct_body, anchor, env, sstr /*scope*/) => }; let name = Identifier.IdentName(name); let (p, {val_fullpath} as desc) = Env.lookup_value(name, env); - (TSigValue(id, desc), {tex_path: val_fullpath, tex_loc: loc}); + ( + TSigValue(id, desc), + {tex_id: id, tex_path: val_fullpath, tex_loc: loc}, + ); }, exports, ); From 1718d8a45cbc105cd42a12f4d878b75c6e4ce9fa Mon Sep 17 00:00:00 2001 From: Blaine Bublitz Date: Sat, 28 May 2022 18:33:39 -0700 Subject: [PATCH 2/5] fix(graindoc): Improve location lookup so re-exports do not crash it --- compiler/graindoc/docblock.re | 98 +++++++++++++++++++++++++---------- compiler/graindoc/graindoc.re | 12 ++++- 2 files changed, 81 insertions(+), 29 deletions(-) diff --git a/compiler/graindoc/docblock.re b/compiler/graindoc/docblock.re index 33848578e3..ec296bc800 100644 --- a/compiler/graindoc/docblock.re +++ b/compiler/graindoc/docblock.re @@ -32,6 +32,54 @@ let () = } }); +let enumerate_exports = stmts => { + let id_tbl = ref(Ident.empty); + + module ExportIterator = + TypedtreeIter.MakeIterator({ + include TypedtreeIter.DefaultIteratorArgument; + + let enter_toplevel_stmt = + ({ttop_desc, ttop_attributes}: Typedtree.toplevel_stmt) => { + switch (ttop_desc) { + | TTopData(decls) => + List.iter( + ({data_id, data_loc}: Typedtree.data_declaration) => { + id_tbl := Ident.add(data_id, data_loc, id_tbl^) + }, + decls, + ) + | TTopExport(decls) => + List.iter( + ({tex_id, tex_loc}: Typedtree.export_declaration) => { + id_tbl := Ident.add(tex_id, tex_loc, id_tbl^) + }, + decls, + ) + | _ => () + }; + }; + }); + + List.iter(ExportIterator.iter_toplevel_stmt, stmts); + + id_tbl^; +}; + +// TODO: This need to be fixed to not do the Env.find_value +// but I can't figure it out +let location_for_value = (~env, ~ident, ~exports, path) => + try({ + let vd = Env.find_value(path, env); + vd.val_loc; + }) { + | exn => snd(Ident.find_name(Ident.name(ident), exports)) + }; + +let location_for_type = (~env, ~exports, ident) => { + snd(Ident.find_name(Ident.name(ident), exports)); +}; + let module_name_of_location = (loc: Grain_parsing.Location.t) => { Grain_utils.Filepath.String.filename_to_module_name( loc.loc_start.pos_fname, @@ -83,12 +131,12 @@ let lookup_type_expr = (~idx, type_exprs) => { }; let for_value_description = - (~comments, ~ident: Ident.t, vd: Types.value_description) => { - let module_name = module_name_of_location(vd.val_loc); + (~comments, ~ident: Ident.t, ~loc, vd: Types.value_description) => { + let module_name = module_name_of_location(loc); let name = title_for_api(~module_name, ident); let type_sig = Printtyp.string_of_value_description(~ident, vd); let comment = - Comments.Doc.ending_on(~lnum=vd.val_loc.loc_start.pos_lnum - 1, comments); + Comments.Doc.ending_on(~lnum=loc.loc_start.pos_lnum - 1, comments); let (description, attributes) = switch (comment) { @@ -118,15 +166,12 @@ let for_value_description = }; let for_type_declaration = - (~comments, ~ident: Ident.t, td: Types.type_declaration) => { - let module_name = module_name_of_location(td.type_loc); + (~comments, ~ident: Ident.t, ~loc, td: Types.type_declaration) => { + let module_name = module_name_of_location(loc); let name = title_for_api(~module_name, ident); let type_sig = Printtyp.string_of_type_declaration(~ident, td); let comment = - Comments.Doc.ending_on( - ~lnum=td.type_loc.loc_start.pos_lnum - 1, - comments, - ); + Comments.Doc.ending_on(~lnum=loc.loc_start.pos_lnum - 1, comments); let (description, attributes) = switch (comment) { @@ -138,35 +183,34 @@ let for_type_declaration = }; let for_signature_item = - (~env: Env.t, ~comments, sig_item: Types.signature_item) => { + (~env: Env.t, ~comments, ~exports, sig_item: Types.signature_item) => { switch (sig_item) { - | TSigValue(ident, ovd) => - // Fetch original location as signatures don't contain real locations - let vd = Env.find_value(ovd.val_fullpath, env); - let val_loc = vd.val_loc; - let docblock = - for_value_description(~comments, ~ident, {...ovd, val_loc}); + | TSigValue(ident, vd) => + let loc = location_for_value(~env, ~ident, ~exports, vd.val_fullpath); + let docblock = for_value_description(~comments, ~ident, ~loc, vd); Some(docblock); - | TSigType(ident, otd, _rec) => - // Fetch original location as signatures don't contain real locations - let td = Env.find_type(otd.type_path, env); - let type_loc = td.type_loc; - let docblock = - for_type_declaration(~comments, ~ident, {...otd, type_loc}); + | TSigType(ident, td, _rec) => + let loc = location_for_type(~env, ~exports, ident); + let docblock = for_type_declaration(~comments, ~ident, ~loc, td); Some(docblock); | _ => None }; }; let signature_item_in_range = - (~env: Env.t, sig_item: Types.signature_item, range: Grain_utils.Range.t) => { + ( + ~env: Env.t, + ~exports, + sig_item: Types.signature_item, + range: Grain_utils.Range.t, + ) => { switch (sig_item) { | TSigValue(ident, vd) => - let vd = Env.find_value(vd.val_fullpath, env); - Grain_utils.Range.inRange(vd.val_loc.loc_start.pos_lnum, range); + let loc = location_for_value(~env, ~ident, ~exports, vd.val_fullpath); + Grain_utils.Range.inRange(loc.loc_start.pos_lnum, range); | TSigType(ident, td, _rec) => - let td = Env.find_type(td.type_path, env); - Grain_utils.Range.inRange(td.type_loc.loc_start.pos_lnum, range); + let loc = location_for_type(~env, ~exports, ident); + Grain_utils.Range.inRange(loc.loc_start.pos_lnum, range); | _ => false }; }; diff --git a/compiler/graindoc/graindoc.re b/compiler/graindoc/graindoc.re index 17435b22cd..70e6e0a811 100644 --- a/compiler/graindoc/graindoc.re +++ b/compiler/graindoc/graindoc.re @@ -78,6 +78,8 @@ let generate_docs = (~current_version, ~output=?, program: Typedtree.typed_program) => { let comments = Comments.to_ordered(program.comments); + let exports = Docblock.enumerate_exports(program.statements); + let env = program.env; let signature_items = program.signature.cmi_sign; @@ -156,7 +158,8 @@ let generate_docs = }; let add_docblock = sig_item => { - let docblock = Docblock.for_signature_item(~env, ~comments, sig_item); + let docblock = + Docblock.for_signature_item(~env, ~comments, ~exports, sig_item); switch (docblock) { | Some(docblock) => Buffer.add_buffer( @@ -197,7 +200,12 @@ let generate_docs = ); List.iter( sig_item => - if (Docblock.signature_item_in_range(~env, sig_item, range)) { + if (Docblock.signature_item_in_range( + ~env, + ~exports, + sig_item, + range, + )) { add_docblock(sig_item); }, signature_items, From 73e65edff9610da5fddb2c4944e668bb76c87fb0 Mon Sep 17 00:00:00 2001 From: Philip Blair Date: Sun, 29 May 2022 17:31:57 +0200 Subject: [PATCH 3/5] Remove Env.find_value() usage --- compiler/graindoc/docblock.re | 52 +++++++++++++++++++++++------------ 1 file changed, 35 insertions(+), 17 deletions(-) diff --git a/compiler/graindoc/docblock.re b/compiler/graindoc/docblock.re index ec296bc800..ee466e601a 100644 --- a/compiler/graindoc/docblock.re +++ b/compiler/graindoc/docblock.re @@ -35,6 +35,19 @@ let () = let enumerate_exports = stmts => { let id_tbl = ref(Ident.empty); + let rec pattern_ids = ({pat_desc, pat_loc}: Typedtree.pattern) => { + switch (pat_desc) { + | TPatVar(id, _) => [(id, pat_loc)] + | TPatAlias(subpat, id, _) => [(id, pat_loc), ...pattern_ids(subpat)] + | TPatTuple(pats) + | TPatArray(pats) + | TPatConstruct(_, _, pats) => List.concat(List.map(pattern_ids, pats)) + | TPatRecord(elts, _) => + List.concat(List.map(((_, _, pat)) => pattern_ids(pat), elts)) + | _ => [] + }; + }; + module ExportIterator = TypedtreeIter.MakeIterator({ include TypedtreeIter.DefaultIteratorArgument; @@ -56,6 +69,16 @@ let enumerate_exports = stmts => { }, decls, ) + | TTopLet(_, _, vbinds) => + List.iter( + ({vb_pat}: Typedtree.value_binding) => { + List.iter( + ((id, loc)) => {id_tbl := Ident.add(id, loc, id_tbl^)}, + pattern_ids(vb_pat), + ) + }, + vbinds, + ) | _ => () }; }; @@ -66,17 +89,7 @@ let enumerate_exports = stmts => { id_tbl^; }; -// TODO: This need to be fixed to not do the Env.find_value -// but I can't figure it out -let location_for_value = (~env, ~ident, ~exports, path) => - try({ - let vd = Env.find_value(path, env); - vd.val_loc; - }) { - | exn => snd(Ident.find_name(Ident.name(ident), exports)) - }; - -let location_for_type = (~env, ~exports, ident) => { +let location_for_ident = (~env, ~exports, ident) => { snd(Ident.find_name(Ident.name(ident), exports)); }; @@ -183,14 +196,19 @@ let for_type_declaration = }; let for_signature_item = - (~env: Env.t, ~comments, ~exports, sig_item: Types.signature_item) => { + ( + ~env: Env.t, + ~comments, + ~exports: Ident.tbl(Grain_parsing.Location.t), + sig_item: Types.signature_item, + ) => { switch (sig_item) { | TSigValue(ident, vd) => - let loc = location_for_value(~env, ~ident, ~exports, vd.val_fullpath); + let loc = location_for_ident(~env, ~exports, ident); let docblock = for_value_description(~comments, ~ident, ~loc, vd); Some(docblock); | TSigType(ident, td, _rec) => - let loc = location_for_type(~env, ~exports, ident); + let loc = location_for_ident(~env, ~exports, ident); let docblock = for_type_declaration(~comments, ~ident, ~loc, td); Some(docblock); | _ => None @@ -200,16 +218,16 @@ let for_signature_item = let signature_item_in_range = ( ~env: Env.t, - ~exports, + ~exports: Ident.tbl(Grain_parsing.Location.t), sig_item: Types.signature_item, range: Grain_utils.Range.t, ) => { switch (sig_item) { | TSigValue(ident, vd) => - let loc = location_for_value(~env, ~ident, ~exports, vd.val_fullpath); + let loc = location_for_ident(~env, ~exports, ident); Grain_utils.Range.inRange(loc.loc_start.pos_lnum, range); | TSigType(ident, td, _rec) => - let loc = location_for_type(~env, ~exports, ident); + let loc = location_for_ident(~env, ~exports, ident); Grain_utils.Range.inRange(loc.loc_start.pos_lnum, range); | _ => false }; From 95fab577813545061b7a6fbd64adb24d3fb78105 Mon Sep 17 00:00:00 2001 From: Blaine Bublitz Date: Sun, 29 May 2022 11:20:01 -0700 Subject: [PATCH 4/5] Forgot to add foreigns to the id table --- compiler/graindoc/docblock.re | 2 ++ 1 file changed, 2 insertions(+) diff --git a/compiler/graindoc/docblock.re b/compiler/graindoc/docblock.re index ee466e601a..c73f02ce2f 100644 --- a/compiler/graindoc/docblock.re +++ b/compiler/graindoc/docblock.re @@ -69,6 +69,8 @@ let enumerate_exports = stmts => { }, decls, ) + | TTopForeign({tvd_id, tvd_loc}) => + id_tbl := Ident.add(tvd_id, tvd_loc, id_tbl^) | TTopLet(_, _, vbinds) => List.iter( ({vb_pat}: Typedtree.value_binding) => { From 49770860a2a065ca3773995c788d3290c689bb36 Mon Sep 17 00:00:00 2001 From: Blaine Bublitz Date: Sun, 29 May 2022 11:20:25 -0700 Subject: [PATCH 5/5] remove env from all of graindoc --- compiler/graindoc/docblock.re | 12 +++++------- compiler/graindoc/graindoc.re | 11 ++--------- 2 files changed, 7 insertions(+), 16 deletions(-) diff --git a/compiler/graindoc/docblock.re b/compiler/graindoc/docblock.re index c73f02ce2f..55ca1ba84e 100644 --- a/compiler/graindoc/docblock.re +++ b/compiler/graindoc/docblock.re @@ -91,7 +91,7 @@ let enumerate_exports = stmts => { id_tbl^; }; -let location_for_ident = (~env, ~exports, ident) => { +let location_for_ident = (~exports, ident) => { snd(Ident.find_name(Ident.name(ident), exports)); }; @@ -199,18 +199,17 @@ let for_type_declaration = let for_signature_item = ( - ~env: Env.t, ~comments, ~exports: Ident.tbl(Grain_parsing.Location.t), sig_item: Types.signature_item, ) => { switch (sig_item) { | TSigValue(ident, vd) => - let loc = location_for_ident(~env, ~exports, ident); + let loc = location_for_ident(~exports, ident); let docblock = for_value_description(~comments, ~ident, ~loc, vd); Some(docblock); | TSigType(ident, td, _rec) => - let loc = location_for_ident(~env, ~exports, ident); + let loc = location_for_ident(~exports, ident); let docblock = for_type_declaration(~comments, ~ident, ~loc, td); Some(docblock); | _ => None @@ -219,17 +218,16 @@ let for_signature_item = let signature_item_in_range = ( - ~env: Env.t, ~exports: Ident.tbl(Grain_parsing.Location.t), sig_item: Types.signature_item, range: Grain_utils.Range.t, ) => { switch (sig_item) { | TSigValue(ident, vd) => - let loc = location_for_ident(~env, ~exports, ident); + let loc = location_for_ident(~exports, ident); Grain_utils.Range.inRange(loc.loc_start.pos_lnum, range); | TSigType(ident, td, _rec) => - let loc = location_for_ident(~env, ~exports, ident); + let loc = location_for_ident(~exports, ident); Grain_utils.Range.inRange(loc.loc_start.pos_lnum, range); | _ => false }; diff --git a/compiler/graindoc/graindoc.re b/compiler/graindoc/graindoc.re index 70e6e0a811..43e46b2c90 100644 --- a/compiler/graindoc/graindoc.re +++ b/compiler/graindoc/graindoc.re @@ -80,7 +80,6 @@ let generate_docs = let exports = Docblock.enumerate_exports(program.statements); - let env = program.env; let signature_items = program.signature.cmi_sign; let buf = Buffer.create(0); @@ -158,8 +157,7 @@ let generate_docs = }; let add_docblock = sig_item => { - let docblock = - Docblock.for_signature_item(~env, ~comments, ~exports, sig_item); + let docblock = Docblock.for_signature_item(~comments, ~exports, sig_item); switch (docblock) { | Some(docblock) => Buffer.add_buffer( @@ -200,12 +198,7 @@ let generate_docs = ); List.iter( sig_item => - if (Docblock.signature_item_in_range( - ~env, - ~exports, - sig_item, - range, - )) { + if (Docblock.signature_item_in_range(~exports, sig_item, range)) { add_docblock(sig_item); }, signature_items,