dev-ml/js_of_ocaml: remove old

Package-Manager: portage-2.3.0

1 files changed, 0 insertions, 1418 deletions

diff --git a/dev-ml/js_of_ocaml/files/oc43.patch b/dev-ml/js_of_ocaml/files/oc43.patch
deleted file mode 100644
index face8101603f..000000000000
--- a/dev-ml/js_of_ocaml/files/oc43.patch
+++ /dev/null
@@ -1,1418 +0,0 @@
-commit 3e4d39ece5a67bfc17f47c3da8a95ccca789abd5
-Author: Hugo Heuzard <hugo.heuzard@gmail.com>
-Date:   Mon Mar 28 23:35:47 2016 +0100
-
-    Deriving_json for ocaml 4.03
-    
-    move
-
-diff --git a/.gitignore b/.gitignore
-index 71e4ccf..ccbb796 100644
---- a/.gitignore
-+++ b/.gitignore
-@@ -58,6 +58,7 @@ benchmarks/results
- benchmarks/config
- lib/deriving_json/deriving_Json_lexer.ml
- lib/ppx/ppx_js.ml
-+lib/ppx/ppx_deriving_json.ml
- lib/ppx/ppx_js
- Makefile.local
- 
-diff --git a/lib/ppx/ppx_deriving_json.cppo.ml b/lib/ppx/ppx_deriving_json.cppo.ml
-new file mode 100644
-index 0000000..814ed99
---- /dev/null
-+++ b/lib/ppx/ppx_deriving_json.cppo.ml
-@@ -0,0 +1,711 @@
-+(* Js_of_ocaml
-+ * http://www.ocsigen.org
-+ * Copyright Vasilis Papavasileiou 2015
-+ *
-+ * This program is free software; you can redistribute it and/or modify
-+ * it under the terms of the GNU Lesser General Public License as published by
-+ * the Free Software Foundation, with linking exception;
-+ * either version 2.1 of the License, or (at your option) any later version.
-+ *
-+ * This program is distributed in the hope that it will be useful,
-+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
-+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-+ * GNU Lesser General Public License for more details.
-+ *
-+ * You should have received a copy of the GNU Lesser General Public License
-+ * along with this program; if not, write to the Free Software
-+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-+ *)
-+
-+let deriver = "json"
-+
-+(* Copied (and adapted) this from ppx_deriving repo (commit
-+   e2079fa8f3460055bf990461f295c6c4b391fafc) ; we get an empty set of
-+   let bindings with ppx_deriving 3.0 *)
-+let sanitize expr = [%expr
-+  (let open! Ppx_deriving_runtime in [%e expr]) [@ocaml.warning "-A"]]
-+
-+let var_ptuple l =
-+  List.map Ast_convenience.pvar l |> Ast_helper.Pat.tuple
-+
-+let map_loc f {Location.txt; loc} =
-+  {Location.txt = f txt; loc}
-+
-+let suffix_lid {Location.txt; loc} ~suffix =
-+  let txt = Ppx_deriving.mangle_lid (`Suffix suffix) txt in
-+  Ast_helper.Exp.ident {txt; loc} ~loc
-+
-+let suffix_decl ({Parsetree.ptype_loc = loc} as d) ~suffix =
-+  (let s =
-+     Ppx_deriving.mangle_type_decl (`Suffix suffix) d |>
-+     Longident.parse
-+   in
-+   Location.mkloc s loc) |> Ast_helper.Exp.ident ~loc
-+
-+let suffix_decl_p ({Parsetree.ptype_loc = loc} as d) ~suffix =
-+  (let s = Ppx_deriving.mangle_type_decl (`Suffix suffix) d in
-+   Location.mkloc s loc) |> Ast_helper.Pat.var ~loc
-+
-+let rec fresh_vars ?(acc = []) n =
-+  if n <= 0 then
-+    List.rev acc
-+  else
-+    let acc = Ppx_deriving.fresh_var acc :: acc in
-+    fresh_vars ~acc (n - 1)
-+
-+let unreachable_case () =
-+  Ast_helper.Exp.case [%pat? _ ] [%expr assert false]
-+
-+let label_of_constructor = map_loc (fun c -> Longident.Lident c)
-+
-+let wrap_write r ~pattern = [%expr fun buf [%p pattern] -> [%e r]]
-+
-+let buf_expand r = [%expr fun buf -> [%e r]]
-+
-+let seqlist = function
-+  | h :: l ->
-+    let f acc e = [%expr [%e acc]; [%e e]] in
-+    List.fold_left f h l
-+  | [] ->
-+    [%expr ()]
-+
-+let check_record_fields =
-+  List.iter @@ function
-+  | {Parsetree.pld_mutable = Mutable} ->
-+    Location.raise_errorf
-+      "%s cannot be derived for mutable records" deriver
-+  | {pld_type = {ptyp_desc = Ptyp_poly _}} ->
-+    Location.raise_errorf
-+      "%s cannot be derived for polymorphic records" deriver
-+  | _ ->
-+    ()
-+
-+let maybe_tuple_type = function
-+  | [y] -> y
-+  | l -> Ast_helper.Typ.tuple l
-+
-+let rec write_tuple_contents l ly ~tag ~poly =
-+  let e =
-+    let f v y =
-+      let arg = Ast_convenience.evar v in
-+      let e = write_body_of_type y ~arg ~poly in
-+      [%expr Buffer.add_string buf ","; [%e e]]
-+    in
-+    List.map2 f l ly |> seqlist
-+  and s = Ast_convenience.str ("[" ^ string_of_int tag) in [%expr
-+    Buffer.add_string buf [%e s];
-+    [%e e];
-+    Buffer.add_string buf "]"]
-+
-+and write_body_of_tuple_type l ~arg ~poly ~tag =
-+  let n = List.length l in
-+  let vars = fresh_vars n in
-+  let e = write_tuple_contents vars l ~tag ~poly
-+  and p = var_ptuple vars in
-+  [%expr let [%p p] = [%e arg] in [%e e]]
-+
-+and write_poly_case r ~arg ~poly =
-+  match r with
-+  | Parsetree.Rtag (label, _, _, l) ->
-+    let i = Ppx_deriving.hash_variant label
-+    and n = List.length l in
-+    let v = Ppx_deriving.fresh_var [] in
-+    let lhs =
-+      (if n = 0 then None else Some (Ast_convenience.pvar v)) |>
-+      Ast_helper.Pat.variant label
-+    and rhs =
-+      match l with
-+      | [] ->
-+        let e = Ast_convenience.int i in
-+        [%expr Deriving_Json.Json_int.write buf [%e e]]
-+      | _ ->
-+        let l = [[%type: int]; maybe_tuple_type l]
-+        and arg = Ast_helper.Exp.tuple Ast_convenience.[int i; evar v] in
-+        write_body_of_tuple_type l ~arg ~poly ~tag:0
-+    in
-+    Ast_helper.Exp.case lhs rhs
-+  | Rinherit ({ptyp_desc = Ptyp_constr (lid, _)} as y) ->
-+    Ast_helper.Exp.case (Ast_helper.Pat.type_ lid)
-+      (write_body_of_type y ~arg ~poly)
-+  | Rinherit {ptyp_loc} ->
-+    Location.raise_errorf ~loc:ptyp_loc
-+      "%s write case cannot be derived" deriver
-+
-+and write_body_of_type y ~arg ~poly =
-+  match y with
-+  | [%type: unit] ->
-+    [%expr Deriving_Json.Json_unit.write buf [%e arg]]
-+  | [%type: int] ->
-+    [%expr Deriving_Json.Json_int.write buf [%e arg]]
-+  | [%type: int32] | [%type: Int32.t] ->
-+    [%expr Deriving_Json.Json_int32.write buf [%e arg]]
-+  | [%type: int64] | [%type: Int64.t] ->
-+    [%expr Deriving_Json.Json_int64.write buf [%e arg]]
-+  | [%type: nativeint] | [%type: Nativeint.t] ->
-+    [%expr Deriving_Json.Json_nativeint.write buf [%e arg]]
-+  | [%type: float] ->
-+    [%expr Deriving_Json.Json_float.write buf [%e arg]]
-+  | [%type: bool] ->
-+    [%expr Deriving_Json.Json_bool.write buf [%e arg]]
-+  | [%type: char] ->
-+    [%expr Deriving_Json.Json_char.write buf [%e arg]]
-+  | [%type: string] ->
-+    [%expr Deriving_Json.Json_string.write buf [%e arg]]
-+  | [%type: bytes] ->
-+    [%expr Deriving_Json.Json_bytes.write buf [%e arg]]
-+  | [%type: [%t? y] list] ->
-+    let e = write_of_type y ~poly in
-+    [%expr Deriving_Json.write_list [%e e] buf [%e arg]]
-+  | [%type: [%t? y] ref] ->
-+    let e = write_of_type y ~poly in
-+    [%expr Deriving_Json.write_ref [%e e] buf [%e arg]]
-+  | [%type: [%t? y] option] ->
-+    let e = write_of_type y ~poly in
-+    [%expr Deriving_Json.write_option [%e e] buf [%e arg]]
-+  | [%type: [%t? y] array] ->
-+    let e = write_of_type y ~poly in
-+    [%expr Deriving_Json.write_array [%e e] buf [%e arg]]
-+  | { Parsetree.ptyp_desc = Ptyp_var v } when poly ->
-+    [%expr [%e Ast_convenience.evar ("poly_" ^ v)] buf [%e arg]]
-+  | { Parsetree.ptyp_desc = Ptyp_tuple l } ->
-+    write_body_of_tuple_type l ~arg ~poly ~tag:0
-+  | { Parsetree.ptyp_desc = Ptyp_variant (l, _, _); ptyp_loc = loc } ->
-+    List.map (write_poly_case ~arg ~poly) l @ [unreachable_case ()] |>
-+    Ast_helper.Exp.match_ arg
-+  | { Parsetree.ptyp_desc = Ptyp_constr (lid, l) } ->
-+    let e = suffix_lid lid ~suffix:"to_json"
-+    and l = List.map (write_of_type ~poly) l in
-+    [%expr [%e Ast_convenience.app e l] buf [%e arg]]
-+  | { Parsetree.ptyp_loc } ->
-+    Location.raise_errorf ~loc:ptyp_loc
-+      "%s_write cannot be derived for %s"
-+      deriver (Ppx_deriving.string_of_core_type y)
-+
-+and write_of_type y ~poly =
-+  let v = "a" in
-+  let arg = Ast_convenience.evar v
-+  and pattern = Ast_convenience.pvar v in
-+  wrap_write (write_body_of_type y ~arg ~poly) ~pattern
-+
-+and write_of_record ?(tag=0) d l =
-+  let pattern =
-+    let l =
-+      let f {Parsetree.pld_name} =
-+        label_of_constructor pld_name,
-+        Ast_helper.Pat.var pld_name
-+      in
-+      List.map f l
-+    in
-+    Ast_helper.Pat.record l Asttypes.Closed
-+  and e =
-+    let l =
-+      let f {Parsetree.pld_name = {txt}} = txt in
-+      List.map f l
-+    and ly =
-+      let f {Parsetree.pld_type} = pld_type in
-+      List.map f l
-+    in
-+    write_tuple_contents l ly ~tag ~poly:true
-+  in
-+  wrap_write e ~pattern
-+
-+let recognize_case_of_constructor i l =
-+  let lhs =
-+    match l with
-+    | [] -> [%pat? `Cst  [%p Ast_convenience.pint i]]
-+    | _  -> [%pat? `NCst [%p Ast_convenience.pint i]]
-+  in
-+  Ast_helper.Exp.case lhs [%expr true]
-+
-+let recognize_body_of_poly_variant l ~loc =
-+  let l =
-+    let f = function
-+      | Parsetree.Rtag (label, _, _, l) ->
-+        let i = Ppx_deriving.hash_variant label in
-+        recognize_case_of_constructor i l
-+      | Rinherit {ptyp_desc = Ptyp_constr (lid, _)} ->
-+        let guard = [%expr [%e suffix_lid lid ~suffix:"recognize"] x] in
-+        Ast_helper.Exp.case ~guard [%pat? x] [%expr true]
-+      | _ ->
-+        Location.raise_errorf ~loc
-+          "%s_recognize cannot be derived" deriver
-+    and default = Ast_helper.Exp.case [%pat? _] [%expr false] in
-+    List.map f l @ [default]
-+  in
-+  Ast_helper.Exp.function_ l
-+
-+let tag_error_case ?(typename="") () =
-+  let y = Ast_convenience.str typename in
-+  Ast_helper.Exp.case
-+    [%pat? _]
-+    [%expr Deriving_Json_lexer.tag_error ~typename:[%e y] buf]
-+
-+let maybe_tuple_type = function
-+  | [y] -> y
-+  | l -> Ast_helper.Typ.tuple l
-+
-+let rec read_poly_case ?decl y = function
-+  | Parsetree.Rtag (label, _, _, l) ->
-+    let i = Ppx_deriving.hash_variant label |> Ast_convenience.pint in
-+    (match l with
-+     | [] ->
-+       Ast_helper.Exp.case [%pat? `Cst [%p i]]
-+         (Ast_helper.Exp.variant label None)
-+     | l ->
-+       Ast_helper.Exp.case [%pat? `NCst [%p i]] [%expr
-+         Deriving_Json_lexer.read_comma buf;
-+         let v = [%e read_body_of_type ?decl (maybe_tuple_type l)] in
-+         Deriving_Json_lexer.read_rbracket buf;
-+         [%e Ast_helper.Exp.variant label (Some [%expr v])]])
-+  | Rinherit {ptyp_desc = Ptyp_constr (lid, l)} ->
-+    let guard = [%expr [%e suffix_lid lid ~suffix:"recognize"] x]
-+    and e =
-+      let e = suffix_lid lid ~suffix:"of_json_with_tag"
-+      and l = List.map (read_of_type ?decl) l in
-+      [%expr ([%e Ast_convenience.app e l] buf x :> [%t y])]
-+    in
-+    Ast_helper.Exp.case ~guard [%pat? x] e
-+  | Rinherit {ptyp_loc} ->
-+    Location.raise_errorf ~loc:ptyp_loc
-+      "%s read case cannot be derived" deriver
-+
-+and read_of_poly_variant ?decl l y ~loc =
-+  List.map (read_poly_case ?decl y) l @ [tag_error_case ()] |>
-+  Ast_helper.Exp.function_ |>
-+  buf_expand
-+
-+and read_tuple_contents ?decl l ~f =
-+  let n = List.length l in
-+  let lv = fresh_vars n in
-+  let f v y acc =
-+    let e = read_body_of_type ?decl y in [%expr
-+      Deriving_Json_lexer.read_comma buf;
-+      let [%p Ast_convenience.pvar v] = [%e e] in
-+      [%e acc]]
-+  and acc = List.map Ast_convenience.evar lv |> f in
-+  let acc = [%expr Deriving_Json_lexer.read_rbracket buf; [%e acc]] in
-+  List.fold_right2 f lv l acc
-+
-+and read_body_of_tuple_type ?decl l = [%expr
-+  Deriving_Json_lexer.read_lbracket buf;
-+  ignore (Deriving_Json_lexer.read_tag_1 0 buf);
-+  [%e read_tuple_contents ?decl l ~f:Ast_helper.Exp.tuple]]
-+
-+and read_of_record_raw ?decl l =
-+  let f =
-+    let f {Parsetree.pld_name} e = label_of_constructor pld_name, e in
-+    fun l' -> Ast_helper.Exp.record (List.map2 f l l') None
-+  and l =
-+    let f {Parsetree.pld_type} = pld_type in
-+    List.map f l
-+  in
-+  read_tuple_contents l ?decl ~f
-+
-+and read_of_record decl l =
-+  let e = read_of_record_raw ~decl l in
-+  [%expr
-+      Deriving_Json_lexer.read_lbracket buf;
-+      ignore (Deriving_Json_lexer.read_tag_2 0 254 buf);
-+      [%e e]] |> buf_expand
-+
-+and read_body_of_type ?decl y =
-+  let poly = match decl with Some _ -> true | _ -> false in
-+  match y with
-+  | [%type: unit] ->
-+    [%expr Deriving_Json.Json_unit.read buf]
-+  | [%type: int] ->
-+    [%expr Deriving_Json.Json_int.read buf]
-+  | [%type: int32] | [%type: Int32.t] ->
-+    [%expr Deriving_Json.Json_int32.read buf]
-+  | [%type: int64] | [%type: Int64.t] ->
-+    [%expr Deriving_Json.Json_int64.read buf]
-+  | [%type: nativeint] | [%type: Nativeint.t] ->
-+    [%expr Deriving_Json.Json_nativeint.read buf]
-+  | [%type: float] ->
-+    [%expr Deriving_Json.Json_float.read buf]
-+  | [%type: bool] ->
-+    [%expr Deriving_Json.Json_bool.read buf]
-+  | [%type: char] ->
-+    [%expr Deriving_Json.Json_char.read buf]
-+  | [%type: string] ->
-+    [%expr Deriving_Json.Json_string.read buf]
-+  | [%type: bytes] ->
-+    [%expr Deriving_Json.Json_bytes.read buf]
-+  | [%type: [%t? y] list] ->
-+    [%expr Deriving_Json.read_list [%e read_of_type ?decl y] buf]
-+  | [%type: [%t? y] ref] ->
-+    [%expr Deriving_Json.read_ref [%e read_of_type ?decl y] buf]
-+  | [%type: [%t? y] option] ->
-+    [%expr Deriving_Json.read_option [%e read_of_type ?decl y] buf]
-+  | [%type: [%t? y] array] ->
-+    [%expr Deriving_Json.read_array [%e read_of_type ?decl y] buf]
-+  | { Parsetree.ptyp_desc = Ptyp_tuple l } ->
-+    read_body_of_tuple_type l ?decl
-+  | { Parsetree.ptyp_desc = Ptyp_variant (l, _, _); ptyp_loc = loc } ->
-+    let e =
-+      (match decl with
-+       | Some decl ->
-+         let e = suffix_decl decl ~suffix:"of_json_with_tag"
-+         and l =
-+           let {Parsetree.ptype_params = l} = decl
-+           and f (y, _) = read_of_type y ~decl in
-+           List.map f l
-+         in
-+         Ast_convenience.app e l
-+       | None ->
-+         read_of_poly_variant l y ~loc)
-+    and tag = [%expr Deriving_Json_lexer.read_vcase buf] in
-+    [%expr [%e e] buf [%e tag]]
-+  | { Parsetree.ptyp_desc = Ptyp_var v } when poly ->
-+    [%expr [%e Ast_convenience.evar ("poly_" ^ v)] buf]
-+  | { Parsetree.ptyp_desc = Ptyp_constr (lid, l) } ->
-+    let e = suffix_lid lid ~suffix:"of_json"
-+    and l = List.map (read_of_type ?decl) l in
-+    [%expr [%e Ast_convenience.app e l] buf]
-+  | { Parsetree.ptyp_loc } ->
-+    Location.raise_errorf ~loc:ptyp_loc
-+      "%s_read cannot be derived for %s" deriver
-+      (Ppx_deriving.string_of_core_type y)
-+
-+and read_of_type ?decl y =
-+  read_body_of_type ?decl y |> buf_expand
-+
-+let json_of_type ?decl y =
-+  let read = read_of_type ?decl y
-+  and write =
-+    let poly = match decl with Some _ -> true | _ -> false in
-+    write_of_type y ~poly in
-+  [%expr Deriving_Json.make [%e write] [%e read]]
-+
-+let fun_str_wrap d e y ~f ~suffix =
-+  let e = Ppx_deriving.poly_fun_of_type_decl d e |> sanitize
-+  and v = suffix_decl_p d ~suffix
-+  and y = Ppx_deriving.poly_arrow_of_type_decl f d y in
-+  Ast_helper.(Vb.mk (Pat.constraint_ v y) e)
-+
-+let read_str_wrap d e =
-+  let f y = [%type: Deriving_Json_lexer.lexbuf -> [%t y]]
-+  and suffix = "of_json" in
-+  let y = f (Ppx_deriving.core_type_of_type_decl d) in
-+  fun_str_wrap d e y ~f ~suffix
-+
-+let read_tag_str_wrap d e =
-+  let f y = [%type: Deriving_Json_lexer.lexbuf -> [%t y]]
-+  and suffix = "of_json_with_tag"
-+  and y =
-+    let y = Ppx_deriving.core_type_of_type_decl d in
-+    [%type: Deriving_Json_lexer.lexbuf ->
-+          [`NCst of int | `Cst of int] -> [%t y]]
-+  in
-+  fun_str_wrap d e y ~f ~suffix
-+
-+let write_str_wrap d e =
-+  let f y = [%type: Buffer.t -> [%t y] -> unit]
-+  and suffix = "to_json" in
-+  let y =
-+    let y = Ppx_deriving.core_type_of_type_decl d in
-+    (match d with
-+     | {ptype_manifest =
-+          Some {ptyp_desc = Parsetree.Ptyp_variant (_, _, _)}} ->
-+       [%type: [> [%t y]]]
-+     | _ ->
-+       y) |> f
-+  in
-+  fun_str_wrap d e y ~f ~suffix
-+
-+let recognize_str_wrap d e =
-+  let v = suffix_decl_p d ~suffix:"recognize"
-+  and y = [%type: [`NCst of int | `Cst of int] -> bool] in
-+  Ast_helper.(Vb.mk (Pat.constraint_ v y) e)
-+
-+let json_poly_type d =
-+  let f y = [%type: [%t y] Deriving_Json.t] in
-+  let y = f (Ppx_deriving.core_type_of_type_decl d) in
-+  Ppx_deriving.poly_arrow_of_type_decl f d y
-+
-+let json_str_wrap d e =
-+  let v = suffix_decl_p d ~suffix:"json"
-+  and e = Ppx_deriving.(poly_fun_of_type_decl d e)
-+  and y = json_poly_type d in
-+  Ast_helper.(Vb.mk (Pat.constraint_ v y) e)
-+
-+let json_str d =
-+  let write =
-+    let f acc id =
-+      let poly = Ast_convenience.evar ("poly_" ^ id) in
-+      [%expr [%e acc] (Deriving_Json.write [%e poly])]
-+    and acc = suffix_decl d ~suffix:"to_json" in
-+    Ppx_deriving.fold_left_type_decl f acc d
-+  and read =
-+    let f acc id =
-+      let poly = Ast_convenience.evar ("poly_" ^ id) in
-+      [%expr [%e acc] (Deriving_Json.read [%e poly])]
-+    and acc = suffix_decl d ~suffix:"of_json" in
-+    Ppx_deriving.fold_left_type_decl f acc d
-+  in
-+  [%expr Deriving_Json.make [%e write] [%e read]] |>
-+  json_str_wrap d
-+
-+let write_decl_of_type d y =
-+  (let e =
-+     let arg = Ast_convenience.evar "a" in
-+     write_body_of_type y ~arg ~poly:true
-+   in
-+   [%expr fun buf a -> [%e e]]) |> write_str_wrap d
-+
-+let read_decl_of_type decl y =
-+  read_body_of_type y ~decl |> buf_expand |> read_str_wrap decl
-+
-+let json_decls_of_type decl y =
-+  let recognize, read_tag =
-+    match y with
-+    | { Parsetree.ptyp_desc = Ptyp_variant (l, _, _);
-+        ptyp_loc = loc } ->
-+      Some (recognize_body_of_poly_variant l ~loc
-+            |> recognize_str_wrap decl),
-+      Some (read_of_poly_variant l y ~decl ~loc
-+            |> read_tag_str_wrap decl)
-+    | _ ->
-+      None, None
-+  in
-+  write_decl_of_type decl y,
-+  read_decl_of_type decl y,
-+  json_str decl,
-+  recognize, read_tag
-+
-+let write_case (i, i', l) {Parsetree.pcd_name; pcd_args; pcd_loc} =
-+  let i, i', lhs, rhs =
-+    match pcd_args with
-+#if OCAML_VERSION >= (4, 03, 0)
-+    | Pcstr_tuple [] | Pcstr_record [] ->
-+#else
-+    | [] ->
-+#endif
-+      i + 1,
-+      i',
-+      None,
-+      [%expr Deriving_Json.Json_int.write buf
-+               [%e Ast_convenience.int i]]
-+#if OCAML_VERSION >= (4, 03, 0)
-+    | Pcstr_tuple ([ _ ] as args) ->
-+#else
-+    | [ _ ] as args ->
-+#endif
-+      let v = Ppx_deriving.fresh_var [] in
-+      i,
-+      i' + 1,
-+      Some (Ast_convenience.pvar v),
-+      write_tuple_contents [v] args ~tag:i' ~poly:true
-+#if OCAML_VERSION >= (4, 03, 0)
-+    | Pcstr_tuple args ->
-+#else
-+    | args ->
-+#endif
-+      let vars = fresh_vars (List.length args) in
-+      i,
-+      i' + 1,
-+      Some (var_ptuple vars),
-+      write_tuple_contents vars args ~tag:i' ~poly:true
-+#if OCAML_VERSION >= (4, 03, 0)
-+    | Pcstr_record args ->
-+      let vars = fresh_vars (List.length args) in
-+      i,
-+      i' + 1,
-+      Some (var_ptuple vars),
-+      write_of_record vars args ~tag:i'
-+#endif
-+  in
-+  i, i',
-+  Ast_helper.
-+    (Exp.case (Pat.construct (label_of_constructor pcd_name) lhs)
-+       rhs) :: l
-+
-+let write_decl_of_variant d l =
-+  (let _, _, l = List.fold_left write_case (0, 0, []) l in
-+   Ast_helper.Exp.function_ l) |> buf_expand |>
-+  write_str_wrap d
-+
-+let read_case ?decl (i, i', l)
-+    {Parsetree.pcd_name; pcd_args; pcd_loc} =
-+  match pcd_args with
-+#if OCAML_VERSION >= (4, 03, 0)
-+  | Pcstr_tuple [] | Pcstr_record [] ->
-+#else
-+  | [] ->
-+#endif
-+    i + 1, i',
-+    Ast_helper.Exp.case
-+      [%pat? `Cst [%p Ast_convenience.pint i]]
-+      (Ast_helper.Exp.construct (label_of_constructor pcd_name) None)
-+    :: l
-+#if OCAML_VERSION >= (4, 03, 0)
-+  | Pcstr_tuple pcd_args ->
-+#else
-+  | pcd_args ->
-+#endif
-+     let f l =
-+       let args =
-+         match l with
-+         | [] ->  None
-+         | [e] -> Some e
-+         | l ->   Some (Ast_helper.Exp.tuple l)
-+       in Ast_helper.Exp.construct (label_of_constructor pcd_name) args
-+     in
-+     let expr = read_tuple_contents ?decl pcd_args ~f in
-+     let case = Ast_helper.Exp.case [%pat? `NCst [%p Ast_convenience.pint i']] expr in
-+     i, i' + 1, case :: l
-+#if OCAML_VERSION >= (4, 03, 0)
-+  | Pcstr_record pcd_args ->
-+     let expr = read_of_record_raw ?decl pcd_args in
-+     let case = Ast_helper.Exp.case [%pat? `NCst [%p Ast_convenience.pint i']] expr in
-+     i, i' + 1, case :: l
-+#endif
-+
-+let read_decl_of_variant decl l =
-+  (let _, _, l = List.fold_left (read_case ~decl) (0, 0, []) l
-+   and e = [%expr Deriving_Json_lexer.read_case buf] in
-+   Ast_helper.Exp.match_ e (l @ [tag_error_case ()])) |>
-+  buf_expand |>
-+  read_str_wrap decl
-+
-+let json_decls_of_variant d l =
-+  write_decl_of_variant d l, read_decl_of_variant d l, json_str d,
-+  None, None
-+
-+let write_decl_of_record d l =
-+  write_of_record d l |> write_str_wrap d
-+
-+let read_decl_of_record d l =
-+  read_of_record d l |> read_str_wrap d
-+
-+let json_decls_of_record d l =
-+  check_record_fields l;
-+  write_decl_of_record d l, read_decl_of_record d l, json_str d,
-+  None, None
-+
-+let json_str_of_decl ({Parsetree.ptype_loc} as d) =
-+  Ast_helper.with_default_loc ptype_loc @@ fun () ->
-+  match d with
-+  | { Parsetree.ptype_manifest = Some y } ->
-+    json_decls_of_type d y
-+  | { ptype_kind = Ptype_variant l } ->
-+    json_decls_of_variant d l
-+  | { ptype_kind = Ptype_record l } ->
-+    json_decls_of_record d l
-+  | _ ->
-+    Location.raise_errorf "%s cannot be derived for %s" deriver
-+      (Ppx_deriving.mangle_type_decl (`Suffix "") d)
-+
-+let read_sig_of_decl ({Parsetree.ptype_loc} as d) =
-+  (let s =
-+     let s = Ppx_deriving.mangle_type_decl (`Suffix "of_json") d in
-+     Location.mkloc s ptype_loc
-+   and y =
-+     let f y = [%type: Deriving_Json_lexer.lexbuf -> [%t y]] in
-+     let y = f (Ppx_deriving.core_type_of_type_decl d) in
-+     Ppx_deriving.poly_arrow_of_type_decl f d y
-+   in
-+   Ast_helper.Val.mk s y) |> Ast_helper.Sig.value
-+
-+let recognize_sig_of_decl ({Parsetree.ptype_loc} as d) =
-+  (let s =
-+     let s = Ppx_deriving.mangle_type_decl (`Suffix "recognize") d in
-+     Location.mkloc s ptype_loc
-+   and y = [%type: [ `NCst of int  | `Cst of int ] -> bool] in
-+   Ast_helper.Val.mk s y) |> Ast_helper.Sig.value
-+
-+let read_with_tag_sig_of_decl ({Parsetree.ptype_loc} as d) =
-+  (let s =
-+     let s =
-+       Ppx_deriving.mangle_type_decl (`Suffix "of_json_with_tag") d
-+     in
-+     Location.mkloc s ptype_loc
-+   and y =
-+     let f y = [%type: Deriving_Json_lexer.lexbuf -> [%t y]] in
-+     let y =
-+       let y = Ppx_deriving.core_type_of_type_decl d in
-+       f [%type: [ `NCst of int  | `Cst of int ] -> [%t y]]
-+     in
-+     Ppx_deriving.poly_arrow_of_type_decl f d y
-+   in
-+   Ast_helper.Val.mk s y) |> Ast_helper.Sig.value
-+
-+let write_sig_of_decl ({Parsetree.ptype_loc} as d) =
-+  (let s =
-+     let s = Ppx_deriving.mangle_type_decl (`Suffix "to_json") d in
-+     Location.mkloc s ptype_loc
-+   and y =
-+     let f y = [%type: Buffer.t -> [%t y] -> unit] in
-+     let y = f (Ppx_deriving.core_type_of_type_decl d) in
-+     Ppx_deriving.poly_arrow_of_type_decl f d y
-+   in
-+   Ast_helper.Val.mk s y) |> Ast_helper.Sig.value
-+
-+let json_sig_of_decl ({Parsetree.ptype_loc} as d) =
-+  (let s =
-+     let s = Ppx_deriving.mangle_type_decl (`Suffix "json") d in
-+     Location.mkloc s ptype_loc
-+   and y =
-+     let f y = [%type: [%t y] Deriving_Json.t] in
-+     let y = f (Ppx_deriving.core_type_of_type_decl d) in
-+     Ppx_deriving.poly_arrow_of_type_decl f d y
-+   in
-+   Ast_helper.Val.mk s y) |> Ast_helper.Sig.value
-+
-+let sigs_of_decl ({Parsetree.ptype_loc} as d) =
-+  Ast_helper.with_default_loc ptype_loc @@ fun () ->
-+  let l = [
-+    read_sig_of_decl d;
-+    write_sig_of_decl d;
-+    json_sig_of_decl d
-+  ] in
-+  match d with
-+  | { Parsetree.ptype_manifest =
-+        Some {Parsetree.ptyp_desc = Parsetree.Ptyp_variant _}} ->
-+    read_with_tag_sig_of_decl d :: recognize_sig_of_decl d :: l
-+  | _ ->
-+    l
-+
-+let register_for_expr s f =
-+  let core_type ({Parsetree.ptyp_loc} as y) =
-+    let f () = f y |> sanitize in
-+    Ast_helper.with_default_loc ptyp_loc f
-+  in
-+  Ppx_deriving.(create s ~core_type () |> register)
-+
-+let _ =
-+  register_for_expr "of_json" @@ fun y -> [%expr
-+    fun s ->
-+      [%e read_of_type y]
-+        (Deriving_Json_lexer.init_lexer (Lexing.from_string s))]
-+
-+let _ =
-+  register_for_expr "to_json" @@ fun y -> [%expr
-+    fun x ->
-+      let buf = Buffer.create 50 in
-+      [%e write_of_type y ~poly:false] buf x;
-+      Buffer.contents buf]
-+
-+let _ =
-+  let core_type ({Parsetree.ptyp_loc} as y) =
-+    let f () = json_of_type y |> sanitize in
-+    Ast_helper.with_default_loc ptyp_loc f
-+  and type_decl_str ~options ~path l =
-+    let lw, lr, lj, lp, lrv =
-+      let f d (lw, lr, lj, lp, lrv) =
-+        let w, r, j, p, rv = json_str_of_decl d in
-+        w :: lw, r :: lr, j :: lj,
-+        (match p with Some p -> p :: lp | None -> lp),
-+        (match rv with Some rv -> rv :: lrv | None -> lrv)
-+      and acc = [], [], [], [], [] in
-+      List.fold_right f l acc
-+    and f = Ast_helper.Str.value Asttypes.Recursive
-+    and f' = Ast_helper.Str.value Asttypes.Nonrecursive in
-+    let l = [f (lrv @ lr); f lw; f' lj] in
-+    match lp with [] -> l | _ -> f lp :: l
-+  and type_decl_sig ~options ~path l =
-+    List.map sigs_of_decl l |> List.flatten
-+  in
-+  Ppx_deriving.
-+    (create "json" ~core_type ~type_decl_str ~type_decl_sig ()
-+     |> register)
-diff --git a/lib/ppx/ppx_deriving_json.ml b/lib/ppx/ppx_deriving_json.ml
-deleted file mode 100644
-index e96ce3f..0000000
---- a/lib/ppx/ppx_deriving_json.ml
-+++ /dev/null
-@@ -1,675 +0,0 @@
--(* Js_of_ocaml
-- * http://www.ocsigen.org
-- * Copyright Vasilis Papavasileiou 2015
-- *
-- * This program is free software; you can redistribute it and/or modify
-- * it under the terms of the GNU Lesser General Public License as published by
-- * the Free Software Foundation, with linking exception;
-- * either version 2.1 of the License, or (at your option) any later version.
-- *
-- * This program is distributed in the hope that it will be useful,
-- * but WITHOUT ANY WARRANTY; without even the implied warranty of
-- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- * GNU Lesser General Public License for more details.
-- *
-- * You should have received a copy of the GNU Lesser General Public License
-- * along with this program; if not, write to the Free Software
-- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-- *)
--
--let deriver = "json"
--
--(* Copied (and adapted) this from ppx_deriving repo (commit
--   e2079fa8f3460055bf990461f295c6c4b391fafc) ; we get an empty set of
--   let bindings with ppx_deriving 3.0 *)
--let sanitize expr = [%expr
--  (let open! Ppx_deriving_runtime in [%e expr]) [@ocaml.warning "-A"]]
--
--let var_ptuple l =
--  List.map Ast_convenience.pvar l |> Ast_helper.Pat.tuple
--
--let map_loc f {Location.txt; loc} =
--  {Location.txt = f txt; loc}
--
--let suffix_lid {Location.txt; loc} ~suffix =
--  let txt = Ppx_deriving.mangle_lid (`Suffix suffix) txt in
--  Ast_helper.Exp.ident {txt; loc} ~loc
--
--let suffix_decl ({Parsetree.ptype_loc = loc} as d) ~suffix =
--  (let s =
--     Ppx_deriving.mangle_type_decl (`Suffix suffix) d |>
--     Longident.parse
--   in
--   Location.mkloc s loc) |> Ast_helper.Exp.ident ~loc
--
--let suffix_decl_p ({Parsetree.ptype_loc = loc} as d) ~suffix =
--  (let s = Ppx_deriving.mangle_type_decl (`Suffix suffix) d in
--   Location.mkloc s loc) |> Ast_helper.Pat.var ~loc
--
--let rec fresh_vars ?(acc = []) n =
--  if n <= 0 then
--    List.rev acc
--  else
--    let acc = Ppx_deriving.fresh_var acc :: acc in
--    fresh_vars ~acc (n - 1)
--
--let unreachable_case () =
--  Ast_helper.Exp.case [%pat? _ ] [%expr assert false]
--
--let label_of_constructor = map_loc (fun c -> Longident.Lident c)
--
--let wrap_write r ~pattern = [%expr fun buf [%p pattern] -> [%e r]]
--
--let buf_expand r = [%expr fun buf -> [%e r]]
--
--let seqlist = function
--  | h :: l ->
--    let f acc e = [%expr [%e acc]; [%e e]] in
--    List.fold_left f h l
--  | [] ->
--    [%expr ()]
--
--let check_record_fields =
--  List.iter @@ function
--  | {Parsetree.pld_mutable = Mutable} ->
--    Location.raise_errorf
--      "%s cannot be derived for mutable records" deriver
--  | {pld_type = {ptyp_desc = Ptyp_poly _}} ->
--    Location.raise_errorf
--      "%s cannot be derived for polymorphic records" deriver
--  | _ ->
--    ()
--
--let maybe_tuple_type = function
--  | [y] -> y
--  | l -> Ast_helper.Typ.tuple l
--
--let rec write_tuple_contents l ly tag ~poly =
--  let e =
--    let f v y =
--      let arg = Ast_convenience.evar v in
--      let e = write_body_of_type y ~arg ~poly in
--      [%expr Buffer.add_string buf ","; [%e e]]
--    in
--    List.map2 f l ly |> seqlist
--  and s = Ast_convenience.str ("[" ^ string_of_int tag) in [%expr
--    Buffer.add_string buf [%e s];
--    [%e e];
--    Buffer.add_string buf "]"]
--
--and write_body_of_tuple_type l ~arg ~poly ~tag =
--  let n = List.length l in
--  let vars = fresh_vars n in
--  let e = write_tuple_contents vars l tag ~poly
--  and p = var_ptuple vars in
--  [%expr let [%p p] = [%e arg] in [%e e]]
--
--and write_poly_case r ~arg ~poly =
--  match r with
--  | Parsetree.Rtag (label, _, _, l) ->
--    let i = Ppx_deriving.hash_variant label
--    and n = List.length l in
--    let v = Ppx_deriving.fresh_var [] in
--    let lhs =
--      (if n = 0 then None else Some (Ast_convenience.pvar v)) |>
--      Ast_helper.Pat.variant label
--    and rhs =
--      match l with
--      | [] ->
--        let e = Ast_convenience.int i in
--        [%expr Deriving_Json.Json_int.write buf [%e e]]
--      | _ ->
--        let l = [[%type: int]; maybe_tuple_type l]
--        and arg = Ast_helper.Exp.tuple Ast_convenience.[int i; evar v] in
--        write_body_of_tuple_type l ~arg ~poly ~tag:0
--    in
--    Ast_helper.Exp.case lhs rhs
--  | Rinherit ({ptyp_desc = Ptyp_constr (lid, _)} as y) ->
--    Ast_helper.Exp.case (Ast_helper.Pat.type_ lid)
--      (write_body_of_type y ~arg ~poly)
--  | Rinherit {ptyp_loc} ->
--    Location.raise_errorf ~loc:ptyp_loc
--      "%s write case cannot be derived" deriver
--
--and write_body_of_type y ~arg ~poly =
--  match y with
--  | [%type: unit] ->
--    [%expr Deriving_Json.Json_unit.write buf [%e arg]]
--  | [%type: int] ->
--    [%expr Deriving_Json.Json_int.write buf [%e arg]]
--  | [%type: int32] | [%type: Int32.t] ->
--    [%expr Deriving_Json.Json_int32.write buf [%e arg]]
--  | [%type: int64] | [%type: Int64.t] ->
--    [%expr Deriving_Json.Json_int64.write buf [%e arg]]
--  | [%type: nativeint] | [%type: Nativeint.t] ->
--    [%expr Deriving_Json.Json_nativeint.write buf [%e arg]]
--  | [%type: float] ->
--    [%expr Deriving_Json.Json_float.write buf [%e arg]]
--  | [%type: bool] ->
--    [%expr Deriving_Json.Json_bool.write buf [%e arg]]
--  | [%type: char] ->
--    [%expr Deriving_Json.Json_char.write buf [%e arg]]
--  | [%type: string] ->
--    [%expr Deriving_Json.Json_string.write buf [%e arg]]
--  | [%type: bytes] ->
--    [%expr Deriving_Json.Json_bytes.write buf [%e arg]]
--  | [%type: [%t? y] list] ->
--    let e = write_of_type y ~poly in
--    [%expr Deriving_Json.write_list [%e e] buf [%e arg]]
--  | [%type: [%t? y] ref] ->
--    let e = write_of_type y ~poly in
--    [%expr Deriving_Json.write_ref [%e e] buf [%e arg]]
--  | [%type: [%t? y] option] ->
--    let e = write_of_type y ~poly in
--    [%expr Deriving_Json.write_option [%e e] buf [%e arg]]
--  | [%type: [%t? y] array] ->
--    let e = write_of_type y ~poly in
--    [%expr Deriving_Json.write_array [%e e] buf [%e arg]]
--  | { Parsetree.ptyp_desc = Ptyp_var v } when poly ->
--    [%expr [%e Ast_convenience.evar ("poly_" ^ v)] buf [%e arg]]
--  | { Parsetree.ptyp_desc = Ptyp_tuple l } ->
--    write_body_of_tuple_type l ~arg ~poly ~tag:0
--  | { Parsetree.ptyp_desc = Ptyp_variant (l, _, _); ptyp_loc = loc } ->
--    List.map (write_poly_case ~arg ~poly) l @ [unreachable_case ()] |>
--    Ast_helper.Exp.match_ arg
--  | { Parsetree.ptyp_desc = Ptyp_constr (lid, l) } ->
--    let e = suffix_lid lid ~suffix:"to_json"
--    and l = List.map (write_of_type ~poly) l in
--    [%expr [%e Ast_convenience.app e l] buf [%e arg]]
--  | { Parsetree.ptyp_loc } ->
--    Location.raise_errorf ~loc:ptyp_loc
--      "%s_write cannot be derived for %s"
--      deriver (Ppx_deriving.string_of_core_type y)
--
--and write_of_type y ~poly =
--  let v = "a" in
--  let arg = Ast_convenience.evar v
--  and pattern = Ast_convenience.pvar v in
--  wrap_write (write_body_of_type y ~arg ~poly) ~pattern
--
--and write_of_record d l =
--  let pattern =
--    let l =
--      let f {Parsetree.pld_name} =
--        label_of_constructor pld_name,
--        Ast_helper.Pat.var pld_name
--      in
--      List.map f l
--    in
--    Ast_helper.Pat.record l Asttypes.Closed
--  and e =
--    let l =
--      let f {Parsetree.pld_name = {txt}} = txt in
--      List.map f l
--    and ly =
--      let f {Parsetree.pld_type} = pld_type in
--      List.map f l
--    in
--    write_tuple_contents l ly 0 ~poly:true
--  in
--  wrap_write e ~pattern
--
--let recognize_case_of_constructor i l =
--  let lhs =
--    match l with
--    | [] -> [%pat? `Cst  [%p Ast_convenience.pint i]]
--    | _  -> [%pat? `NCst [%p Ast_convenience.pint i]]
--  in
--  Ast_helper.Exp.case lhs [%expr true]
--
--let recognize_body_of_poly_variant l ~loc =
--  let l =
--    let f = function
--      | Parsetree.Rtag (label, _, _, l) ->
--        let i = Ppx_deriving.hash_variant label in
--        recognize_case_of_constructor i l
--      | Rinherit {ptyp_desc = Ptyp_constr (lid, _)} ->
--        let guard = [%expr [%e suffix_lid lid ~suffix:"recognize"] x] in
--        Ast_helper.Exp.case ~guard [%pat? x] [%expr true]
--      | _ ->
--        Location.raise_errorf ~loc
--          "%s_recognize cannot be derived" deriver
--    and default = Ast_helper.Exp.case [%pat? _] [%expr false] in
--    List.map f l @ [default]
--  in
--  Ast_helper.Exp.function_ l
--
--let tag_error_case ?(typename="") () =
--  let y = Ast_convenience.str typename in
--  Ast_helper.Exp.case
--    [%pat? _]
--    [%expr Deriving_Json_lexer.tag_error ~typename:[%e y] buf]
--
--let maybe_tuple_type = function
--  | [y] -> y
--  | l -> Ast_helper.Typ.tuple l
--
--let rec read_poly_case ?decl y = function
--  | Parsetree.Rtag (label, _, _, l) ->
--    let i = Ppx_deriving.hash_variant label |> Ast_convenience.pint in
--    (match l with
--     | [] ->
--       Ast_helper.Exp.case [%pat? `Cst [%p i]]
--         (Ast_helper.Exp.variant label None)
--     | l ->
--       Ast_helper.Exp.case [%pat? `NCst [%p i]] [%expr
--         Deriving_Json_lexer.read_comma buf;
--         let v = [%e read_body_of_type ?decl (maybe_tuple_type l)] in
--         Deriving_Json_lexer.read_rbracket buf;
--         [%e Ast_helper.Exp.variant label (Some [%expr v])]])
--  | Rinherit {ptyp_desc = Ptyp_constr (lid, l)} ->
--    let guard = [%expr [%e suffix_lid lid ~suffix:"recognize"] x]
--    and e =
--      let e = suffix_lid lid ~suffix:"of_json_with_tag"
--      and l = List.map (read_of_type ?decl) l in
--      [%expr ([%e Ast_convenience.app e l] buf x :> [%t y])]
--    in
--    Ast_helper.Exp.case ~guard [%pat? x] e
--  | Rinherit {ptyp_loc} ->
--    Location.raise_errorf ~loc:ptyp_loc
--      "%s read case cannot be derived" deriver
--
--and read_of_poly_variant ?decl l y ~loc =
--  List.map (read_poly_case ?decl y) l @ [tag_error_case ()] |>
--  Ast_helper.Exp.function_ |>
--  buf_expand
--
--and read_tuple_contents ?decl l ~f =
--  let n = List.length l in
--  let lv = fresh_vars n in
--  let f v y acc =
--    let e = read_body_of_type ?decl y in [%expr
--      Deriving_Json_lexer.read_comma buf;
--      let [%p Ast_convenience.pvar v] = [%e e] in
--      [%e acc]]
--  and acc = List.map Ast_convenience.evar lv |> f in
--  let acc = [%expr Deriving_Json_lexer.read_rbracket buf; [%e acc]] in
--  List.fold_right2 f lv l acc
--
--and read_body_of_tuple_type ?decl l = [%expr
--  Deriving_Json_lexer.read_lbracket buf;
--  ignore (Deriving_Json_lexer.read_tag_1 0 buf);
--  [%e read_tuple_contents ?decl l ~f:Ast_helper.Exp.tuple]]
--
--and read_of_record decl l =
--  let e =
--    let f =
--      let f {Parsetree.pld_name} e = label_of_constructor pld_name, e in
--      fun l' -> Ast_helper.Exp.record (List.map2 f l l') None
--    and l =
--      let f {Parsetree.pld_type} = pld_type in
--      List.map f l
--    in
--    read_tuple_contents l ~decl ~f
--  in [%expr
--    Deriving_Json_lexer.read_lbracket buf;
--    ignore (Deriving_Json_lexer.read_tag_2 0 254 buf);
--    [%e e]] |> buf_expand
--
--and read_body_of_type ?decl y =
--  let poly = match decl with Some _ -> true | _ -> false in
--  match y with
--  | [%type: unit] ->
--    [%expr Deriving_Json.Json_unit.read buf]
--  | [%type: int] ->
--    [%expr Deriving_Json.Json_int.read buf]
--  | [%type: int32] | [%type: Int32.t] ->
--    [%expr Deriving_Json.Json_int32.read buf]
--  | [%type: int64] | [%type: Int64.t] ->
--    [%expr Deriving_Json.Json_int64.read buf]
--  | [%type: nativeint] | [%type: Nativeint.t] ->
--    [%expr Deriving_Json.Json_nativeint.read buf]
--  | [%type: float] ->
--    [%expr Deriving_Json.Json_float.read buf]
--  | [%type: bool] ->
--    [%expr Deriving_Json.Json_bool.read buf]
--  | [%type: char] ->
--    [%expr Deriving_Json.Json_char.read buf]
--  | [%type: string] ->
--    [%expr Deriving_Json.Json_string.read buf]
--  | [%type: bytes] ->
--    [%expr Deriving_Json.Json_bytes.read buf]
--  | [%type: [%t? y] list] ->
--    [%expr Deriving_Json.read_list [%e read_of_type ?decl y] buf]
--  | [%type: [%t? y] ref] ->
--    [%expr Deriving_Json.read_ref [%e read_of_type ?decl y] buf]
--  | [%type: [%t? y] option] ->
--    [%expr Deriving_Json.read_option [%e read_of_type ?decl y] buf]
--  | [%type: [%t? y] array] ->
--    [%expr Deriving_Json.read_array [%e read_of_type ?decl y] buf]
--  | { Parsetree.ptyp_desc = Ptyp_tuple l } ->
--    read_body_of_tuple_type l ?decl
--  | { Parsetree.ptyp_desc = Ptyp_variant (l, _, _); ptyp_loc = loc } ->
--    let e =
--      (match decl with
--       | Some decl ->
--         let e = suffix_decl decl ~suffix:"of_json_with_tag"
--         and l =
--           let {Parsetree.ptype_params = l} = decl
--           and f (y, _) = read_of_type y ~decl in
--           List.map f l
--         in
--         Ast_convenience.app e l
--       | None ->
--         read_of_poly_variant l y ~loc)
--    and tag = [%expr Deriving_Json_lexer.read_vcase buf] in
--    [%expr [%e e] buf [%e tag]]
--  | { Parsetree.ptyp_desc = Ptyp_var v } when poly ->
--    [%expr [%e Ast_convenience.evar ("poly_" ^ v)] buf]
--  | { Parsetree.ptyp_desc = Ptyp_constr (lid, l) } ->
--    let e = suffix_lid lid ~suffix:"of_json"
--    and l = List.map (read_of_type ?decl) l in
--    [%expr [%e Ast_convenience.app e l] buf]
--  | { Parsetree.ptyp_loc } ->
--    Location.raise_errorf ~loc:ptyp_loc
--      "%s_read cannot be derived for %s" deriver
--      (Ppx_deriving.string_of_core_type y)
--
--and read_of_type ?decl y =
--  read_body_of_type ?decl y |> buf_expand
--
--let json_of_type ?decl y =
--  let read = read_of_type ?decl y
--  and write =
--    let poly = match decl with Some _ -> true | _ -> false in
--    write_of_type y ~poly in
--  [%expr Deriving_Json.make [%e write] [%e read]]
--
--let fun_str_wrap d e y ~f ~suffix =
--  let e = Ppx_deriving.poly_fun_of_type_decl d e |> sanitize
--  and v = suffix_decl_p d ~suffix
--  and y = Ppx_deriving.poly_arrow_of_type_decl f d y in
--  Ast_helper.(Vb.mk (Pat.constraint_ v y) e)
--
--let read_str_wrap d e =
--  let f y = [%type: Deriving_Json_lexer.lexbuf -> [%t y]]
--  and suffix = "of_json" in
--  let y = f (Ppx_deriving.core_type_of_type_decl d) in
--  fun_str_wrap d e y ~f ~suffix
--
--let read_tag_str_wrap d e =
--  let f y = [%type: Deriving_Json_lexer.lexbuf -> [%t y]]
--  and suffix = "of_json_with_tag"
--  and y =
--    let y = Ppx_deriving.core_type_of_type_decl d in
--    [%type: Deriving_Json_lexer.lexbuf ->
--          [`NCst of int | `Cst of int] -> [%t y]]
--  in
--  fun_str_wrap d e y ~f ~suffix
--
--let write_str_wrap d e =
--  let f y = [%type: Buffer.t -> [%t y] -> unit]
--  and suffix = "to_json" in
--  let y =
--    let y = Ppx_deriving.core_type_of_type_decl d in
--    (match d with
--     | {ptype_manifest =
--          Some {ptyp_desc = Parsetree.Ptyp_variant (_, _, _)}} ->
--       [%type: [> [%t y]]]
--     | _ ->
--       y) |> f
--  in
--  fun_str_wrap d e y ~f ~suffix
--
--let recognize_str_wrap d e =
--  let v = suffix_decl_p d ~suffix:"recognize"
--  and y = [%type: [`NCst of int | `Cst of int] -> bool] in
--  Ast_helper.(Vb.mk (Pat.constraint_ v y) e)
--
--let json_poly_type d =
--  let f y = [%type: [%t y] Deriving_Json.t] in
--  let y = f (Ppx_deriving.core_type_of_type_decl d) in
--  Ppx_deriving.poly_arrow_of_type_decl f d y
--
--let json_str_wrap d e =
--  let v = suffix_decl_p d ~suffix:"json"
--  and e = Ppx_deriving.(poly_fun_of_type_decl d e)
--  and y = json_poly_type d in
--  Ast_helper.(Vb.mk (Pat.constraint_ v y) e)
--
--let json_str d =
--  let write =
--    let f acc id =
--      let poly = Ast_convenience.evar ("poly_" ^ id) in
--      [%expr [%e acc] (Deriving_Json.write [%e poly])]
--    and acc = suffix_decl d ~suffix:"to_json" in
--    Ppx_deriving.fold_left_type_decl f acc d
--  and read =
--    let f acc id =
--      let poly = Ast_convenience.evar ("poly_" ^ id) in
--      [%expr [%e acc] (Deriving_Json.read [%e poly])]
--    and acc = suffix_decl d ~suffix:"of_json" in
--    Ppx_deriving.fold_left_type_decl f acc d
--  in
--  [%expr Deriving_Json.make [%e write] [%e read]] |>
--  json_str_wrap d
--
--let write_decl_of_type d y =
--  (let e =
--     let arg = Ast_convenience.evar "a" in
--     write_body_of_type y ~arg ~poly:true
--   in
--   [%expr fun buf a -> [%e e]]) |> write_str_wrap d
--
--let read_decl_of_type decl y =
--  read_body_of_type y ~decl |> buf_expand |> read_str_wrap decl
--
--let json_decls_of_type decl y =
--  let recognize, read_tag =
--    match y with
--    | { Parsetree.ptyp_desc = Ptyp_variant (l, _, _);
--        ptyp_loc = loc } ->
--      Some (recognize_body_of_poly_variant l ~loc
--            |> recognize_str_wrap decl),
--      Some (read_of_poly_variant l y ~decl ~loc
--            |> read_tag_str_wrap decl)
--    | _ ->
--      None, None
--  in
--  write_decl_of_type decl y,
--  read_decl_of_type decl y,
--  json_str decl,
--  recognize, read_tag
--
--let write_case (i, i', l) {Parsetree.pcd_name; pcd_args; pcd_loc} =
--  let n = List.length pcd_args in
--  let vars = fresh_vars n in
--  let i, i', lhs, rhs =
--    match vars with
--    | [] ->
--      i + 1,
--      i',
--      None,
--      [%expr Deriving_Json.Json_int.write buf
--               [%e Ast_convenience.int i]]
--    | [v] ->
--      i,
--      i' + 1,
--      Some (Ast_convenience.pvar v),
--      write_tuple_contents vars pcd_args i' ~poly:true
--    | _ ->
--      i,
--      i' + 1,
--      Some (var_ptuple vars),
--      write_tuple_contents vars pcd_args i' ~poly:true
--  in
--  i, i',
--  Ast_helper.
--    (Exp.case (Pat.construct (label_of_constructor pcd_name) lhs)
--       rhs) :: l
--
--let write_decl_of_variant d l =
--  (let _, _, l = List.fold_left write_case (0, 0, []) l in
--   Ast_helper.Exp.function_ l) |> buf_expand |>
--  write_str_wrap d
--
--let read_case ?decl (i, i', l)
--    {Parsetree.pcd_name; pcd_args; pcd_loc} =
--  match pcd_args with
--  | [] ->
--    i + 1, i',
--    Ast_helper.Exp.case
--      [%pat? `Cst [%p Ast_convenience.pint i]]
--      (Ast_helper.Exp.construct (label_of_constructor pcd_name) None)
--    :: l
--  | _ ->
--    i, i' + 1,
--    ((let f l =
--        (match l with
--         | [] ->  None
--         | [e] -> Some e
--         | l ->   Some (Ast_helper.Exp.tuple l)) |>
--        Ast_helper.Exp.construct (label_of_constructor pcd_name)
--      in
--      read_tuple_contents ?decl pcd_args ~f) |>
--     Ast_helper.Exp.case [%pat? `NCst [%p Ast_convenience.pint i']])
--    :: l
--
--let read_decl_of_variant decl l =
--  (let _, _, l = List.fold_left (read_case ~decl) (0, 0, []) l
--   and e = [%expr Deriving_Json_lexer.read_case buf] in
--   Ast_helper.Exp.match_ e (l @ [tag_error_case ()])) |>
--  buf_expand |>
--  read_str_wrap decl
--
--let json_decls_of_variant d l =
--  write_decl_of_variant d l, read_decl_of_variant d l, json_str d,
--  None, None
--
--let write_decl_of_record d l =
--  write_of_record d l |> write_str_wrap d
--
--let read_decl_of_record d l =
--  read_of_record d l |> read_str_wrap d
--
--let json_decls_of_record d l =
--  check_record_fields l;
--  write_decl_of_record d l, read_decl_of_record d l, json_str d,
--  None, None
--
--let json_str_of_decl ({Parsetree.ptype_loc} as d) =
--  Ast_helper.with_default_loc ptype_loc @@ fun () ->
--  match d with
--  | { Parsetree.ptype_manifest = Some y } ->
--    json_decls_of_type d y
--  | { ptype_kind = Ptype_variant l } ->
--    json_decls_of_variant d l
--  | { ptype_kind = Ptype_record l } ->
--    json_decls_of_record d l
--  | _ ->
--    Location.raise_errorf "%s cannot be derived for %s" deriver
--      (Ppx_deriving.mangle_type_decl (`Suffix "") d)
--
--let read_sig_of_decl ({Parsetree.ptype_loc} as d) =
--  (let s =
--     let s = Ppx_deriving.mangle_type_decl (`Suffix "of_json") d in
--     Location.mkloc s ptype_loc
--   and y =
--     let f y = [%type: Deriving_Json_lexer.lexbuf -> [%t y]] in
--     let y = f (Ppx_deriving.core_type_of_type_decl d) in
--     Ppx_deriving.poly_arrow_of_type_decl f d y
--   in
--   Ast_helper.Val.mk s y) |> Ast_helper.Sig.value
--
--let recognize_sig_of_decl ({Parsetree.ptype_loc} as d) =
--  (let s =
--     let s = Ppx_deriving.mangle_type_decl (`Suffix "recognize") d in
--     Location.mkloc s ptype_loc
--   and y = [%type: [ `NCst of int  | `Cst of int ] -> bool] in
--   Ast_helper.Val.mk s y) |> Ast_helper.Sig.value
--
--let read_with_tag_sig_of_decl ({Parsetree.ptype_loc} as d) =
--  (let s =
--     let s =
--       Ppx_deriving.mangle_type_decl (`Suffix "of_json_with_tag") d
--     in
--     Location.mkloc s ptype_loc
--   and y =
--     let f y = [%type: Deriving_Json_lexer.lexbuf -> [%t y]] in
--     let y =
--       let y = Ppx_deriving.core_type_of_type_decl d in
--       f [%type: [ `NCst of int  | `Cst of int ] -> [%t y]]
--     in
--     Ppx_deriving.poly_arrow_of_type_decl f d y
--   in
--   Ast_helper.Val.mk s y) |> Ast_helper.Sig.value
--
--let write_sig_of_decl ({Parsetree.ptype_loc} as d) =
--  (let s =
--     let s = Ppx_deriving.mangle_type_decl (`Suffix "to_json") d in
--     Location.mkloc s ptype_loc
--   and y =
--     let f y = [%type: Buffer.t -> [%t y] -> unit] in
--     let y = f (Ppx_deriving.core_type_of_type_decl d) in
--     Ppx_deriving.poly_arrow_of_type_decl f d y
--   in
--   Ast_helper.Val.mk s y) |> Ast_helper.Sig.value
--
--let json_sig_of_decl ({Parsetree.ptype_loc} as d) =
--  (let s =
--     let s = Ppx_deriving.mangle_type_decl (`Suffix "json") d in
--     Location.mkloc s ptype_loc
--   and y =
--     let f y = [%type: [%t y] Deriving_Json.t] in
--     let y = f (Ppx_deriving.core_type_of_type_decl d) in
--     Ppx_deriving.poly_arrow_of_type_decl f d y
--   in
--   Ast_helper.Val.mk s y) |> Ast_helper.Sig.value
--
--let sigs_of_decl ({Parsetree.ptype_loc} as d) =
--  Ast_helper.with_default_loc ptype_loc @@ fun () ->
--  let l = [
--    read_sig_of_decl d;
--    write_sig_of_decl d;
--    json_sig_of_decl d
--  ] in
--  match d with
--  | { Parsetree.ptype_manifest =
--        Some {Parsetree.ptyp_desc = Parsetree.Ptyp_variant _}} ->
--    read_with_tag_sig_of_decl d :: recognize_sig_of_decl d :: l
--  | _ ->
--    l
--
--let register_for_expr s f =
--  let core_type ({Parsetree.ptyp_loc} as y) =
--    let f () = f y |> sanitize in
--    Ast_helper.with_default_loc ptyp_loc f
--  in
--  Ppx_deriving.(create s ~core_type () |> register)
--
--let _ =
--  register_for_expr "of_json" @@ fun y -> [%expr
--    fun s ->
--      [%e read_of_type y]
--        (Deriving_Json_lexer.init_lexer (Lexing.from_string s))]
--
--let _ =
--  register_for_expr "to_json" @@ fun y -> [%expr
--    fun x ->
--      let buf = Buffer.create 50 in
--      [%e write_of_type y ~poly:false] buf x;
--      Buffer.contents buf]
--
--let _ =
--  let core_type ({Parsetree.ptyp_loc} as y) =
--    let f () = json_of_type y |> sanitize in
--    Ast_helper.with_default_loc ptyp_loc f
--  and type_decl_str ~options ~path l =
--    let lw, lr, lj, lp, lrv =
--      let f d (lw, lr, lj, lp, lrv) =
--        let w, r, j, p, rv = json_str_of_decl d in
--        w :: lw, r :: lr, j :: lj,
--        (match p with Some p -> p :: lp | None -> lp),
--        (match rv with Some rv -> rv :: lrv | None -> lrv)
--      and acc = [], [], [], [], [] in
--      List.fold_right f l acc
--    and f = Ast_helper.Str.value Asttypes.Recursive
--    and f' = Ast_helper.Str.value Asttypes.Nonrecursive in
--    let l = [f (lrv @ lr); f lw; f' lj] in
--    match lp with [] -> l | _ -> f lp :: l
--  and type_decl_sig ~options ~path l =
--    List.map sigs_of_decl l |> List.flatten
--  in
--  Ppx_deriving.
--    (create "json" ~core_type ~type_decl_str ~type_decl_sig ()
--     |> register)