diff --git a/CHANGES.md b/CHANGES.md
index 6cb5bf928b..35497da123 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -7,6 +7,8 @@
- Support OxCaml 5.2.0minus39 (@jonludlam, #1469)
- Support for OxCaml modes (@art-w, #1454)
- Fix OxCaml with-bounds for arbitrary types (@art-w, #1466)
+- Display items included via `include functor` as included via the functor
+ (@Leonidas-from-XIV, #1452)
### Fixed
- Remove requirement for ppx_expect in tests (@jonludlam, #1445)
diff --git a/src/document/generator.ml b/src/document/generator.ml
index f8efd42ef8..35cbda85ba 100644
--- a/src/document/generator.ml
+++ b/src/document/generator.ml
@@ -1912,8 +1912,10 @@ module Make (Syntax : SYNTAX) = struct
and include_ (t : Odoc_model.Lang.Include.t) =
let decl_hidden =
match t.decl with
- | Alias p -> Paths.Path.(is_hidden (p :> t))
- | ModuleType mty -> umty_hidden mty
+ | Alias p | Functor { original_ref = Path p; _ } ->
+ Paths.Path.(is_hidden (p :> t))
+ | Functor { original_ref = ModuleType mty; _ } -> mty_hidden mty
+ | ModuleType umty -> umty_hidden umty
in
let status = if decl_hidden then `Inline else t.status in
@@ -1921,14 +1923,22 @@ module Make (Syntax : SYNTAX) = struct
let summary =
if decl_hidden then O.render (O.keyword "include" ++ O.txt " ...")
else
+ let include_kw =
+ match t.decl with
+ | Odoc_model.Lang.Include.Alias _ | ModuleType _ ->
+ O.keyword "include"
+ | Functor _ -> O.keyword "include functor"
+ in
let include_decl =
match t.decl with
- | Odoc_model.Lang.Include.Alias mod_path ->
+ | Odoc_model.Lang.Include.Alias mod_path
+ | Functor { original_ref = Path mod_path; _ } ->
Link.from_path (mod_path :> Paths.Path.t)
+ | Functor { original_ref = ModuleType mt; _ } -> mty mt
| ModuleType mt -> umty mt
in
O.render
- (O.keyword "include" ++ O.txt " " ++ include_decl
+ (include_kw ++ O.txt " " ++ include_decl
++ if Syntax.Mod.include_semicolon then O.keyword ";" else O.noop)
in
let content = { Include.content; status; summary } in
diff --git a/src/loader/cmt.ml b/src/loader/cmt.ml
index 5c225a6c8b..f8b31f43cb 100644
--- a/src/loader/cmt.ml
+++ b/src/loader/cmt.ml
@@ -22,6 +22,7 @@ module OCamlPath = Path
open Odoc_model.Paths
open Odoc_model.Lang
+module Names = Odoc_model.Names
module Env = Ident_env
@@ -579,16 +580,8 @@ and read_include env parent incl =
let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
let doc, status = Doc_attr.attached ~warnings_tag:env.warnings_tag Odoc_model.Semantics.Expect_status container incl.incl_attributes in
let decl_modty =
-#if defined OXCAML
- match unwrap_module_expr_desc incl.incl_mod.mod_desc, incl.incl_kind with
- | _, (Tincl_functor _ | Tincl_gen_functor _) ->
- (* TODO: Handle [include functor] *)
- None
- | Tmod_ident(p, _), Tincl_structure ->
-#else
match unwrap_module_expr_desc incl.incl_mod.mod_desc with
| Tmod_ident(p, _) ->
-#endif
let p = Env.Path.read_module env.ident_env p in
Some (ModuleType.U.TypeOf (ModuleType.StructInclude p, p))
| _ ->
@@ -601,9 +594,37 @@ and read_include env parent incl =
| Some m ->
let decl = ModuleType m in
[Include {parent; doc; decl; expansion; status; strengthened=None; loc }]
- | _ ->
+ | None ->
content.items
+#if defined OXCAML
+(* [include functor F] applies [F] to [wrapper], a synthetic module holding
+ everything defined before the include. [F] itself need not be a path -- it
+ can be an anonymous functor -- in which case it is bound to a module so that
+ there is something to apply. *)
+and read_include_functor env parent wrapper incl =
+ let open Include in
+ let loc = Doc_attr.read_location incl.incl_loc in
+ let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
+ let doc, status = Doc_attr.attached ~warnings_tag:env.warnings_tag Odoc_model.Semantics.Expect_status container incl.incl_attributes in
+ let content, shadowed = Cmi.read_signature_noenv env parent (Odoc_model.Compat.signature incl.incl_type) in
+ let expansion = { content; shadowed; } in
+ let bound, functor_path, original_ref =
+ match unwrap_module_expr_desc incl.incl_mod.mod_desc with
+ | Tmod_ident (p, _) ->
+ let p = Env.Path.read_module env.ident_env p in
+ ([], p, Path p)
+ | _ ->
+ let mty = read_module_expr env parent container incl.incl_mod in
+ let hidden = true in
+ let id, path = Cmti.generate_wrapper_module parent ~prefix:"INCLUDE" ~hidden in
+ let m : Module.t = {id; source_loc=None; doc; type_=ModuleType mty; canonical=None; hidden} in
+ ([Signature.Module (Ordinary, m)], path, ModuleType mty)
+ in
+ let decl = Functor {target = Path (`Apply (functor_path, wrapper)); original_ref} in
+ bound @ [Include {parent; doc; decl; expansion; status; strengthened=None; loc }]
+#endif
+
and read_open env parent o =
let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
let doc = Doc_attr.attached_no_tag ~warnings_tag:env.warnings_tag container o.open_attributes in
@@ -611,6 +632,22 @@ and read_open env parent o =
let expansion, _ = Cmi.read_signature_noenv env parent (Odoc_model.Compat.signature signature) in
Open.{expansion; doc}
+and read_items env parent items =
+ List.fold_left
+ (fun acc item ->
+ match item.str_desc with
+#if defined OXCAML
+ | Tstr_include ({ incl_kind = (Tincl_functor _ | Tincl_gen_functor _); _ } as incl) ->
+ let hidden = true in
+ let wrapper = Cmti.generate_wrapper_module parent ~prefix:"BODY" ~hidden in
+ let wrapper_module = Cmti.wrapper_module wrapper ~hidden (List.rev acc) in
+ let items = read_include_functor env parent (snd wrapper) incl in
+ List.rev_append items (wrapper_module :: acc)
+#endif
+ | _ -> List.rev_append (read_structure_item env parent item) acc)
+ [] items
+ |> List.rev
+
and read_structure :
'tags. 'tags Odoc_model.Semantics.handle_internal_tags -> _ -> _ -> _ ->
_ * 'tags =
@@ -626,13 +663,7 @@ and read_structure :
in
Doc_attr.extract_top_comment internal_tags ~warnings_tag:env.warnings_tag ~classify parent str.str_items
in
- let items =
- List.fold_left
- (fun items item ->
- List.rev_append (read_structure_item env parent item) items)
- [] items
- |> List.rev
- in
+ let items = read_items env parent items in
match doc_post with
| { elements = [] ; _} ->
({ Signature.items; compiled = false; removed = []; doc }, tags)
diff --git a/src/loader/cmti.ml b/src/loader/cmti.ml
index fba321a21e..c58e867204 100644
--- a/src/loader/cmti.ml
+++ b/src/loader/cmti.ml
@@ -38,6 +38,93 @@ let opt_map f = function
| None -> None
| Some x -> Some (f x)
+let generate_wrapper_module =
+ let wrapper_counter = ref 0 in
+ fun parent ~prefix ~hidden ->
+ incr wrapper_counter;
+ let dummy_id =
+ let dummy_name =
+ let sep = match hidden with | true -> "__" | false -> "_" in
+ let name = Printf.sprintf "%s%s%d" prefix sep !wrapper_counter in
+ match hidden with
+ | false -> Odoc_model.Names.ModuleName.make_std name
+ | true -> Odoc_model.Names.ModuleName.hidden_of_string name
+ in
+ Identifier.Mk.module_ (parent, dummy_name)
+ in
+ let dummy_path = `Identifier (dummy_id, hidden) in
+ (dummy_id, dummy_path)
+
+let no_doc : Odoc_model.Comment.docs = { elements = []; warnings_tag = None }
+
+(* [include functor F] is modelled as the application of [F] to a synthetic,
+ hidden module holding the items that precede the include.
+
+ That module's items are *aliases* of the real ones rather than copies: the
+ expansion of [F(BODY__n)] refers to the functor argument, so a copy would
+ leave the expansion mentioning [BODY__n.t], a hidden path, which the
+ generator renders as an abstract [type t]. With an alias, [BODY__n.t]
+ reduces to the enclosing signature's own [t] and is rendered, and linked, as
+ such. *)
+let wrapper_items dummy_id items =
+ let module Id = Identifier in
+ let name id = Id.name id in
+ let parent = (dummy_id : Id.Module.t :> Id.Signature.t) in
+ (* Anonymous parameters ([_]) have to be named so that the alias can pass
+ them on to the item it aliases. *)
+ let alias_params params =
+ List.split
+ (List.mapi
+ (fun i (p : TypeDecl.param) ->
+ let v = match p.desc with Var v -> v | Any -> Printf.sprintf "a%d" i in
+ ({ p with TypeDecl.desc = TypeDecl.Var v }, TypeExpr.Var v))
+ params)
+ in
+ let rec wrapper_item item acc =
+ match (item : Signature.item) with
+ | Type (rec_, td) ->
+ let params, args = alias_params td.equation.params in
+ let manifest =
+ Some (TypeExpr.Constr (`Identifier ((td.id :> Id.Path.Type.t), false), args))
+ in
+ let equation =
+ { td.equation with TypeDecl.Equation.params; manifest; constraints = []; private_ = false }
+ in
+ let id = Id.Mk.type_ (parent, Odoc_model.Names.TypeName.make_std (name td.id)) in
+ Signature.Type (rec_, { td with TypeDecl.id; equation; representation = None; canonical = None; source_loc = None }) :: acc
+ | Module (rec_, m) ->
+ let id = Id.Mk.module_ (parent, Odoc_model.Names.ModuleName.make_std (name m.id)) in
+ let type_ = Module.Alias (`Identifier ((m.id :> Id.Path.Module.t), false), None) in
+ Signature.Module (rec_, { m with Module.id; type_; canonical = None; hidden = false; source_loc = None }) :: acc
+ | ModuleType mt ->
+ let id = Id.Mk.module_type (parent, Odoc_model.Names.ModuleTypeName.make_std (name mt.id)) in
+ let expr =
+ Some (ModuleType.Path { p_path = `Identifier ((mt.id :> Id.Path.ModuleType.t), false); p_expansion = None })
+ in
+ Signature.ModuleType { mt with ModuleType.id; expr; canonical = None; source_loc = None } :: acc
+ | Include incl ->
+ (* The items an [include] brings in are visible to the functor too. *)
+ List.fold_left (fun acc item -> wrapper_item item acc) acc incl.Include.expansion.content.items
+ | Value _ | ModuleSubstitution _ | ModuleTypeSubstitution _ | Open _
+ | TypeSubstitution _ | TypExt _ | Exception _ | Comment _ ->
+ (* Nothing in the expansion of [F(BODY__n)] can refer to these. *)
+ acc
+ | Class _ | ClassType _ ->
+ (* A class type of the argument can be referred to from the expansion,
+ but odoc does not chase class type aliases the way it chases type
+ manifests, so aliasing them here would not help: such a reference is
+ left printing the (hidden) name of the synthetic module. *)
+ acc
+ in
+ List.rev (List.fold_left (fun acc item -> wrapper_item item acc) [] items)
+
+let wrapper_module (dummy_id, _dummy_path) ~hidden items =
+ let items = wrapper_items dummy_id items in
+ let sig_ : Signature.t = { items; compiled = true; removed = []; doc = no_doc } in
+ let type_ : Module.decl = ModuleType (Signature sig_) in
+ let module_ : Module.t = {id=dummy_id; source_loc=None; doc=no_doc; type_; canonical=None; hidden} in
+ Signature.Module (Ordinary, module_)
+
let read_label = Cmi.read_label
let rec read_core_type env container ctyp =
@@ -907,21 +994,36 @@ and read_include env parent incl =
let include_parent = Identifier.fresh_include_parent parent in
let include_container = (include_parent :> Identifier.LabelParent.t) in
let expr = read_module_type env include_parent include_container incl.incl_mod in
- let umty = Odoc_model.Lang.umty_of_mty expr in
let expansion = { content; shadowed; } in
-#if defined OXCAML
- match umty, incl.incl_kind with
- | Some uexpr, Tincl_structure ->
-#else
- match umty with
+ match Odoc_model.Lang.umty_of_mty expr with
| Some uexpr ->
-#endif
let decl = Include.ModuleType uexpr in
[Include {parent; doc; decl; expansion; status; strengthened=None; loc }]
- | _ ->
- (* TODO: Handle [include functor] *)
+ | None ->
content.items
+#if defined OXCAML
+(* [include functor F] applies [F] to [wrapper], a synthetic module holding
+ everything defined before the include. A signature never has a path to [F]
+ -- only its module type -- so [F] is bound to a module to obtain one. *)
+and read_include_functor env parent wrapper incl =
+ let open Include in
+ let loc = Doc_attr.read_location incl.incl_loc in
+ let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
+ let doc, status = Doc_attr.attached ~warnings_tag:env.warnings_tag Odoc_model.Semantics.Expect_status container incl.incl_attributes in
+ let content, shadowed = Cmi.read_signature_noenv env parent (Odoc_model.Compat.signature incl.incl_type) in
+ let include_parent = Identifier.fresh_include_parent parent in
+ let include_container = (include_parent :> Identifier.LabelParent.t) in
+ let expr = read_module_type env include_parent include_container incl.incl_mod in
+ let expansion = { content; shadowed; } in
+ let hidden = true in
+ let id, functor_path = generate_wrapper_module parent ~prefix:"INCLUDE" ~hidden in
+ let functor_ : Module.t = {id; source_loc=None; doc; type_=ModuleType expr; canonical=None; hidden} in
+ let decl = Functor {target = Path (`Apply (functor_path, wrapper)); original_ref = ModuleType expr} in
+ [ Signature.Module (Ordinary, functor_);
+ Include {parent; doc; decl; expansion; status; strengthened=None; loc } ]
+#endif
+
and read_open env parent o =
let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
let doc = Doc_attr.attached_no_tag container ~warnings_tag:env.warnings_tag o.open_attributes in
@@ -929,6 +1031,23 @@ and read_open env parent o =
let expansion, _ = Cmi.read_signature_noenv env parent (Odoc_model.Compat.signature signature) in
{ expansion; doc }
+and read_items env parent items =
+ List.fold_left
+ (fun acc item ->
+ match item.sig_desc with
+#if defined OXCAML
+ | Tsig_include ({ incl_kind = (Tincl_functor _ | Tincl_gen_functor _);
+ incl_mod = { mty_desc = (Tmty_typeof _ | Tmty_ident _); _ }; _ } as incl, _) ->
+ let hidden = true in
+ let wrapper = generate_wrapper_module parent ~prefix:"BODY" ~hidden in
+ let wrapper_module = wrapper_module wrapper ~hidden (List.rev acc) in
+ let items = read_include_functor env parent (snd wrapper) incl in
+ List.rev_append items (wrapper_module :: acc)
+#endif
+ | _ -> List.rev_append (read_signature_item env parent item) acc)
+ [] items
+ |> List.rev
+
and read_signature :
'tags. 'tags Odoc_model.Semantics.handle_internal_tags -> _ -> _ -> _ ->
_ * 'tags =
@@ -944,13 +1063,7 @@ and read_signature :
in
Doc_attr.extract_top_comment internal_tags ~warnings_tag:env.warnings_tag ~classify parent sg.sig_items
in
- let items =
- List.fold_left
- (fun items item ->
- List.rev_append (read_signature_item env parent item) items)
- [] items
- |> List.rev
- in
+ let items = read_items env parent items in
match doc_post with
| {elements=[]; _} ->
({ Signature.items; compiled = false; removed = []; doc }, tags)
diff --git a/src/loader/cmti.mli b/src/loader/cmti.mli
index d2e5905a2d..2268a367c5 100644
--- a/src/loader/cmti.mli
+++ b/src/loader/cmti.mli
@@ -67,3 +67,20 @@ val read_class_type_declarations :
Paths.Identifier.Signature.t ->
Typedtree.class_type Typedtree.class_infos list ->
Odoc_model.Lang.Signature.item list
+
+val generate_wrapper_module :
+ Paths.Identifier.Signature.t ->
+ prefix:string ->
+ hidden:bool ->
+ Paths.Identifier.Module.t * Paths.Path.Module.t
+
+val wrapper_module :
+ Paths.Identifier.Module.t * Paths.Path.Module.t ->
+ hidden:bool ->
+ Odoc_model.Lang.Signature.item list ->
+ Odoc_model.Lang.Signature.item
+(** [wrapper_module w ~hidden items] is the synthetic module an
+ [include functor] applies its functor to. Its items are aliases of [items],
+ the items that precede the include, so that whatever the functor's expansion
+ inherits from its argument resolves back to them rather than to the (hidden)
+ name of the wrapper. *)
diff --git a/src/model/lang.ml b/src/model/lang.ml
index 9dabb70404..937d008064 100644
--- a/src/model/lang.ml
+++ b/src/model/lang.ml
@@ -195,8 +195,15 @@ and Include : sig
type expansion = { shadowed : shadowed; content : Signature.t }
+ type functor_ref = Path of Path.Module.t | ModuleType of ModuleType.expr
+
+ type functor_t = { target : functor_ref; original_ref : functor_ref }
+
(* Explicitly unexpanded decl *)
- type decl = Alias of Path.Module.t | ModuleType of ModuleType.U.expr
+ type decl =
+ | Alias of Path.Module.t
+ | ModuleType of ModuleType.U.expr
+ | Functor of functor_t
type t = {
loc : Location_.span;
@@ -639,7 +646,12 @@ let extract_signature_doc (s : Signature.t) =
(* A signature that starts with an include may inherits the
top-comment from the expansion. *)
| { Include.status = `Inline; _ } -> true
- | { decl = Alias p; _ } -> Paths.Path.is_hidden (p :> Path.t)
+ | { decl = Functor { original_ref = Path p }; _ } | { decl = Alias p; _ } ->
+ Paths.Path.is_hidden (p :> Path.t)
+ | { decl = Functor { original_ref = ModuleType _ }; _ } ->
+ (* [include functor module type of ...]: nothing to be hidden behind,
+ so the enclosing signature does not inherit the top comment. *)
+ false
| { decl = ModuleType expr; _ } -> uexpr_considered_hidden expr
in
match (s.doc, s.items) with
diff --git a/src/model_desc/lang_desc.ml b/src/model_desc/lang_desc.ml
index f09fad15bb..9f71f2b794 100644
--- a/src/model_desc/lang_desc.ml
+++ b/src/model_desc/lang_desc.ml
@@ -288,11 +288,27 @@ and include_shadowed =
F ("s_class_types", (fun t -> List.map fst t.s_class_types), List string);
]
+and include_functor_ref =
+ let open Lang.Include in
+ Variant
+ (function
+ | Path p -> C ("Path", (p :> Paths.Path.t), path)
+ | ModuleType e -> C ("ModuleType", e, moduletype_expr))
+
+and include_functor_t =
+ let open Lang.Include in
+ Record
+ [
+ F ("target", (fun t -> t.target), include_functor_ref);
+ F ("original_ref", (fun t -> t.original_ref), include_functor_ref);
+ ]
+
and include_decl =
let open Lang.Include in
Variant
(function
| Alias p -> C ("Alias", (p :> Paths.Path.t), path)
+ | Functor f -> C ("Functor", f, include_functor_t)
| ModuleType e -> C ("ModuleType", e, moduletype_u_expr))
and include_expansion =
diff --git a/src/xref2/compile.ml b/src/xref2/compile.ml
index 3c64d74b2b..7b8d961115 100644
--- a/src/xref2/compile.ml
+++ b/src/xref2/compile.ml
@@ -389,6 +389,19 @@ and include_decl : Env.t -> Id.Signature.t -> Include.decl -> Include.decl =
| ModuleType expr ->
if is_elidable_with_module_type_u expr then ModuleType expr
else ModuleType (u_module_type_expr env id expr)
+ | Functor { target = Path target; original_ref = Path original_ref } ->
+ Functor
+ {
+ target = Path (module_path env target);
+ original_ref = Path (module_path env original_ref);
+ }
+ | Functor { target = Path p; original_ref = ModuleType mt } ->
+ Functor
+ {
+ target = Path (module_path env p);
+ original_ref = ModuleType (module_type_expr env id mt);
+ }
+ | Functor { target = ModuleType _ } -> assert false
| Alias p -> Alias (module_path env p)
and module_type : Env.t -> ModuleType.t -> ModuleType.t =
@@ -410,7 +423,7 @@ and include_ : Env.t -> Include.t -> Include.t * Env.t =
match
let open Odoc_utils.ResultMonad in
match decl with
- | Alias p ->
+ | Alias p | Functor p ->
Tools.expansion_of_module_path env ~strengthen:true p >>= fun exp ->
Tools.assert_not_functor exp
| ModuleType mty -> Tools.signature_of_u_module_type_expr env mty
diff --git a/src/xref2/component.ml b/src/xref2/component.ml
index f132b56729..ee645dd023 100644
--- a/src/xref2/component.ml
+++ b/src/xref2/component.ml
@@ -367,7 +367,10 @@ end =
Open
and Include : sig
- type decl = Alias of Cpath.module_ | ModuleType of ModuleType.U.expr
+ type decl =
+ | Alias of Cpath.module_
+ | ModuleType of ModuleType.U.expr
+ | Functor of Cpath.module_
type t = {
parent : Odoc_model.Paths.Identifier.Signature.t;
@@ -927,6 +930,7 @@ module Fmt = struct
let open Include in
function
| Alias p -> Format.fprintf ppf "%a" (module_path c) p
+ | Functor p -> Format.fprintf ppf "functor %a" (module_path c) p
| ModuleType mt -> Format.fprintf ppf "%a" (u_module_type_expr c) mt
and value c ppf v =
@@ -2416,6 +2420,9 @@ module Of_Lang = struct
and include_decl ident_map m =
match m with
| Odoc_model.Lang.Include.Alias p -> Include.Alias (module_path ident_map p)
+ | Functor { target = Path p; _ } ->
+ Include.Functor (module_path ident_map p)
+ | Functor { target = ModuleType _ } -> assert false
| ModuleType s -> ModuleType (u_module_type_expr ident_map s)
and simple_expansion ident_map
diff --git a/src/xref2/component.mli b/src/xref2/component.mli
index d9e25394ff..f8395d9e81 100644
--- a/src/xref2/component.mli
+++ b/src/xref2/component.mli
@@ -339,7 +339,10 @@ and Open : sig
end
and Include : sig
- type decl = Alias of Cpath.module_ | ModuleType of ModuleType.U.expr
+ type decl =
+ | Alias of Cpath.module_
+ | ModuleType of ModuleType.U.expr
+ | Functor of Cpath.module_
type t = {
parent : Odoc_model.Paths.Identifier.Signature.t;
diff --git a/src/xref2/lang_of.ml b/src/xref2/lang_of.ml
index 796bad42e3..8f0e92e60a 100644
--- a/src/xref2/lang_of.ml
+++ b/src/xref2/lang_of.ml
@@ -651,6 +651,9 @@ and include_decl :
(* Don't start shadowing within any signatures *)
match d with
| Alias p -> Alias (Path.module_ map p)
+ | Functor p ->
+ let target = Lang.Include.Path (Path.module_ map p) in
+ Functor { target; original_ref = target }
| ModuleType mty ->
let include_parent = Identifier.fresh_include_parent identifier in
ModuleType (u_module_type_expr map include_parent mty)
diff --git a/src/xref2/link.ml b/src/xref2/link.ml
index 2620a49065..a76d4a01d4 100644
--- a/src/xref2/link.ml
+++ b/src/xref2/link.ml
@@ -707,6 +707,10 @@ and include_decl : Env.t -> Id.Signature.t -> Include.decl -> Include.decl =
match decl with
| ModuleType expr when is_elidable_with_module_type_u expr -> ModuleType expr
| ModuleType expr -> ModuleType (u_module_type_expr env id expr)
+ | Functor ({ target = Path p; _ } as f) ->
+ let target = Path (module_path env p) in
+ Functor { f with target }
+ | Functor mt -> Functor mt
| Alias p -> Alias (module_path env p)
and module_type : Env.t -> ModuleType.t -> ModuleType.t =
diff --git a/src/xref2/subst.ml b/src/xref2/subst.ml
index 5a90ef98cb..2358c36ac0 100644
--- a/src/xref2/subst.ml
+++ b/src/xref2/subst.ml
@@ -760,6 +760,7 @@ and module_decl s t =
and include_decl s t =
match t with
| Include.Alias p -> Include.Alias (module_path s p)
+ | Functor p -> Functor (module_path s p)
| ModuleType t -> ModuleType (u_module_type_expr s t)
and module_ s t =
diff --git a/src/xref2/tools.ml b/src/xref2/tools.ml
index 8f3964c584..2c1b9d5f2f 100644
--- a/src/xref2/tools.ml
+++ b/src/xref2/tools.ml
@@ -1799,7 +1799,7 @@ and fragmap :
let map_include_decl decl subst =
let open Component.Include in
match decl with
- | Alias p ->
+ | Alias p | Functor p ->
expansion_of_module_path env ~strengthen:true p >>= assert_not_functor
>>= fun sg ->
fragmap env subst sg >>= fun sg -> Ok (ModuleType (Signature sg))
diff --git a/test/generators/cases/oxcaml.mli b/test/generators/cases/oxcaml.mli
index 3947f4e83a..0f6678709c 100644
--- a/test/generators/cases/oxcaml.mli
+++ b/test/generators/cases/oxcaml.mli
@@ -517,3 +517,187 @@ type mode_cstr =
(** Nested arrow: higher-order with a mode on the inner argument. *)
| Mc_gadt : ('a @ once -> 'a) -> mode_cstr
(** GADT constructor *)
+
+(** {1 Include functor on signatures} *)
+
+module No_include_functor : sig
+(** Module without any [include functor] features, this is how things are done
+ in plain OCaml at the moment. *)
+ module Make (T : sig type t end) : sig type included end
+ module T : sig
+ type t
+ end
+
+ include module type of T
+ include module type of Make(T)
+end
+
+module Include_functor : sig
+(** Module which defines a functor and includes it via [module type of] *)
+ module Make (T : sig type t end) : sig type included = T.t end
+ type t
+ include functor module type of Make
+end
+
+module Include_functor_argument_shapes : sig
+(** Everything the expansion of the functor can inherit from its argument:
+ types, including parameterised and anonymously parameterised ones,
+ submodules, and module types. *)
+ module type Arg = sig
+ type t
+ type 'a p
+ type _ anon
+ module X : sig type v end
+ module type S
+ val via_module_type_include : unit
+ val via_module_include : unit
+
+ class class_type : object
+ val content : int
+ end
+
+ class class_ : class_type
+ end
+
+ module Make (T : Arg) : sig
+ type included = T.t
+ (** No parameters, so the alias odoc puts in the synthetic module is a bare
+ [type t = t]. *)
+
+ type applied = int T.p
+ (** A named parameter, which the alias threads through as
+ [type 'a p = 'a p]. *)
+
+ type anonymous = bool T.anon
+ (** An anonymous parameter: [_] gives the alias no name to mention on the
+ right, so one is invented, as [type 'a0 anon = 'a0 anon]. *)
+
+ type from_module = T.X.v
+ (** Reached through a submodule of the argument, aliased as
+ [module X = X]. *)
+
+ module type Reexported = T.S
+ (** A module type of the argument, aliased as a path to it. *)
+
+ class output_class_via_type : T.class_type
+ (** A class whose type comes from an explicitely named class type *)
+
+ class output_class_via_name : T.class_
+ (** A class whose type comes from the name of a class *)
+
+ module Aliased = T
+ (** The input module itself. It should contain everything from the top
+ level module *)
+ end
+
+ (**/**)
+ module type To_include_module_type = sig
+ val via_module_type_include : unit
+ end
+
+ module To_include_module : sig
+ val via_module_include : unit
+ end
+ (**/**)
+
+ class class_type : object
+ val content : int
+ end
+
+ class class_ : class_type
+
+ type t
+ type 'a p
+ type _ anon
+ module X : sig type v end
+ module type S = sig type u end
+ include To_include_module_type
+ include module type of To_include_module
+
+ include functor module type of Make
+end
+
+module Include_functor_desugared : sig
+(** This module is the desugared version of {!Include_functor}: the synthetic
+ module aliases the preceding items rather than copying them, so that the
+ types the functor inherits from its argument resolve back to them. *)
+ module Make (T : sig type t end) : sig type included = T.t end
+
+ type t
+
+ module DUMMY__ : sig
+ type nonrec t = t
+ end
+
+ include module type of Make(DUMMY__)
+end
+
+module Include_functor_named_type_desugared : sig
+(** This is the desugared version of {!Include_functor_named_type}. *)
+ module type MakeType = (X : sig type t end) -> sig type included = X.t end
+
+ type t
+
+ module DUMMY__ : sig
+ type nonrec t = t
+ end
+
+ module STRUCT__MakeType : MakeType
+ include module type of STRUCT__MakeType(DUMMY__)
+end
+
+module Include_functor_named_type : sig
+(** This is a module where the functor is named and then included. *)
+ module type MakeType = (X : sig type t end) -> sig type included = X.t end
+ type t
+ include functor MakeType
+end
+
+module Include_functor_inline : sig
+(** This is a test case where the functor is named and included inline *)
+ module type Make = (_ : sig type t end) -> sig type included end
+ type t
+ include functor Make
+ (** @inline *)
+end
+
+module Anonymous_functor : sig
+(** In this test case the functor is defined inline *)
+ type t
+ include functor module type of functor (T : sig type t end) -> struct type included end
+end
+
+module Anonymous_functor_desugared : sig
+(** In this test case the functor is defined inline *)
+ module DUMMY__ : sig
+ type t
+ end
+ include module type of DUMMY__
+
+ include module type of (functor (T : sig type t end) -> struct type included end)(DUMMY__)
+end
+
+module Multiple_include_functors : sig
+(** Two [include functor]s in the same signature, with an item defined between
+ them. *)
+ module First (T : sig type t end) : sig type first = T.t end
+
+ module Second (T : sig type t type first type between end) : sig
+ type second = T.first
+ type third = T.between
+ end
+
+ type t
+ include functor module type of First
+ type between
+ include functor module type of Second
+end
+
+module Include_functor_not_last : sig
+(** An [include functor] that is not the last item of the signature. *)
+ module Make (T : sig type t end) : sig type included = T.t end
+
+ type t
+ include functor module type of Make
+ type after
+end
diff --git a/test/generators/cases/oxcaml_impl.ml b/test/generators/cases/oxcaml_impl.ml
index 3d605794d5..4789f12542 100644
--- a/test/generators/cases/oxcaml_impl.ml
+++ b/test/generators/cases/oxcaml_impl.ml
@@ -59,3 +59,68 @@ let mode_arg : int @ local -> int = fun x -> x
let mode_multi : string @ local once -> string @ local once = fun x -> x
(** Multiple modes on argument and return. *)
+
+(** {1 Include functor on structures} *)
+
+module Include_functor = struct
+(** This module demonstrates the [include functor] functionality. [Make] uses
+ its argument, so [included] has to come out equal to [t] rather than
+ abstract. *)
+ module Make (T : sig type t end) = struct type included = T.t end
+ type t
+ include functor Make
+end
+
+module Include_functor_desugared = struct
+(** This module is the desugared version from above *)
+ module Make (T : sig type t end) = struct type included = T.t end
+ type t
+ module DUMMY__ = struct
+ type nonrec t = t
+ end
+ include Make(DUMMY__)
+end
+
+module Resolve_functor = struct
+ module F ( I : sig type t end ) = struct
+ type myt = I.t
+ end
+
+ module M = struct
+ type t = float
+ include functor F
+ end
+end
+
+module Multiple_include_functors = struct
+(** Two [include functor]s in the same structure, with an item defined between
+ them. *)
+ module First (T : sig type t end) = struct type first = T.t end
+
+ module Second (T : sig type t type first type between end) = struct
+ type second = T.first
+ type third = T.between
+ end
+
+ type t
+ include functor First
+ type between
+ include functor Second
+end
+
+module Include_functor_not_last = struct
+(** An [include functor] that is not the last item of the structure. *)
+ module Make (T : sig type t end) = struct type included = T.t end
+
+ type t
+ include functor Make
+ type after = string
+end
+
+module Anonymous_functor = struct
+(** The functor is defined inline, so there is no path for odoc to apply: it
+ has to bind the functor to a module first, as it does for every
+ [include functor] in a signature. *)
+ type t
+ include functor (functor (T : sig type t end) -> struct type included = T.t end)
+end
diff --git a/test/generators/html/Oxcaml-Anonymous_functor.html b/test/generators/html/Oxcaml-Anonymous_functor.html
new file mode 100644
index 0000000000..7179fdc3a4
--- /dev/null
+++ b/test/generators/html/Oxcaml-Anonymous_functor.html
@@ -0,0 +1,54 @@
+
+
+ Anonymous_functor (Oxcaml.Anonymous_functor)
+
+
+
+
+
+
+
+
+
+
Module Oxcaml.Anonymous_functor
+
+
+
+
+
+ type t
+
+
+
In this test case the functor is defined inline
+
+
+
+
+
+
+ include functor
+ functor
+ (
+ T
+ : sig ...
+ end)
+ ->
+ sig ...
+ end
+
+
+
+
Everything the expansion of the functor can inherit from its
+ argument: types, including parameterised and anonymously parameterised
+ ones, submodules, and module types.
+
Module type
+ Include_functor_argument_shapes.Arg
+
+
Everything the expansion of the functor can inherit from its argument:
+ types, including parameterised and anonymously parameterised ones,
+ submodules, and module types.
+
+
+
+ module
+ type
+
+ Arg
+
+
+ = sig ...
+ end
+
+
+
+
+
Everything the expansion of the functor can inherit from its
+ argument: types, including parameterised and anonymously parameterised
+ ones, submodules, and module types.
+
This module is the desugared version of
+ Include_functor
+ : the synthetic module aliases the preceding items rather than copying
+ them, so that the types the functor inherits from its argument resolve
+ back to them.
+
+
+
+ module
+ Make
+
+ (
+ T
+ : sig ...
+ end) : sig
+ ... end
+
+
+
+
+
This module is the desugared version of
+ Include_functor
+ : the synthetic module aliases the preceding items rather than
+ copying them, so that the types the functor inherits from its argument
+ resolve back to them.
+