Skip to content

Commit

Permalink
Compatibility
Browse files Browse the repository at this point in the history
Signed-off-by: Paul-Elliot <[email protected]>
  • Loading branch information
panglesd committed Aug 31, 2023
1 parent 6cba59c commit 37bc8de
Show file tree
Hide file tree
Showing 5 changed files with 29 additions and 19 deletions.
8 changes: 7 additions & 1 deletion src/document/generator.ml
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,12 @@ open Types
module O = Codefmt
open O.Infix

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 -> O.txt s
Expand Down Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions src/loader/cmt.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 _ ->
Expand Down
22 changes: 11 additions & 11 deletions src/loader/ident_env.cppo.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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. *)
]
Expand Down Expand Up @@ -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 ->
Expand Down
3 changes: 1 addition & 2 deletions src/loader/ident_env.cppo.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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. *)
11 changes: 8 additions & 3 deletions src/loader/implementation.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down Expand Up @@ -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 _ -> []
Expand Down

0 comments on commit 37bc8de

Please sign in to comment.