Merge pull request #40 from andersfugmann/andersfugmann/ppxlib_0.36.0

Fix compatibility with ppxlib 0.36.0

Author: andersfugmann

.github/workflows/workflow.yml

@@ -34,6 +34,7 @@ jobs:
         with:
           ocaml-compiler: ${{ matrix.ocaml-compiler }}
           opam-local-packages: ${{ matrix.packages }}
+          opam-pin: false
 
       - run: |
           opam install . --deps-only --with-doc --with-test

Changelog

@@ -9,6 +9,9 @@ Changes marked with '*' indicates a changes that breaks backward compatibility
 - [ ] Add namespaces to attributes
 - [ ] Unify xmlm and xml_light driver to share codebase
 
+## 5.2.3 (unreleased)
+- [x] Compatibility against ppxlib 0.36.0
+
 ## 5.2.2
 - [x] Fix compatability with Ocaml 5
 - [x] Avoid linking against ppxlib

ppx/ppx_protocol_conv.ml

@@ -279,6 +279,8 @@ and serialize_expr_of_tdecl t ~loc tdecl =
         serialize_expr_of_type_descr t ~loc core_type.ptyp_desc
       | None -> raise_errorf ~loc "Opaque types are not supported."
     end
+  | Ptype_variant [] ->
+    raise_errorf ~loc "ADTs with no constructors not supported"
   | Ptype_variant constrs ->
     test_constructor_mapping t constrs;
     let bindings, cases =
@@ -291,7 +293,7 @@ and serialize_expr_of_tdecl t ~loc tdecl =
         ) constrs
       |> List.unzip
     in
-    pexp_let ~loc Nonrecursive bindings @@ pexp_function ~loc cases
+    pexp_let ~loc Nonrecursive bindings @@ pexp_function_cases ~loc cases
 
   | Ptype_record labels ->
     let spec, patt, args = serialize_record t ~loc labels in
@@ -341,7 +343,7 @@ and serialize_expr_of_type_descr t ~loc = function
         ) rows
       |> List.unzip
     in
-    pexp_let ~loc Nonrecursive bindings @@ pexp_function ~loc cases
+    pexp_let ~loc Nonrecursive bindings @@ pexp_function_cases ~loc cases
   | Ptyp_var core_type ->
     pexp_ident ~loc { loc; txt = Lident ( sprintf "__param_to_%s" core_type) }
   | Ptyp_arrow _ -> raise_errorf ~loc "Functions not supported"
@@ -351,6 +353,7 @@ and serialize_expr_of_type_descr t ~loc = function
   | Ptyp_class _
   | Ptyp_alias _
   | Ptyp_package _
+  | Ptyp_open _
   | Ptyp_extension _ -> raise_errorf ~loc "Unsupported type descr"
 
 
@@ -534,7 +537,8 @@ and deserialize_expr_of_type_descr t ~loc = function
   | Ptyp_class _
   | Ptyp_alias _
   | Ptyp_package _
-  | Ptyp_extension _ -> raise_errorf ~loc "Unsupported type descr"
+  | Ptyp_extension _
+  | Ptyp_open _ -> raise_errorf ~loc "Unsupported type descr"
 
 let serialize_function_name ~loc ~driver name =
   let prefix = match name.txt with
@@ -586,28 +590,31 @@ let name_of_core_type ~prefix = function
   | { ptyp_desc = Ptyp_poly (_, _); _} -> failwith "Ptyp_poly "
   | { ptyp_desc = Ptyp_package _; _} -> failwith "Ptyp_package "
   | { ptyp_desc = Ptyp_extension _; _} -> failwith "Ptyp_extension "
+  | { ptyp_desc = Ptyp_open _; _} -> failwith "Ptyp_open "
 
 
 let rec is_recursive_ct types = function
   | { ptyp_desc = Ptyp_var var; _ } ->
     List.mem types var ~equal:String.equal
-  | { ptyp_desc = Ptyp_any; _ } -> false
-  | { ptyp_desc = Ptyp_arrow _; _} -> false
   | { ptyp_desc = Ptyp_tuple cts; _} -> List.exists ~f:(is_recursive_ct types) cts
   | { ptyp_desc = Ptyp_constr (l, cts); _} ->
     List.mem types (string_of_ident_loc l).txt ~equal:String.equal ||
     List.exists ~f:(is_recursive_ct types) cts
-  | { ptyp_desc = Ptyp_object _; _} -> false
-  | { ptyp_desc = Ptyp_class _; _} -> false
   | { ptyp_desc = Ptyp_alias (c, _); _} -> is_recursive_ct types c
   | { ptyp_desc = Ptyp_variant (rows, _, _); _} ->
     List.exists ~f:(fun row -> match row.prf_desc with
         | Rtag (_, _, cts) -> List.exists ~f:(is_recursive_ct types) cts
         | Rinherit _ -> false
       ) rows
   | { ptyp_desc = Ptyp_poly (_, ct); _} -> is_recursive_ct types ct
-  | { ptyp_desc = Ptyp_package _; _} -> false
-  | { ptyp_desc = Ptyp_extension _; _} -> false
+  | { ptyp_desc = (Ptyp_any
+                  | Ptyp_arrow _
+                  | Ptyp_object _
+                  | Ptyp_class _
+                  | Ptyp_package _
+                  | Ptyp_extension _
+                  | Ptyp_open _); _ } -> false
+
 
 let is_recursive types = function
   | Ptype_abstract -> false
@@ -710,14 +717,16 @@ let make_recursive ~loc (e : expression) = function
   | true ->
     [%expr
       ( let f = ref None in
-            (fun t -> match !f with
-               | None ->
-                 let f' = [%e e] in f := Some f'; f' t
-               | Some f -> f t
-            ))
+        (fun t ->
+           match !f with
+           | None ->
+             let f' = [%e e] in
+             f := Some f';
+             f' t
+           | Some f -> f t
+        ))
     ]
 
-
 let to_protocol_str_type_decls t rec_flag ~loc tydecls =
   let (defs, is_recursive) =
     let is_recursive_f = is_recursive tydecls rec_flag in

ppx_protocol_conv.opam

@@ -11,10 +11,10 @@ build: [
   ["dune" "runtest" "-p" name "-j" jobs] {with-test}
 ]
 depends: [
-  "ocaml" {>= "4.07"}
-  "base" {>= "v0.14.0" }
+  "ocaml" {>= "4.08"}
+  "base" {>= "v0.14.0"}
   "dune" {>= "1.2"}
-  "ppxlib" {>= "0.9.0"}
+  "ppxlib" {>= "0.36.0"}
   "ppx_sexp_conv" {with-test}
   "sexplib" {with-test}
   "alcotest" {with-test & >= "0.8.0"}