Basic fixes for OCaml 5.2.0:

- Typedtree changes
- Shape request API changes
- Shape uid map changes
- Basic support for open in types
- Unit_info changes for typemod

Author: Octachron

src/loader/cmi.ml

@@ -316,7 +316,11 @@ let mark_constructor_args =
 #endif
 
 let mark_type_kind = function
+#if OCAML_VERSION >= (5,2,0)
+  | Type_abstract _ -> ()
+#else
   | Type_abstract -> ()
+#endif
 #if OCAML_VERSION >= (4,13,0)
   | Type_variant (cds,_) ->
 #else
@@ -639,7 +643,12 @@ let read_constructor_declaration env parent cd =
 
 let read_type_kind env parent =
   let open TypeDecl.Representation in function
-    | Type_abstract -> None
+#if OCAML_VERSION >= (5,2,0)
+  | Type_abstract _ ->
+#else
+  | Type_abstract ->
+#endif
+    None
 #if OCAML_VERSION >= (4,13,0)
   | Type_variant (cstrs,_) ->
 #else
@@ -716,7 +725,11 @@ let read_type_declaration env parent id decl =
   let representation = read_type_kind env (id :> Identifier.DataType.t) decl.type_kind in
   let abstr =
     match decl.type_kind with
-      Type_abstract ->
+#if OCAML_VERSION >= (5,2,0)
+    | Type_abstract _ ->
+#else
+    | Type_abstract ->
+#endif
         decl.type_manifest = None || decl.type_private = Private
     | Type_record _ ->
         decl.type_private = Private

src/loader/cmt.ml

@@ -33,14 +33,22 @@ let rec read_pattern env parent doc pat =
   let open Signature in
     match pat.pat_desc with
     | Tpat_any -> []
+#if OCAML_VERSION < (5,2,0)
     | Tpat_var(id, _) ->
+#else
+    | Tpat_var(id,_,_uid) ->
+#endif
         let open Value in
         let id = Env.find_value_identifier env id in
           Cmi.mark_type_expr pat.pat_type;
           let type_ = Cmi.read_type_expr env pat.pat_type in
           let value = Abstract in
           [Value {id; source_loc; doc; type_; value}]
+#if OCAML_VERSION < (5,2, 0)
     | Tpat_alias(pat, id, _) ->
+#else
+    | Tpat_alias(pat, id, _,_) ->
+#endif
         let open Value in
         let id = Env.find_value_identifier env id in
           Cmi.mark_type_expr pat.pat_type;

src/loader/cmti.ml

@@ -98,7 +98,11 @@ let rec read_core_type env container ctyp =
           Class(p, params)
     | Ttyp_alias(typ, var) ->
         let typ = read_core_type env container typ in
-          Alias(typ, var)
+#if OCAML_VERSION >= (5,2,0)
+        Alias(typ, var.txt)
+#else
+        Alias(typ, var)
+#endif
     | Ttyp_variant(fields, closed, present) ->
         let open TypeExpr.Polymorphic_variant in
         let elements =
@@ -142,6 +146,11 @@ let rec read_core_type env container ctyp =
             pack_fields
         in
           Package {path; substitutions}
+#if OCAML_VERSION >= (5,2,0)
+    | Ttyp_open (_p,_l,t) ->
+      (* TODO: adjust model *)
+      read_core_type env container t
+#endif
 
 let read_value_description env parent vd =
   let open Signature in

src/loader/ident_env.cppo.ml

@@ -91,7 +91,11 @@ let rec extract_signature_type_items vis items =
       then extract_signature_type_items vis rest
       else
         let constrs = match td.type_kind with
+#if OCAML_VERSION < (5,2,0)
           | Types.Type_abstract -> []
+#else
+          | Types.Type_abstract _ -> []
+#endif
           | Type_record (_, _) -> []
 #if OCAML_VERSION < (4,13,0)
           | Type_variant cstrs ->
@@ -274,8 +278,18 @@ let rec extract_signature_tree_items : bool -> Typedtree.signature_item list ->
 let rec read_pattern hide_item pat =
   let open Typedtree in
   match pat.pat_desc with
-  | Tpat_var(id, loc) -> [`Value(id, hide_item, Some loc.loc)]
-  | Tpat_alias(pat, id, loc) -> `Value(id, hide_item, Some loc.loc) :: read_pattern hide_item pat
+#if OCAML_VERSION < (5,2,0)
+  | Tpat_var(id, loc) ->
+#else
+  | Tpat_var(id, loc, _) ->
+#endif
+    [`Value(id, hide_item, Some loc.loc)]
+#if OCAML_VERSION < (5,2,0)
+  | Tpat_alias(pat, id, loc) ->
+#else
+  | Tpat_alias(pat, id, loc, _) ->
+#endif
+    `Value(id, hide_item, Some loc.loc) :: read_pattern hide_item pat
   | Tpat_record(pats, _) -> 
       List.concat (List.map (fun (_, _, pat) -> read_pattern hide_item pat) pats)
 #if OCAML_VERSION < (4,13,0)

src/loader/typedtree_traverse.ml

@@ -25,11 +25,19 @@ module Analysis = struct
         in
         let () =
           match pat_desc with
+#if OCAML_VERSION >= (5, 2, 0)
+          | Tpat_var (id, loc, _uid) -> (
+#else
           | Tpat_var (id, loc) -> (
+#endif
               match maybe_localvalue id loc.loc with
               | Some x -> poses := x :: !poses
               | None -> ())
+#if OCAML_VERSION >= (5, 2, 0)
+          | Tpat_alias (_, id, loc, _uid) -> (
+#else
           | Tpat_alias (_, id, loc) -> (
+#endif
               match maybe_localvalue id loc.loc with
               | Some x -> poses := x :: !poses
               | None -> ())

src/model/compat.cppo.ml

@@ -235,8 +235,30 @@ type 'a shape_uid_map = 'a Shape.Uid.Map.t
 type uid_to_loc = Warnings.loc Types.Uid.Tbl.t
 let empty_map = Shape.Uid.Map.empty
 
+#if OCAML_VERSION < (5,2,0)
 let shape_info_of_cmt_infos : Cmt_format.cmt_infos -> (shape * uid_to_loc) option =
  fun x -> Option.map (fun s -> (s, x.cmt_uid_to_loc)) x.cmt_impl_shape
+#else
+let loc_of_declaration =
+  let open Typedtree in
+  function
+  | Value v -> v.val_loc
+  | Value_binding vb -> vb.vb_pat.pat_loc
+  | Type t -> t.typ_loc
+  | Constructor c -> c.cd_loc
+  | Extension_constructor e -> e.ext_loc
+  | Label l -> l.ld_loc
+  | Module m -> m.md_loc
+  | Module_substitution ms -> ms.ms_loc
+  | Module_binding mb -> mb.mb_loc
+  | Module_type mt -> mt.mtd_loc
+  | Class cd -> cd.ci_id_name.loc
+  | Class_type ctd -> ctd.ci_id_name.loc
+
+
+let shape_info_of_cmt_infos : Cmt_format.cmt_infos -> (shape * uid_to_loc) option =
+ fun x -> Option.map (fun s -> (s, Shape.Uid.Tbl.map x.cmt_uid_to_decl loc_of_declaration)) x.cmt_impl_shape
+#endif
 
 #else
 

src/xref2/shape_tools.cppo.ml

@@ -109,6 +109,7 @@ let unit_of_uid uid =
 
 let lookup_shape : Env.t -> Shape.t -> Identifier.SourceLocation.t option =
  fun env query ->
+#if OCAML_VERSION < (5,2,0)
   let module Reduce = Shape.Make_reduce (struct
     type env = unit
     let fuel = 10
@@ -124,6 +125,26 @@ let lookup_shape : Env.t -> Shape.t -> Identifier.SourceLocation.t option =
   let result = try Some (Reduce.reduce () query) with Not_found -> None in
   result >>= fun result ->
   result.uid >>= fun uid ->
+#else
+  let module Reduce = Shape_reduce.Make(struct
+    let fuel = 10
+    let read_unit_shape ~unit_name =
+      match Env.lookup_impl unit_name env with
+      | Some impl -> (
+          match impl.shape_info with
+          | Some (shape, _) -> Some shape
+          | None -> None)
+       | _ -> None
+  end) in
+  let result = try Some (Reduce.reduce_for_uid Ocaml_env.empty query) with Not_found -> None in
+  result >>= (function
+    | Resolved uid -> Some uid
+    | Resolved_alias (_::_ as l) ->
+      let last = List.hd (List.rev l) in
+      Some last
+    | Approximated x -> x
+    | _ -> None) >>= fun uid ->
+#endif
   unit_of_uid uid >>= fun unit_name ->
   match Env.lookup_impl unit_name env with
   | None -> None

test/xref2/lib/common.cppo.ml

@@ -32,7 +32,11 @@ let cmt_of_string s =
     let env = Compmisc.initial_env () in
     let l = Lexing.from_string s in
     let p = Parse.implementation l in
+#if OCAML_VERSION < (5,2,0)
     Typemod.type_implementation "" "" "" env p
+#else
+    Typemod.type_implementation (Unit_info.make ~source_file:"" "") env p
+#endif
 
 let parent = Odoc_model.Paths.Identifier.Mk.page (None, Odoc_model.Names.PageName.make_std "None")
 let id = Odoc_model.Paths.Identifier.Mk.root (Some parent, Odoc_model.Names.ModuleName.make_std "Root")
@@ -623,7 +627,10 @@ let mkresolver () =
   Odoc_odoc.Resolver.create
     ~important_digests:false
     ~directories:(List.map Odoc_odoc.Fs.Directory.of_string
-#if OCAML_VERSION >= (4,8,0)
+#if OCAML_VERSION >= (5,2,0)
+  (let paths = Load_path.get_paths () in
+   List.filter (fun s -> s <> "") (paths.visible @ paths.hidden))
+#elif OCAML_VERSION >= (4,8,0)
     (Load_path.get_paths () |> List.filter (fun s -> s <> ""))
 #else
     !Config.load_path