diff --git a/CHANGES.md b/CHANGES.md
index 551d12f499..423f94a2e7 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -4,6 +4,8 @@
- Support for OxCaml zero alloc definitions (@Leonidas-from-XIV, #1422, #1444)
- Remove requirement for ppx_expect in tests (@jonludlam, #1445)
- Support for OxCaml modalities (@art-w, #1420)
+- Display items included via `include functor` as included via the functor
+ (@Leonidas-from-XIV, #1452)
# 3.2.1
diff --git a/src/document/generator.ml b/src/document/generator.ml
index 0133714b0f..6d840e3d89 100644
--- a/src/document/generator.ml
+++ b/src/document/generator.ml
@@ -1916,8 +1916,8 @@ 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 (Path p) -> Paths.Path.(is_hidden (p :> t))
+ | ModuleType mty | Functor (ModuleType mty) -> umty_hidden mty
in
let status = if decl_hidden then `Inline else t.status in
@@ -1925,14 +1925,18 @@ module Make (Syntax : SYNTAX) = struct
let summary =
if decl_hidden then O.render (O.keyword "include" ++ O.txt " ...")
else
- let include_decl =
+ let include_kw, include_decl =
match t.decl with
| Odoc_model.Lang.Include.Alias mod_path ->
- Link.from_path (mod_path :> Paths.Path.t)
- | ModuleType mt -> umty mt
+ (O.keyword "include", Link.from_path (mod_path :> Paths.Path.t))
+ | Functor (Path mod_path) ->
+ ( O.keyword "include functor",
+ Link.from_path (mod_path :> Paths.Path.t) )
+ | Functor (ModuleType mt) -> (O.keyword "include functor", umty mt)
+ | ModuleType mt -> (O.keyword "include", 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 7de18c4296..94dc3d9fb9 100644
--- a/src/loader/cmt.ml
+++ b/src/loader/cmt.ml
@@ -613,26 +613,29 @@ and read_include env parent incl =
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_functor _ | Tincl_gen_functor _) -> (
+ let p = Env.Path.read_module env.ident_env p in
+ Some (`Functor p))
| 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))
+ Some (`Module_type (ModuleType.U.TypeOf (ModuleType.StructInclude p, p)))
| _ ->
let mty = read_module_expr env parent container incl.incl_mod in
- umty_of_mty mty
+ umty_of_mty mty |> Option.map (fun m -> `Module_type m)
in
let content, shadowed = Cmi.read_signature_noenv env parent (Odoc_model.Compat.signature incl.incl_type) in
let expansion = { content; shadowed; } in
match decl_modty with
- | Some m ->
+ | Some `Module_type m ->
let decl = ModuleType m in
[Include {parent; doc; decl; expansion; status; strengthened=None; loc }]
+ | Some `Functor p ->
+ let decl = Include.Functor (Path p) in
+ [Include {parent; doc; decl; expansion; status; strengthened=None; loc }]
| _ ->
content.items
diff --git a/src/loader/cmti.ml b/src/loader/cmti.ml
index a5200ae3b5..33ef7cc95a 100644
--- a/src/loader/cmti.ml
+++ b/src/loader/cmti.ml
@@ -965,8 +965,16 @@ and read_include env parent incl =
#endif
let decl = Include.ModuleType uexpr in
[Include {parent; doc; decl; expansion; status; strengthened=None; loc }]
+#if defined OXCAML
+ | Some uexpr, (Tincl_functor _ | Tincl_gen_functor _) ->
+ let decl = match uexpr with
+ | TypeOf (ModPath p, _) -> Include.Functor (Path p)
+ | Path p -> Include.Functor (ModuleType uexpr)
+ | _ -> failwith "We expected TypeOf or Path but got something else"
+ in
+ [Include {parent; doc; decl; expansion; status; strengthened=None; loc }]
+#endif
| _ ->
- (* TODO: Handle [include functor] *)
content.items
and read_open env parent o =
diff --git a/src/model/lang.ml b/src/model/lang.ml
index 4fe5b890ae..b791592c79 100644
--- a/src/model/lang.ml
+++ b/src/model/lang.ml
@@ -195,8 +195,13 @@ and Include : sig
type expansion = { shadowed : shadowed; content : Signature.t }
+ type functor' = Path of Path.Module.t | ModuleType of ModuleType.U.expr
+
(* 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'
type t = {
loc : Location_.span;
@@ -632,7 +637,9 @@ 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 = Alias p; _ } | { decl = Functor (Path p); _ } ->
+ Paths.Path.is_hidden (p :> Path.t)
+ | { decl = Functor (ModuleType expr); _ } -> uexpr_considered_hidden expr
| { 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 75e9bcf7e3..103ba28239 100644
--- a/src/model_desc/lang_desc.ml
+++ b/src/model_desc/lang_desc.ml
@@ -293,6 +293,8 @@ and include_decl =
Variant
(function
| Alias p -> C ("Alias", (p :> Paths.Path.t), path)
+ | Functor (Path p) -> C ("Functor", (p :> Paths.Path.t), path)
+ | Functor (ModuleType e) -> C ("Functor", e, moduletype_u_expr)
| ModuleType e -> C ("ModuleType", e, moduletype_u_expr))
and include_expansion =
diff --git a/src/xref2/compile.ml b/src/xref2/compile.ml
index a6dd9a101d..dbb4b386f3 100644
--- a/src/xref2/compile.ml
+++ b/src/xref2/compile.ml
@@ -389,6 +389,10 @@ 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 (Path p) -> Functor (Path (module_path env p))
+ | Functor (ModuleType expr) ->
+ if is_elidable_with_module_type_u expr then ModuleType expr
+ else Functor (ModuleType (u_module_type_expr env id expr))
| Alias p -> Alias (module_path env p)
and module_type : Env.t -> ModuleType.t -> ModuleType.t =
@@ -410,10 +414,16 @@ and include_ : Env.t -> Include.t -> Include.t * Env.t =
match
let open Odoc_utils.ResultMonad in
match decl with
+ | Functor (Path p) ->
+ Tools.expansion_of_module_path env ~strengthen:true p >>= fun exp ->
+ Tools.assert_functor exp
+ | Functor (ModuleType mty) ->
+ Tools.signature_of_u_module_type_expr env mty ~allow_functor:true
| Alias 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
+ | ModuleType mty ->
+ Tools.signature_of_u_module_type_expr env mty ~allow_functor:false
with
| Error e ->
Errors.report ~what:(`Include decl) ~tools_error:e `Expand;
@@ -639,7 +649,9 @@ and module_type_map_subs env id cexpr subs =
match find_parent cexpr with
| None -> None
| Some parent -> (
- match Tools.signature_of_u_module_type_expr env cexpr with
+ match
+ Tools.signature_of_u_module_type_expr env cexpr ~allow_functor:false
+ with
| Error e ->
Errors.report ~what:(`Module_type id) ~tools_error:e `Lookup;
None
diff --git a/src/xref2/component.ml b/src/xref2/component.ml
index be23a7b3ea..e26874737d 100644
--- a/src/xref2/component.ml
+++ b/src/xref2/component.ml
@@ -364,7 +364,11 @@ end =
Open
and Include : sig
- type decl = Alias of Cpath.module_ | ModuleType of ModuleType.U.expr
+ type functor' = Path of Cpath.module_ | ModuleType of ModuleType.U.expr
+ type decl =
+ | Alias of Cpath.module_
+ | ModuleType of ModuleType.U.expr
+ | Functor of functor'
type t = {
parent : Odoc_model.Paths.Identifier.Signature.t;
@@ -924,6 +928,9 @@ module Fmt = struct
let open Include in
function
| Alias p -> Format.fprintf ppf "%a" (module_path c) p
+ | Functor (Path p) -> Format.fprintf ppf "functor %a" (module_path c) p
+ | Functor (ModuleType mt) ->
+ Format.fprintf ppf "functor %a" (u_module_type_expr c) mt
| ModuleType mt -> Format.fprintf ppf "%a" (u_module_type_expr c) mt
and value c ppf v =
@@ -2410,6 +2417,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 (Path p) -> Functor (Path (module_path ident_map p))
+ | Functor (ModuleType s) ->
+ Functor (ModuleType (u_module_type_expr ident_map s))
| 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 abda54e140..8a3a92a03d 100644
--- a/src/xref2/component.mli
+++ b/src/xref2/component.mli
@@ -336,7 +336,11 @@ and Open : sig
end
and Include : sig
- type decl = Alias of Cpath.module_ | ModuleType of ModuleType.U.expr
+ type functor' = Path of Cpath.module_ | ModuleType of ModuleType.U.expr
+ type decl =
+ | Alias of Cpath.module_
+ | ModuleType of ModuleType.U.expr
+ | Functor of functor'
type t = {
parent : Odoc_model.Paths.Identifier.Signature.t;
diff --git a/src/xref2/lang_of.ml b/src/xref2/lang_of.ml
index 5c49cb96c9..88fff40ea4 100644
--- a/src/xref2/lang_of.ml
+++ b/src/xref2/lang_of.ml
@@ -651,6 +651,10 @@ and include_decl :
(* Don't start shadowing within any signatures *)
match d with
| Alias p -> Alias (Path.module_ map p)
+ | Functor (Path p) -> Functor (Path (Path.module_ map p))
+ | Functor (ModuleType mty) ->
+ let include_parent = Identifier.fresh_include_parent identifier in
+ Functor (ModuleType (u_module_type_expr map include_parent mty))
| 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 bd332ee691..1b38fa8c0a 100644
--- a/src/xref2/link.ml
+++ b/src/xref2/link.ml
@@ -707,6 +707,9 @@ 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 (Path p) -> Functor (Path (module_path env p))
+ | Functor (ModuleType expr) ->
+ Functor (ModuleType (u_module_type_expr env id expr))
| Alias p -> Alias (module_path env p)
and module_type : Env.t -> ModuleType.t -> ModuleType.t =
@@ -898,7 +901,9 @@ and u_module_type_expr :
| Path p -> Path (module_type_path env p)
| With (subs, expr) as unresolved -> (
let cexpr = Component.Of_Lang.(u_module_type_expr (empty ()) expr) in
- match Tools.signature_of_u_module_type_expr env cexpr with
+ match
+ Tools.signature_of_u_module_type_expr env cexpr ~allow_functor:false
+ with
| Ok sg ->
With (handle_fragments env id sg subs, u_module_type_expr env id expr)
| Error e ->
@@ -945,7 +950,9 @@ and module_type_expr :
Path { p_path; p_expansion = do_expn p_expansion (Some p_path) }
| With { w_substitutions; w_expansion; w_expr } as unresolved -> (
let cexpr = Component.Of_Lang.(u_module_type_expr (empty ()) w_expr) in
- match Tools.signature_of_u_module_type_expr env cexpr with
+ match
+ Tools.signature_of_u_module_type_expr env cexpr ~allow_functor:false
+ with
| Ok sg ->
With
{
diff --git a/src/xref2/subst.ml b/src/xref2/subst.ml
index 49bbf0205e..64a16662ec 100644
--- a/src/xref2/subst.ml
+++ b/src/xref2/subst.ml
@@ -759,6 +759,8 @@ and module_decl s t =
and include_decl s t =
match t with
| Include.Alias p -> Include.Alias (module_path s p)
+ | Functor (Path p) -> Functor (Path (module_path s p))
+ | Functor (ModuleType t) -> ModuleType (u_module_type_expr s t)
| 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 a560ec01cc..ca8e641db9 100644
--- a/src/xref2/tools.ml
+++ b/src/xref2/tools.ml
@@ -1586,6 +1586,12 @@ and assert_not_functor : type err.
| Signature sg -> Ok sg
| _ -> assert false
+and assert_functor : type err. expansion -> (Component.Signature.t, err) result
+ = function
+ | Functor (_, mty) -> (
+ match mty with Signature s -> Ok s | _ -> assert false)
+ | _ -> assert false
+
and unresolve_subs subs =
List.map
(function
@@ -1621,22 +1627,28 @@ and signature_of_module_type_of :
and signature_of_u_module_type_expr :
Env.t ->
Component.ModuleType.U.expr ->
+ allow_functor:bool ->
(Component.Signature.t, expansion_of_module_error) result =
- fun env m ->
+ fun env m ~allow_functor ->
match m with
| Component.ModuleType.U.Path p -> (
match resolve_module_type env p with
- | Ok (_, mt) -> expansion_of_module_type env mt >>= assert_not_functor
+ | Ok (_, mt) -> (
+ expansion_of_module_type env mt
+ >>=
+ match allow_functor with
+ | true -> assert_functor
+ | false -> assert_not_functor)
| Error e -> Error (`UnresolvedPath (`ModuleType (p, e))))
| Signature s -> Ok s
| With (subs, s) ->
- signature_of_u_module_type_expr env s >>= fun sg ->
+ signature_of_u_module_type_expr env s ~allow_functor >>= fun sg ->
let subs = unresolve_subs subs in
handle_signature_with_subs env sg subs
| TypeOf (desc, original_path) ->
signature_of_module_type_of env desc ~original_path >>= assert_not_functor
| Strengthen (expr, path, _aliasable) ->
- signature_of_u_module_type_expr env expr >>= fun sg ->
+ signature_of_u_module_type_expr env expr ~allow_functor >>= fun sg ->
Ok (Strengthen.signature path sg)
and expansion_of_simple_expansion :
@@ -1667,7 +1679,8 @@ and expansion_of_module_type_expr :
| Component.ModuleType.With { w_expansion = Some e; _ } ->
Ok (expansion_of_simple_expansion e)
| Component.ModuleType.With { w_substitutions; w_expr; _ } ->
- signature_of_u_module_type_expr env w_expr >>= fun sg ->
+ signature_of_u_module_type_expr env w_expr ~allow_functor:false
+ >>= fun sg ->
let subs = unresolve_subs w_substitutions in
handle_signature_with_subs env sg subs >>= fun sg -> Ok (Signature sg)
| Component.ModuleType.Functor (arg, expr) -> Ok (Functor (arg, expr))
@@ -1681,7 +1694,8 @@ and expansion_of_module_type_expr :
in
expansion_of_module_path env ~strengthen p
| Component.ModuleType.Strengthen { s_expr; s_path; _ } ->
- signature_of_u_module_type_expr env s_expr >>= fun sg ->
+ signature_of_u_module_type_expr env s_expr ~allow_functor:false
+ >>= fun sg ->
let sg = Strengthen.signature s_path sg in
Ok (Signature sg)
@@ -1812,7 +1826,12 @@ and fragmap :
expansion_of_module_path env ~strengthen:true p >>= assert_not_functor
>>= fun sg ->
fragmap env subst sg >>= fun sg -> Ok (ModuleType (Signature sg))
- | ModuleType mty' -> Ok (ModuleType (With ([ subst ], mty')))
+ | Functor (Path p) ->
+ expansion_of_module_path env ~strengthen:true p >>= assert_functor
+ >>= fun sg ->
+ fragmap env subst sg >>= fun sg -> Ok (ModuleType (Signature sg))
+ | Functor (ModuleType mty') | ModuleType mty' ->
+ Ok (ModuleType (With ([ subst ], mty')))
in
let map_module m new_subst =
let open Component.Module in
diff --git a/src/xref2/tools.mli b/src/xref2/tools.mli
index 81c1322c42..b381c1534e 100644
--- a/src/xref2/tools.mli
+++ b/src/xref2/tools.mli
@@ -201,6 +201,8 @@ val prefix_signature :
val assert_not_functor : expansion -> (Component.Signature.t, 'err) result
+val assert_functor : expansion -> (Component.Signature.t, 'err) result
+
val expansion_of_module_path :
Env.t ->
strengthen:bool ->
@@ -240,6 +242,7 @@ val expansion_of_module_type_expr :
val signature_of_u_module_type_expr :
Env.t ->
Component.ModuleType.U.expr ->
+ allow_functor:bool ->
(Component.Signature.t, expansion_of_module_error) result
(** The following functions are use for the resolution of
{{!type:Odoc_model.Paths.Fragment.t}Fragments} Whilst resolving fragments it
diff --git a/test/generators/cases/oxcaml.mli b/test/generators/cases/oxcaml.mli
index 11db3f653a..0557c84fe3 100644
--- a/test/generators/cases/oxcaml.mli
+++ b/test/generators/cases/oxcaml.mli
@@ -280,3 +280,31 @@ module M3 : sig @@ contended
end
(** [contended] modality applied to all definitions in the module, except the
ones which have already specified this axis. *)
+
+(** {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 end
+ type t
+ include functor module type of Make
+end
+
+module Include_functor_named_type : sig
+(** This is a Module where the type is named and then included. *)
+ module type Make = (_ : sig type t end) -> sig type included end
+ type t
+ include functor Make
+end
diff --git a/test/generators/cases/oxcaml_impl.ml b/test/generators/cases/oxcaml_impl.ml
index 351121dbe1..caffeb8a98 100644
--- a/test/generators/cases/oxcaml_impl.ml
+++ b/test/generators/cases/oxcaml_impl.ml
@@ -8,3 +8,24 @@ end
module Including = struct
include To_be_included
end
+
+(** {1 Include functor on structures} *)
+
+module No_include_functor = struct
+(** This module shows how to achieve the effect without [include functor],
+ with an intermediate module [T]. *)
+ module Make (T : sig type t end) = struct type included end
+ module T = struct
+ type t
+ end
+
+ include T
+ include Make(T)
+end
+
+module Include_functor = struct
+(** This module demonstratest the [include functor] functionality *)
+ module Make (T : sig type t end) = struct type included end
+ type t
+ include functor Make
+end
diff --git a/test/generators/html/Oxcaml-Include_functor-Make-argument-1-T.html b/test/generators/html/Oxcaml-Include_functor-Make-argument-1-T.html
new file mode 100644
index 0000000000..4d5cabd316
--- /dev/null
+++ b/test/generators/html/Oxcaml-Include_functor-Make-argument-1-T.html
@@ -0,0 +1,29 @@
+
+
+ T (Oxcaml.Include_functor.Make.T)
+
+
+
+
+
+
+
+
+
+