Ocaml 5.5 compat

CHANGES.md

@@ -5,6 +5,7 @@
 - `markdown-generate` command now accepts multiple `.odocl` files in a single
   invocation, eliminating the need for shell scripting (@davesnx, #1387)
 - Support for OxCaml (@lukemaurer, @art-w, #1399)
+- OCaml 5.5.0 support (@panglesd, @xvw, #1406)
 
 ### Fixed
 - Fix compile-time crashing bugs #930 and #1385 (@jonludlam, #1400)

odoc-parser.opam

@@ -14,7 +14,7 @@ dev-repo: "git+https://github.com/ocaml/odoc.git"
 doc: "https://ocaml.github.io/odoc/odoc_parser"
 depends: [
   "dune" {>= "3.21"}
-  "ocaml" {>= "4.08.0" & < "5.5"}
+  "ocaml" {>= "4.08.0"}
   "astring"
   "camlp-streams"
   "ppx_expect" {with-test}

odoc.opam

@@ -45,7 +45,7 @@ depends: [
   "cppo" {build & >= "1.1.0"}
   "dune" {>= "3.21.0"}
   "fpath" {>= "0.7.3"}
-  "ocaml" {>= "4.08.0" & < "5.5"}
+  "ocaml" {>= "4.08.0" & < "5.6"}
   "tyxml" {>= "4.4.0"}
   "fmt"
   "crunch" {>= "1.4.1"}

src/document/generator.ml

@@ -485,19 +485,36 @@ module Make (Syntax : SYNTAX) = struct
       | Splice t -> O.span (O.txt "$" ++ type_expr ~needs_parentheses:true t)
       | Package pkg ->
           enclose ~l:"(" ~r:")"
-            (O.keyword "module" ++ O.txt " "
-            ++ Link.from_path (pkg.path :> Paths.Path.t)
-            ++
-            match pkg.substitutions with
-            | [] -> O.noop
-            | fst :: lst ->
-                O.sp
-                ++ O.box_hv (O.keyword "with" ++ O.txt " " ++ package_subst fst)
-                ++ O.list lst ~f:(fun s ->
-                       O.cut
-                       ++ (O.box_hv
-                          @@ O.txt " " ++ O.keyword "and" ++ O.txt " "
-                             ++ package_subst s)))
+            (O.keyword "module" ++ O.txt " " ++ package_path pkg)
+      | Arrow_functor (lbl, m_arg, dst) ->
+          let lbl =
+            match lbl with None -> O.noop | Some lbl -> label lbl ++ O.txt ":"
+          in
+          let name =
+            match m_arg.id.iv with
+            | `Parameter (_, name) -> ModuleName.to_string name
+          in
+          let dst = type_expr dst in
+          let pkg =
+            enclose ~l:"(" ~r:")"
+            @@ O.keyword "module" ++ O.txt " " ++ O.txt name ++ O.txt " : "
+               ++ package_path m_arg.package
+          in
+          lbl ++ pkg ++ O.sp ++ Syntax.Type.arrow ++ O.sp ++ dst
+
+    and package_path pkg =
+      Link.from_path (pkg.path :> Paths.Path.t)
+      ++
+      match pkg.substitutions with
+      | [] -> O.noop
+      | fst :: lst ->
+          O.sp
+          ++ O.box_hv (O.keyword "with" ++ O.txt " " ++ package_subst fst)
+          ++ O.list lst ~f:(fun s ->
+                 O.cut
+                 ++ (O.box_hv
+                    @@ O.txt " " ++ O.keyword "and" ++ O.txt " "
+                       ++ package_subst s))
 
     and package_subst
         ((frag_typ, te) : Paths.Fragment.Type.t * Odoc_model.Lang.TypeExpr.t) :

src/loader/cmi.ml

@@ -300,7 +300,13 @@ let mark_type ty =
       | Tpoly (ty, tyl) ->
           List.iter (fun t -> add_alias t) tyl;
           loop visited ty
-#if OCAML_VERSION>=(5,4,0)
+#if OCAML_VERSION>=(5,5,0)
+      | Tpackage p ->
+          List.iter (fun (_,x) -> loop visited x) p.pack_constraints
+      | Tfunctor (_lbl, _id, pkg, ret_type) ->
+          List.iter (fun (_,x) -> loop visited x) pkg.pack_constraints;
+          loop visited ret_type
+#elif OCAML_VERSION>=(5,4,0)
       | Tpackage p ->
           List.iter (fun (_,x) -> loop visited x) p.pack_cstrs
 #elif OCAML_VERSION>=(4,13,0)
@@ -428,6 +434,9 @@ let mark_type_kind = function
 #endif
       List.iter (fun ld -> mark_type ld.ld_type) lds
   | Type_open -> ()
+#if OCAML_VERSION >= (5,5,0)
+  | Type_external _ -> ()
+#endif
 
 let mark_type_declaration decl =
   let params = prepare_type_parameters decl.type_params decl.type_manifest in
@@ -554,7 +563,10 @@ let rec read_type_expr env typ =
             remove_names tyl;
             Poly(vars, typ)
       | Tunivar _ -> Var (name_of_type typ)
-#if OCAML_VERSION>=(5,4,0)
+#if OCAML_VERSION>=(5,5,0)
+      | Tpackage {pack_path=p; pack_constraints } ->
+        let eqs = List.filter_map (fun (l,ty) -> Option.map (fun x -> x, ty) (Longident.unflatten l)) pack_constraints in
+#elif OCAML_VERSION>=(5,4,0)
       | Tpackage {pack_path=p; pack_cstrs } ->
         let eqs = List.filter_map (fun (l,ty) -> Option.map (fun x -> x, ty) (Longident.unflatten l)) pack_cstrs in
 #elif OCAML_VERSION>=(4,13,0)
@@ -563,22 +575,30 @@ let rec read_type_expr env typ =
       | Tpackage(p, frags, tyl) ->
         let eqs = List.combine frags tyl in
 #endif
-          let open TypeExpr.Package in
-          let path = Env.Path.read_module_type env.ident_env p in
-          let substitutions =
-            List.map
-              (fun (frag,typ) ->
-                 let frag = Env.Fragment.read_type frag in
-                 let typ = read_type_expr env typ in
-                   (frag, typ))
-              eqs
-          in
-
-          Package {path; substitutions}
+        let package = read_package env eqs p in
+        Package package
 #if OCAML_VERSION<(4,13,0)
       | Tsubst typ -> read_type_expr env typ
 #else
       | Tsubst (typ,_) -> read_type_expr env typ
+#endif
+#if OCAML_VERSION >= (5,5,0)
+  | Tfunctor (lbl, id, pkg, ret_type) ->
+    let lbl = read_label lbl in
+    let parent = Identifier.fresh_module_arg_parent () in
+    let id = Ocaml_ident.of_unscoped id in
+    let e', id =
+      Env.add_module_arg parent id (ModuleName.hidden_of_ident id)
+        env.ident_env
+    in
+    let env = {env with ident_env = e'} in
+    let ret = read_type_expr env ret_type in
+    let eqs =
+      List.filter_map (fun (l,ty) -> Option.map (fun x -> x, ty) (Longident.unflatten l)) pkg.pack_constraints
+    in
+    let package = read_package env eqs pkg.pack_path in
+    Arrow_functor(lbl, {id ; package}, ret)
+
 #endif
       | Tlink _ -> assert false
 #if defined OXCAML
@@ -592,6 +612,20 @@ let rec read_type_expr env typ =
       | Some name -> Alias(typ, name)
   end
 
+and read_package env eqs p =
+  let open TypeExpr in
+  let open TypeExpr.Package in
+  let path = Env.Path.read_module_type env.ident_env p in
+  let substitutions =
+    List.map
+      (fun (frag,typ) ->
+         let frag = Env.Fragment.read_type frag in
+         let typ = read_type_expr env typ in
+         (frag, typ))
+      eqs
+  in
+  {path; substitutions}
+
 and read_row env _px row =
   let open TypeExpr in
   let open TypeExpr.Polymorphic_variant in
@@ -811,6 +845,9 @@ let read_type_kind env parent =
         in
           Some (Record lbls)
     | Type_open ->  Some Extensible
+#if OCAML_VERSION >= (5,5,0)
+    | Type_external _ -> None
+#endif
 
 let read_injectivity var =
 #if OCAML_VERSION < (5, 1, 0)
@@ -893,6 +930,10 @@ let read_type_declaration env parent id decl =
         List.exists (fun cd -> cd.cd_res <> None) tll
     | Type_open ->
         decl.type_manifest = None
+#if OCAML_VERSION >= (5,5,0)
+    | Type_external _ ->
+        decl.type_manifest = None || decl.type_private = Private
+#endif
   in
   let params =
     List.map2 (read_type_parameter abstr) decl.type_variance params

src/loader/cmti.ml

@@ -173,22 +173,15 @@ let rec read_core_type env container ctyp =
 #else
     | Ttyp_poly(vars, typ) -> Poly(vars, read_core_type env container typ)
 #endif
-#if OCAML_VERSION >= (5,4,0)
+#if OCAML_VERSION >= (5,5,0)
+    | Ttyp_package {tpt_path = pack_path; tpt_constraints=pack_fields; _} ->
+#elif OCAML_VERSION >= (5,4,0)
     | Ttyp_package {tpt_path = pack_path; tpt_cstrs=pack_fields; _} ->
 #else
     | Ttyp_package {pack_path; pack_fields; _} ->
 #endif
-        let open TypeExpr.Package in
-        let path = Env.Path.read_module_type env.ident_env pack_path in
-        let substitutions =
-          List.map
-            (fun (frag, typ) ->
-               let frag = Env.Fragment.read_type frag.Location.txt in
-               let typ = read_core_type env container typ in
-               (frag, typ))
-            pack_fields
-        in
-          Package {path; substitutions}
+        let pkg = read_package env container pack_path pack_fields in
+        Package pkg
 #if OCAML_VERSION >= (5,2,0)
     | Ttyp_open (_p,_l,t) ->
       (* TODO: adjust model *)
@@ -199,8 +192,33 @@ let rec read_core_type env container ctyp =
     | Ttyp_splice typ -> Splice (read_core_type env container typ)
     | Ttyp_call_pos -> Constr(Env.Path.read_type env.ident_env Predef.path_lexing_position, [])
     | Ttyp_of_kind _ -> assert false
+#elif OCAML_VERSION >= (5,5,0)
+  | Ttyp_functor (lbl, id, pkg, ret_type) ->
+    let lbl = read_label lbl in
+    let parent = Identifier.fresh_module_arg_parent () in
+    let e', id =
+      Env.add_module_arg parent id.txt (ModuleName.hidden_of_ident id.txt)
+        env.ident_env
+    in
+      let env = {env with ident_env = e'} in
+      let ret = read_core_type env container ret_type in
+      let package = read_package env container pkg.tpt_path pkg.tpt_constraints in
+    Arrow_functor(lbl, {id ; package}, ret)
 #endif
 
+and read_package env container pack_path pack_fields =
+  let open TypeExpr.Package in
+  let path = Env.Path.read_module_type env.ident_env pack_path in
+  let substitutions =
+    List.map
+      (fun (frag, typ) ->
+         let frag = Env.Fragment.read_type frag.Location.txt in
+         let typ = read_core_type env container typ in
+         (frag, typ))
+      pack_fields
+  in
+  {path; substitutions}
+
 let read_value_description env parent vd =
   let open Signature in
   let id = Env.find_value_identifier env.ident_env vd.val_id in
@@ -333,6 +351,9 @@ let read_type_kind env parent =
           Some (Record_unboxed_product lbls)
 #endif
     | Ttype_open -> Some Extensible
+#if OCAML_VERSION >= (5,5,0)
+    | Ttype_external _ -> None
+#endif
 
 let read_type_equation env container decl =
   let open TypeDecl.Equation in
@@ -344,7 +365,11 @@ let read_type_equation env container decl =
       (fun (typ1, typ2, _) ->
          (read_core_type env container typ1,
           read_core_type env container typ2))
+#if OCAML_VERSION >= (5,5,0)
+      decl.typ_constraints
+#else
       decl.typ_cstrs
+#endif
   in
     {params; private_; manifest; constraints}
 
@@ -661,7 +686,11 @@ and read_module_type env parent label_parent mty =
             let p = Env.Path.read_module env.ident_env p in
             TypeOf {t_desc = ModPath p; t_original_path = p; t_expansion = None}
           | Tmod_structure {str_items = [{str_desc = Tstr_include {incl_mod; _}; _}]; _} -> begin
+#if OCAML_VERSION >= (5,5,0)
+            match Typedtree.path_of_module incl_mod with
+#else
             match Typemod.path_of_module incl_mod with
+#endif
               | Some p ->
                 let p = Env.Path.read_module env.ident_env p in
                 TypeOf {t_desc=StructInclude p; t_original_path = p; t_expansion = None}

src/loader/ident_env.ml

@@ -132,7 +132,11 @@ and extract_signature_type_items_extract vis ~hidden item rest =
           | Type_variant (cstrs, _) ->
 #endif
             List.map (fun c -> `Constructor (c.Types.cd_id, id, Some c.cd_loc)) cstrs
-          | Type_open -> [] in
+          | Type_open -> []
+#if OCAML_VERSION >= (5,5,0)
+          | Type_external _ -> []
+#endif
+          in
         `Type (id, hidden, None) :: constrs @ extract_signature_type_items vis rest
 
     | Sig_module(id, _, _, _, _), _ ->
@@ -221,6 +225,9 @@ let rec extract_signature_tree_items : bool -> Typedtree.signature_item list ->
         | Ttype_record_unboxed_product _ -> []
 #endif
         | Ttype_open -> []
+#if OCAML_VERSION >= (5,5,0)
+        | Ttype_external _ -> []
+#endif
           )
       decls @ extract_signature_tree_items hide_item rest
 
@@ -389,6 +396,9 @@ let rec extract_structure_tree_items : bool -> Typedtree.structure_item list ->
         | Ttype_record_unboxed_product _ -> []
 #endif
         | Ttype_open -> []
+#if OCAML_VERSION >= (5,5,0)
+        | Ttype_external _ -> []
+#endif
           ))
            decls @ extract_structure_tree_items hide_item rest
 
@@ -660,6 +670,13 @@ let add_parameter parent id name env =
   let parameters = Ident.add id oid env.parameters in
   { env with module_paths; modules; parameters }
 
+let add_module_arg parent id name env =
+  let oid = Odoc_model.Paths.Identifier.Mk.(parameter (parent, name)) in
+  let path = `Identifier (oid, false) in
+  let module_paths = Ident.add id path env.module_paths in
+  let modules = Ident.add id oid env.modules in
+  { env with module_paths; modules }, oid
+
 let find_module env id =
   Ident.find_same id env.module_paths
 

src/loader/ident_env.mli

@@ -23,6 +23,13 @@ val empty : unit -> t
 val add_parameter :
   Paths.Identifier.Signature.t -> Ident.t -> Names.ModuleName.t -> t -> t
 
+val add_module_arg :
+  Paths.Identifier.Signature.t ->
+  Ident.t ->
+  Names.ModuleName.t ->
+  t ->
+  t * Odoc_model.Paths.Identifier.FunctorParameter.t
+
 val handle_signature_type_items :
   Paths.Identifier.Signature.t -> Compat.signature -> t -> t
 

src/model/lang.ml

@@ -451,6 +451,10 @@ and TypeExpr : sig
     type t = { path : Path.ModuleType.t; substitutions : substitution list }
   end
 
+  module Module : sig
+    type t = { package : Package.t; id : Identifier.FunctorParameter.t }
+  end
+
   type label = Label of string | RawOptional of string | Optional of string
 
   type t =
@@ -468,6 +472,7 @@ and TypeExpr : sig
     | Quote of t
     | Splice of t
     | Package of TypeExpr.Package.t
+    | Arrow_functor of label option * Module.t * t
 end =
   TypeExpr