Add support for OCaml 5.3

libs/indexBuild.ml

@@ -31,6 +31,10 @@ type parents = (string list * t Lazy.t) list
 
 open IndexMisc
 
+#if OCAML_VERSION >= (5,3,0)
+  module Printtyp = Out_type
+#endif
+
 let orig_file_name = function
   | Cmt f | Cmti f | Cmi f -> f
 
@@ -246,7 +250,11 @@ let qualify_ty (parents:parents) ty =
         Otyp_object (List.map (fun (str,ty) -> str, aux ty) strtylist, blopt)
 #endif
     | Otyp_record (strbltylist) ->
+#if OCAML_VERSION >= (5,3,0)
+        Otyp_record (List.map (fun {olab_name; olab_mut; olab_type} -> {olab_name; olab_mut; olab_type = aux olab_type}) strbltylist)
+#else
         Otyp_record (List.map (fun (str,bl,ty) -> str, bl, aux ty) strbltylist)
+#endif
     | Otyp_stuff str -> Otyp_stuff str
     | Otyp_sum (strtylisttyoptlist) ->
         Otyp_sum
@@ -420,7 +428,9 @@ let doc_of_attributes attrs =
   | _, PStr [{pstr_desc = Pstr_eval ({pexp_desc},_)}] ->
 #endif
       (match pexp_desc with
-#if OCAML_VERSION >= (4,11,0)
+#if OCAML_VERSION >= (5,3,0)
+       | Pexp_constant {pconst_desc = Pconst_string (s,_,_); _} -> Some s
+#elif OCAML_VERSION >= (4,11,0)
        | Pexp_constant (Pconst_string (s,_,_)) -> Some s
 #elif OCAML_VERSION >= (4,03,0)
        | Pexp_constant (Pconst_string (s,_)) -> Some s
@@ -533,12 +543,20 @@ let trie_of_type_decl ?comments info ty_decl =
                   Outcometree.Otyp_record (
                     List.map
                       (fun l ->
+#if OCAML_VERSION >= (5,3,0)
+                         {
+                           Outcometree.olab_name = Ident.name l.Types.ld_id;
+                           olab_mut = l.ld_mutable;
+                           olab_type = Printtyp.tree_of_typexp Printtyp.Type l.ld_type;
+                         }
+#else
                          (Ident.name l.Types.ld_id,
                           l.ld_mutable = Mutable,
 #if OCAML_VERSION >= (4,14,0)
                           Printtyp.tree_of_typexp Printtyp.Type l.ld_type)
 #else
                           Printtyp.tree_of_typexp false l.ld_type)
+#endif
 #endif
                       )
                       params)

libs/indexOut.ml

@@ -38,27 +38,27 @@ module IndexFormat = struct
     | [] -> ()
     | [x] -> left fmt; pr fmt x; right fmt
     | _::_::_ ->
-        if paren then Format.pp_print_char fmt '(';
+        if paren then Format_doc.pp_print_char fmt '(';
         left fmt; aux lst; right fmt;
-        if paren then Format.pp_print_char fmt ')'
+        if paren then Format_doc.pp_print_char fmt ')'
 
   let lines ?(escaped=false) fmt str =
     let len = String.length str in
     let esc = if escaped then String.escaped else fun s -> s in
     let rec aux i =
       if i >= len then () else
         let j = try String.index_from str i '\n' with Not_found -> len in
-        Format.pp_print_string fmt
+        Format_doc.pp_print_string fmt
           (esc (String.trim (String.sub str i (j - i))));
         if j < len - 1 then
-          (Format.pp_force_newline fmt ();
+          (Format_doc.pp_force_newline fmt ();
            aux (j+1))
     in
     aux 0
 
   type coloriser =
     { f: 'a. kind ->
-        ('a, Format.formatter, unit) format -> Format.formatter
+        ('a, Format_doc.formatter, unit) format -> Format_doc.formatter
         -> 'a }
 
   let color =
@@ -74,63 +74,71 @@ module IndexFormat = struct
         | Class | ClassType -> "\027[35m"
         | Keyword -> "\027[32m"
       in
-      Format.pp_print_as fmt 0 colorcode;
-      Format.kfprintf (fun fmt -> Format.pp_print_as fmt 0 "\027[m") fmt fstr
+      Format_doc.pp_print_as fmt 0 colorcode;
+      Format_doc.kfprintf (fun fmt -> Format_doc.pp_print_as fmt 0 "\027[m") fmt fstr
     in { f }
 
   let no_color =
-    let f _ fstr fmt = Format.fprintf fmt fstr in
+    let f _ fstr fmt = Format_doc.fprintf fmt fstr in
     { f }
 
   let name ?(colorise = no_color) fmt id =
     colorise.f id.kind "%s" fmt id.name
 
   let path ?(short = false) ?(colorise = no_color) fmt id =
     List.iter
-      (Format.fprintf fmt "%a." (colorise.f Module "%s"))
+      (Format_doc.fprintf fmt "%a." (colorise.f Module "%s"))
       (if short then id.path else id.orig_path);
     name ~colorise fmt id
 
   let kind ?(colorise = no_color) fmt id =
     match id.kind with
-    | OpenType -> Format.pp_print_string fmt "opentype"
-    | Type -> Format.pp_print_string fmt "type"
-    | Value -> Format.pp_print_string fmt "val"
-    | Exception -> Format.pp_print_string fmt "exception"
+    | OpenType -> Format_doc.pp_print_string fmt "opentype"
+    | Type -> Format_doc.pp_print_string fmt "type"
+    | Value -> Format_doc.pp_print_string fmt "val"
+    | Exception -> Format_doc.pp_print_string fmt "exception"
     | Field parentty ->
-        Format.fprintf fmt "field(%a)"
+        Format_doc.fprintf fmt "field(%a)"
           (colorise.f parentty.kind "%s") parentty.name
     | Variant parentty ->
-        Format.fprintf fmt "constr(%a)"
+        Format_doc.fprintf fmt "constr(%a)"
           (colorise.f parentty.kind "%s") parentty.name
     | Method parentclass ->
-        Format.fprintf fmt "method(%a)"
+        Format_doc.fprintf fmt "method(%a)"
           (colorise.f parentclass.kind "%s") parentclass.name
-    | Module -> Format.pp_print_string fmt "module"
-    | ModuleType -> Format.pp_print_string fmt "modtype"
-    | Class -> Format.pp_print_string fmt "class"
-    | ClassType -> Format.pp_print_string fmt "classtype"
-    | Keyword -> Format.pp_print_string fmt "keyword"
+    | Module -> Format_doc.pp_print_string fmt "module"
+    | ModuleType -> Format_doc.pp_print_string fmt "modtype"
+    | Class -> Format_doc.pp_print_string fmt "class"
+    | ClassType -> Format_doc.pp_print_string fmt "classtype"
+    | Keyword -> Format_doc.pp_print_string fmt "keyword"
 
   let rec tydecl fmt =
     let open Outcometree in
     function
-    | Otyp_abstract -> Format.fprintf fmt "<abstract>"
+    | Otyp_abstract -> Format_doc.fprintf fmt "<abstract>"
     | Otyp_manifest (ty,_) -> tydecl fmt ty
     | Otyp_record fields ->
+#if OCAML_VERSION >= (5,3,0)
+        let print_field fmt {olab_name; olab_mut; olab_type} =
+          Format_doc.fprintf fmt "@[<2>%s%s :@ @[%a@]@];"
+            (match olab_mut with Mutable -> "mutable " | Immutable -> "")
+            olab_name
+            !Oprint.out_type olab_type
+#else
         let print_field fmt (name, mut, arg) =
           Format.fprintf fmt "@[<2>%s%s :@ @[%a@]@];"
             (if mut then "mutable " else "") name
             !Oprint.out_type arg
+#endif
         in
-        Format.fprintf fmt "@[<hv 2>{%a}@]"
+        Format_doc.fprintf fmt "@[<hv 2>{%a}@]"
           (list
-             ~left:(fun fmt -> Format.pp_print_space fmt ())
-             ~right:(fun fmt -> Format.pp_print_break fmt 1 (-2))
-             print_field Format.pp_print_space)
+             ~left:(fun fmt -> Format_doc.pp_print_space fmt ())
+             ~right:(fun fmt -> Format_doc.pp_print_break fmt 1 (-2))
+             print_field Format_doc.pp_print_space)
           fields
     | Otyp_sum [] ->
-        Format.pp_print_char fmt '-'
+        Format_doc.pp_print_char fmt '-'
     | Otyp_sum constrs ->
 #if OCAML_VERSION >= (4,14,0)
         let print_variant fmt {Outcometree.ocstr_name = name; ocstr_args = tyl; ocstr_return_type = ret_type_opt} =
@@ -139,29 +147,29 @@ module IndexFormat = struct
 #endif
           match ret_type_opt with
           | None ->
-              if tyl = [] then Format.pp_print_string fmt name
+              if tyl = [] then Format_doc.pp_print_string fmt name
               else
-                Format.fprintf fmt "@[<2>%s of@ @[%a@]@]"
+                Format_doc.fprintf fmt "@[<2>%s of@ @[%a@]@]"
                   name
                   (list !Oprint.out_type
-                     (fun fmt () -> Format.fprintf fmt " *@ "))
+                     (fun fmt () -> Format_doc.fprintf fmt " *@ "))
                   tyl
           | Some ret_type ->
               if tyl = [] then
-                Format.fprintf fmt "@[<2>%s :@ @[%a@]@]" name
+                Format_doc.fprintf fmt "@[<2>%s :@ @[%a@]@]" name
                   !Oprint.out_type ret_type
               else
-                Format.fprintf fmt "@[<2>%s :@ @[%a -> @[%a@]@]@]"
+                Format_doc.fprintf fmt "@[<2>%s :@ @[%a -> @[%a@]@]@]"
                   name
                   (list !Oprint.out_type
-                     (fun fmt () -> Format.fprintf fmt " *@ "))
+                     (fun fmt () -> Format_doc.fprintf fmt " *@ "))
                   tyl
                   !Oprint.out_type ret_type
         in
         list print_variant
           ~left:(fun fmt ->
-              Format.pp_print_if_newline fmt (); Format.fprintf fmt "| ")
-          (fun fmt () -> Format.fprintf fmt "@ | ")
+              Format_doc.pp_print_if_newline fmt (); Format_doc.fprintf fmt "| ")
+          (fun fmt () -> Format_doc.fprintf fmt "@ | ")
           fmt constrs
     | ty ->
         !Oprint.out_type fmt ty
@@ -173,12 +181,12 @@ module IndexFormat = struct
     | Osig_class_type (_,_,_,ctyp,_) ->
         !Oprint.out_class_type fmt ctyp
     | Osig_typext ({ oext_args = [] }, _) ->
-        Format.pp_print_char fmt '-'
+        Format_doc.pp_print_char fmt '-'
     | Osig_typext ({ oext_args }, _) ->
         list ~paren:true
           !Oprint.out_type
           (fun fmt () ->
-            Format.pp_print_char fmt ','; Format.pp_print_space fmt ())
+            Format_doc.pp_print_char fmt ','; Format_doc.pp_print_space fmt ())
           fmt
           oext_args
     | Osig_modtype (_,mtyp)
@@ -190,7 +198,7 @@ module IndexFormat = struct
     | Osig_value {oval_type} ->
         !Oprint.out_type fmt oval_type
     | Osig_ellipsis ->
-        Format.fprintf fmt "..."
+        Format_doc.fprintf fmt "..."
 #elif OCAML_VERSION >= (4,02,0)
     | Osig_type ({ otype_type },_) ->
         tydecl fmt otype_type
@@ -210,21 +218,21 @@ module IndexFormat = struct
   let parent_ty ?colorise ?short fmt id =
     option_iter (IndexMisc.parent_type id)
       (fun id ->
-         Format.fprintf fmt "@[<hv>%a =@ %a@]"
+         Format_doc.fprintf fmt "@[<hv>%a =@ %a@]"
            (path ?colorise ?short) id
            (ty ?colorise) id)
 
   let doc ?escaped ?colorise:(_ = no_color) fmt id =
     option_iter (Lazy.force id.doc)
-      (Format.fprintf fmt "@[<h>%a@]" (lines ?escaped))
+      (Format_doc.fprintf fmt "@[<h>%a@]" (lines ?escaped))
 
   let loc ?root ?(intf=false) ?colorise:(_ = no_color) fmt id =
     let loc =
       if intf then Lazy.force id.loc_sig
       else Lazy.force id.loc_impl
     in
     if loc = Location.none then
-      Format.fprintf fmt "@[<h><no location information>@]"
+      Format_doc.fprintf fmt "@[<h><no location information>@]"
     else
       let pos = loc.Location.loc_start in
       let fname = match root with
@@ -243,19 +251,19 @@ module IndexFormat = struct
                pos.Lexing.pos_fname
         | _ -> pos.Lexing.pos_fname
       in
-      Format.fprintf fmt "@[<h>%s:%d:%d@]"
+      Format_doc.fprintf fmt "@[<h>%s:%d:%d@]"
         fname pos.Lexing.pos_lnum (pos.Lexing.pos_cnum - pos.Lexing.pos_bol)
 
   let file ?colorise:(_ = no_color) fmt id =
-    Format.fprintf fmt "@[<h>%s@]"
+    Format_doc.fprintf fmt "@[<h>%s@]"
       (match id.file with Cmt f | Cmi f | Cmti f -> f)
 
   let info ?(colorise = no_color) fmt id =
     let breakif n fmt = function
       | None -> ()
-      | Some _ -> Format.pp_print_break fmt 1 n
+      | Some _ -> Format_doc.pp_print_break fmt 1 n
     in
-    Format.fprintf fmt "@[<v 2>@[<hov 2>%a@ %a%a%a@]%a%a@]@."
+    Format_doc.fprintf fmt "@[<v 2>@[<hov 2>%a@ %a%a%a@]%a%a@]@."
       (path ?short:None ~colorise) id
       (kind ~colorise) id
       (breakif 0) id.ty
@@ -276,8 +284,8 @@ module IndexFormat = struct
     | 'f' -> file ?colorise fmt id
     | 'i' -> info ?colorise fmt id
     | 'e' -> parent_ty ?colorise fmt id
-    | '%' -> Format.fprintf fmt "%%"
-    | c   -> Format.fprintf fmt "%%%c" c
+    | '%' -> Format_doc.fprintf fmt "%%"
+    | c   -> Format_doc.fprintf fmt "%%%c" c
 
   let format ?root ?(separate=false) format ?colorise fmt id =
     let len = String.length format in
@@ -288,7 +296,7 @@ module IndexFormat = struct
       else
         let fmt = ffmt () in
         begin match format.[j], format.[j+1] with
-          | '%', c -> handle_format_char ?root c ?colorise fmt id
+          | '%', c -> Format_doc.compat (handle_format_char ?root c ?colorise) fmt id
           | '\\', 'n' -> Format.pp_print_newline fmt ()
           | '\\', 't' -> Format.pp_print_char fmt '\t'
           | '\\', 'r' -> Format.pp_print_char fmt '\r'
@@ -322,7 +330,7 @@ module Print = struct
     let colorise =
       if color then IndexFormat.color else IndexFormat.no_color
     in
-    f ~colorise Format.str_formatter id;
+    Format_doc.compat (f ~colorise) Format.str_formatter id;
     Format.flush_str_formatter ()
 
   let name = make IndexFormat.name
@@ -342,7 +350,7 @@ module Print = struct
   let info = make IndexFormat.info
 
   let format ?root ?separate format =
-    make (IndexFormat.format ?root ?separate format)
+    make (fun ?colorise fmt x -> Format_doc.deprecated_printer (fun fmt -> IndexFormat.format ?root ?separate format ?colorise fmt x) fmt)
 
 end
 

libs/indexOut.mli

@@ -21,35 +21,35 @@ open IndexTypes
 module Format: sig
   type coloriser =
     { f: 'a. kind ->
-        ('a, Format.formatter, unit) format -> Format.formatter
+        ('a, Format_doc.formatter, unit) format -> Format_doc.formatter
         -> 'a }
 
   val color: coloriser
   val no_color: coloriser
 
   (** short name of the identifier *)
-  val name: ?colorise:coloriser -> Format.formatter -> info -> unit
+  val name: ?colorise:coloriser -> Format_doc.formatter -> info -> unit
 
   (** fully qualified name (with [short], returns the path the ident was found
       at, not the path where it was originally created) *)
-  val path: ?short:bool -> ?colorise:coloriser -> Format.formatter -> info -> unit
+  val path: ?short:bool -> ?colorise:coloriser -> Format_doc.formatter -> info -> unit
 
-  val kind: ?colorise:coloriser -> Format.formatter -> info -> unit
+  val kind: ?colorise:coloriser -> Format_doc.formatter -> info -> unit
 
-  val ty: ?colorise:coloriser -> Format.formatter -> info -> unit
+  val ty: ?colorise:coloriser -> Format_doc.formatter -> info -> unit
 
   val doc:
     ?escaped:bool ->
-    ?colorise:coloriser -> Format.formatter -> info -> unit
+    ?colorise:coloriser -> Format_doc.formatter -> info -> unit
 
   val loc:
     ?root:string -> ?intf:bool ->
-    ?colorise:coloriser -> Format.formatter -> info -> unit
+    ?colorise:coloriser -> Format_doc.formatter -> info -> unit
 
-  val file: ?colorise:coloriser -> Format.formatter -> info -> unit
+  val file: ?colorise:coloriser -> Format_doc.formatter -> info -> unit
 
   (** summary of the information *)
-  val info: ?colorise:coloriser -> Format.formatter -> info -> unit
+  val info: ?colorise:coloriser -> Format_doc.formatter -> info -> unit
 
   (** print following a custom format string (%n,%p,%k,%t,%d,%l,%s,%f,%i are
       interpreted). If [~separate] is set to [true], escapes are formatted

libs/indexTypes.ml

@@ -49,3 +49,13 @@ type t = (char, info) IndexTrie.t
 (* * Raised when cmi/cmt/cmti files can't be loaded. Probably a different
     version of OCaml *)
 exception Bad_format of string
+
+#if OCAML_VERSION >= (5,3,0)
+  module Format_doc = Format_doc
+#else
+  module Format_doc = struct
+    include Format
+    let compat = Fun.id
+    let deprecated_printer = Fun.id
+  end
+#endif