Merge pull request #89 from kit-ty-kate/413

Add support for OCaml 4.13

ppx_tools.opam

@@ -9,7 +9,7 @@ bug-reports: "https://github.com/ocaml-ppx/ppx_tools/issues"
 dev-repo: "git+https://github.com/ocaml-ppx/ppx_tools.git"
 build: ["dune" "build" "-p" name "-j" jobs]
 depends: [
-  "ocaml" {>= "4.08.0" & < "4.13.0"}
+  "ocaml" {>= "4.08.0" & < "4.14.0"}
   "dune" {>= "1.6"}
-  "cppo" {build}
+  "cppo" {build & >= "1.1.0"}
 ]

src/ast_convenience.ml

@@ -47,6 +47,15 @@ let may_tuple ?loc tup = function
   | [x] -> Some x
   | l -> Some (tup ?loc ?attrs:None l)
 
+#if OCAML_VERSION >= (4, 13, 0)
+let may_pat_tuple ?loc tup = function
+  | [] -> None
+  | [x] -> Some ([], x)
+  | l -> Some ([], tup ?loc ?attrs:None l)
+#else
+let may_pat_tuple ?loc tup x = may_tuple ?loc tup x
+#endif
+
 let lid ?(loc = !default_loc) s = mkloc (Longident.parse s) loc [@ocaml.warning "-3"]
 let constr ?loc ?attrs s args = Exp.construct ?loc ?attrs (lid ?loc s) (may_tuple ?loc Exp.tuple args)
 let nil ?loc ?attrs () = constr ?loc ?attrs "[]" []
@@ -81,7 +90,7 @@ let sequence ?loc ?attrs = function
   | hd :: tl -> List.fold_left (fun e1 e2 -> Exp.sequence ?loc ?attrs e1 e2) hd tl
 
 let pvar ?(loc = !default_loc) ?attrs s = Pat.var ~loc ?attrs (mkloc s loc)
-let pconstr ?loc ?attrs s args = Pat.construct ?loc ?attrs (lid ?loc s) (may_tuple ?loc Pat.tuple args)
+let pconstr ?loc ?attrs s args = Pat.construct ?loc ?attrs (lid ?loc s) (may_pat_tuple ?loc Pat.tuple args)
 let precord ?loc ?attrs ?(closed = Open) l =
   Pat.record ?loc ?attrs (List.map (fun (s, e) -> (lid ~loc:e.ppat_loc s, e)) l) closed
 let pnil ?loc ?attrs () = pconstr ?loc ?attrs "[]" []

src/ast_mapper_class.ml

@@ -16,6 +16,14 @@ let map_opt f = function None -> None | Some x -> Some (f x)
 
 let map_loc sub {loc; txt} = {loc = sub # location loc; txt}
 
+#if OCAML_VERSION >= (4, 13, 0)
+let map_pat_opt sub f = function
+  | None -> None
+  | Some (exist, x) -> Some (List.map (map_loc sub) exist, f x)
+#else
+let map_pat_opt _sub f x = map_opt f x
+#endif
+
 module T = struct
   (* Type expressions for the core language *)
 
@@ -205,6 +213,12 @@ module MT = struct
         Pwith_typesubst (map_loc sub lid, sub # type_declaration d)
     | Pwith_modsubst (lid, lid2) ->
         Pwith_modsubst (map_loc sub lid, map_loc sub lid2)
+#if OCAML_VERSION >= (4, 13, 0)
+    | Pwith_modtype (lid, mty) ->
+        Pwith_modtype (map_loc sub lid, sub # module_type mty)
+    | Pwith_modtypesubst (lid, mty) ->
+        Pwith_modtypesubst (map_loc sub lid, sub # module_type mty)
+#endif
 
   let map_signature_item sub {psig_desc = desc; psig_loc = loc} =
     let open Sig in
@@ -217,6 +231,9 @@ module MT = struct
     | Psig_exception texn -> exception_ ~loc (sub # type_exception texn)
     | Psig_module x -> module_ ~loc (sub # module_declaration x)
     | Psig_modsubst ms -> mod_subst ~loc (sub # module_substitution ms)
+#if OCAML_VERSION >= (4, 13, 0)
+    | Psig_modtypesubst ms -> modtype_subst ~loc (sub # module_type_declaration ms)
+#endif
     | Psig_recmodule l ->
         rec_module ~loc (List.map (sub # module_declaration) l)
     | Psig_modtype x -> modtype ~loc (sub # module_type_declaration x)
@@ -382,7 +399,7 @@ module P = struct
     | Ppat_interval (c1, c2) -> interval ~loc ~attrs c1 c2
     | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub # pat) pl)
     | Ppat_construct (l, p) ->
-        construct ~loc ~attrs (map_loc sub l) (map_opt (sub # pat) p)
+        construct ~loc ~attrs (map_loc sub l) (map_pat_opt sub (sub # pat) p)
     | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub # pat) p)
     | Ppat_record (lpl, cf) ->
         record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub # pat)) lpl)

src/genlifter.ml

@@ -98,7 +98,11 @@ module Main : sig end = struct
             (lam
                (Pat.record (List.map fst l) Closed)
                (selfcall "record" [str ty; list (List.map snd l)]))
+#if OCAML_VERSION >= (4, 13, 0)
+      | Type_variant (l, _rep), _ ->
+#else
       | Type_variant l, _ ->
+#endif
           let case cd =
             let c = Ident.name cd.cd_id in
             let qc = prefix ^ c in