Merge pull request #172 from kit-ty-kate/ocaml-5.3

Add OCaml 5.3 support

Author: AltGr

.github/workflows/workflow.yml

@@ -12,7 +12,9 @@ jobs:
         os:
           - ubuntu-latest
         ocaml-version:
-          - 5.1.0~rc1
+          - 5.3.0~beta2
+          - 5.2.0
+          - 5.1.1
           - 5.0.0
           - 4.14.0
           - 4.13.1

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

@@ -14,6 +14,12 @@
 
 open IndexTypes
 
+#if OCAML_VERSION < (5,3,0)
+module Format_doc = struct
+  let compat = Fun.id
+end
+#endif
+
 let option_iter opt f = match opt with
   | Some x -> f x
   | None -> ()
@@ -118,10 +124,18 @@ module IndexFormat = struct
     | Otyp_abstract -> Format.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.fprintf fmt "@[<2>%s%s :@ @[%a@]@];"
+            (match olab_mut with Mutable -> "mutable " | Immutable -> "")
+            olab_name
+            (Format_doc.compat !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}@]"
           (list
@@ -143,52 +157,52 @@ module IndexFormat = struct
               else
                 Format.fprintf fmt "@[<2>%s of@ @[%a@]@]"
                   name
-                  (list !Oprint.out_type
+                  (list (Format_doc.compat !Oprint.out_type)
                      (fun fmt () -> Format.fprintf fmt " *@ "))
                   tyl
           | Some ret_type ->
               if tyl = [] then
                 Format.fprintf fmt "@[<2>%s :@ @[%a@]@]" name
-                  !Oprint.out_type ret_type
+                  (Format_doc.compat !Oprint.out_type) ret_type
               else
                 Format.fprintf fmt "@[<2>%s :@ @[%a -> @[%a@]@]@]"
                   name
-                  (list !Oprint.out_type
+                  (list (Format_doc.compat !Oprint.out_type)
                      (fun fmt () -> Format.fprintf fmt " *@ "))
                   tyl
-                  !Oprint.out_type ret_type
+                  (Format_doc.compat !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 "@ | ")
           fmt constrs
     | ty ->
-        !Oprint.out_type fmt ty
+        Format_doc.compat !Oprint.out_type fmt ty
 
   let out_ty fmt ty =
     let open Outcometree in
     match ty with
     | Osig_class (_,_,_,ctyp,_)
     | Osig_class_type (_,_,_,ctyp,_) ->
-        !Oprint.out_class_type fmt ctyp
+        Format_doc.compat !Oprint.out_class_type fmt ctyp
     | Osig_typext ({ oext_args = [] }, _) ->
         Format.pp_print_char fmt '-'
     | Osig_typext ({ oext_args }, _) ->
         list ~paren:true
-          !Oprint.out_type
+          (Format_doc.compat !Oprint.out_type)
           (fun fmt () ->
             Format.pp_print_char fmt ','; Format.pp_print_space fmt ())
           fmt
           oext_args
     | Osig_modtype (_,mtyp)
     | Osig_module (_,mtyp,_) ->
-        !Oprint.out_module_type fmt mtyp
+        Format_doc.compat !Oprint.out_module_type fmt mtyp
 #if OCAML_VERSION >= (4,03,0)
     | Osig_type ({ otype_type },_) ->
         tydecl fmt otype_type
     | Osig_value {oval_type} ->
-        !Oprint.out_type fmt oval_type
+        Format_doc.compat !Oprint.out_type fmt oval_type
     | Osig_ellipsis ->
         Format.fprintf fmt "..."
 #elif OCAML_VERSION >= (4,02,0)

src/indexMain.ml

@@ -14,12 +14,11 @@
 
 (** This module contains the run-time for the command-line ocp-index tool *)
 
-
 open Cmdliner
 
 let common_opts = IndexOptions.common_opts ()
 
-let default_cmd = 
+let default_cmd =
   Term.(ret (const (fun _ -> `Help (`Pager, None)) $ common_opts))
 
 let default_info =
@@ -146,7 +145,7 @@ let complete_cmd =
   Cmd.v
     (Cmd.info "complete" ~doc ~man)
     Term.(const print_compl $ common_opts $ sexpr $ format $ separate $ t)
-  
+
 
 let type_cmd =
   let man = [
@@ -171,7 +170,7 @@ let type_cmd =
   Cmd.v
     (Cmd.info "type" ~doc ~man)
     Term.(const print_ty $ common_opts $ t)
-  
+
 
 let locate_cmd =
   let man = [
@@ -215,7 +214,7 @@ let locate_cmd =
   Cmd.v
     (Cmd.info "locate" ~doc ~man)
     Term.(const print_loc $ common_opts $ interface $ t)
-  
+
 
 let print_cmd =
   let man = [
@@ -252,7 +251,7 @@ let print_cmd =
   let doc = "Print information about an identifier with a custom format." in
   Cmd.v
     (Cmd.info "print" ~doc ~man)
-    Term.(const print $ common_opts $ query $ format $ separate)  
+    Term.(const print $ common_opts $ query $ format $ separate)
 
 let full_cmd =
   Cmd.group ~default:default_cmd default_info