Skip to content

Move include functor over to the modular extensions machinery #1377

New issue

Have a question about this project? # for a free GitHub account to open an issue and contact its maintainers and the community.

#

By clicking “#”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? # to your account

Merged
merged 11 commits into from
May 22, 2023
Merged

Move include functor over to the modular extensions machinery #1377

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
11 commits
Select commit Hold shift + click to select a range
678432a
[minor] Formatting
antalsz Apr 4, 2023
b30d036
Add support for extensions as signature and structure items
antalsz May 9, 2023
b035ae1
Move `include functor` over to the modular extensions framework
antalsz May 9, 2023
0e92836
Remove the `include_functor` attribute from the warning 53 tests
antalsz May 12, 2023
8b338ae
[minor] Use `%t` for printing
antalsz May 18, 2023
201032e
Respond to Richard's comments
antalsz May 18, 2023
7c1f7f4
[minor] Update comment for the renaming to "Jane syntax"
antalsz May 18, 2023
a80f7a9
Add `include functor` to `Untypeast`
antalsz May 18, 2023
7f90cc6
Update ocamldoc for `include functor`
antalsz May 18, 2023
b392629
`lintapidiff.ml` already didn't build but I updated it too
antalsz May 18, 2023
2392933
[minor] Drop leading `_` on a forwarded variable
antalsz May 19, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
10,244 changes: 5,126 additions & 5,118 deletions ocaml/boot/menhir/parser.ml
View file
Open in desktop

Large diffs are not rendered by default.

Binary file modified ocaml/boot/ocamlc
View file
Open in desktop
Binary file not shown.
53 changes: 39 additions & 14 deletions ocaml/ocamldoc/odoc_ast.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1037,13 +1037,13 @@ module Analyser =
[] -> pos_limit
| item2 :: _ -> item2.Parsetree.pstr_loc.Location.loc_start.Lexing.pos_cnum
in
let (maybe_more, new_env, elements) = analyse_structure_item
let (maybe_more, new_env, elements) = analyse_structure_item_nondesc
env
current_module_name
item.Parsetree.pstr_loc
pos_limit2
comment_opt
item.Parsetree.pstr_desc
item
typedtree
table
table_values
Expand All @@ -1052,6 +1052,27 @@ module Analyser =
in
iter env last_pos parsetree

and analyse_structure_item_include ~env ~comment_opt _incl =
(* we add a dummy included module which will be replaced by a correct
one at the end of the module analysis,
to use the Path.t of the included modules in the typdtree. *)
let im =
{
im_name = "dummy" ;
im_module = None ;
im_info = comment_opt ;
}
in
(0, env, [ Element_included_module im ]) (* FIXME: extend the environment? With what? *)

and analyse_structure_item_jst env _current_module_name _loc _pos_limit comment_opt jstritem _typedtree
_table _table_values =
match (jstritem : Jane_syntax.Structure_item.t) with
| Jstr_include_functor ifincl -> begin match ifincl with
| Ifstr_include_functor incl ->
analyse_structure_item_include ~env ~comment_opt incl
end

(** Analysis of a parse tree structure item to obtain a new environment and a list of elements.*)
and analyse_structure_item env current_module_name loc pos_limit comment_opt parsetree_item_desc _typedtree
table table_values =
Expand Down Expand Up @@ -1653,18 +1674,22 @@ module Analyser =
in
(0, new_env, f ~first: true loc.Location.loc_start.Lexing.pos_cnum class_type_decl_list)

| Parsetree.Pstr_include _ ->
(* we add a dummy included module which will be replaced by a correct
one at the end of the module analysis,
to use the Path.t of the included modules in the typdtree. *)
let im =
{
im_name = "dummy" ;
im_module = None ;
im_info = comment_opt ;
}
in
(0, env, [ Element_included_module im ]) (* FIXME: extend the environment? With what? *)
| Parsetree.Pstr_include incl ->
analyse_structure_item_include ~env ~comment_opt incl

and analyse_structure_item_nondesc env current_module_name loc pos_limit comment_opt parsetree_item typedtree
table table_values =
match Jane_syntax.Structure_item.of_ast parsetree_item with
| Some jparsetree_item ->
analyse_structure_item_jst
env current_module_name loc pos_limit comment_opt
jparsetree_item
typedtree table table_values
| None ->
analyse_structure_item
env current_module_name loc pos_limit comment_opt
parsetree_item.Parsetree.pstr_desc
typedtree table table_values

(** Analysis of a [Parsetree.module_expr] and a name to return a [t_module].*)
and analyse_module env current_module_name module_name comment_opt p_module_expr tt_module_expr =
Expand Down
105 changes: 69 additions & 36 deletions ocaml/ocamldoc/odoc_sig.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -480,10 +480,18 @@ module Analyser =
pmty_attributes = []
}

let filter_out_erased_item_from_signature_jst _erased acc
: Jane_syntax.Signature_item.t -> _ = function
| Jsig_include_functor (Ifsig_include_functor _) -> acc

let filter_out_erased_items_from_signature erased signature =
if Name.Map.is_empty erased then signature
else List.fold_right (fun sig_item acc ->
let take_item psig_desc = { sig_item with Parsetree.psig_desc } :: acc in
match Jane_syntax.Signature_item.of_ast sig_item with
| Some jsig_item ->
filter_out_erased_item_from_signature_jst erased acc jsig_item
| None ->
match sig_item.Parsetree.psig_desc with
| Parsetree.Psig_attribute _
| Parsetree.Psig_extension _
Expand Down Expand Up @@ -736,7 +744,7 @@ module Analyser =
let (assoc_com, ele_comments) =
get_comments_in_module last_pos (Loc.psig_start ele)
in
let (maybe_more, new_env, elements) = analyse_signature_item_desc
let (maybe_more, new_env, elements) = analyse_signature_item
acc_env
signat
table
Expand All @@ -749,7 +757,7 @@ module Analyser =
| ele2 :: _ -> Loc.psig_start ele2
)
assoc_com
ele.Parsetree.psig_desc
ele
in
let new_pos = Loc.psig_end ele + maybe_more
(* for the comments of constructors in types,
Expand All @@ -763,6 +771,50 @@ module Analyser =
in
f [] env last_pos sig_item_list

and analyse_signature_item_desc_include ~env ~comment_opt incl =
let rec f = function
Parsetree.Pmty_ident longident ->
Name.from_longident longident.txt
| Parsetree.Pmty_alias longident ->
Name.from_longident longident.txt
| Parsetree.Pmty_signature _ ->
"??"
| Parsetree.Pmty_functor _ ->
"??"
| Parsetree.Pmty_with (mt, _) ->
f mt.Parsetree.pmty_desc
| Parsetree.Pmty_typeof mexpr ->
let open Parsetree in
begin match mexpr.pmod_desc with
Pmod_ident longident -> Name.from_longident longident.txt
| Pmod_structure [
{pstr_desc=Pstr_include
{pincl_mod={pmod_desc=Pmod_ident longident}}
}] -> (* include module type of struct include M end*)
Name.from_longident longident.txt
| _ -> "??"
end
| Parsetree.Pmty_extension _ -> assert false
in
let name = f incl.Parsetree.pincl_mod.Parsetree.pmty_desc in
let full_name = Odoc_env.full_module_or_module_type_name env name in
let im =
{
im_name = full_name ;
im_module = None ;
im_info = comment_opt;
}
in
(0, env, [ Element_included_module im ]) (* FIXME : extend the environment? How? *)

and analyse_signature_item_desc_jst env _signat _table _current_module_name
_sig_item_loc _pos_start_ele _pos_end_ele _pos_limit comment_opt
: Jane_syntax.Signature_item.t -> _ = function
| Jsig_include_functor ifincl -> begin match ifincl with
| Ifsig_include_functor incl ->
analyse_signature_item_desc_include ~env ~comment_opt incl
end

(** Analyse the given signature_item_desc to create the corresponding module element
(with the given attached comment).*)
and analyse_signature_item_desc env _signat table current_module_name
Expand Down Expand Up @@ -1338,40 +1390,7 @@ module Analyser =
(maybe_more, new_env2, [ Element_module_type mt ])

| Parsetree.Psig_include incl ->
let rec f = function
Parsetree.Pmty_ident longident ->
Name.from_longident longident.txt
| Parsetree.Pmty_alias longident ->
Name.from_longident longident.txt
| Parsetree.Pmty_signature _ ->
"??"
| Parsetree.Pmty_functor _ ->
"??"
| Parsetree.Pmty_with (mt, _) ->
f mt.Parsetree.pmty_desc
| Parsetree.Pmty_typeof mexpr ->
let open Parsetree in
begin match mexpr.pmod_desc with
Pmod_ident longident -> Name.from_longident longident.txt
| Pmod_structure [
{pstr_desc=Pstr_include
{pincl_mod={pmod_desc=Pmod_ident longident}}
}] -> (* include module type of struct include M end*)
Name.from_longident longident.txt
| _ -> "??"
end
| Parsetree.Pmty_extension _ -> assert false
in
let name = f incl.Parsetree.pincl_mod.Parsetree.pmty_desc in
let full_name = Odoc_env.full_module_or_module_type_name env name in
let im =
{
im_name = full_name ;
im_module = None ;
im_info = comment_opt;
}
in
(0, env, [ Element_included_module im ]) (* FIXME : extend the environment? How? *)
analyse_signature_item_desc_include ~env ~comment_opt incl

| Parsetree.Psig_class class_description_list ->
(* we start by extending the environment *)
Expand Down Expand Up @@ -1519,6 +1538,20 @@ module Analyser =
| Parsetree.Psig_extension _ ->
(0, env, [])

and analyse_signature_item env _signat table current_module_name
sig_item_loc pos_start_ele pos_end_ele pos_limit comment_opt sig_item =
match Jane_syntax.Signature_item.of_ast sig_item with
| Some jsig_item ->
analyse_signature_item_desc_jst
env _signat table current_module_name
sig_item_loc pos_start_ele pos_end_ele pos_limit comment_opt
jsig_item
| None ->
analyse_signature_item_desc
env _signat table current_module_name
sig_item_loc pos_start_ele pos_end_ele pos_limit comment_opt
sig_item.Parsetree.psig_desc

(** Return a module_type_kind from a Parsetree.module_type and a Types.module_type *)
and analyse_module_type_kind
?(erased = Name.Map.empty) env current_module_name module_type sig_module_type =
Expand Down
30 changes: 28 additions & 2 deletions ocaml/parsing/ast_iterator.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -62,8 +62,10 @@ type iterator = {
payload: iterator -> payload -> unit;
signature: iterator -> signature -> unit;
signature_item: iterator -> signature_item -> unit;
signature_item_jane_syntax: iterator -> Jane_syntax.Signature_item.t -> unit;
structure: iterator -> structure -> unit;
structure_item: iterator -> structure_item -> unit;
structure_item_jane_syntax: iterator -> Jane_syntax.Structure_item.t -> unit;
typ: iterator -> core_type -> unit;
row_field: iterator -> row_field -> unit;
object_field: iterator -> object_field -> unit;
Expand Down Expand Up @@ -281,8 +283,19 @@ module MT = struct
| Pwith_modtypesubst (lid, mty) ->
iter_loc sub lid; sub.module_type sub mty

let iter_signature_item sub {psig_desc = desc; psig_loc = loc} =
let iter_sig_include_functor sub
: Jane_syntax.Include_functor.signature_item -> unit = function
| Ifsig_include_functor incl -> sub.include_description sub incl

let iter_signature_item_jst sub : Jane_syntax.Signature_item.t -> unit =
function
| Jsig_include_functor ifincl -> iter_sig_include_functor sub ifincl

let iter_signature_item sub ({psig_desc = desc; psig_loc = loc} as sigi) =
sub.location sub loc;
match Jane_syntax.Signature_item.of_ast sigi with
| Some jsigi -> sub.signature_item_jane_syntax sub jsigi
| None ->
match desc with
| Psig_value vd -> sub.value_description sub vd
| Psig_type (_, l)
Expand Down Expand Up @@ -331,8 +344,19 @@ module M = struct
| Pmod_unpack e -> sub.expr sub e
| Pmod_extension x -> sub.extension sub x

let iter_structure_item sub {pstr_loc = loc; pstr_desc = desc} =
let iter_str_include_functor sub
: Jane_syntax.Include_functor.structure_item -> unit = function
| Ifstr_include_functor incl -> sub.include_declaration sub incl

let iter_structure_item_jst sub : Jane_syntax.Structure_item.t -> unit =
function
| Jstr_include_functor ifincl -> iter_str_include_functor sub ifincl

let iter_structure_item sub ({pstr_loc = loc; pstr_desc = desc} as stri) =
sub.location sub loc;
match Jane_syntax.Structure_item.of_ast stri with
| Some jstri -> sub.structure_item_jane_syntax sub jstri
| None ->
match desc with
| Pstr_eval (x, attrs) ->
sub.attributes sub attrs; sub.expr sub x
Expand Down Expand Up @@ -598,9 +622,11 @@ let default_iterator =
{
structure = (fun this l -> List.iter (this.structure_item this) l);
structure_item = M.iter_structure_item;
structure_item_jane_syntax = M.iter_structure_item_jst;
module_expr = M.iter;
signature = (fun this l -> List.iter (this.signature_item this) l);
signature_item = MT.iter_signature_item;
signature_item_jane_syntax = MT.iter_signature_item_jst;
module_type = MT.iter;
module_type_jane_syntax = MT.iter_jane_syntax;
with_constraint = MT.iter_with_constraint;
Expand Down
2 changes: 2 additions & 0 deletions ocaml/parsing/ast_iterator.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -65,8 +65,10 @@ type iterator = {
payload: iterator -> payload -> unit;
signature: iterator -> signature -> unit;
signature_item: iterator -> signature_item -> unit;
signature_item_jane_syntax: iterator -> Jane_syntax.Signature_item.t -> unit;
structure: iterator -> structure -> unit;
structure_item: iterator -> structure_item -> unit;
structure_item_jane_syntax: iterator -> Jane_syntax.Structure_item.t -> unit;
typ: iterator -> core_type -> unit;
row_field: iterator -> row_field -> unit;
object_field: iterator -> object_field -> unit;
Expand Down
52 changes: 50 additions & 2 deletions ocaml/parsing/ast_mapper.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -71,8 +71,12 @@ type mapper = {
payload: mapper -> payload -> payload;
signature: mapper -> signature -> signature;
signature_item: mapper -> signature_item -> signature_item;
signature_item_jane_syntax: mapper ->
Jane_syntax.Signature_item.t -> Jane_syntax.Signature_item.t;
structure: mapper -> structure -> structure;
structure_item: mapper -> structure_item -> structure_item;
structure_item_jane_syntax: mapper ->
Jane_syntax.Structure_item.t -> Jane_syntax.Structure_item.t;
typ: mapper -> core_type -> core_type;
type_declaration: mapper -> type_declaration -> type_declaration;
type_extension: mapper -> type_extension -> type_extension;
Expand Down Expand Up @@ -317,9 +321,30 @@ module MT = struct
| Pwith_modtypesubst (lid, mty) ->
Pwith_modtypesubst (map_loc sub lid, sub.module_type sub mty)

let map_signature_item sub {psig_desc = desc; psig_loc = loc} =
module IF = Jane_syntax.Include_functor

let map_sig_include_functor sub : IF.signature_item -> IF.signature_item =
function
| Ifsig_include_functor incl ->
Ifsig_include_functor (sub.include_description sub incl)

let map_signature_item_jst sub :
Jane_syntax.Signature_item.t -> Jane_syntax.Signature_item.t =
function
| Jsig_include_functor ifincl ->
Jsig_include_functor (map_sig_include_functor sub ifincl)

let map_signature_item sub ({psig_desc = desc; psig_loc = loc} as sigi) =
let open Sig in
let loc = sub.location sub loc in
match Jane_syntax.Signature_item.of_ast sigi with
| Some jsigi -> begin
Jane_syntax_parsing.Signature_item.wrap_desc ~loc ~attrs:[] @@
match sub.signature_item_jane_syntax sub jsigi with
| Jsig_include_functor incl ->
Jane_syntax.Include_functor.sig_item_of ~loc incl
end
| None ->
match desc with
| Psig_value vd -> value ~loc (sub.value_description sub vd)
| Psig_type (rf, l) ->
Expand Down Expand Up @@ -376,9 +401,30 @@ module M = struct
| Pmod_unpack e -> unpack ~loc ~attrs (sub.expr sub e)
| Pmod_extension x -> extension ~loc ~attrs (sub.extension sub x)

let map_structure_item sub {pstr_loc = loc; pstr_desc = desc} =
module IF = Jane_syntax.Include_functor

let map_str_include_functor sub : IF.structure_item -> IF.structure_item =
function
| Ifstr_include_functor incl ->
Ifstr_include_functor (sub.include_declaration sub incl)

let map_structure_item_jst sub :
Jane_syntax.Structure_item.t -> Jane_syntax.Structure_item.t =
function
| Jstr_include_functor ifincl ->
Jstr_include_functor (map_str_include_functor sub ifincl)

let map_structure_item sub ({pstr_loc = loc; pstr_desc = desc} as stri) =
let open Str in
let loc = sub.location sub loc in
match Jane_syntax.Structure_item.of_ast stri with
| Some jstri -> begin
Jane_syntax_parsing.Structure_item.wrap_desc ~loc ~attrs:[] @@
match sub.structure_item_jane_syntax sub jstri with
| Jstr_include_functor incl ->
Jane_syntax.Include_functor.str_item_of ~loc incl
end
| None ->
match desc with
| Pstr_eval (x, attrs) ->
let attrs = sub.attributes sub attrs in
Expand Down Expand Up @@ -671,9 +717,11 @@ let default_mapper =
constant = C.map;
structure = (fun this l -> List.map (this.structure_item this) l);
structure_item = M.map_structure_item;
structure_item_jane_syntax = M.map_structure_item_jst;
module_expr = M.map;
signature = (fun this l -> List.map (this.signature_item this) l);
signature_item = MT.map_signature_item;
signature_item_jane_syntax = MT.map_signature_item_jst;
module_type = MT.map;
module_type_jane_syntax = MT.map_jane_syntax;
with_constraint = MT.map_with_constraint;
Expand Down
Loading