diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml index e01dbbd..872a4da 100644 --- a/.github/workflows/workflow.yml +++ b/.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 diff --git a/Changelog b/Changelog index 3c73f5d..66305c0 100644 --- a/Changelog +++ b/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 diff --git a/ppx/ppx_protocol_conv.ml b/ppx/ppx_protocol_conv.ml index db5424e..5cbcc69 100644 --- a/ppx/ppx_protocol_conv.ml +++ b/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,19 +590,16 @@ 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 @@ -606,8 +607,14 @@ let rec is_recursive_ct types = function | 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 diff --git a/ppx_protocol_conv.opam b/ppx_protocol_conv.opam index c07c00b..ab6ec95 100644 --- a/ppx_protocol_conv.opam +++ b/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"}