Merge pull request #763 from ocsigen/ocaml-5.1-compat

Compatibility with OCaml 5.1
ocsigen · Sep 25, 2023 · beeaa58 · beeaa58
2 parents ef5d25b + 9f14ce1
commit beeaa58
Show file tree

Hide file tree

Showing 3 changed files with 50 additions and 6 deletions.
diff --git a/opam b/opam
@@ -36,4 +36,5 @@ depends: [
   "reactiveData" {>= "0.2.1"}
   "base-bytes"
   "ocsipersist" {>= "1.0" & < "2.0"}
+  "ppx_optcomp"
 ]
diff --git a/src/_tags b/src/_tags
@@ -38,7 +38,7 @@ true:keep_locs
 <lib/server/monitor/*.ml{,i}>:package(lwt,ocsigenserver,ocsipersist,tyxml)
 <lib/server/monitor/*.ml{,i}>:I(src/lib/server)
 
-<ppx/**/*>: package(ppxlib,ppxlib.metaquot,compiler-libs.bytecomp)
+<ppx/**/*>: package(ppxlib,ppxlib.metaquot,compiler-libs.bytecomp,ppx_optcomp)
 
 <ocamlbuild/ocamlbuild_eliom.ml{,i}>: package(ocamlbuild,js_of_ocaml-ocamlbuild)
 <ocamlbuild/eliombuild.{ml,mli,byte,native}>:package(ocamlbuild,js_of_ocaml-ocamlbuild)

diff --git a/src/ppx/ppx_eliom_utils.ml b/src/ppx/ppx_eliom_utils.ml
@@ -355,7 +355,18 @@ module Cmo = struct
           Typ.constr
             (mkloc (ident_of_out_ident id) Location.none)
             (List.map type_of_out_type tyl)
-      | Otyp_object (fields, rest) ->
+      | ((Otyp_object {fields; open_row}) [@if ocaml_version >= (5, 1, 0)]) ->
+          let fields =
+            List.map
+              (fun (label, ty) ->
+                { pof_desc =
+                    Otag (mkloc label Location.none, type_of_out_type ty)
+                ; pof_loc = Location.none
+                ; pof_attributes = [] })
+              fields
+          in
+          Typ.object_ fields (if open_row then Open else Closed)
+      | ((Otyp_object (fields, rest)) [@if ocaml_version < (5, 1, 0)]) ->
           let fields =
             List.map
               (fun (label, ty) ->
@@ -366,17 +377,49 @@ module Cmo = struct
               fields
           in
           Typ.object_ fields (if rest = None then Closed else Open)
-      | Otyp_class (_, id, tyl) ->
+      | ((Otyp_class (id, tyl)) [@if ocaml_version >= (5, 1, 0)]) ->
           Typ.class_
             (mkloc (ident_of_out_ident id) Location.none)
             (List.map type_of_out_type tyl)
-      | Otyp_alias (ty, s) -> Typ.alias (type_of_out_type ty) (var s)
-      | Otyp_variant (_, Ovar_typ ty, closed, tags) ->
+      | ((Otyp_class (_, id, tyl)) [@if ocaml_version < (5, 1, 0)]) ->
+          Typ.class_
+            (mkloc (ident_of_out_ident id) Location.none)
+            (List.map type_of_out_type tyl)
+      | ((Otyp_alias {aliased; alias}) [@if ocaml_version >= (5, 1, 0)]) ->
+          Typ.alias (type_of_out_type aliased) (var alias)
+      | ((Otyp_alias (ty, s)) [@if ocaml_version < (5, 1, 0)]) ->
+          Typ.alias (type_of_out_type ty) (var s)
+      | ((Otyp_variant (Ovar_typ ty, closed, tags)) [@if
+                                                      ocaml_version >= (5, 1, 0)])
+        ->
+          Typ.variant
+            [Rf.mk (Rinherit (type_of_out_type ty))]
+            (if closed then Closed else Open)
+            tags
+      | ((Otyp_variant (_, Ovar_typ ty, closed, tags)) [@if
+                                                         ocaml_version
+                                                         < (5, 1, 0)]) ->
           Typ.variant
             [Rf.mk (Rinherit (type_of_out_type ty))]
             (if closed then Closed else Open)
             tags
-      | Otyp_variant (_, Ovar_fields lst, closed, tags) ->
+      | ((Otyp_variant (Ovar_fields lst, closed, tags)) [@if
+                                                          ocaml_version
+                                                          >= (5, 1, 0)]) ->
+          let row_fields =
+            List.map
+              (fun (label, const, tyl) ->
+                Rf.mk
+                  (Rtag
+                     ( mkloc label Location.none
+                     , const
+                     , List.map type_of_out_type tyl )))
+              lst
+          in
+          Typ.variant row_fields (if closed then Closed else Open) tags
+      | ((Otyp_variant (_, Ovar_fields lst, closed, tags)) [@if
+                                                             ocaml_version
+                                                             < (5, 1, 0)]) ->
           let row_fields =
             List.map
               (fun (label, const, tyl) ->