Compatibility

Signed-off-by: Paul-Elliot <[email protected]>

Author: panglesd

src/document/generator.ml

@@ -23,6 +23,12 @@ open O.Infix
 
 let tag tag t = O.span ~attr:tag t
 
+let rec filter_map acc f = function
+  | hd :: tl ->
+      let acc = match f hd with Some x -> x :: acc | None -> acc in
+      filter_map acc f tl
+  | [] -> List.rev acc
+
 let label t =
   match t with
   | Odoc_model.Lang.TypeExpr.Label s -> tag "label" (O.txt s)
@@ -265,7 +271,7 @@ module Make (Syntax : SYNTAX) = struct
       let mapper (info, loc) =
         match info_of_info info with Some x -> Some (x, loc) | None -> None
       in
-      let infos = List.filter_map mapper infos in
+      let infos = filter_map [] mapper infos in
       let syntax_info =
         List.map (fun (ty, loc) -> (Source_page.Syntax ty, loc)) syntax_info
       in

src/loader/cmt.ml

@@ -386,11 +386,11 @@ let rec read_module_expr env parent label_parent mexpr =
           match arg with
           | None -> FunctorParameter.Unit
           | Some arg ->
-              let id = Env.find_parameter_identifier env id in
+              let id = Env.find_parameter_identifier new_env id in
               let arg = Cmti.read_module_type env (id :> Identifier.Signature.t) label_parent arg in
               Named { FunctorParameter. id; expr = arg; }
         in
-        let res = read_module_expr env (Identifier.Mk.result parent) label_parent res in
+        let res = read_module_expr new_env (Identifier.Mk.result parent) label_parent res in
         Functor(f_parameter, res)
 #endif
     | Tmod_apply _ ->

src/loader/ident_env.cppo.ml

@@ -24,7 +24,7 @@ module P = Paths.Path
 type type_ident = Paths.Identifier.Path.Type.t
 
 module LocHashtbl = Hashtbl.Make(struct
-    type t = Warnings.loc
+    type t = Location.t
     let equal l1 l2 = l1 = l2
     let hash = Hashtbl.hash
   end)
@@ -62,15 +62,15 @@ let empty () =
 (* The boolean is an override for whether it should be hidden - true only for
    items introduced by extended open *)
 type item = [
-    `Module of Ident.t * bool * Warnings.loc option
-  | `ModuleType of Ident.t * bool * Warnings.loc option
-  | `Type of Ident.t * bool * Warnings.loc option
-  | `Value of Ident.t * bool * Warnings.loc option
-  | `Class of Ident.t * Ident.t * Ident.t * Ident.t option * bool * Warnings.loc option
-  | `ClassType of Ident.t * Ident.t * Ident.t option * bool * Warnings.loc option
-  | `Exception of Ident.t * Warnings.loc option
+    `Module of Ident.t * bool * Location.t option
+  | `ModuleType of Ident.t * bool * Location.t option
+  | `Type of Ident.t * bool * Location.t option
+  | `Value of Ident.t * bool * Location.t option
+  | `Class of Ident.t * Ident.t * Ident.t * Ident.t option * bool * Location.t option
+  | `ClassType of Ident.t * Ident.t * Ident.t option * bool * Location.t option
+  | `Exception of Ident.t * Location.t option
   (* Exceptions needs to be added to the [loc_to_ident] table. *)
-  | `Extension of Ident.t * Warnings.loc option
+  | `Extension of Ident.t * Location.t option
   (* Extension constructor also need to be added to the [loc_to_ident] table,
      since they get an entry in the [uid_to_loc] table. *)
 ]
@@ -560,8 +560,8 @@ let add_items : Id.Signature.t -> item list -> t -> t = fun parent items env ->
     | [] -> env
     in inner items env
 
-let identifier_of_loc : t -> Warnings.loc -> Odoc_model.Paths.Identifier.t option = fun env loc ->
-  LocHashtbl.find_opt env.loc_to_ident loc
+let identifier_of_loc : t -> Location.t -> Odoc_model.Paths.Identifier.t option = fun env loc ->
+  try Some (LocHashtbl.find env.loc_to_ident loc) with Not_found -> None
 
 let add_signature_tree_items : Paths.Identifier.Signature.t -> Typedtree.signature -> t -> t = 
   fun parent sg env ->

src/loader/ident_env.cppo.mli

@@ -75,8 +75,7 @@ module Fragment : sig
   val read_type : Longident.t -> Paths.Fragment.Type.t
 end
 
-val identifier_of_loc :
-  t -> Warnings.loc -> Odoc_model.Paths.Identifier.t option
+val identifier_of_loc : t -> Location.t -> Odoc_model.Paths.Identifier.t option
 (** Each generated id has its location stored. This allows to get back the id
     knowing only the location. This is used to generate links to source from the
     resolution of a shape. *)

src/loader/implementation.ml

@@ -15,14 +15,14 @@ module Analysis = struct
   open Typedtree
   open Odoc_model.Paths
 
-  type env = Ident_env.t * Warnings.loc Shape.Uid.Tbl.t
+  type env = Ident_env.t * Location.t Shape.Uid.Tbl.t
 
   let env_wrap : (Ident_env.t -> Ident_env.t) -> env -> env =
    fun f (env, uid_to_loc) -> (f env, uid_to_loc)
 
   let get_env : env -> Ident_env.t = fun (env, _) -> env
 
-  let get_uid_to_loc : env -> Warnings.loc Shape.Uid.Tbl.t =
+  let get_uid_to_loc : env -> Location.t Shape.Uid.Tbl.t =
    fun (_, uid_to_loc) -> uid_to_loc
 
   let rec structure env parent str =
@@ -222,7 +222,12 @@ module Analysis = struct
         List.concat_map (fun (_, _, e) -> expression env e) es
     | Texp_letmodule (_, _, _, _m, e) -> expression env e
     | Texp_letexception (_, e) -> expression env e
-    | Texp_assert e -> expression env e
+#if  OCAML_VERSION < (5,1,0)
+    | Texp_assert e
+#else
+    | Texp_assert (e, _)
+#endif
+         -> expression env e
     | Texp_lazy e -> expression env e
     | Texp_object (_, _) -> []
     | Texp_pack _ -> []