From 79a2c876a0c90b31e8d0ed71e075d0488e2be85d Mon Sep 17 00:00:00 2001 From: Anders Fugmann Date: Sat, 30 Dec 2023 21:57:43 +0100 Subject: [PATCH 01/30] Add benchmark to compare with ocaml-protoc --- Makefile | 7 ++- bench/Makefile | 2 + bench/bench.ml | 152 ++++++++++++++++++++++++++++++++++++++++++++++ bench/bench.proto | 26 ++++++++ bench/dune | 3 + bench/perf.data | 0 bench/plugin/dune | 12 ++++ bench/protoc/dune | 10 +++ 8 files changed, 211 insertions(+), 1 deletion(-) create mode 100644 bench/Makefile create mode 100644 bench/bench.ml create mode 100644 bench/bench.proto create mode 100644 bench/dune create mode 100644 bench/perf.data create mode 100644 bench/plugin/dune create mode 100644 bench/protoc/dune diff --git a/Makefile b/Makefile index 242f855..b156e84 100644 --- a/Makefile +++ b/Makefile @@ -42,7 +42,7 @@ src/spec/options.ml: build --ocaml_out=src/spec/. \ src/spec/options.proto .PHONY: bootstrap -bootstrap: src/spec/descriptor.ml src/spec/plugin.ml src/spec/options.ml +bootstrap: src/spec/descriptor.ml src/spec/plugin.ml src/spec/options.ml ## Regenerate files used for generation @@ -62,6 +62,11 @@ gh-pages: doc ## Publish documentation git -C .gh-pages push origin gh-pages -f rm -rf .gh-pages +.PHONY: bench +bench: ## Run benchmark to compare with ocaml-protoc + dune exec bench/bench.exe + + .PHONY: help help: ## Show this help @grep -h -E '^[.a-zA-Z_-]+:.*## .*$$' $(MAKEFILE_LIST) | awk 'BEGIN {FS = ":.*## "}; {printf "\033[36m%-30s\033[0m %s\n", $$1, $$2}' diff --git a/bench/Makefile b/bench/Makefile new file mode 100644 index 0000000..1ca5a87 --- /dev/null +++ b/bench/Makefile @@ -0,0 +1,2 @@ +default: + dune build bench.exe diff --git a/bench/bench.ml b/bench/bench.ml new file mode 100644 index 0000000..794dcfe --- /dev/null +++ b/bench/bench.ml @@ -0,0 +1,152 @@ +open Base +open Stdio + +module type Protobuf = sig + type t + val name : string + val encode : t -> string + val decode : string -> t +end +let _ = Random.init 0 + +module Protoc_mod : Protobuf = struct + type t = Protoc.Bench.btree + let name = "Protoc" + let encode t = + let encoder = Pbrt.Encoder.create () in + Protoc.Bench.encode_pb_btree t encoder; + Pbrt.Encoder.to_string encoder + + let decode data = + let decoder = Pbrt.Decoder.of_string data in + Protoc.Bench.decode_pb_btree decoder +end + +module Plugin_mod : Protobuf with type t = Plugin.Bench.Bench.Btree.t = struct + type t = Plugin.Bench.Bench.Btree.t + let name = "Plugin" + let encode t = + let writer = Plugin.Bench.Bench.Btree.to_proto t in + Ocaml_protoc_plugin.Writer.contents writer + + let decode data = + let reader = Ocaml_protoc_plugin.Reader.create data in + Plugin.Bench.Bench.Btree.from_proto reader |> Ocaml_protoc_plugin.Result.get ~msg:"Unable to decode" +end + +let create_test_data ~depth () = + let module Btree = Plugin.Bench.Bench.Btree in + let module Data = Plugin.Bench.Bench.Data in + let module Enum = Plugin.Bench.Bench.Enum in + let optional ~f () = + match (Random.int 4 = 0) with + | true -> None + | false -> Some (f ()) + in + let random_string () = + String.init (Random.int 20) ~f:(fun _ -> Random.char ()) + in + + let random_list ?(len=100) ~f () = + List.init (Random.int len) ~f:(fun _ -> f ()) + in + + let create_data () = + + let random_enum () = + match Random.int 5 with + | 0 -> Enum.EA + | 1 -> Enum.EB + | 2 -> Enum.EC + | 3 -> Enum.ED + | 4 -> Enum.EE + | _ -> failwith "Impossible value" + in + let s1 = optional ~f:random_string () in + let n1 = optional ~f:(random_list ~f:(fun () -> Random.int 1_000)) () in + let n2 = optional ~f:(random_list ~f:(fun () -> Random.int 1_000)) () in + let d1 = optional ~f:(random_list ~f:(fun () -> Random.float 1_000.)) () in + let n3 = optional ~f:(fun () -> Random.int 1_000) () in + let b1 = optional ~f:Random.bool () in + let _e = optional ~f:(random_list ~f:random_enum) () in + + Data.make ?s1 ?n1 ?n2 ?d1 ?n3 ?b1 (* ?e *) () + in + + let rec create_btree n () = + match n with + | 0 -> None + | n -> + let data = random_list ~f:create_data () in + let children = + random_list ~len:8 ~f:(create_btree (n - 1)) () |> List.filter_opt + in + Btree.make ~children ~data () |> Option.some + in + create_btree depth () + +let make_test (module P : Protobuf) data_str = + let data = P.decode data_str in + let open Bechamel in + let test_decode = Test.make ~name:"decode" (Staged.stage @@ fun () -> P.decode data_str) in + let test_encode = Test.make ~name:"encode" (Staged.stage @@ fun () -> P.encode data) in + Test.make_grouped ~name:P.name [test_decode; test_encode] + +let make_tests data_str = + [ make_test (module Protoc_mod) data_str; make_test (module Plugin_mod) data_str ] + |> Bechamel.Test.make_grouped ~name:"Protobuf" + + +let benchmark tests = + let open Bechamel in + let instances = Bechamel_perf.Instance.[ cpu_clock ] in + let cfg = Benchmark.cfg ~limit:10000 ~stabilize:true ~compaction:true + ~quota:(Time.second 2.5) () in + Benchmark.all cfg instances tests + +let analyze results = + let open Bechamel in + let ols = Analyze.ols ~bootstrap:0 ~r_square:true + ~predictors:[| Measure.run |] in + let results = Analyze.all ols Bechamel_perf.Instance.cpu_clock results in + Analyze.merge ols [ Bechamel_perf.Instance.cpu_clock ] [ results ] + +let print_bench_results results = + let open Bechamel in + let () = Bechamel_notty.Unit.add + Bechamel_perf.Instance.cpu_clock + (Measure.unit Bechamel_perf.Instance.cpu_clock) + in + + let img (window, results) = + Bechamel_notty.Multiple.image_of_ols_results ~rect:window + ~predictor:Measure.run results + in + + let open Notty_unix in + + let window = + match winsize Unix.stdout with + | Some (w, h) -> { Bechamel_notty.w; h } + | None -> { Bechamel_notty.w= 80; h= 1; } in + img (window, results) |> eol |> output_image + +let _ = + let data = create_test_data ~depth:4 () in + let data = Option.value_exn data in + let proto_str = Plugin_mod.encode data in + let _data = Plugin_mod.decode proto_str in + let data_protoc = Protoc_mod.decode proto_str in + let data_str' = Protoc_mod.encode data_protoc in + let data' = Plugin_mod.decode data_str' in + let data_str' = Plugin_mod.encode data' in + printf "Data length: %d / %d %b\n%!" (String.length proto_str) (String.length data_str') (String.equal proto_str data_str'); + let module Gc = Stdlib.Gc in + Gc.full_major (); + let control = Gc.get () in + Gc.set { control with minor_heap_size = 1024*1024*10; space_overhead=5 }; + + make_tests proto_str + |> benchmark + |> analyze + |> print_bench_results diff --git a/bench/bench.proto b/bench/bench.proto new file mode 100644 index 0000000..584fe5a --- /dev/null +++ b/bench/bench.proto @@ -0,0 +1,26 @@ +syntax = "proto3"; + +package bench; + +enum Enum { + EA = 0; + EB = 1; + EC = 2; + ED = 3; + EE = 4; +} + +message data { + optional string s1 = 1; + repeated int64 n1 = 2 [packed = true]; + repeated int64 n2 = 3 [packed = true]; + repeated double d1 = 4 [packed = true]; + optional int64 n3 = 5; + bool b1 = 6; + //repeated Enum e = 7; +} + +message btree { + repeated btree children = 1; + repeated data data = 2; +} diff --git a/bench/dune b/bench/dune new file mode 100644 index 0000000..ed36eac --- /dev/null +++ b/bench/dune @@ -0,0 +1,3 @@ +(executable + (name bench) + (libraries protoc plugin bechamel bechamel-notty notty.unix bechamel-perf base stdio)) diff --git a/bench/perf.data b/bench/perf.data new file mode 100644 index 0000000..e69de29 diff --git a/bench/plugin/dune b/bench/plugin/dune new file mode 100644 index 0000000..181a017 --- /dev/null +++ b/bench/plugin/dune @@ -0,0 +1,12 @@ +(rule + (targets bench.ml) + (deps + (:plugin ../../src/plugin/protoc_gen_ocaml.exe) + (:proto ../bench.proto)) + (action + (run protoc -I .. + "--plugin=protoc-gen-ocaml=%{plugin}" + "--ocaml_out=." %{proto}))) +(library + (name plugin) + (libraries ocaml_protoc_plugin)) diff --git a/bench/protoc/dune b/bench/protoc/dune new file mode 100644 index 0000000..14b36fc --- /dev/null +++ b/bench/protoc/dune @@ -0,0 +1,10 @@ +(rule + (targets bench.ml bench.mli) + (deps + (:proto ../bench.proto)) + (action + (run ocaml-protoc --binary --ml_out . %{proto}))) + +(library + (name protoc) + (libraries pbrt)) From 3231937353d2cc3ebbd76ad1574f39a7a115d438 Mon Sep 17 00:00:00 2001 From: Anders Fugmann Date: Sun, 31 Dec 2023 00:28:04 +0100 Subject: [PATCH 02/30] Speed up deserialization by using exceptions for error propagation rather than the result monad. * User facing API remains unchanged * This change speeds up deserialization by a factor of ~2 --- src/ocaml_protoc_plugin/deserialize.ml | 140 ++-- src/ocaml_protoc_plugin/extensions.ml | 5 +- src/ocaml_protoc_plugin/extensions.mli | 2 +- src/ocaml_protoc_plugin/reader.ml | 41 +- src/ocaml_protoc_plugin/reader.mli | 12 +- src/ocaml_protoc_plugin/result.ml | 17 +- src/ocaml_protoc_plugin/result.mli | 44 ++ src/ocaml_protoc_plugin/spec.ml | 4 +- src/plugin/emit.ml | 23 +- src/plugin/parameters.ml | 6 +- src/plugin/protoc_gen_ocaml.ml | 2 - src/plugin/types.ml | 6 +- src/spec/descriptor.ml | 870 +++++++------------------ src/spec/options.ml | 10 +- src/spec/plugin.ml | 168 +---- 15 files changed, 470 insertions(+), 880 deletions(-) create mode 100644 src/ocaml_protoc_plugin/result.mli diff --git a/src/ocaml_protoc_plugin/deserialize.ml b/src/ocaml_protoc_plugin/deserialize.ml index 23775b0..f2beb05 100644 --- a/src/ocaml_protoc_plugin/deserialize.ml +++ b/src/ocaml_protoc_plugin/deserialize.ml @@ -1,24 +1,21 @@ (** Module for deserializing values *) open StdLabels -open Result module S = Spec.Deserialize module C = S.C open S -type 'a sentinal = unit -> 'a Result.t -type 'a decoder = Field.t -> 'a Result.t +type 'a sentinal = unit -> 'a +type 'a decoder = Field.t -> 'a type (_, _) sentinal_list = | SNil : ('a, 'a) sentinal_list | SCons : ('a sentinal) * ('b, 'c) sentinal_list -> ('a -> 'b, 'c) sentinal_list -let error_wrong_field str field : _ Result.t = - `Wrong_field_type (str, field) |> Result.fail - -let error_illegal_value str field : _ Result.t = `Illegal_value (str, field) |> Result.fail -let error_required_field_missing: _ Result.t = `Required_field_missing |> Result.fail +let error_wrong_field str field = Result.raise (`Wrong_field_type (str, field)) +let error_illegal_value str field = Result.raise (`Illegal_value (str, field)) +let error_required_field_missing () = Result.raise `Required_field_missing let read_varint ~signed ~type_name = let open! Infix.Int64 in @@ -29,18 +26,18 @@ let read_varint ~signed ~type_name = | true -> (v / 2L * -1L) - 1L | false -> v in - return v + v end | field -> error_wrong_field type_name field let read_varint32 ~signed ~type_name field = - read_varint ~signed ~type_name field >>| Int64.to_int32 + read_varint ~signed ~type_name field |> Int64.to_int32 let rec type_of_spec: type a. a spec -> 'b * a decoder = let int_of_int32 spec = let (tpe, f) = type_of_spec spec in let f field = - f field >>| Int32.to_int + f field |> Int32.to_int in (tpe, f) in @@ -48,7 +45,7 @@ let rec type_of_spec: type a. a spec -> 'b * a decoder = let int_of_uint32 spec = let (tpe, f) = type_of_spec spec in let f field = - f field >>| (fun v -> + f field |> (fun v -> match Sys.word_size with | 32 -> (* If the high bit is set, we cannot represent it anyways *) @@ -65,7 +62,7 @@ let rec type_of_spec: type a. a spec -> 'b * a decoder = let int_of_int64 spec = let (tpe, f) = type_of_spec spec in let f field = - f field >>| Int64.to_int + f field |> Int64.to_int in (tpe, f) in @@ -74,17 +71,17 @@ let rec type_of_spec: type a. a spec -> 'b * a decoder = let (tpe, f) = type_of_spec spec in let f field = (* If high-bit is set, we cannot represent it *) - f field >>| Int64.to_int + f field |> Int64.to_int in (tpe, f) in function | Double -> (`Fixed_64_bit, function - | Field.Fixed_64_bit v -> return (Int64.float_of_bits v) + | Field.Fixed_64_bit v -> Int64.float_of_bits v | field -> error_wrong_field "double" field) | Float -> (`Fixed_32_bit, function - | Field.Fixed_32_bit v -> return (Int32.float_of_bits v) + | Field.Fixed_32_bit v -> Int32.float_of_bits v | field -> error_wrong_field "float" field) | Int32 -> (`Varint, read_varint32 ~signed:false ~type_name:"int32") | Int32_int -> int_of_int32 Int32 @@ -99,33 +96,33 @@ let rec type_of_spec: type a. a spec -> 'b * a decoder = | SInt64 -> (`Varint, read_varint ~signed:true ~type_name:"sint64") | SInt64_int -> int_of_int64 SInt64 | Fixed32 -> (`Fixed_32_bit, function - | Field.Fixed_32_bit v -> return (v) + | Field.Fixed_32_bit v -> v | field -> error_wrong_field "fixed32" field) | Fixed32_int -> int_of_int32 Fixed32 | Fixed64 -> (`Fixed_64_bit, function - | Field.Fixed_64_bit v -> return v + | Field.Fixed_64_bit v -> v | field -> error_wrong_field "fixed64" field) | Fixed64_int -> int_of_int64 Fixed64 | SFixed32 -> (`Fixed_32_bit, function - | Field.Fixed_32_bit v -> return v + | Field.Fixed_32_bit v -> v | field -> error_wrong_field "sfixed32" field) | SFixed32_int -> int_of_int32 SFixed32 | SFixed64 -> (`Fixed_64_bit, function - | Field.Fixed_64_bit v -> return v + | Field.Fixed_64_bit v -> v | field -> error_wrong_field "sfixed64" field) | SFixed64_int -> int_of_int64 SFixed64 | Bool -> (`Varint, function - | Field.Varint v -> return (Int64.equal v 0L |> not) + | Field.Varint v -> Int64.equal v 0L |> not | field -> error_wrong_field "bool" field) | Enum of_int -> (`Varint, function | Field.Varint v -> of_int (Int64.to_int v) | field -> error_wrong_field "enum" field) | String -> (`Length_delimited, function - | Field.Length_delimited {offset; length; data} -> return (String.sub ~pos:offset ~len:length data) + | Field.Length_delimited {offset; length; data} -> String.sub ~pos:offset ~len:length data | field -> error_wrong_field "string" field) | Bytes -> (`Length_delimited, function - | Field.Length_delimited {offset; length; data} -> return (String.sub ~pos:offset ~len:length data |> Bytes.of_string) + | Field.Length_delimited {offset; length; data} -> String.sub ~pos:offset ~len:length data |> Bytes.of_string | field -> error_wrong_field "string" field) | Message from_proto -> (`Length_delimited, function | Field.Length_delimited {offset; length; data} -> from_proto (Reader.create ~offset ~length data) @@ -142,13 +139,13 @@ let sentinal: type a. a compound -> (int * unit decoder) list * a sentinal = fun | Basic (index, (Message deser), _) -> let v = ref None in let get () = match !v with - | None -> error_required_field_missing - | Some v -> return v + | None -> error_required_field_missing () + | Some v -> v in let read = function | Field.Length_delimited {offset; length; data} -> let reader = Reader.create ~length ~offset data in - deser reader >>| fun message -> v := Some message + deser reader |> fun message -> v := Some message | field -> error_wrong_field "message" field in ([index, read], get) @@ -156,11 +153,11 @@ let sentinal: type a. a compound -> (int * unit decoder) list * a sentinal = fun let _, read = type_of_spec spec in let v = ref None in let get () = match !v with - | Some v -> return v - | None -> error_required_field_missing + | Some v -> v + | None -> error_required_field_missing () in let read field = - read field >>| fun value -> v := Some value + read field |> fun value -> v := Some value in ([index, read], get) | Basic (index, spec, default) -> @@ -170,24 +167,21 @@ let sentinal: type a. a compound -> (int * unit decoder) list * a sentinal = fun | Required | Proto3 -> begin default_of_field_type field_type - |> read - |> function - | Ok v -> v - | Error _ -> failwith "Cannot decode default field value" + |> fun v -> try read v with Result.Error _ -> failwith "Cannot decode default field value" end in let v = ref default in - let get () = return !v in + let get () = !v in let read field = - read field >>| fun value -> v := value + read field |> fun value -> v := value in ([index, read], get) | Basic_opt (index, spec) -> let _, read = type_of_spec spec in let v = ref None in - let get () = return !v in + let get () = !v in let read field = - read field >>| fun value -> v := Some value + read field |> fun value -> v := Some value in ([index, read], get) | Repeated (index, spec, _) -> @@ -198,33 +192,33 @@ let sentinal: type a. a compound -> (int * unit decoder) list * a sentinal = fun | `Fixed_32_bit -> Some Reader.read_fixed32 in let rec read_repeated reader decode read_f = match Reader.has_more reader with - | false -> return () + | false -> () | true -> - decode reader >>= fun field -> - read_f field >>= fun () -> + decode reader |> fun field -> + read_f field |> fun () -> read_repeated reader decode read_f in let (field_type, read_type) = type_of_spec spec in let v = ref [] in - let get () = return (List.rev !v) in + let get () = List.rev !v in let rec read field = match field, read_field field_type with | (Field.Length_delimited _ as field), None -> - read_type field >>| fun v' -> v := v' :: !v + read_type field |> fun v' -> v := v' :: !v | Field.Length_delimited { offset; length; data }, Some read_field -> read_repeated (Reader.create ~offset ~length data) read_field read - | field, _ -> read_type field >>| fun v' -> v := v' :: !v + | field, _ -> read_type field |> fun v' -> v := v' :: !v in ([index, read], get) | Oneof oneofs -> let make_reader: a ref -> a oneof -> (int * unit decoder) = fun v (Oneof_elem (index, spec, constr)) -> let _, read = type_of_spec spec in let read field = - read field >>| fun value -> v := (constr value) + read field |> fun value -> v := (constr value) in (index, read) in let v = ref `not_set in - let get () = return !v in + let get () = !v in List.map ~f:(make_reader v) oneofs, get module Map = struct @@ -246,21 +240,19 @@ let read_fields_map extension_ranges reader_list = let map = Map.of_alist_exn reader_list in let rec read reader = match Reader.has_more reader with - | false -> return (List.rev !extensions) - | true -> begin - match Reader.read_field reader with - | Ok (index, field) -> begin - match Map.find_opt index map with - | Some f -> - f field >>= fun () -> - read reader - | None when in_extension_ranges extension_ranges index -> - extensions := (index, field) :: !extensions; - read reader - | None -> - read reader - end - | Error err -> Error err + | false -> List.rev !extensions + | true -> + begin + let (index, field) = Reader.read_field reader in + match Map.find_opt index map with + | Some f -> + f field |> fun () -> + read reader + | None when in_extension_ranges extension_ranges index -> + extensions := (index, field) :: !extensions; + read reader + | None -> + read reader end in read @@ -271,30 +263,30 @@ let read_fields_array extension_ranges max_index reader_list = let default index field = match in_extension_ranges extension_ranges index with | true -> extensions := (index, field) :: !extensions; - return () + () | false -> - return () + () in let readers = Array.init (max_index + 1) ~f:(fun _ -> default) in List.iter ~f:(fun (idx, f) -> readers.(idx) <- (fun _ -> f)) reader_list; let rec read reader = match Reader.has_more reader with - | false -> return (List.rev !extensions) + | false -> List.rev !extensions | true -> begin - match Reader.read_field reader with - | Ok (index, field) when index <= max_index -> - readers.(index) index field >>= fun () -> + let (index, field) = Reader.read_field reader in + match index <= max_index with + | true -> + readers.(index) index field |> fun () -> read reader - | Ok (index, field) -> - default index field >>= fun () -> + | false -> + default index field |> fun () -> read reader - | Error err -> Error err end in read -let deserialize: type constr t. (int * int) list -> (constr, t) compound_list -> ((int * Field.t) list -> constr) -> Reader.t -> t Result.t = fun extension_ranges spec constr -> +let deserialize: type constr t. (int * int) list -> (constr, t) compound_list -> ((int * Field.t) list -> constr) -> Reader.t -> t = fun extension_ranges spec constr -> let max_index = let rec inner: type a b. int -> (a, b) compound_list -> int = fun acc -> function | Cons (Oneof oneofs, rest) -> @@ -332,10 +324,10 @@ let deserialize: type constr t. (int * int) list -> (constr, t) compound_list -> | true -> read_fields_array extension_ranges max_index | false -> read_fields_map extension_ranges in - let rec apply: type constr t. constr -> (constr, t) sentinal_list -> t Result.t = fun constr -> function + let rec apply: type constr t. constr -> (constr, t) sentinal_list -> t = fun constr -> function | SCons (sentinal, rest) -> - sentinal () >>= fun v -> apply (constr v) rest - | SNil -> return constr + sentinal () |> fun v -> apply (constr v) rest + | SNil -> constr in (* We first make a list of sentinal_getters, which we can map to the constr *) let rec make_sentinals: type a b. (a, b) compound_list -> (a, b) sentinal_list * (int * unit decoder) list = function @@ -348,4 +340,4 @@ let deserialize: type constr t. (int * int) list -> (constr, t) compound_list -> fun reader -> let sentinals, reader_list = make_sentinals spec in (* Read the fields one by one, and apply the reader - if found *) - read_fields reader_list reader >>= fun extensions -> apply (constr extensions) sentinals + read_fields reader_list reader |> fun extensions -> apply (constr extensions) sentinals diff --git a/src/ocaml_protoc_plugin/extensions.ml b/src/ocaml_protoc_plugin/extensions.ml index fece862..b16645e 100644 --- a/src/ocaml_protoc_plugin/extensions.ml +++ b/src/ocaml_protoc_plugin/extensions.ml @@ -7,7 +7,7 @@ let show : t -> string = Format.asprintf "%a" pp let equal _ _ = true let compare _ _ = 0 -let get: ('b -> 'b, 'b) Deserialize.S.compound_list -> t -> 'b Result.t = fun spec t -> +let get: ('b -> 'b, 'b) Deserialize.S.compound_list -> t -> 'b = fun spec t -> let writer = Writer.of_list t in (* Back and forth - its the same, no? *) let reader = Writer.contents writer |> Reader.create in @@ -16,7 +16,8 @@ let get: ('b -> 'b, 'b) Deserialize.S.compound_list -> t -> 'b Result.t = fun sp let set: ('a -> Writer.t, Writer.t) Serialize.S.compound_list -> t -> 'a -> t = fun spec t v -> let writer = Serialize.serialize [] spec [] v in let reader = Writer.contents writer |> Reader.create in - match Reader.to_list reader |> Result.get ~msg:"Internal serialization fail" with + match Reader.to_list reader with | (((index, _) :: _) as fields) -> (List.filter ~f:(fun (i, _) -> i != index) t) @ fields | [] -> t + | exception Result.Error _ -> failwith "Internal serialization fail" diff --git a/src/ocaml_protoc_plugin/extensions.mli b/src/ocaml_protoc_plugin/extensions.mli index 83ffa88..44b3d60 100644 --- a/src/ocaml_protoc_plugin/extensions.mli +++ b/src/ocaml_protoc_plugin/extensions.mli @@ -4,5 +4,5 @@ val pp : Format.formatter -> t -> unit val show : t -> string val equal : t -> t -> bool val compare : t -> t -> int -val get : ('b -> 'b, 'b) Deserialize.S.compound_list -> t -> 'b Result.t +val get : ('b -> 'b, 'b) Deserialize.S.compound_list -> t -> 'b val set : ('a -> Writer.t, Writer.t) Spec.Serialize.compound_list -> t -> 'a -> t diff --git a/src/ocaml_protoc_plugin/reader.ml b/src/ocaml_protoc_plugin/reader.ml index 56dbf4b..3bf4245 100644 --- a/src/ocaml_protoc_plugin/reader.ml +++ b/src/ocaml_protoc_plugin/reader.ml @@ -2,7 +2,6 @@ open StdLabels open Field -open Result type t = { mutable offset : int; @@ -22,15 +21,15 @@ let create ?(offset = 0) ?length data = (** Return an error if there is not enough data in input *) let validate_capacity t count = match t.offset + count <= t.end_offset with - | true -> return () + | true -> () | false -> - Result.fail `Premature_end_of_input + Result.raise `Premature_end_of_input (** Test if there is more data in the buffer to be read *) let has_more t = t.offset < t.end_offset let read_byte t = - validate_capacity t 1 >>| fun () -> + validate_capacity t 1 |> fun () -> let v = t.data.[t.offset] in t.offset <- t.offset + 1; (Char.code v) @@ -38,33 +37,33 @@ let read_byte t = let read_raw_varint t = let open Infix.Int64 in let rec inner acc = - read_byte t >>= fun v -> + read_byte t |> fun v -> let v = Int64.of_int v in let acc = (v land 0x7FL) :: acc in match v > 127L with | true -> (* Still More data *) inner acc - | false -> Result.return acc + | false -> acc in - inner [] >>| + inner [] |> List.fold_left ~init:0L ~f:(fun acc c -> (acc lsl 7) + c) -let read_varint t = read_raw_varint t >>| fun v -> Varint v +let read_varint t = read_raw_varint t |> fun v -> Varint v -let read_field_header : t -> (int * int) Result.t = +let read_field_header : t -> int * int = fun t -> let open Infix.Int64 in - read_raw_varint t >>| fun v -> + read_raw_varint t |> fun v -> let tpe = v land 0x7L |> Int64.to_int in let field_number = v / 8L |> Int64.to_int in (tpe, field_number) let read_length_delimited t = - read_raw_varint t >>= fun length -> + read_raw_varint t |> fun length -> let length = Int64.to_int length in - validate_capacity t length >>| fun () -> + validate_capacity t length |> fun () -> let v = Length_delimited {offset = t.offset; length; data = t.data} in t.offset <- t.offset + length; v @@ -72,34 +71,34 @@ let read_length_delimited t = (* Implement little endian ourselves *) let read_fixed32 t = let size = 4 in - validate_capacity t size >>| fun () -> + validate_capacity t size |> fun () -> let v = Bytes.get_int32_le (Bytes.unsafe_of_string t.data) t.offset in t.offset <- t.offset + size; (Fixed_32_bit v) let read_fixed64 t = let size = 8 in - validate_capacity t size >>| fun () -> + validate_capacity t size |> fun () -> let v = Bytes.get_int64_le (Bytes.unsafe_of_string t.data) t.offset in t.offset <- t.offset + size; (Fixed_64_bit v) -let read_field : t -> (int * Field.t) Result.t = +let read_field : t -> int * Field.t = fun t -> - read_field_header t >>= (fun (field_type, field_number) -> + read_field_header t |> (fun (field_type, field_number) -> (match field_type with | 0 -> read_varint t | 1 -> read_fixed64 t | 2 -> read_length_delimited t | 5 -> read_fixed32 t - | n -> Result.fail (`Unknown_field_type n)) - >>| fun field -> (field_number, field) + | n -> Result.raise (`Unknown_field_type n)) + |> fun field -> (field_number, field) ) -let to_list: t -> (int * Field.t) list Result.t = fun t -> +let to_list: t -> (int * Field.t) list = fun t -> let rec inner acc = match has_more t with - | true -> read_field t >>= fun v -> + | true -> read_field t |> fun v -> inner (v :: acc) - | false -> return (List.rev acc) + | false -> List.rev acc in inner [] diff --git a/src/ocaml_protoc_plugin/reader.mli b/src/ocaml_protoc_plugin/reader.mli index 0f3a466..e191899 100644 --- a/src/ocaml_protoc_plugin/reader.mli +++ b/src/ocaml_protoc_plugin/reader.mli @@ -5,10 +5,10 @@ val create : ?offset:int -> ?length:int -> string -> t (**/**) val has_more : t -> bool -val to_list : t -> (int * Field.t) list Result.t -val read_varint : t -> (Field.t, [> `Premature_end_of_input ]) result -val read_length_delimited : t -> (Field.t, [> `Premature_end_of_input ]) result -val read_fixed32 : t -> (Field.t, [> `Premature_end_of_input ]) result -val read_fixed64 : t -> (Field.t, [> `Premature_end_of_input ]) result -val read_field : t -> (int * Field.t) Result.t +val to_list : t -> (int * Field.t) list +val read_varint : t -> Field.t +val read_length_delimited : t -> Field.t +val read_fixed32 : t -> Field.t +val read_fixed64 : t -> Field.t +val read_field : t -> (int * Field.t) (**/**) diff --git a/src/ocaml_protoc_plugin/result.ml b/src/ocaml_protoc_plugin/result.ml index f1dd4e2..f32c143 100644 --- a/src/ocaml_protoc_plugin/result.ml +++ b/src/ocaml_protoc_plugin/result.ml @@ -10,18 +10,19 @@ type error = | `Oneof_missing | `Required_field_missing ] +exception Error of error type 'a t = ('a, error) result -let ( >>| ) v f = match v with Ok x -> Ok (f x) | Error err -> Error err -let ( >>= ) v f = match v with Ok x -> f x | Error err -> Error err -let open_error = function - | Ok _ as v -> v - | Error #error as v -> v +let raise error = raise (Error error) +let catch f = try Ok (f ()) with Error (#error as v) -> Error v + +let ( >>| ) : 'a t -> ('a -> 'b) -> 'b t = function Ok x -> fun f -> Ok (f x) | Error err -> fun _ -> Error err +let ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t = function Ok x -> fun f -> f x | Error err -> fun _ -> Error err (* Extra functions (from Base) *) let return x = Ok x -let fail x = Error x +let fail : error -> 'a t = fun x -> Error x let get ~msg = function | Ok v -> v | Error _ -> failwith msg @@ -67,7 +68,11 @@ let pp_error : Format.formatter -> [> error] -> unit = fun fmt -> function "`Required_field_missing" let show_error : error -> string = Format.asprintf "%a" pp_error +let _ = + Printexc.register_printer (function Error e -> Printf.sprintf "Ocaml_protoc_plugin.Result.Error (%s)" (show_error e) |> Option.some | _ -> None) + let pp pp fmt = function | Ok v -> Format.fprintf fmt "Ok %a" pp v | Error (#error as e) -> Format.fprintf fmt "Error %a" pp_error e + (* let show : 'a t -> string = Format.asprintf "%a" pp *) diff --git a/src/ocaml_protoc_plugin/result.mli b/src/ocaml_protoc_plugin/result.mli new file mode 100644 index 0000000..ce3cf65 --- /dev/null +++ b/src/ocaml_protoc_plugin/result.mli @@ -0,0 +1,44 @@ +type error = + [ `Premature_end_of_input + | `Unknown_field_type of int + | `Wrong_field_type of string * Field.t + | `Illegal_value of string * Field.t + | `Unknown_enum_value of int + | `Oneof_missing + | `Required_field_missing ] + +exception Error of error + +type 'a t = ('a, error) result + +(** Raise [error] as an exception of type Result.Error *) +val raise : error -> 'a + +(** catch [f] catches any exception of type Result.Error raised and returns a result type *) +val catch : (unit -> 'a) -> ('a, [> error ]) result + +(** Monadic map *) +val ( >>| ) : 'a t -> ('a -> 'b) -> 'b t + +(** Monadoc bind *) +val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t + +(** Monadic return *) +val return : 'a -> 'a t + +(** Create the error state *) +val fail : error -> 'a t + +(** Get the value or fail with the given message *) +val get : msg:string -> 'a t -> 'a + +(** Pretty printer of the error type *) +val pp_error : Format.formatter -> error -> unit + +(** Create a string representation of [error] *) +val show_error : error -> string + +(** Prettyprinter *) +val pp : + (Format.formatter -> 'a -> unit) -> + Format.formatter -> ('a, [< error ]) result -> unit diff --git a/src/ocaml_protoc_plugin/spec.ml b/src/ocaml_protoc_plugin/spec.ml index 41ed020..6863706 100644 --- a/src/ocaml_protoc_plugin/spec.ml +++ b/src/ocaml_protoc_plugin/spec.ml @@ -38,8 +38,8 @@ module Make(T : T) = struct | Bool : bool spec | String : string spec | Bytes : bytes spec - | Enum : ('a, int -> 'a Result.t, 'a -> int) T.dir -> 'a spec - | Message : ('a, Reader.t -> 'a Result.t, 'a -> Writer.t) T.dir -> 'a spec + | Enum : ('a, int -> 'a, 'a -> int) T.dir -> 'a spec + | Message : ('a, Reader.t -> 'a, 'a -> Writer.t) T.dir -> 'a spec type _ oneof = | Oneof_elem : int * 'b spec * ('a, ('b -> 'a), 'b) T.dir -> 'a oneof diff --git a/src/plugin/emit.ml b/src/plugin/emit.ml index 908ff54..80f8076 100644 --- a/src/plugin/emit.ml +++ b/src/plugin/emit.ml @@ -31,27 +31,29 @@ let emit_enum_type ~scope ~params Code.append signature t; Code.append implementation t; Code.emit signature `None "val to_int: t -> int"; - Code.emit signature `None "val from_int: int -> (t, [> Runtime'.Result.error]) result"; + Code.emit signature `None "val from_int: int -> t Runtime'.Result.t"; + Code.emit signature `None "val from_int_exn: int -> t"; Code.emit implementation `Begin "let to_int = function"; List.iter ~f:(fun EnumValueDescriptorProto.{name; number; _} -> Code.emit implementation `None "| %s -> %d" (Scope.get_name_exn scope name) (Option.value_exn number) ) values; Code.emit implementation `End ""; - - Code.emit implementation `Begin "let from_int = function"; + Code.emit implementation `Begin "let from_int_exn = function"; let _ = List.fold_left ~init:IntSet.empty ~f:(fun seen EnumValueDescriptorProto.{name; number; _} -> let idx = (Option.value_exn ~message:"All enum descriptions must have a value" number) in match IntSet.mem idx seen with | true -> seen | false -> - Code.emit implementation `None "| %d -> Ok %s" idx (Scope.get_name_exn scope name); + Code.emit implementation `None "| %d -> %s" idx (Scope.get_name_exn scope name); IntSet.add idx seen ) values in - Code.emit implementation `None "| n -> Error (`Unknown_enum_value n)"; + Code.emit implementation `None "| n -> Runtime'.Result.raise (`Unknown_enum_value n)"; Code.emit implementation `End ""; + Code.emit implementation `Begin "let from_int e = Runtime'.Result.catch (fun () -> from_int_exn e)"; + {module_name; signature; implementation} let emit_service_type ~options scope ServiceDescriptorProto.{ name; method' = methods; _ } = @@ -131,11 +133,13 @@ let emit_extension ~scope ~params field = Code.append implementation signature; Code.emit signature `None "type t = %s %s" t.type' params.annot; + Code.emit signature `None "val get_exn: %s -> %s" extendee_type t.type'; Code.emit signature `None "val get: %s -> (%s, [> Runtime'.Result.error]) result" extendee_type t.type'; Code.emit signature `None "val set: %s -> %s -> %s" extendee_type t.type' extendee_type; Code.emit implementation `None "type t = %s %s" t.type' params.annot; - Code.emit implementation `None "let get extendee = Runtime'.Extensions.get %s (extendee.%s) |> Runtime'.Result.open_error" t.deserialize_spec extendee_field ; + Code.emit implementation `None "let get_exn extendee = Runtime'.Extensions.get %s (extendee.%s)" t.deserialize_spec extendee_field ; + Code.emit implementation `None "let get extendee = Runtime'.Result.catch (fun () -> get_exn extendee)"; Code.emit implementation `Begin "let set extendee t ="; Code.emit implementation `None "let extensions' = Runtime'.Extensions.set (%s) (extendee.%s) t in" t.serialize_spec extendee_field; Code.emit implementation `None "{ extendee with %s = extensions' }" extendee_field; @@ -223,6 +227,7 @@ let rec emit_message ~params ~syntax scope Code.emit signature `None "val make : %s" default_constructor_sig; Code.emit signature `None "val to_proto: t -> Runtime'.Writer.t"; Code.emit signature `None "val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result"; + Code.emit signature `None "val from_proto_exn: Runtime'.Reader.t -> t"; Code.emit implementation `None "let name' () = \"%s\"" (Scope.get_current_scope scope); Code.emit implementation `None "type t = %s%s" type' params.annot; @@ -237,11 +242,13 @@ let rec emit_message ~params ~syntax scope Code.emit implementation `None "fun t -> apply ~f:serialize t"; Code.emit implementation `End ""; - Code.emit implementation `Begin "let from_proto ="; + Code.emit implementation `Begin "let from_proto_exn ="; Code.emit implementation `None "let constructor = %s in" constructor; Code.emit implementation `None "let spec = %s in" deserialize_spec; Code.emit implementation `None "let deserialize = Runtime'.Deserialize.deserialize %s spec constructor in" extension_ranges; - Code.emit implementation `None "fun writer -> deserialize writer |> Runtime'.Result.open_error"; + Code.emit implementation `None "fun writer -> deserialize writer"; + + Code.emit implementation `None "let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer)"; Code.emit implementation `End ""; | None -> () in diff --git a/src/plugin/parameters.ml b/src/plugin/parameters.ml index fe0eed4..2b45a46 100644 --- a/src/plugin/parameters.ml +++ b/src/plugin/parameters.ml @@ -44,7 +44,7 @@ let parse parameters = let use_snakecase options = Option.bind ~f:(fun option -> - Spec.Options.Ocaml_options.get option - |> Ocaml_protoc_plugin.Result.get ~msg:"Could not parse ocaml options" - ) options + Spec.Options.Ocaml_options.get option + |> Ocaml_protoc_plugin.Result.get ~msg:"Could not parse ocaml options" + ) options |> Option.value ~default:false diff --git a/src/plugin/protoc_gen_ocaml.ml b/src/plugin/protoc_gen_ocaml.ml index 1ec7580..d6b2419 100644 --- a/src/plugin/protoc_gen_ocaml.ml +++ b/src/plugin/protoc_gen_ocaml.ml @@ -53,8 +53,6 @@ let parse_request Plugin.CodeGeneratorRequest.{file_to_generate = files_to_gener | false -> ()); result - - let () = let request = read () in let outputs = parse_request request in diff --git a/src/plugin/types.ml b/src/plugin/types.ml index aaab331..0965040 100644 --- a/src/plugin/types.ml +++ b/src/plugin/types.ml @@ -145,7 +145,7 @@ let default_of_spec: type a. a spec -> string = fun spec -> match spec with | Bool -> string_of_default spec false | String -> string_of_default spec "" | Bytes -> string_of_default spec (Bytes.of_string "") - | Enum (_ , s, _, _) -> sprintf {|(%s 0 |> Runtime'.Result.get ~msg:"Code gen error")|} s + | Enum (_ , s, _, _) -> sprintf {|(%s 0)|} s | Message _ -> failwith "Messages defaults are not relevant" let string_of_spec: type a. [`Deserialize | `Serialize] -> a spec -> string = fun dir spec -> @@ -221,13 +221,13 @@ let type_of_spec: type a. a spec -> string = function let spec_of_message ~scope type_name = let type' = Scope.get_scoped_name ~postfix:"t" scope type_name in - let deserialize_func = Scope.get_scoped_name ~postfix:"from_proto" scope type_name in + let deserialize_func = Scope.get_scoped_name ~postfix:"from_proto_exn" scope type_name in let serialize_func = Scope.get_scoped_name ~postfix:"to_proto" scope type_name in Message (type', deserialize_func, serialize_func, None) let spec_of_enum ~scope type_name default = let type' = Scope.get_scoped_name ~postfix:"t" scope type_name in - let deserialize_func = Scope.get_scoped_name ~postfix:"from_int" scope type_name in + let deserialize_func = Scope.get_scoped_name ~postfix:"from_int_exn" scope type_name in let serialize_func = Scope.get_scoped_name ~postfix:"to_int" scope type_name in let default = Option.map ~f:(fun default -> Scope.get_scoped_name ~postfix:default scope type_name) default in Enum (type', deserialize_func, serialize_func, default) diff --git a/src/spec/descriptor.ml b/src/spec/descriptor.ml index a555780..34eee2d 100644 --- a/src/spec/descriptor.ml +++ b/src/spec/descriptor.ml @@ -18,456 +18,15 @@ *) open Ocaml_protoc_plugin.Runtime [@@warning "-33"] -module rec Google : sig - module rec Protobuf : sig - module rec FileDescriptorSet : sig - val name': unit -> string - type t = FileDescriptorProto.t list - val make : ?file:FileDescriptorProto.t list -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and FileDescriptorProto : sig - val name': unit -> string - type t = { name: string option; package: string option; dependency: string list; public_dependency: int list; weak_dependency: int list; message_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; service: ServiceDescriptorProto.t list; extension: FieldDescriptorProto.t list; options: FileOptions.t option; source_code_info: SourceCodeInfo.t option; syntax: string option } - val make : ?name:string -> ?package:string -> ?dependency:string list -> ?public_dependency:int list -> ?weak_dependency:int list -> ?message_type:DescriptorProto.t list -> ?enum_type:EnumDescriptorProto.t list -> ?service:ServiceDescriptorProto.t list -> ?extension:FieldDescriptorProto.t list -> ?options:FileOptions.t -> ?source_code_info:SourceCodeInfo.t -> ?syntax:string -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and DescriptorProto : sig - module rec ExtensionRange : sig - val name': unit -> string - type t = { start: int option; end': int option; options: ExtensionRangeOptions.t option } - val make : ?start:int -> ?end':int -> ?options:ExtensionRangeOptions.t -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and ReservedRange : sig - val name': unit -> string - type t = { start: int option; end': int option } - val make : ?start:int -> ?end':int -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - val name': unit -> string - type t = { name: string option; field: FieldDescriptorProto.t list; extension: FieldDescriptorProto.t list; nested_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; extension_range: ExtensionRange.t list; oneof_decl: OneofDescriptorProto.t list; options: MessageOptions.t option; reserved_range: ReservedRange.t list; reserved_name: string list } - val make : ?name:string -> ?field:FieldDescriptorProto.t list -> ?extension:FieldDescriptorProto.t list -> ?nested_type:DescriptorProto.t list -> ?enum_type:EnumDescriptorProto.t list -> ?extension_range:ExtensionRange.t list -> ?oneof_decl:OneofDescriptorProto.t list -> ?options:MessageOptions.t -> ?reserved_range:ReservedRange.t list -> ?reserved_name:string list -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and ExtensionRangeOptions : sig - val name': unit -> string - type t = { uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } - val make : ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and FieldDescriptorProto : sig - module rec Type : sig - type t = TYPE_DOUBLE | TYPE_FLOAT | TYPE_INT64 | TYPE_UINT64 | TYPE_INT32 | TYPE_FIXED64 | TYPE_FIXED32 | TYPE_BOOL | TYPE_STRING | TYPE_GROUP | TYPE_MESSAGE | TYPE_BYTES | TYPE_UINT32 | TYPE_ENUM | TYPE_SFIXED32 | TYPE_SFIXED64 | TYPE_SINT32 | TYPE_SINT64 - val to_int: t -> int - val from_int: int -> (t, [> Runtime'.Result.error]) result - end - and Label : sig - type t = LABEL_OPTIONAL | LABEL_REQUIRED | LABEL_REPEATED - val to_int: t -> int - val from_int: int -> (t, [> Runtime'.Result.error]) result - end - val name': unit -> string - type t = { name: string option; number: int option; label: Label.t option; type': Type.t option; type_name: string option; extendee: string option; default_value: string option; oneof_index: int option; json_name: string option; options: FieldOptions.t option; proto3_optional: bool option } - val make : ?name:string -> ?number:int -> ?label:Label.t -> ?type':Type.t -> ?type_name:string -> ?extendee:string -> ?default_value:string -> ?oneof_index:int -> ?json_name:string -> ?options:FieldOptions.t -> ?proto3_optional:bool -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and OneofDescriptorProto : sig - val name': unit -> string - type t = { name: string option; options: OneofOptions.t option } - val make : ?name:string -> ?options:OneofOptions.t -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and EnumDescriptorProto : sig - module rec EnumReservedRange : sig - val name': unit -> string - type t = { start: int option; end': int option } - val make : ?start:int -> ?end':int -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - val name': unit -> string - type t = { name: string option; value: EnumValueDescriptorProto.t list; options: EnumOptions.t option; reserved_range: EnumReservedRange.t list; reserved_name: string list } - val make : ?name:string -> ?value:EnumValueDescriptorProto.t list -> ?options:EnumOptions.t -> ?reserved_range:EnumReservedRange.t list -> ?reserved_name:string list -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and EnumValueDescriptorProto : sig - val name': unit -> string - type t = { name: string option; number: int option; options: EnumValueOptions.t option } - val make : ?name:string -> ?number:int -> ?options:EnumValueOptions.t -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and ServiceDescriptorProto : sig - val name': unit -> string - type t = { name: string option; method': MethodDescriptorProto.t list; options: ServiceOptions.t option } - val make : ?name:string -> ?method':MethodDescriptorProto.t list -> ?options:ServiceOptions.t -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and MethodDescriptorProto : sig - val name': unit -> string - type t = { name: string option; input_type: string option; output_type: string option; options: MethodOptions.t option; client_streaming: bool; server_streaming: bool } - val make : ?name:string -> ?input_type:string -> ?output_type:string -> ?options:MethodOptions.t -> ?client_streaming:bool -> ?server_streaming:bool -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and FileOptions : sig - module rec OptimizeMode : sig - type t = SPEED | CODE_SIZE | LITE_RUNTIME - val to_int: t -> int - val from_int: int -> (t, [> Runtime'.Result.error]) result - end - val name': unit -> string - type t = { java_package: string option; java_outer_classname: string option; java_multiple_files: bool; java_generate_equals_and_hash: bool option; java_string_check_utf8: bool; optimize_for: OptimizeMode.t; go_package: string option; cc_generic_services: bool; java_generic_services: bool; py_generic_services: bool; php_generic_services: bool; deprecated: bool; cc_enable_arenas: bool; objc_class_prefix: string option; csharp_namespace: string option; swift_prefix: string option; php_class_prefix: string option; php_namespace: string option; php_metadata_namespace: string option; ruby_package: string option; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } - val make : ?java_package:string -> ?java_outer_classname:string -> ?java_multiple_files:bool -> ?java_generate_equals_and_hash:bool -> ?java_string_check_utf8:bool -> ?optimize_for:OptimizeMode.t -> ?go_package:string -> ?cc_generic_services:bool -> ?java_generic_services:bool -> ?py_generic_services:bool -> ?php_generic_services:bool -> ?deprecated:bool -> ?cc_enable_arenas:bool -> ?objc_class_prefix:string -> ?csharp_namespace:string -> ?swift_prefix:string -> ?php_class_prefix:string -> ?php_namespace:string -> ?php_metadata_namespace:string -> ?ruby_package:string -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and MessageOptions : sig - val name': unit -> string - type t = { message_set_wire_format: bool; no_standard_descriptor_accessor: bool; deprecated: bool; map_entry: bool option; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } - val make : ?message_set_wire_format:bool -> ?no_standard_descriptor_accessor:bool -> ?deprecated:bool -> ?map_entry:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and FieldOptions : sig - module rec CType : sig - type t = STRING | CORD | STRING_PIECE - val to_int: t -> int - val from_int: int -> (t, [> Runtime'.Result.error]) result - end - and JSType : sig - type t = JS_NORMAL | JS_STRING | JS_NUMBER - val to_int: t -> int - val from_int: int -> (t, [> Runtime'.Result.error]) result - end - val name': unit -> string - type t = { ctype: CType.t; packed: bool option; jstype: JSType.t; lazy': bool; unverified_lazy: bool; deprecated: bool; weak: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } - val make : ?ctype:CType.t -> ?packed:bool -> ?jstype:JSType.t -> ?lazy':bool -> ?unverified_lazy:bool -> ?deprecated:bool -> ?weak:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and OneofOptions : sig - val name': unit -> string - type t = { uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } - val make : ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and EnumOptions : sig - val name': unit -> string - type t = { allow_alias: bool option; deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } - val make : ?allow_alias:bool -> ?deprecated:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and EnumValueOptions : sig - val name': unit -> string - type t = { deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } - val make : ?deprecated:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and ServiceOptions : sig - val name': unit -> string - type t = { deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } - val make : ?deprecated:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and MethodOptions : sig - module rec IdempotencyLevel : sig - type t = IDEMPOTENCY_UNKNOWN | NO_SIDE_EFFECTS | IDEMPOTENT - val to_int: t -> int - val from_int: int -> (t, [> Runtime'.Result.error]) result - end - val name': unit -> string - type t = { deprecated: bool; idempotency_level: IdempotencyLevel.t; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } - val make : ?deprecated:bool -> ?idempotency_level:IdempotencyLevel.t -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and UninterpretedOption : sig - module rec NamePart : sig - val name': unit -> string - type t = { name_part: string; is_extension: bool } - val make : name_part:string -> is_extension:bool -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - val name': unit -> string - type t = { name: NamePart.t list; identifier_value: string option; positive_int_value: int option; negative_int_value: int option; double_value: float option; string_value: bytes option; aggregate_value: string option } - val make : ?name:NamePart.t list -> ?identifier_value:string -> ?positive_int_value:int -> ?negative_int_value:int -> ?double_value:float -> ?string_value:bytes -> ?aggregate_value:string -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and SourceCodeInfo : sig - module rec Location : sig - val name': unit -> string - type t = { path: int list; span: int list; leading_comments: string option; trailing_comments: string option; leading_detached_comments: string list } - val make : ?path:int list -> ?span:int list -> ?leading_comments:string -> ?trailing_comments:string -> ?leading_detached_comments:string list -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - val name': unit -> string - type t = Location.t list - val make : ?location:Location.t list -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and GeneratedCodeInfo : sig - module rec Annotation : sig - val name': unit -> string - type t = { path: int list; source_file: string option; begin': int option; end': int option } - val make : ?path:int list -> ?source_file:string -> ?begin':int -> ?end':int -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - val name': unit -> string - type t = Annotation.t list - val make : ?annotation:Annotation.t list -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - end -end = struct - module rec Protobuf : sig - module rec FileDescriptorSet : sig - val name': unit -> string - type t = FileDescriptorProto.t list - val make : ?file:FileDescriptorProto.t list -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and FileDescriptorProto : sig - val name': unit -> string - type t = { name: string option; package: string option; dependency: string list; public_dependency: int list; weak_dependency: int list; message_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; service: ServiceDescriptorProto.t list; extension: FieldDescriptorProto.t list; options: FileOptions.t option; source_code_info: SourceCodeInfo.t option; syntax: string option } - val make : ?name:string -> ?package:string -> ?dependency:string list -> ?public_dependency:int list -> ?weak_dependency:int list -> ?message_type:DescriptorProto.t list -> ?enum_type:EnumDescriptorProto.t list -> ?service:ServiceDescriptorProto.t list -> ?extension:FieldDescriptorProto.t list -> ?options:FileOptions.t -> ?source_code_info:SourceCodeInfo.t -> ?syntax:string -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and DescriptorProto : sig - module rec ExtensionRange : sig - val name': unit -> string - type t = { start: int option; end': int option; options: ExtensionRangeOptions.t option } - val make : ?start:int -> ?end':int -> ?options:ExtensionRangeOptions.t -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and ReservedRange : sig - val name': unit -> string - type t = { start: int option; end': int option } - val make : ?start:int -> ?end':int -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - val name': unit -> string - type t = { name: string option; field: FieldDescriptorProto.t list; extension: FieldDescriptorProto.t list; nested_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; extension_range: ExtensionRange.t list; oneof_decl: OneofDescriptorProto.t list; options: MessageOptions.t option; reserved_range: ReservedRange.t list; reserved_name: string list } - val make : ?name:string -> ?field:FieldDescriptorProto.t list -> ?extension:FieldDescriptorProto.t list -> ?nested_type:DescriptorProto.t list -> ?enum_type:EnumDescriptorProto.t list -> ?extension_range:ExtensionRange.t list -> ?oneof_decl:OneofDescriptorProto.t list -> ?options:MessageOptions.t -> ?reserved_range:ReservedRange.t list -> ?reserved_name:string list -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and ExtensionRangeOptions : sig - val name': unit -> string - type t = { uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } - val make : ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and FieldDescriptorProto : sig - module rec Type : sig - type t = TYPE_DOUBLE | TYPE_FLOAT | TYPE_INT64 | TYPE_UINT64 | TYPE_INT32 | TYPE_FIXED64 | TYPE_FIXED32 | TYPE_BOOL | TYPE_STRING | TYPE_GROUP | TYPE_MESSAGE | TYPE_BYTES | TYPE_UINT32 | TYPE_ENUM | TYPE_SFIXED32 | TYPE_SFIXED64 | TYPE_SINT32 | TYPE_SINT64 - val to_int: t -> int - val from_int: int -> (t, [> Runtime'.Result.error]) result - end - and Label : sig - type t = LABEL_OPTIONAL | LABEL_REQUIRED | LABEL_REPEATED - val to_int: t -> int - val from_int: int -> (t, [> Runtime'.Result.error]) result - end - val name': unit -> string - type t = { name: string option; number: int option; label: Label.t option; type': Type.t option; type_name: string option; extendee: string option; default_value: string option; oneof_index: int option; json_name: string option; options: FieldOptions.t option; proto3_optional: bool option } - val make : ?name:string -> ?number:int -> ?label:Label.t -> ?type':Type.t -> ?type_name:string -> ?extendee:string -> ?default_value:string -> ?oneof_index:int -> ?json_name:string -> ?options:FieldOptions.t -> ?proto3_optional:bool -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and OneofDescriptorProto : sig - val name': unit -> string - type t = { name: string option; options: OneofOptions.t option } - val make : ?name:string -> ?options:OneofOptions.t -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and EnumDescriptorProto : sig - module rec EnumReservedRange : sig - val name': unit -> string - type t = { start: int option; end': int option } - val make : ?start:int -> ?end':int -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - val name': unit -> string - type t = { name: string option; value: EnumValueDescriptorProto.t list; options: EnumOptions.t option; reserved_range: EnumReservedRange.t list; reserved_name: string list } - val make : ?name:string -> ?value:EnumValueDescriptorProto.t list -> ?options:EnumOptions.t -> ?reserved_range:EnumReservedRange.t list -> ?reserved_name:string list -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and EnumValueDescriptorProto : sig - val name': unit -> string - type t = { name: string option; number: int option; options: EnumValueOptions.t option } - val make : ?name:string -> ?number:int -> ?options:EnumValueOptions.t -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and ServiceDescriptorProto : sig - val name': unit -> string - type t = { name: string option; method': MethodDescriptorProto.t list; options: ServiceOptions.t option } - val make : ?name:string -> ?method':MethodDescriptorProto.t list -> ?options:ServiceOptions.t -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and MethodDescriptorProto : sig - val name': unit -> string - type t = { name: string option; input_type: string option; output_type: string option; options: MethodOptions.t option; client_streaming: bool; server_streaming: bool } - val make : ?name:string -> ?input_type:string -> ?output_type:string -> ?options:MethodOptions.t -> ?client_streaming:bool -> ?server_streaming:bool -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and FileOptions : sig - module rec OptimizeMode : sig - type t = SPEED | CODE_SIZE | LITE_RUNTIME - val to_int: t -> int - val from_int: int -> (t, [> Runtime'.Result.error]) result - end - val name': unit -> string - type t = { java_package: string option; java_outer_classname: string option; java_multiple_files: bool; java_generate_equals_and_hash: bool option; java_string_check_utf8: bool; optimize_for: OptimizeMode.t; go_package: string option; cc_generic_services: bool; java_generic_services: bool; py_generic_services: bool; php_generic_services: bool; deprecated: bool; cc_enable_arenas: bool; objc_class_prefix: string option; csharp_namespace: string option; swift_prefix: string option; php_class_prefix: string option; php_namespace: string option; php_metadata_namespace: string option; ruby_package: string option; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } - val make : ?java_package:string -> ?java_outer_classname:string -> ?java_multiple_files:bool -> ?java_generate_equals_and_hash:bool -> ?java_string_check_utf8:bool -> ?optimize_for:OptimizeMode.t -> ?go_package:string -> ?cc_generic_services:bool -> ?java_generic_services:bool -> ?py_generic_services:bool -> ?php_generic_services:bool -> ?deprecated:bool -> ?cc_enable_arenas:bool -> ?objc_class_prefix:string -> ?csharp_namespace:string -> ?swift_prefix:string -> ?php_class_prefix:string -> ?php_namespace:string -> ?php_metadata_namespace:string -> ?ruby_package:string -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and MessageOptions : sig - val name': unit -> string - type t = { message_set_wire_format: bool; no_standard_descriptor_accessor: bool; deprecated: bool; map_entry: bool option; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } - val make : ?message_set_wire_format:bool -> ?no_standard_descriptor_accessor:bool -> ?deprecated:bool -> ?map_entry:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and FieldOptions : sig - module rec CType : sig - type t = STRING | CORD | STRING_PIECE - val to_int: t -> int - val from_int: int -> (t, [> Runtime'.Result.error]) result - end - and JSType : sig - type t = JS_NORMAL | JS_STRING | JS_NUMBER - val to_int: t -> int - val from_int: int -> (t, [> Runtime'.Result.error]) result - end - val name': unit -> string - type t = { ctype: CType.t; packed: bool option; jstype: JSType.t; lazy': bool; unverified_lazy: bool; deprecated: bool; weak: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } - val make : ?ctype:CType.t -> ?packed:bool -> ?jstype:JSType.t -> ?lazy':bool -> ?unverified_lazy:bool -> ?deprecated:bool -> ?weak:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and OneofOptions : sig - val name': unit -> string - type t = { uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } - val make : ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and EnumOptions : sig - val name': unit -> string - type t = { allow_alias: bool option; deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } - val make : ?allow_alias:bool -> ?deprecated:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and EnumValueOptions : sig - val name': unit -> string - type t = { deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } - val make : ?deprecated:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and ServiceOptions : sig - val name': unit -> string - type t = { deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } - val make : ?deprecated:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and MethodOptions : sig - module rec IdempotencyLevel : sig - type t = IDEMPOTENCY_UNKNOWN | NO_SIDE_EFFECTS | IDEMPOTENT - val to_int: t -> int - val from_int: int -> (t, [> Runtime'.Result.error]) result - end - val name': unit -> string - type t = { deprecated: bool; idempotency_level: IdempotencyLevel.t; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } - val make : ?deprecated:bool -> ?idempotency_level:IdempotencyLevel.t -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and UninterpretedOption : sig - module rec NamePart : sig - val name': unit -> string - type t = { name_part: string; is_extension: bool } - val make : name_part:string -> is_extension:bool -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - val name': unit -> string - type t = { name: NamePart.t list; identifier_value: string option; positive_int_value: int option; negative_int_value: int option; double_value: float option; string_value: bytes option; aggregate_value: string option } - val make : ?name:NamePart.t list -> ?identifier_value:string -> ?positive_int_value:int -> ?negative_int_value:int -> ?double_value:float -> ?string_value:bytes -> ?aggregate_value:string -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and SourceCodeInfo : sig - module rec Location : sig - val name': unit -> string - type t = { path: int list; span: int list; leading_comments: string option; trailing_comments: string option; leading_detached_comments: string list } - val make : ?path:int list -> ?span:int list -> ?leading_comments:string -> ?trailing_comments:string -> ?leading_detached_comments:string list -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - val name': unit -> string - type t = Location.t list - val make : ?location:Location.t list -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and GeneratedCodeInfo : sig - module rec Annotation : sig - val name': unit -> string - type t = { path: int list; source_file: string option; begin': int option; end': int option } - val make : ?path:int list -> ?source_file:string -> ?begin':int -> ?end':int -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - val name': unit -> string - type t = Annotation.t list - val make : ?annotation:Annotation.t list -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - end = struct +module Google = struct + module Protobuf = struct module rec FileDescriptorSet : sig val name': unit -> string type t = FileDescriptorProto.t list val make : ?file:FileDescriptorProto.t list -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end = struct let name' () = "descriptor.google.protobuf.FileDescriptorSet" type t = FileDescriptorProto.t list @@ -482,11 +41,12 @@ end = struct let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - let from_proto = + let from_proto_exn = let constructor = fun _extensions file -> file in - let spec = Runtime'.Deserialize.C.( repeated (1, (message (fun t -> FileDescriptorProto.from_proto t)), not_packed) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( repeated (1, (message (fun t -> FileDescriptorProto.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in - fun writer -> deserialize writer |> Runtime'.Result.open_error + fun writer -> deserialize writer + let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) end and FileDescriptorProto : sig @@ -495,6 +55,7 @@ end = struct val make : ?name:string -> ?package:string -> ?dependency:string list -> ?public_dependency:int list -> ?weak_dependency:int list -> ?message_type:DescriptorProto.t list -> ?enum_type:EnumDescriptorProto.t list -> ?service:ServiceDescriptorProto.t list -> ?extension:FieldDescriptorProto.t list -> ?options:FileOptions.t -> ?source_code_info:SourceCodeInfo.t -> ?syntax:string -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end = struct let name' () = "descriptor.google.protobuf.FileDescriptorProto" type t = { name: string option; package: string option; dependency: string list; public_dependency: int list; weak_dependency: int list; message_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; service: ServiceDescriptorProto.t list; extension: FieldDescriptorProto.t list; options: FileOptions.t option; source_code_info: SourceCodeInfo.t option; syntax: string option } @@ -515,11 +76,12 @@ end = struct let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - let from_proto = + let from_proto_exn = let constructor = fun _extensions name package dependency public_dependency weak_dependency message_type enum_type service extension options source_code_info syntax -> { name; package; dependency; public_dependency; weak_dependency; message_type; enum_type; service; extension; options; source_code_info; syntax } in - let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (2, string) ^:: repeated (3, string, not_packed) ^:: repeated (10, int32_int, not_packed) ^:: repeated (11, int32_int, not_packed) ^:: repeated (4, (message (fun t -> DescriptorProto.from_proto t)), not_packed) ^:: repeated (5, (message (fun t -> EnumDescriptorProto.from_proto t)), not_packed) ^:: repeated (6, (message (fun t -> ServiceDescriptorProto.from_proto t)), not_packed) ^:: repeated (7, (message (fun t -> FieldDescriptorProto.from_proto t)), not_packed) ^:: basic_opt (8, (message (fun t -> FileOptions.from_proto t))) ^:: basic_opt (9, (message (fun t -> SourceCodeInfo.from_proto t))) ^:: basic_opt (12, string) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (2, string) ^:: repeated (3, string, not_packed) ^:: repeated (10, int32_int, not_packed) ^:: repeated (11, int32_int, not_packed) ^:: repeated (4, (message (fun t -> DescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (5, (message (fun t -> EnumDescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (6, (message (fun t -> ServiceDescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (7, (message (fun t -> FieldDescriptorProto.from_proto_exn t)), not_packed) ^:: basic_opt (8, (message (fun t -> FileOptions.from_proto_exn t))) ^:: basic_opt (9, (message (fun t -> SourceCodeInfo.from_proto_exn t))) ^:: basic_opt (12, string) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in - fun writer -> deserialize writer |> Runtime'.Result.open_error + fun writer -> deserialize writer + let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) end and DescriptorProto : sig @@ -529,6 +91,7 @@ end = struct val make : ?start:int -> ?end':int -> ?options:ExtensionRangeOptions.t -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end and ReservedRange : sig val name': unit -> string @@ -536,12 +99,14 @@ end = struct val make : ?start:int -> ?end':int -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end val name': unit -> string - type t = { name: string option; field: FieldDescriptorProto.t list; extension: FieldDescriptorProto.t list; nested_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; extension_range: ExtensionRange.t list; oneof_decl: OneofDescriptorProto.t list; options: MessageOptions.t option; reserved_range: ReservedRange.t list; reserved_name: string list } - val make : ?name:string -> ?field:FieldDescriptorProto.t list -> ?extension:FieldDescriptorProto.t list -> ?nested_type:DescriptorProto.t list -> ?enum_type:EnumDescriptorProto.t list -> ?extension_range:ExtensionRange.t list -> ?oneof_decl:OneofDescriptorProto.t list -> ?options:MessageOptions.t -> ?reserved_range:ReservedRange.t list -> ?reserved_name:string list -> unit -> t + type t = { name: string option; field: FieldDescriptorProto.t list; extension: FieldDescriptorProto.t list; nested_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; extension_range: DescriptorProto.ExtensionRange.t list; oneof_decl: OneofDescriptorProto.t list; options: MessageOptions.t option; reserved_range: DescriptorProto.ReservedRange.t list; reserved_name: string list } + val make : ?name:string -> ?field:FieldDescriptorProto.t list -> ?extension:FieldDescriptorProto.t list -> ?nested_type:DescriptorProto.t list -> ?enum_type:EnumDescriptorProto.t list -> ?extension_range:DescriptorProto.ExtensionRange.t list -> ?oneof_decl:OneofDescriptorProto.t list -> ?options:MessageOptions.t -> ?reserved_range:DescriptorProto.ReservedRange.t list -> ?reserved_name:string list -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end = struct module rec ExtensionRange : sig val name': unit -> string @@ -549,6 +114,7 @@ end = struct val make : ?start:int -> ?end':int -> ?options:ExtensionRangeOptions.t -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end = struct let name' () = "descriptor.google.protobuf.DescriptorProto.ExtensionRange" type t = { start: int option; end': int option; options: ExtensionRangeOptions.t option } @@ -563,11 +129,12 @@ end = struct let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - let from_proto = + let from_proto_exn = let constructor = fun _extensions start end' options -> { start; end'; options } in - let spec = Runtime'.Deserialize.C.( basic_opt (1, int32_int) ^:: basic_opt (2, int32_int) ^:: basic_opt (3, (message (fun t -> ExtensionRangeOptions.from_proto t))) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic_opt (1, int32_int) ^:: basic_opt (2, int32_int) ^:: basic_opt (3, (message (fun t -> ExtensionRangeOptions.from_proto_exn t))) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in - fun writer -> deserialize writer |> Runtime'.Result.open_error + fun writer -> deserialize writer + let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) end and ReservedRange : sig @@ -576,6 +143,7 @@ end = struct val make : ?start:int -> ?end':int -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end = struct let name' () = "descriptor.google.protobuf.DescriptorProto.ReservedRange" type t = { start: int option; end': int option } @@ -590,15 +158,16 @@ end = struct let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - let from_proto = + let from_proto_exn = let constructor = fun _extensions start end' -> { start; end' } in let spec = Runtime'.Deserialize.C.( basic_opt (1, int32_int) ^:: basic_opt (2, int32_int) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in - fun writer -> deserialize writer |> Runtime'.Result.open_error + fun writer -> deserialize writer + let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) end let name' () = "descriptor.google.protobuf.DescriptorProto" - type t = { name: string option; field: FieldDescriptorProto.t list; extension: FieldDescriptorProto.t list; nested_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; extension_range: ExtensionRange.t list; oneof_decl: OneofDescriptorProto.t list; options: MessageOptions.t option; reserved_range: ReservedRange.t list; reserved_name: string list } + type t = { name: string option; field: FieldDescriptorProto.t list; extension: FieldDescriptorProto.t list; nested_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; extension_range: DescriptorProto.ExtensionRange.t list; oneof_decl: OneofDescriptorProto.t list; options: MessageOptions.t option; reserved_range: DescriptorProto.ReservedRange.t list; reserved_name: string list } let make = fun ?name ?field ?extension ?nested_type ?enum_type ?extension_range ?oneof_decl ?options ?reserved_range ?reserved_name () -> let field = match field with Some v -> v | None -> [] in @@ -613,15 +182,16 @@ end = struct let to_proto = let apply = fun ~f:f' { name; field; extension; nested_type; enum_type; extension_range; oneof_decl; options; reserved_range; reserved_name } -> f' [] name field extension nested_type enum_type extension_range oneof_decl options reserved_range reserved_name in - let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> FieldDescriptorProto.to_proto t)), not_packed) ^:: repeated (6, (message (fun t -> FieldDescriptorProto.to_proto t)), not_packed) ^:: repeated (3, (message (fun t -> DescriptorProto.to_proto t)), not_packed) ^:: repeated (4, (message (fun t -> EnumDescriptorProto.to_proto t)), not_packed) ^:: repeated (5, (message (fun t -> ExtensionRange.to_proto t)), not_packed) ^:: repeated (8, (message (fun t -> OneofDescriptorProto.to_proto t)), not_packed) ^:: basic_opt (7, (message (fun t -> MessageOptions.to_proto t))) ^:: repeated (9, (message (fun t -> ReservedRange.to_proto t)), not_packed) ^:: repeated (10, string, not_packed) ^:: nil ) in + let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> FieldDescriptorProto.to_proto t)), not_packed) ^:: repeated (6, (message (fun t -> FieldDescriptorProto.to_proto t)), not_packed) ^:: repeated (3, (message (fun t -> DescriptorProto.to_proto t)), not_packed) ^:: repeated (4, (message (fun t -> EnumDescriptorProto.to_proto t)), not_packed) ^:: repeated (5, (message (fun t -> DescriptorProto.ExtensionRange.to_proto t)), not_packed) ^:: repeated (8, (message (fun t -> OneofDescriptorProto.to_proto t)), not_packed) ^:: basic_opt (7, (message (fun t -> MessageOptions.to_proto t))) ^:: repeated (9, (message (fun t -> DescriptorProto.ReservedRange.to_proto t)), not_packed) ^:: repeated (10, string, not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - let from_proto = + let from_proto_exn = let constructor = fun _extensions name field extension nested_type enum_type extension_range oneof_decl options reserved_range reserved_name -> { name; field; extension; nested_type; enum_type; extension_range; oneof_decl; options; reserved_range; reserved_name } in - let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> FieldDescriptorProto.from_proto t)), not_packed) ^:: repeated (6, (message (fun t -> FieldDescriptorProto.from_proto t)), not_packed) ^:: repeated (3, (message (fun t -> DescriptorProto.from_proto t)), not_packed) ^:: repeated (4, (message (fun t -> EnumDescriptorProto.from_proto t)), not_packed) ^:: repeated (5, (message (fun t -> ExtensionRange.from_proto t)), not_packed) ^:: repeated (8, (message (fun t -> OneofDescriptorProto.from_proto t)), not_packed) ^:: basic_opt (7, (message (fun t -> MessageOptions.from_proto t))) ^:: repeated (9, (message (fun t -> ReservedRange.from_proto t)), not_packed) ^:: repeated (10, string, not_packed) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> FieldDescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (6, (message (fun t -> FieldDescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (3, (message (fun t -> DescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (4, (message (fun t -> EnumDescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (5, (message (fun t -> DescriptorProto.ExtensionRange.from_proto_exn t)), not_packed) ^:: repeated (8, (message (fun t -> OneofDescriptorProto.from_proto_exn t)), not_packed) ^:: basic_opt (7, (message (fun t -> MessageOptions.from_proto_exn t))) ^:: repeated (9, (message (fun t -> DescriptorProto.ReservedRange.from_proto_exn t)), not_packed) ^:: repeated (10, string, not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in - fun writer -> deserialize writer |> Runtime'.Result.open_error + fun writer -> deserialize writer + let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) end and ExtensionRangeOptions : sig @@ -630,6 +200,7 @@ end = struct val make : ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end = struct let name' () = "descriptor.google.protobuf.ExtensionRangeOptions" type t = { uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } @@ -644,34 +215,39 @@ end = struct let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] (spec) in fun t -> apply ~f:serialize t - let from_proto = + let from_proto_exn = let constructor = fun extensions' uninterpreted_option -> { uninterpreted_option; extensions' } in - let spec = Runtime'.Deserialize.C.( repeated (999, (message (fun t -> UninterpretedOption.from_proto t)), not_packed) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in - fun writer -> deserialize writer |> Runtime'.Result.open_error + fun writer -> deserialize writer + let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) end and FieldDescriptorProto : sig module rec Type : sig type t = TYPE_DOUBLE | TYPE_FLOAT | TYPE_INT64 | TYPE_UINT64 | TYPE_INT32 | TYPE_FIXED64 | TYPE_FIXED32 | TYPE_BOOL | TYPE_STRING | TYPE_GROUP | TYPE_MESSAGE | TYPE_BYTES | TYPE_UINT32 | TYPE_ENUM | TYPE_SFIXED32 | TYPE_SFIXED64 | TYPE_SINT32 | TYPE_SINT64 val to_int: t -> int - val from_int: int -> (t, [> Runtime'.Result.error]) result + val from_int: int -> t Runtime'.Result.t + val from_int_exn: int -> t end and Label : sig type t = LABEL_OPTIONAL | LABEL_REQUIRED | LABEL_REPEATED val to_int: t -> int - val from_int: int -> (t, [> Runtime'.Result.error]) result + val from_int: int -> t Runtime'.Result.t + val from_int_exn: int -> t end val name': unit -> string - type t = { name: string option; number: int option; label: Label.t option; type': Type.t option; type_name: string option; extendee: string option; default_value: string option; oneof_index: int option; json_name: string option; options: FieldOptions.t option; proto3_optional: bool option } - val make : ?name:string -> ?number:int -> ?label:Label.t -> ?type':Type.t -> ?type_name:string -> ?extendee:string -> ?default_value:string -> ?oneof_index:int -> ?json_name:string -> ?options:FieldOptions.t -> ?proto3_optional:bool -> unit -> t + type t = { name: string option; number: int option; label: FieldDescriptorProto.Label.t option; type': FieldDescriptorProto.Type.t option; type_name: string option; extendee: string option; default_value: string option; oneof_index: int option; json_name: string option; options: FieldOptions.t option; proto3_optional: bool option } + val make : ?name:string -> ?number:int -> ?label:FieldDescriptorProto.Label.t -> ?type':FieldDescriptorProto.Type.t -> ?type_name:string -> ?extendee:string -> ?default_value:string -> ?oneof_index:int -> ?json_name:string -> ?options:FieldOptions.t -> ?proto3_optional:bool -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end = struct module rec Type : sig type t = TYPE_DOUBLE | TYPE_FLOAT | TYPE_INT64 | TYPE_UINT64 | TYPE_INT32 | TYPE_FIXED64 | TYPE_FIXED32 | TYPE_BOOL | TYPE_STRING | TYPE_GROUP | TYPE_MESSAGE | TYPE_BYTES | TYPE_UINT32 | TYPE_ENUM | TYPE_SFIXED32 | TYPE_SFIXED64 | TYPE_SINT32 | TYPE_SINT64 val to_int: t -> int - val from_int: int -> (t, [> Runtime'.Result.error]) result + val from_int: int -> t Runtime'.Result.t + val from_int_exn: int -> t end = struct type t = TYPE_DOUBLE | TYPE_FLOAT | TYPE_INT64 | TYPE_UINT64 | TYPE_INT32 | TYPE_FIXED64 | TYPE_FIXED32 | TYPE_BOOL | TYPE_STRING | TYPE_GROUP | TYPE_MESSAGE | TYPE_BYTES | TYPE_UINT32 | TYPE_ENUM | TYPE_SFIXED32 | TYPE_SFIXED64 | TYPE_SINT32 | TYPE_SINT64 let to_int = function @@ -694,32 +270,34 @@ end = struct | TYPE_SINT32 -> 17 | TYPE_SINT64 -> 18 - let from_int = function - | 1 -> Ok TYPE_DOUBLE - | 2 -> Ok TYPE_FLOAT - | 3 -> Ok TYPE_INT64 - | 4 -> Ok TYPE_UINT64 - | 5 -> Ok TYPE_INT32 - | 6 -> Ok TYPE_FIXED64 - | 7 -> Ok TYPE_FIXED32 - | 8 -> Ok TYPE_BOOL - | 9 -> Ok TYPE_STRING - | 10 -> Ok TYPE_GROUP - | 11 -> Ok TYPE_MESSAGE - | 12 -> Ok TYPE_BYTES - | 13 -> Ok TYPE_UINT32 - | 14 -> Ok TYPE_ENUM - | 15 -> Ok TYPE_SFIXED32 - | 16 -> Ok TYPE_SFIXED64 - | 17 -> Ok TYPE_SINT32 - | 18 -> Ok TYPE_SINT64 - | n -> Error (`Unknown_enum_value n) + let from_int_exn = function + | 1 -> TYPE_DOUBLE + | 2 -> TYPE_FLOAT + | 3 -> TYPE_INT64 + | 4 -> TYPE_UINT64 + | 5 -> TYPE_INT32 + | 6 -> TYPE_FIXED64 + | 7 -> TYPE_FIXED32 + | 8 -> TYPE_BOOL + | 9 -> TYPE_STRING + | 10 -> TYPE_GROUP + | 11 -> TYPE_MESSAGE + | 12 -> TYPE_BYTES + | 13 -> TYPE_UINT32 + | 14 -> TYPE_ENUM + | 15 -> TYPE_SFIXED32 + | 16 -> TYPE_SFIXED64 + | 17 -> TYPE_SINT32 + | 18 -> TYPE_SINT64 + | n -> Runtime'.Result.raise (`Unknown_enum_value n) + let from_int e = Runtime'.Result.catch (fun () -> from_int_exn e) end and Label : sig type t = LABEL_OPTIONAL | LABEL_REQUIRED | LABEL_REPEATED val to_int: t -> int - val from_int: int -> (t, [> Runtime'.Result.error]) result + val from_int: int -> t Runtime'.Result.t + val from_int_exn: int -> t end = struct type t = LABEL_OPTIONAL | LABEL_REQUIRED | LABEL_REPEATED let to_int = function @@ -727,15 +305,16 @@ end = struct | LABEL_REQUIRED -> 2 | LABEL_REPEATED -> 3 - let from_int = function - | 1 -> Ok LABEL_OPTIONAL - | 2 -> Ok LABEL_REQUIRED - | 3 -> Ok LABEL_REPEATED - | n -> Error (`Unknown_enum_value n) + let from_int_exn = function + | 1 -> LABEL_OPTIONAL + | 2 -> LABEL_REQUIRED + | 3 -> LABEL_REPEATED + | n -> Runtime'.Result.raise (`Unknown_enum_value n) + let from_int e = Runtime'.Result.catch (fun () -> from_int_exn e) end let name' () = "descriptor.google.protobuf.FieldDescriptorProto" - type t = { name: string option; number: int option; label: Label.t option; type': Type.t option; type_name: string option; extendee: string option; default_value: string option; oneof_index: int option; json_name: string option; options: FieldOptions.t option; proto3_optional: bool option } + type t = { name: string option; number: int option; label: FieldDescriptorProto.Label.t option; type': FieldDescriptorProto.Type.t option; type_name: string option; extendee: string option; default_value: string option; oneof_index: int option; json_name: string option; options: FieldOptions.t option; proto3_optional: bool option } let make = fun ?name ?number ?label ?type' ?type_name ?extendee ?default_value ?oneof_index ?json_name ?options ?proto3_optional () -> @@ -743,15 +322,16 @@ end = struct let to_proto = let apply = fun ~f:f' { name; number; label; type'; type_name; extendee; default_value; oneof_index; json_name; options; proto3_optional } -> f' [] name number label type' type_name extendee default_value oneof_index json_name options proto3_optional in - let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (3, int32_int) ^:: basic_opt (4, (enum Label.to_int)) ^:: basic_opt (5, (enum Type.to_int)) ^:: basic_opt (6, string) ^:: basic_opt (2, string) ^:: basic_opt (7, string) ^:: basic_opt (9, int32_int) ^:: basic_opt (10, string) ^:: basic_opt (8, (message (fun t -> FieldOptions.to_proto t))) ^:: basic_opt (17, bool) ^:: nil ) in + let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (3, int32_int) ^:: basic_opt (4, (enum FieldDescriptorProto.Label.to_int)) ^:: basic_opt (5, (enum FieldDescriptorProto.Type.to_int)) ^:: basic_opt (6, string) ^:: basic_opt (2, string) ^:: basic_opt (7, string) ^:: basic_opt (9, int32_int) ^:: basic_opt (10, string) ^:: basic_opt (8, (message (fun t -> FieldOptions.to_proto t))) ^:: basic_opt (17, bool) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - let from_proto = + let from_proto_exn = let constructor = fun _extensions name number label type' type_name extendee default_value oneof_index json_name options proto3_optional -> { name; number; label; type'; type_name; extendee; default_value; oneof_index; json_name; options; proto3_optional } in - let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (3, int32_int) ^:: basic_opt (4, (enum Label.from_int)) ^:: basic_opt (5, (enum Type.from_int)) ^:: basic_opt (6, string) ^:: basic_opt (2, string) ^:: basic_opt (7, string) ^:: basic_opt (9, int32_int) ^:: basic_opt (10, string) ^:: basic_opt (8, (message (fun t -> FieldOptions.from_proto t))) ^:: basic_opt (17, bool) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (3, int32_int) ^:: basic_opt (4, (enum FieldDescriptorProto.Label.from_int_exn)) ^:: basic_opt (5, (enum FieldDescriptorProto.Type.from_int_exn)) ^:: basic_opt (6, string) ^:: basic_opt (2, string) ^:: basic_opt (7, string) ^:: basic_opt (9, int32_int) ^:: basic_opt (10, string) ^:: basic_opt (8, (message (fun t -> FieldOptions.from_proto_exn t))) ^:: basic_opt (17, bool) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in - fun writer -> deserialize writer |> Runtime'.Result.open_error + fun writer -> deserialize writer + let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) end and OneofDescriptorProto : sig @@ -760,6 +340,7 @@ end = struct val make : ?name:string -> ?options:OneofOptions.t -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end = struct let name' () = "descriptor.google.protobuf.OneofDescriptorProto" type t = { name: string option; options: OneofOptions.t option } @@ -774,11 +355,12 @@ end = struct let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - let from_proto = + let from_proto_exn = let constructor = fun _extensions name options -> { name; options } in - let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (2, (message (fun t -> OneofOptions.from_proto t))) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (2, (message (fun t -> OneofOptions.from_proto_exn t))) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in - fun writer -> deserialize writer |> Runtime'.Result.open_error + fun writer -> deserialize writer + let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) end and EnumDescriptorProto : sig @@ -788,12 +370,14 @@ end = struct val make : ?start:int -> ?end':int -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end val name': unit -> string - type t = { name: string option; value: EnumValueDescriptorProto.t list; options: EnumOptions.t option; reserved_range: EnumReservedRange.t list; reserved_name: string list } - val make : ?name:string -> ?value:EnumValueDescriptorProto.t list -> ?options:EnumOptions.t -> ?reserved_range:EnumReservedRange.t list -> ?reserved_name:string list -> unit -> t + type t = { name: string option; value: EnumValueDescriptorProto.t list; options: EnumOptions.t option; reserved_range: EnumDescriptorProto.EnumReservedRange.t list; reserved_name: string list } + val make : ?name:string -> ?value:EnumValueDescriptorProto.t list -> ?options:EnumOptions.t -> ?reserved_range:EnumDescriptorProto.EnumReservedRange.t list -> ?reserved_name:string list -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end = struct module rec EnumReservedRange : sig val name': unit -> string @@ -801,6 +385,7 @@ end = struct val make : ?start:int -> ?end':int -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end = struct let name' () = "descriptor.google.protobuf.EnumDescriptorProto.EnumReservedRange" type t = { start: int option; end': int option } @@ -815,15 +400,16 @@ end = struct let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - let from_proto = + let from_proto_exn = let constructor = fun _extensions start end' -> { start; end' } in let spec = Runtime'.Deserialize.C.( basic_opt (1, int32_int) ^:: basic_opt (2, int32_int) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in - fun writer -> deserialize writer |> Runtime'.Result.open_error + fun writer -> deserialize writer + let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) end let name' () = "descriptor.google.protobuf.EnumDescriptorProto" - type t = { name: string option; value: EnumValueDescriptorProto.t list; options: EnumOptions.t option; reserved_range: EnumReservedRange.t list; reserved_name: string list } + type t = { name: string option; value: EnumValueDescriptorProto.t list; options: EnumOptions.t option; reserved_range: EnumDescriptorProto.EnumReservedRange.t list; reserved_name: string list } let make = fun ?name ?value ?options ?reserved_range ?reserved_name () -> let value = match value with Some v -> v | None -> [] in @@ -833,15 +419,16 @@ end = struct let to_proto = let apply = fun ~f:f' { name; value; options; reserved_range; reserved_name } -> f' [] name value options reserved_range reserved_name in - let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> EnumValueDescriptorProto.to_proto t)), not_packed) ^:: basic_opt (3, (message (fun t -> EnumOptions.to_proto t))) ^:: repeated (4, (message (fun t -> EnumReservedRange.to_proto t)), not_packed) ^:: repeated (5, string, not_packed) ^:: nil ) in + let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> EnumValueDescriptorProto.to_proto t)), not_packed) ^:: basic_opt (3, (message (fun t -> EnumOptions.to_proto t))) ^:: repeated (4, (message (fun t -> EnumDescriptorProto.EnumReservedRange.to_proto t)), not_packed) ^:: repeated (5, string, not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - let from_proto = + let from_proto_exn = let constructor = fun _extensions name value options reserved_range reserved_name -> { name; value; options; reserved_range; reserved_name } in - let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> EnumValueDescriptorProto.from_proto t)), not_packed) ^:: basic_opt (3, (message (fun t -> EnumOptions.from_proto t))) ^:: repeated (4, (message (fun t -> EnumReservedRange.from_proto t)), not_packed) ^:: repeated (5, string, not_packed) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> EnumValueDescriptorProto.from_proto_exn t)), not_packed) ^:: basic_opt (3, (message (fun t -> EnumOptions.from_proto_exn t))) ^:: repeated (4, (message (fun t -> EnumDescriptorProto.EnumReservedRange.from_proto_exn t)), not_packed) ^:: repeated (5, string, not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in - fun writer -> deserialize writer |> Runtime'.Result.open_error + fun writer -> deserialize writer + let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) end and EnumValueDescriptorProto : sig @@ -850,6 +437,7 @@ end = struct val make : ?name:string -> ?number:int -> ?options:EnumValueOptions.t -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end = struct let name' () = "descriptor.google.protobuf.EnumValueDescriptorProto" type t = { name: string option; number: int option; options: EnumValueOptions.t option } @@ -864,11 +452,12 @@ end = struct let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - let from_proto = + let from_proto_exn = let constructor = fun _extensions name number options -> { name; number; options } in - let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (2, int32_int) ^:: basic_opt (3, (message (fun t -> EnumValueOptions.from_proto t))) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (2, int32_int) ^:: basic_opt (3, (message (fun t -> EnumValueOptions.from_proto_exn t))) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in - fun writer -> deserialize writer |> Runtime'.Result.open_error + fun writer -> deserialize writer + let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) end and ServiceDescriptorProto : sig @@ -877,6 +466,7 @@ end = struct val make : ?name:string -> ?method':MethodDescriptorProto.t list -> ?options:ServiceOptions.t -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end = struct let name' () = "descriptor.google.protobuf.ServiceDescriptorProto" type t = { name: string option; method': MethodDescriptorProto.t list; options: ServiceOptions.t option } @@ -891,11 +481,12 @@ end = struct let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - let from_proto = + let from_proto_exn = let constructor = fun _extensions name method' options -> { name; method'; options } in - let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> MethodDescriptorProto.from_proto t)), not_packed) ^:: basic_opt (3, (message (fun t -> ServiceOptions.from_proto t))) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> MethodDescriptorProto.from_proto_exn t)), not_packed) ^:: basic_opt (3, (message (fun t -> ServiceOptions.from_proto_exn t))) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in - fun writer -> deserialize writer |> Runtime'.Result.open_error + fun writer -> deserialize writer + let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) end and MethodDescriptorProto : sig @@ -904,6 +495,7 @@ end = struct val make : ?name:string -> ?input_type:string -> ?output_type:string -> ?options:MethodOptions.t -> ?client_streaming:bool -> ?server_streaming:bool -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end = struct let name' () = "descriptor.google.protobuf.MethodDescriptorProto" type t = { name: string option; input_type: string option; output_type: string option; options: MethodOptions.t option; client_streaming: bool; server_streaming: bool } @@ -919,29 +511,33 @@ end = struct let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - let from_proto = + let from_proto_exn = let constructor = fun _extensions name input_type output_type options client_streaming server_streaming -> { name; input_type; output_type; options; client_streaming; server_streaming } in - let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (2, string) ^:: basic_opt (3, string) ^:: basic_opt (4, (message (fun t -> MethodOptions.from_proto t))) ^:: basic (5, bool, proto2 (false)) ^:: basic (6, bool, proto2 (false)) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (2, string) ^:: basic_opt (3, string) ^:: basic_opt (4, (message (fun t -> MethodOptions.from_proto_exn t))) ^:: basic (5, bool, proto2 (false)) ^:: basic (6, bool, proto2 (false)) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in - fun writer -> deserialize writer |> Runtime'.Result.open_error + fun writer -> deserialize writer + let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) end and FileOptions : sig module rec OptimizeMode : sig type t = SPEED | CODE_SIZE | LITE_RUNTIME val to_int: t -> int - val from_int: int -> (t, [> Runtime'.Result.error]) result + val from_int: int -> t Runtime'.Result.t + val from_int_exn: int -> t end val name': unit -> string - type t = { java_package: string option; java_outer_classname: string option; java_multiple_files: bool; java_generate_equals_and_hash: bool option; java_string_check_utf8: bool; optimize_for: OptimizeMode.t; go_package: string option; cc_generic_services: bool; java_generic_services: bool; py_generic_services: bool; php_generic_services: bool; deprecated: bool; cc_enable_arenas: bool; objc_class_prefix: string option; csharp_namespace: string option; swift_prefix: string option; php_class_prefix: string option; php_namespace: string option; php_metadata_namespace: string option; ruby_package: string option; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } - val make : ?java_package:string -> ?java_outer_classname:string -> ?java_multiple_files:bool -> ?java_generate_equals_and_hash:bool -> ?java_string_check_utf8:bool -> ?optimize_for:OptimizeMode.t -> ?go_package:string -> ?cc_generic_services:bool -> ?java_generic_services:bool -> ?py_generic_services:bool -> ?php_generic_services:bool -> ?deprecated:bool -> ?cc_enable_arenas:bool -> ?objc_class_prefix:string -> ?csharp_namespace:string -> ?swift_prefix:string -> ?php_class_prefix:string -> ?php_namespace:string -> ?php_metadata_namespace:string -> ?ruby_package:string -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + type t = { java_package: string option; java_outer_classname: string option; java_multiple_files: bool; java_generate_equals_and_hash: bool option; java_string_check_utf8: bool; optimize_for: FileOptions.OptimizeMode.t; go_package: string option; cc_generic_services: bool; java_generic_services: bool; py_generic_services: bool; php_generic_services: bool; deprecated: bool; cc_enable_arenas: bool; objc_class_prefix: string option; csharp_namespace: string option; swift_prefix: string option; php_class_prefix: string option; php_namespace: string option; php_metadata_namespace: string option; ruby_package: string option; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + val make : ?java_package:string -> ?java_outer_classname:string -> ?java_multiple_files:bool -> ?java_generate_equals_and_hash:bool -> ?java_string_check_utf8:bool -> ?optimize_for:FileOptions.OptimizeMode.t -> ?go_package:string -> ?cc_generic_services:bool -> ?java_generic_services:bool -> ?py_generic_services:bool -> ?php_generic_services:bool -> ?deprecated:bool -> ?cc_enable_arenas:bool -> ?objc_class_prefix:string -> ?csharp_namespace:string -> ?swift_prefix:string -> ?php_class_prefix:string -> ?php_namespace:string -> ?php_metadata_namespace:string -> ?ruby_package:string -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end = struct module rec OptimizeMode : sig type t = SPEED | CODE_SIZE | LITE_RUNTIME val to_int: t -> int - val from_int: int -> (t, [> Runtime'.Result.error]) result + val from_int: int -> t Runtime'.Result.t + val from_int_exn: int -> t end = struct type t = SPEED | CODE_SIZE | LITE_RUNTIME let to_int = function @@ -949,20 +545,21 @@ end = struct | CODE_SIZE -> 2 | LITE_RUNTIME -> 3 - let from_int = function - | 1 -> Ok SPEED - | 2 -> Ok CODE_SIZE - | 3 -> Ok LITE_RUNTIME - | n -> Error (`Unknown_enum_value n) + let from_int_exn = function + | 1 -> SPEED + | 2 -> CODE_SIZE + | 3 -> LITE_RUNTIME + | n -> Runtime'.Result.raise (`Unknown_enum_value n) + let from_int e = Runtime'.Result.catch (fun () -> from_int_exn e) end let name' () = "descriptor.google.protobuf.FileOptions" - type t = { java_package: string option; java_outer_classname: string option; java_multiple_files: bool; java_generate_equals_and_hash: bool option; java_string_check_utf8: bool; optimize_for: OptimizeMode.t; go_package: string option; cc_generic_services: bool; java_generic_services: bool; py_generic_services: bool; php_generic_services: bool; deprecated: bool; cc_enable_arenas: bool; objc_class_prefix: string option; csharp_namespace: string option; swift_prefix: string option; php_class_prefix: string option; php_namespace: string option; php_metadata_namespace: string option; ruby_package: string option; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { java_package: string option; java_outer_classname: string option; java_multiple_files: bool; java_generate_equals_and_hash: bool option; java_string_check_utf8: bool; optimize_for: FileOptions.OptimizeMode.t; go_package: string option; cc_generic_services: bool; java_generic_services: bool; py_generic_services: bool; php_generic_services: bool; deprecated: bool; cc_enable_arenas: bool; objc_class_prefix: string option; csharp_namespace: string option; swift_prefix: string option; php_class_prefix: string option; php_namespace: string option; php_metadata_namespace: string option; ruby_package: string option; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } let make = fun ?java_package ?java_outer_classname ?java_multiple_files ?java_generate_equals_and_hash ?java_string_check_utf8 ?optimize_for ?go_package ?cc_generic_services ?java_generic_services ?py_generic_services ?php_generic_services ?deprecated ?cc_enable_arenas ?objc_class_prefix ?csharp_namespace ?swift_prefix ?php_class_prefix ?php_namespace ?php_metadata_namespace ?ruby_package ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> let java_multiple_files = match java_multiple_files with Some v -> v | None -> false in let java_string_check_utf8 = match java_string_check_utf8 with Some v -> v | None -> false in - let optimize_for = match optimize_for with Some v -> v | None -> OptimizeMode.SPEED in + let optimize_for = match optimize_for with Some v -> v | None -> FileOptions.OptimizeMode.SPEED in let cc_generic_services = match cc_generic_services with Some v -> v | None -> false in let java_generic_services = match java_generic_services with Some v -> v | None -> false in let py_generic_services = match py_generic_services with Some v -> v | None -> false in @@ -974,15 +571,16 @@ end = struct let to_proto = let apply = fun ~f:f' { java_package; java_outer_classname; java_multiple_files; java_generate_equals_and_hash; java_string_check_utf8; optimize_for; go_package; cc_generic_services; java_generic_services; py_generic_services; php_generic_services; deprecated; cc_enable_arenas; objc_class_prefix; csharp_namespace; swift_prefix; php_class_prefix; php_namespace; php_metadata_namespace; ruby_package; uninterpreted_option; extensions' } -> f' extensions' java_package java_outer_classname java_multiple_files java_generate_equals_and_hash java_string_check_utf8 optimize_for go_package cc_generic_services java_generic_services py_generic_services php_generic_services deprecated cc_enable_arenas objc_class_prefix csharp_namespace swift_prefix php_class_prefix php_namespace php_metadata_namespace ruby_package uninterpreted_option in - let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (8, string) ^:: basic (10, bool, proto2 (false)) ^:: basic_opt (20, bool) ^:: basic (27, bool, proto2 (false)) ^:: basic (9, (enum OptimizeMode.to_int), proto2 (OptimizeMode.SPEED)) ^:: basic_opt (11, string) ^:: basic (16, bool, proto2 (false)) ^:: basic (17, bool, proto2 (false)) ^:: basic (18, bool, proto2 (false)) ^:: basic (42, bool, proto2 (false)) ^:: basic (23, bool, proto2 (false)) ^:: basic (31, bool, proto2 (true)) ^:: basic_opt (36, string) ^:: basic_opt (37, string) ^:: basic_opt (39, string) ^:: basic_opt (40, string) ^:: basic_opt (41, string) ^:: basic_opt (44, string) ^:: basic_opt (45, string) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto t)), not_packed) ^:: nil ) in + let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (8, string) ^:: basic (10, bool, proto2 (false)) ^:: basic_opt (20, bool) ^:: basic (27, bool, proto2 (false)) ^:: basic (9, (enum FileOptions.OptimizeMode.to_int), proto2 (FileOptions.OptimizeMode.SPEED)) ^:: basic_opt (11, string) ^:: basic (16, bool, proto2 (false)) ^:: basic (17, bool, proto2 (false)) ^:: basic (18, bool, proto2 (false)) ^:: basic (42, bool, proto2 (false)) ^:: basic (23, bool, proto2 (false)) ^:: basic (31, bool, proto2 (true)) ^:: basic_opt (36, string) ^:: basic_opt (37, string) ^:: basic_opt (39, string) ^:: basic_opt (40, string) ^:: basic_opt (41, string) ^:: basic_opt (44, string) ^:: basic_opt (45, string) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] (spec) in fun t -> apply ~f:serialize t - let from_proto = + let from_proto_exn = let constructor = fun extensions' java_package java_outer_classname java_multiple_files java_generate_equals_and_hash java_string_check_utf8 optimize_for go_package cc_generic_services java_generic_services py_generic_services php_generic_services deprecated cc_enable_arenas objc_class_prefix csharp_namespace swift_prefix php_class_prefix php_namespace php_metadata_namespace ruby_package uninterpreted_option -> { java_package; java_outer_classname; java_multiple_files; java_generate_equals_and_hash; java_string_check_utf8; optimize_for; go_package; cc_generic_services; java_generic_services; py_generic_services; php_generic_services; deprecated; cc_enable_arenas; objc_class_prefix; csharp_namespace; swift_prefix; php_class_prefix; php_namespace; php_metadata_namespace; ruby_package; uninterpreted_option; extensions' } in - let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (8, string) ^:: basic (10, bool, proto2 (false)) ^:: basic_opt (20, bool) ^:: basic (27, bool, proto2 (false)) ^:: basic (9, (enum OptimizeMode.from_int), proto2 (OptimizeMode.SPEED)) ^:: basic_opt (11, string) ^:: basic (16, bool, proto2 (false)) ^:: basic (17, bool, proto2 (false)) ^:: basic (18, bool, proto2 (false)) ^:: basic (42, bool, proto2 (false)) ^:: basic (23, bool, proto2 (false)) ^:: basic (31, bool, proto2 (true)) ^:: basic_opt (36, string) ^:: basic_opt (37, string) ^:: basic_opt (39, string) ^:: basic_opt (40, string) ^:: basic_opt (41, string) ^:: basic_opt (44, string) ^:: basic_opt (45, string) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto t)), not_packed) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (8, string) ^:: basic (10, bool, proto2 (false)) ^:: basic_opt (20, bool) ^:: basic (27, bool, proto2 (false)) ^:: basic (9, (enum FileOptions.OptimizeMode.from_int_exn), proto2 (FileOptions.OptimizeMode.SPEED)) ^:: basic_opt (11, string) ^:: basic (16, bool, proto2 (false)) ^:: basic (17, bool, proto2 (false)) ^:: basic (18, bool, proto2 (false)) ^:: basic (42, bool, proto2 (false)) ^:: basic (23, bool, proto2 (false)) ^:: basic (31, bool, proto2 (true)) ^:: basic_opt (36, string) ^:: basic_opt (37, string) ^:: basic_opt (39, string) ^:: basic_opt (40, string) ^:: basic_opt (41, string) ^:: basic_opt (44, string) ^:: basic_opt (45, string) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in - fun writer -> deserialize writer |> Runtime'.Result.open_error + fun writer -> deserialize writer + let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) end and MessageOptions : sig @@ -991,6 +589,7 @@ end = struct val make : ?message_set_wire_format:bool -> ?no_standard_descriptor_accessor:bool -> ?deprecated:bool -> ?map_entry:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end = struct let name' () = "descriptor.google.protobuf.MessageOptions" type t = { message_set_wire_format: bool; no_standard_descriptor_accessor: bool; deprecated: bool; map_entry: bool option; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } @@ -1008,34 +607,39 @@ end = struct let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] (spec) in fun t -> apply ~f:serialize t - let from_proto = + let from_proto_exn = let constructor = fun extensions' message_set_wire_format no_standard_descriptor_accessor deprecated map_entry uninterpreted_option -> { message_set_wire_format; no_standard_descriptor_accessor; deprecated; map_entry; uninterpreted_option; extensions' } in - let spec = Runtime'.Deserialize.C.( basic (1, bool, proto2 (false)) ^:: basic (2, bool, proto2 (false)) ^:: basic (3, bool, proto2 (false)) ^:: basic_opt (7, bool) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto t)), not_packed) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic (1, bool, proto2 (false)) ^:: basic (2, bool, proto2 (false)) ^:: basic (3, bool, proto2 (false)) ^:: basic_opt (7, bool) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in - fun writer -> deserialize writer |> Runtime'.Result.open_error + fun writer -> deserialize writer + let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) end and FieldOptions : sig module rec CType : sig type t = STRING | CORD | STRING_PIECE val to_int: t -> int - val from_int: int -> (t, [> Runtime'.Result.error]) result + val from_int: int -> t Runtime'.Result.t + val from_int_exn: int -> t end and JSType : sig type t = JS_NORMAL | JS_STRING | JS_NUMBER val to_int: t -> int - val from_int: int -> (t, [> Runtime'.Result.error]) result + val from_int: int -> t Runtime'.Result.t + val from_int_exn: int -> t end val name': unit -> string - type t = { ctype: CType.t; packed: bool option; jstype: JSType.t; lazy': bool; unverified_lazy: bool; deprecated: bool; weak: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } - val make : ?ctype:CType.t -> ?packed:bool -> ?jstype:JSType.t -> ?lazy':bool -> ?unverified_lazy:bool -> ?deprecated:bool -> ?weak:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + type t = { ctype: FieldOptions.CType.t; packed: bool option; jstype: FieldOptions.JSType.t; lazy': bool; unverified_lazy: bool; deprecated: bool; weak: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + val make : ?ctype:FieldOptions.CType.t -> ?packed:bool -> ?jstype:FieldOptions.JSType.t -> ?lazy':bool -> ?unverified_lazy:bool -> ?deprecated:bool -> ?weak:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end = struct module rec CType : sig type t = STRING | CORD | STRING_PIECE val to_int: t -> int - val from_int: int -> (t, [> Runtime'.Result.error]) result + val from_int: int -> t Runtime'.Result.t + val from_int_exn: int -> t end = struct type t = STRING | CORD | STRING_PIECE let to_int = function @@ -1043,17 +647,19 @@ end = struct | CORD -> 1 | STRING_PIECE -> 2 - let from_int = function - | 0 -> Ok STRING - | 1 -> Ok CORD - | 2 -> Ok STRING_PIECE - | n -> Error (`Unknown_enum_value n) + let from_int_exn = function + | 0 -> STRING + | 1 -> CORD + | 2 -> STRING_PIECE + | n -> Runtime'.Result.raise (`Unknown_enum_value n) + let from_int e = Runtime'.Result.catch (fun () -> from_int_exn e) end and JSType : sig type t = JS_NORMAL | JS_STRING | JS_NUMBER val to_int: t -> int - val from_int: int -> (t, [> Runtime'.Result.error]) result + val from_int: int -> t Runtime'.Result.t + val from_int_exn: int -> t end = struct type t = JS_NORMAL | JS_STRING | JS_NUMBER let to_int = function @@ -1061,19 +667,20 @@ end = struct | JS_STRING -> 1 | JS_NUMBER -> 2 - let from_int = function - | 0 -> Ok JS_NORMAL - | 1 -> Ok JS_STRING - | 2 -> Ok JS_NUMBER - | n -> Error (`Unknown_enum_value n) + let from_int_exn = function + | 0 -> JS_NORMAL + | 1 -> JS_STRING + | 2 -> JS_NUMBER + | n -> Runtime'.Result.raise (`Unknown_enum_value n) + let from_int e = Runtime'.Result.catch (fun () -> from_int_exn e) end let name' () = "descriptor.google.protobuf.FieldOptions" - type t = { ctype: CType.t; packed: bool option; jstype: JSType.t; lazy': bool; unverified_lazy: bool; deprecated: bool; weak: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { ctype: FieldOptions.CType.t; packed: bool option; jstype: FieldOptions.JSType.t; lazy': bool; unverified_lazy: bool; deprecated: bool; weak: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } let make = fun ?ctype ?packed ?jstype ?lazy' ?unverified_lazy ?deprecated ?weak ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> - let ctype = match ctype with Some v -> v | None -> CType.STRING in - let jstype = match jstype with Some v -> v | None -> JSType.JS_NORMAL in + let ctype = match ctype with Some v -> v | None -> FieldOptions.CType.STRING in + let jstype = match jstype with Some v -> v | None -> FieldOptions.JSType.JS_NORMAL in let lazy' = match lazy' with Some v -> v | None -> false in let unverified_lazy = match unverified_lazy with Some v -> v | None -> false in let deprecated = match deprecated with Some v -> v | None -> false in @@ -1083,15 +690,16 @@ end = struct let to_proto = let apply = fun ~f:f' { ctype; packed; jstype; lazy'; unverified_lazy; deprecated; weak; uninterpreted_option; extensions' } -> f' extensions' ctype packed jstype lazy' unverified_lazy deprecated weak uninterpreted_option in - let spec = Runtime'.Serialize.C.( basic (1, (enum CType.to_int), proto2 (CType.STRING)) ^:: basic_opt (2, bool) ^:: basic (6, (enum JSType.to_int), proto2 (JSType.JS_NORMAL)) ^:: basic (5, bool, proto2 (false)) ^:: basic (15, bool, proto2 (false)) ^:: basic (3, bool, proto2 (false)) ^:: basic (10, bool, proto2 (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto t)), not_packed) ^:: nil ) in + let spec = Runtime'.Serialize.C.( basic (1, (enum FieldOptions.CType.to_int), proto2 (FieldOptions.CType.STRING)) ^:: basic_opt (2, bool) ^:: basic (6, (enum FieldOptions.JSType.to_int), proto2 (FieldOptions.JSType.JS_NORMAL)) ^:: basic (5, bool, proto2 (false)) ^:: basic (15, bool, proto2 (false)) ^:: basic (3, bool, proto2 (false)) ^:: basic (10, bool, proto2 (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] (spec) in fun t -> apply ~f:serialize t - let from_proto = + let from_proto_exn = let constructor = fun extensions' ctype packed jstype lazy' unverified_lazy deprecated weak uninterpreted_option -> { ctype; packed; jstype; lazy'; unverified_lazy; deprecated; weak; uninterpreted_option; extensions' } in - let spec = Runtime'.Deserialize.C.( basic (1, (enum CType.from_int), proto2 (CType.STRING)) ^:: basic_opt (2, bool) ^:: basic (6, (enum JSType.from_int), proto2 (JSType.JS_NORMAL)) ^:: basic (5, bool, proto2 (false)) ^:: basic (15, bool, proto2 (false)) ^:: basic (3, bool, proto2 (false)) ^:: basic (10, bool, proto2 (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto t)), not_packed) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic (1, (enum FieldOptions.CType.from_int_exn), proto2 (FieldOptions.CType.STRING)) ^:: basic_opt (2, bool) ^:: basic (6, (enum FieldOptions.JSType.from_int_exn), proto2 (FieldOptions.JSType.JS_NORMAL)) ^:: basic (5, bool, proto2 (false)) ^:: basic (15, bool, proto2 (false)) ^:: basic (3, bool, proto2 (false)) ^:: basic (10, bool, proto2 (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in - fun writer -> deserialize writer |> Runtime'.Result.open_error + fun writer -> deserialize writer + let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) end and OneofOptions : sig @@ -1100,6 +708,7 @@ end = struct val make : ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end = struct let name' () = "descriptor.google.protobuf.OneofOptions" type t = { uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } @@ -1114,11 +723,12 @@ end = struct let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] (spec) in fun t -> apply ~f:serialize t - let from_proto = + let from_proto_exn = let constructor = fun extensions' uninterpreted_option -> { uninterpreted_option; extensions' } in - let spec = Runtime'.Deserialize.C.( repeated (999, (message (fun t -> UninterpretedOption.from_proto t)), not_packed) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in - fun writer -> deserialize writer |> Runtime'.Result.open_error + fun writer -> deserialize writer + let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) end and EnumOptions : sig @@ -1127,6 +737,7 @@ end = struct val make : ?allow_alias:bool -> ?deprecated:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end = struct let name' () = "descriptor.google.protobuf.EnumOptions" type t = { allow_alias: bool option; deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } @@ -1142,11 +753,12 @@ end = struct let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] (spec) in fun t -> apply ~f:serialize t - let from_proto = + let from_proto_exn = let constructor = fun extensions' allow_alias deprecated uninterpreted_option -> { allow_alias; deprecated; uninterpreted_option; extensions' } in - let spec = Runtime'.Deserialize.C.( basic_opt (2, bool) ^:: basic (3, bool, proto2 (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto t)), not_packed) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic_opt (2, bool) ^:: basic (3, bool, proto2 (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in - fun writer -> deserialize writer |> Runtime'.Result.open_error + fun writer -> deserialize writer + let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) end and EnumValueOptions : sig @@ -1155,6 +767,7 @@ end = struct val make : ?deprecated:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end = struct let name' () = "descriptor.google.protobuf.EnumValueOptions" type t = { deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } @@ -1170,11 +783,12 @@ end = struct let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] (spec) in fun t -> apply ~f:serialize t - let from_proto = + let from_proto_exn = let constructor = fun extensions' deprecated uninterpreted_option -> { deprecated; uninterpreted_option; extensions' } in - let spec = Runtime'.Deserialize.C.( basic (1, bool, proto2 (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto t)), not_packed) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic (1, bool, proto2 (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in - fun writer -> deserialize writer |> Runtime'.Result.open_error + fun writer -> deserialize writer + let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) end and ServiceOptions : sig @@ -1183,6 +797,7 @@ end = struct val make : ?deprecated:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end = struct let name' () = "descriptor.google.protobuf.ServiceOptions" type t = { deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } @@ -1198,29 +813,33 @@ end = struct let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] (spec) in fun t -> apply ~f:serialize t - let from_proto = + let from_proto_exn = let constructor = fun extensions' deprecated uninterpreted_option -> { deprecated; uninterpreted_option; extensions' } in - let spec = Runtime'.Deserialize.C.( basic (33, bool, proto2 (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto t)), not_packed) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic (33, bool, proto2 (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in - fun writer -> deserialize writer |> Runtime'.Result.open_error + fun writer -> deserialize writer + let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) end and MethodOptions : sig module rec IdempotencyLevel : sig type t = IDEMPOTENCY_UNKNOWN | NO_SIDE_EFFECTS | IDEMPOTENT val to_int: t -> int - val from_int: int -> (t, [> Runtime'.Result.error]) result + val from_int: int -> t Runtime'.Result.t + val from_int_exn: int -> t end val name': unit -> string - type t = { deprecated: bool; idempotency_level: IdempotencyLevel.t; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } - val make : ?deprecated:bool -> ?idempotency_level:IdempotencyLevel.t -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + type t = { deprecated: bool; idempotency_level: MethodOptions.IdempotencyLevel.t; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + val make : ?deprecated:bool -> ?idempotency_level:MethodOptions.IdempotencyLevel.t -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end = struct module rec IdempotencyLevel : sig type t = IDEMPOTENCY_UNKNOWN | NO_SIDE_EFFECTS | IDEMPOTENT val to_int: t -> int - val from_int: int -> (t, [> Runtime'.Result.error]) result + val from_int: int -> t Runtime'.Result.t + val from_int_exn: int -> t end = struct type t = IDEMPOTENCY_UNKNOWN | NO_SIDE_EFFECTS | IDEMPOTENT let to_int = function @@ -1228,33 +847,35 @@ end = struct | NO_SIDE_EFFECTS -> 1 | IDEMPOTENT -> 2 - let from_int = function - | 0 -> Ok IDEMPOTENCY_UNKNOWN - | 1 -> Ok NO_SIDE_EFFECTS - | 2 -> Ok IDEMPOTENT - | n -> Error (`Unknown_enum_value n) + let from_int_exn = function + | 0 -> IDEMPOTENCY_UNKNOWN + | 1 -> NO_SIDE_EFFECTS + | 2 -> IDEMPOTENT + | n -> Runtime'.Result.raise (`Unknown_enum_value n) + let from_int e = Runtime'.Result.catch (fun () -> from_int_exn e) end let name' () = "descriptor.google.protobuf.MethodOptions" - type t = { deprecated: bool; idempotency_level: IdempotencyLevel.t; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { deprecated: bool; idempotency_level: MethodOptions.IdempotencyLevel.t; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } let make = fun ?deprecated ?idempotency_level ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> let deprecated = match deprecated with Some v -> v | None -> false in - let idempotency_level = match idempotency_level with Some v -> v | None -> IdempotencyLevel.IDEMPOTENCY_UNKNOWN in + let idempotency_level = match idempotency_level with Some v -> v | None -> MethodOptions.IdempotencyLevel.IDEMPOTENCY_UNKNOWN in let uninterpreted_option = match uninterpreted_option with Some v -> v | None -> [] in { deprecated; idempotency_level; uninterpreted_option; extensions' } let to_proto = let apply = fun ~f:f' { deprecated; idempotency_level; uninterpreted_option; extensions' } -> f' extensions' deprecated idempotency_level uninterpreted_option in - let spec = Runtime'.Serialize.C.( basic (33, bool, proto2 (false)) ^:: basic (34, (enum IdempotencyLevel.to_int), proto2 (IdempotencyLevel.IDEMPOTENCY_UNKNOWN)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto t)), not_packed) ^:: nil ) in + let spec = Runtime'.Serialize.C.( basic (33, bool, proto2 (false)) ^:: basic (34, (enum MethodOptions.IdempotencyLevel.to_int), proto2 (MethodOptions.IdempotencyLevel.IDEMPOTENCY_UNKNOWN)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] (spec) in fun t -> apply ~f:serialize t - let from_proto = + let from_proto_exn = let constructor = fun extensions' deprecated idempotency_level uninterpreted_option -> { deprecated; idempotency_level; uninterpreted_option; extensions' } in - let spec = Runtime'.Deserialize.C.( basic (33, bool, proto2 (false)) ^:: basic (34, (enum IdempotencyLevel.from_int), proto2 (IdempotencyLevel.IDEMPOTENCY_UNKNOWN)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto t)), not_packed) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic (33, bool, proto2 (false)) ^:: basic (34, (enum MethodOptions.IdempotencyLevel.from_int_exn), proto2 (MethodOptions.IdempotencyLevel.IDEMPOTENCY_UNKNOWN)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in - fun writer -> deserialize writer |> Runtime'.Result.open_error + fun writer -> deserialize writer + let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) end and UninterpretedOption : sig @@ -1264,12 +885,14 @@ end = struct val make : name_part:string -> is_extension:bool -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end val name': unit -> string - type t = { name: NamePart.t list; identifier_value: string option; positive_int_value: int option; negative_int_value: int option; double_value: float option; string_value: bytes option; aggregate_value: string option } - val make : ?name:NamePart.t list -> ?identifier_value:string -> ?positive_int_value:int -> ?negative_int_value:int -> ?double_value:float -> ?string_value:bytes -> ?aggregate_value:string -> unit -> t + type t = { name: UninterpretedOption.NamePart.t list; identifier_value: string option; positive_int_value: int option; negative_int_value: int option; double_value: float option; string_value: bytes option; aggregate_value: string option } + val make : ?name:UninterpretedOption.NamePart.t list -> ?identifier_value:string -> ?positive_int_value:int -> ?negative_int_value:int -> ?double_value:float -> ?string_value:bytes -> ?aggregate_value:string -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end = struct module rec NamePart : sig val name': unit -> string @@ -1277,6 +900,7 @@ end = struct val make : name_part:string -> is_extension:bool -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end = struct let name' () = "descriptor.google.protobuf.UninterpretedOption.NamePart" type t = { name_part: string; is_extension: bool } @@ -1291,15 +915,16 @@ end = struct let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - let from_proto = + let from_proto_exn = let constructor = fun _extensions name_part is_extension -> { name_part; is_extension } in let spec = Runtime'.Deserialize.C.( basic (1, string, required) ^:: basic (2, bool, required) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in - fun writer -> deserialize writer |> Runtime'.Result.open_error + fun writer -> deserialize writer + let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) end let name' () = "descriptor.google.protobuf.UninterpretedOption" - type t = { name: NamePart.t list; identifier_value: string option; positive_int_value: int option; negative_int_value: int option; double_value: float option; string_value: bytes option; aggregate_value: string option } + type t = { name: UninterpretedOption.NamePart.t list; identifier_value: string option; positive_int_value: int option; negative_int_value: int option; double_value: float option; string_value: bytes option; aggregate_value: string option } let make = fun ?name ?identifier_value ?positive_int_value ?negative_int_value ?double_value ?string_value ?aggregate_value () -> let name = match name with Some v -> v | None -> [] in @@ -1307,15 +932,16 @@ end = struct let to_proto = let apply = fun ~f:f' { name; identifier_value; positive_int_value; negative_int_value; double_value; string_value; aggregate_value } -> f' [] name identifier_value positive_int_value negative_int_value double_value string_value aggregate_value in - let spec = Runtime'.Serialize.C.( repeated (2, (message (fun t -> NamePart.to_proto t)), not_packed) ^:: basic_opt (3, string) ^:: basic_opt (4, uint64_int) ^:: basic_opt (5, int64_int) ^:: basic_opt (6, double) ^:: basic_opt (7, bytes) ^:: basic_opt (8, string) ^:: nil ) in + let spec = Runtime'.Serialize.C.( repeated (2, (message (fun t -> UninterpretedOption.NamePart.to_proto t)), not_packed) ^:: basic_opt (3, string) ^:: basic_opt (4, uint64_int) ^:: basic_opt (5, int64_int) ^:: basic_opt (6, double) ^:: basic_opt (7, bytes) ^:: basic_opt (8, string) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - let from_proto = + let from_proto_exn = let constructor = fun _extensions name identifier_value positive_int_value negative_int_value double_value string_value aggregate_value -> { name; identifier_value; positive_int_value; negative_int_value; double_value; string_value; aggregate_value } in - let spec = Runtime'.Deserialize.C.( repeated (2, (message (fun t -> NamePart.from_proto t)), not_packed) ^:: basic_opt (3, string) ^:: basic_opt (4, uint64_int) ^:: basic_opt (5, int64_int) ^:: basic_opt (6, double) ^:: basic_opt (7, bytes) ^:: basic_opt (8, string) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( repeated (2, (message (fun t -> UninterpretedOption.NamePart.from_proto_exn t)), not_packed) ^:: basic_opt (3, string) ^:: basic_opt (4, uint64_int) ^:: basic_opt (5, int64_int) ^:: basic_opt (6, double) ^:: basic_opt (7, bytes) ^:: basic_opt (8, string) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in - fun writer -> deserialize writer |> Runtime'.Result.open_error + fun writer -> deserialize writer + let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) end and SourceCodeInfo : sig @@ -1325,12 +951,14 @@ end = struct val make : ?path:int list -> ?span:int list -> ?leading_comments:string -> ?trailing_comments:string -> ?leading_detached_comments:string list -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end val name': unit -> string - type t = Location.t list - val make : ?location:Location.t list -> unit -> t + type t = SourceCodeInfo.Location.t list + val make : ?location:SourceCodeInfo.Location.t list -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end = struct module rec Location : sig val name': unit -> string @@ -1338,6 +966,7 @@ end = struct val make : ?path:int list -> ?span:int list -> ?leading_comments:string -> ?trailing_comments:string -> ?leading_detached_comments:string list -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end = struct let name' () = "descriptor.google.protobuf.SourceCodeInfo.Location" type t = { path: int list; span: int list; leading_comments: string option; trailing_comments: string option; leading_detached_comments: string list } @@ -1354,15 +983,16 @@ end = struct let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - let from_proto = + let from_proto_exn = let constructor = fun _extensions path span leading_comments trailing_comments leading_detached_comments -> { path; span; leading_comments; trailing_comments; leading_detached_comments } in let spec = Runtime'.Deserialize.C.( repeated (1, int32_int, packed) ^:: repeated (2, int32_int, packed) ^:: basic_opt (3, string) ^:: basic_opt (4, string) ^:: repeated (6, string, not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in - fun writer -> deserialize writer |> Runtime'.Result.open_error + fun writer -> deserialize writer + let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) end let name' () = "descriptor.google.protobuf.SourceCodeInfo" - type t = Location.t list + type t = SourceCodeInfo.Location.t list let make = fun ?location () -> let location = match location with Some v -> v | None -> [] in @@ -1370,15 +1000,16 @@ end = struct let to_proto = let apply = fun ~f:f' location -> f' [] location in - let spec = Runtime'.Serialize.C.( repeated (1, (message (fun t -> Location.to_proto t)), not_packed) ^:: nil ) in + let spec = Runtime'.Serialize.C.( repeated (1, (message (fun t -> SourceCodeInfo.Location.to_proto t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - let from_proto = + let from_proto_exn = let constructor = fun _extensions location -> location in - let spec = Runtime'.Deserialize.C.( repeated (1, (message (fun t -> Location.from_proto t)), not_packed) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( repeated (1, (message (fun t -> SourceCodeInfo.Location.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in - fun writer -> deserialize writer |> Runtime'.Result.open_error + fun writer -> deserialize writer + let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) end and GeneratedCodeInfo : sig @@ -1388,12 +1019,14 @@ end = struct val make : ?path:int list -> ?source_file:string -> ?begin':int -> ?end':int -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end val name': unit -> string - type t = Annotation.t list - val make : ?annotation:Annotation.t list -> unit -> t + type t = GeneratedCodeInfo.Annotation.t list + val make : ?annotation:GeneratedCodeInfo.Annotation.t list -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end = struct module rec Annotation : sig val name': unit -> string @@ -1401,6 +1034,7 @@ end = struct val make : ?path:int list -> ?source_file:string -> ?begin':int -> ?end':int -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end = struct let name' () = "descriptor.google.protobuf.GeneratedCodeInfo.Annotation" type t = { path: int list; source_file: string option; begin': int option; end': int option } @@ -1415,15 +1049,16 @@ end = struct let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - let from_proto = + let from_proto_exn = let constructor = fun _extensions path source_file begin' end' -> { path; source_file; begin'; end' } in let spec = Runtime'.Deserialize.C.( repeated (1, int32_int, packed) ^:: basic_opt (2, string) ^:: basic_opt (3, int32_int) ^:: basic_opt (4, int32_int) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in - fun writer -> deserialize writer |> Runtime'.Result.open_error + fun writer -> deserialize writer + let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) end let name' () = "descriptor.google.protobuf.GeneratedCodeInfo" - type t = Annotation.t list + type t = GeneratedCodeInfo.Annotation.t list let make = fun ?annotation () -> let annotation = match annotation with Some v -> v | None -> [] in @@ -1431,15 +1066,16 @@ end = struct let to_proto = let apply = fun ~f:f' annotation -> f' [] annotation in - let spec = Runtime'.Serialize.C.( repeated (1, (message (fun t -> Annotation.to_proto t)), not_packed) ^:: nil ) in + let spec = Runtime'.Serialize.C.( repeated (1, (message (fun t -> GeneratedCodeInfo.Annotation.to_proto t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - let from_proto = + let from_proto_exn = let constructor = fun _extensions annotation -> annotation in - let spec = Runtime'.Deserialize.C.( repeated (1, (message (fun t -> Annotation.from_proto t)), not_packed) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( repeated (1, (message (fun t -> GeneratedCodeInfo.Annotation.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in - fun writer -> deserialize writer |> Runtime'.Result.open_error + fun writer -> deserialize writer + let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) end end diff --git a/src/spec/options.ml b/src/spec/options.ml index bab526e..7028b65 100644 --- a/src/spec/options.ml +++ b/src/spec/options.ml @@ -29,6 +29,7 @@ module rec Options : sig val make : ?mangle_names:bool -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end = struct let name' () = "options.Options" type t = bool @@ -43,20 +44,23 @@ end = struct let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - let from_proto = + let from_proto_exn = let constructor = fun _extensions mangle_names -> mangle_names in let spec = Runtime'.Deserialize.C.( basic (1, bool, proto3) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in - fun writer -> deserialize writer |> Runtime'.Result.open_error + fun writer -> deserialize writer + let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) end and Ocaml_options : sig type t = Options.t option + val get_exn: Imported'modules.Descriptor.Google.Protobuf.FileOptions.t -> Options.t option val get: Imported'modules.Descriptor.Google.Protobuf.FileOptions.t -> (Options.t option, [> Runtime'.Result.error]) result val set: Imported'modules.Descriptor.Google.Protobuf.FileOptions.t -> Options.t option -> Imported'modules.Descriptor.Google.Protobuf.FileOptions.t end = struct type t = Options.t option - let get extendee = Runtime'.Extensions.get Runtime'.Deserialize.C.( basic_opt (1074, (message (fun t -> Options.from_proto t))) ^:: nil ) (extendee.Imported'modules.Descriptor.Google.Protobuf.FileOptions.extensions') |> Runtime'.Result.open_error + let get_exn extendee = Runtime'.Extensions.get Runtime'.Deserialize.C.( basic_opt (1074, (message (fun t -> Options.from_proto_exn t))) ^:: nil ) (extendee.Imported'modules.Descriptor.Google.Protobuf.FileOptions.extensions') + let get extendee = Runtime'.Result.catch (fun () -> get_exn extendee) let set extendee t = let extensions' = Runtime'.Extensions.set (Runtime'.Serialize.C.( basic_opt (1074, (message (fun t -> Options.to_proto t))) ^:: nil )) (extendee.Imported'modules.Descriptor.Google.Protobuf.FileOptions.extensions') t in { extendee with Imported'modules.Descriptor.Google.Protobuf.FileOptions.extensions' = extensions' } diff --git a/src/spec/plugin.ml b/src/spec/plugin.ml index 9f353a5..c861d59 100644 --- a/src/spec/plugin.ml +++ b/src/spec/plugin.ml @@ -23,123 +23,16 @@ module Imported'modules = struct module Descriptor = Descriptor end (**/**) -module rec Google : sig - module rec Protobuf : sig - module rec Compiler : sig - module rec Version : sig - val name': unit -> string - type t = { major: int option; minor: int option; patch: int option; suffix: string option } - val make : ?major:int -> ?minor:int -> ?patch:int -> ?suffix:string -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and CodeGeneratorRequest : sig - val name': unit -> string - type t = { file_to_generate: string list; parameter: string option; proto_file: Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list; compiler_version: Version.t option } - val make : ?file_to_generate:string list -> ?parameter:string -> ?proto_file:Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list -> ?compiler_version:Version.t -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and CodeGeneratorResponse : sig - module rec Feature : sig - type t = FEATURE_NONE | FEATURE_PROTO3_OPTIONAL - val to_int: t -> int - val from_int: int -> (t, [> Runtime'.Result.error]) result - end - and File : sig - val name': unit -> string - type t = { name: string option; insertion_point: string option; content: string option; generated_code_info: Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.t option } - val make : ?name:string -> ?insertion_point:string -> ?content:string -> ?generated_code_info:Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.t -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - val name': unit -> string - type t = { error: string option; supported_features: int option; file: File.t list } - val make : ?error:string -> ?supported_features:int -> ?file:File.t list -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - end - end -end = struct - module rec Protobuf : sig - module rec Compiler : sig - module rec Version : sig - val name': unit -> string - type t = { major: int option; minor: int option; patch: int option; suffix: string option } - val make : ?major:int -> ?minor:int -> ?patch:int -> ?suffix:string -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and CodeGeneratorRequest : sig - val name': unit -> string - type t = { file_to_generate: string list; parameter: string option; proto_file: Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list; compiler_version: Version.t option } - val make : ?file_to_generate:string list -> ?parameter:string -> ?proto_file:Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list -> ?compiler_version:Version.t -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and CodeGeneratorResponse : sig - module rec Feature : sig - type t = FEATURE_NONE | FEATURE_PROTO3_OPTIONAL - val to_int: t -> int - val from_int: int -> (t, [> Runtime'.Result.error]) result - end - and File : sig - val name': unit -> string - type t = { name: string option; insertion_point: string option; content: string option; generated_code_info: Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.t option } - val make : ?name:string -> ?insertion_point:string -> ?content:string -> ?generated_code_info:Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.t -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - val name': unit -> string - type t = { error: string option; supported_features: int option; file: File.t list } - val make : ?error:string -> ?supported_features:int -> ?file:File.t list -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - end - end = struct - module rec Compiler : sig - module rec Version : sig - val name': unit -> string - type t = { major: int option; minor: int option; patch: int option; suffix: string option } - val make : ?major:int -> ?minor:int -> ?patch:int -> ?suffix:string -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and CodeGeneratorRequest : sig - val name': unit -> string - type t = { file_to_generate: string list; parameter: string option; proto_file: Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list; compiler_version: Version.t option } - val make : ?file_to_generate:string list -> ?parameter:string -> ?proto_file:Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list -> ?compiler_version:Version.t -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - and CodeGeneratorResponse : sig - module rec Feature : sig - type t = FEATURE_NONE | FEATURE_PROTO3_OPTIONAL - val to_int: t -> int - val from_int: int -> (t, [> Runtime'.Result.error]) result - end - and File : sig - val name': unit -> string - type t = { name: string option; insertion_point: string option; content: string option; generated_code_info: Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.t option } - val make : ?name:string -> ?insertion_point:string -> ?content:string -> ?generated_code_info:Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.t -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - val name': unit -> string - type t = { error: string option; supported_features: int option; file: File.t list } - val make : ?error:string -> ?supported_features:int -> ?file:File.t list -> unit -> t - val to_proto: t -> Runtime'.Writer.t - val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result - end - end = struct +module Google = struct + module Protobuf = struct + module Compiler = struct module rec Version : sig val name': unit -> string type t = { major: int option; minor: int option; patch: int option; suffix: string option } val make : ?major:int -> ?minor:int -> ?patch:int -> ?suffix:string -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end = struct let name' () = "plugin.google.protobuf.compiler.Version" type t = { major: int option; minor: int option; patch: int option; suffix: string option } @@ -154,11 +47,12 @@ end = struct let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - let from_proto = + let from_proto_exn = let constructor = fun _extensions major minor patch suffix -> { major; minor; patch; suffix } in let spec = Runtime'.Deserialize.C.( basic_opt (1, int32_int) ^:: basic_opt (2, int32_int) ^:: basic_opt (3, int32_int) ^:: basic_opt (4, string) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in - fun writer -> deserialize writer |> Runtime'.Result.open_error + fun writer -> deserialize writer + let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) end and CodeGeneratorRequest : sig @@ -167,6 +61,7 @@ end = struct val make : ?file_to_generate:string list -> ?parameter:string -> ?proto_file:Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list -> ?compiler_version:Version.t -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end = struct let name' () = "plugin.google.protobuf.compiler.CodeGeneratorRequest" type t = { file_to_generate: string list; parameter: string option; proto_file: Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list; compiler_version: Version.t option } @@ -182,18 +77,20 @@ end = struct let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - let from_proto = + let from_proto_exn = let constructor = fun _extensions file_to_generate parameter proto_file compiler_version -> { file_to_generate; parameter; proto_file; compiler_version } in - let spec = Runtime'.Deserialize.C.( repeated (1, string, not_packed) ^:: basic_opt (2, string) ^:: repeated (15, (message (fun t -> Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.from_proto t)), not_packed) ^:: basic_opt (3, (message (fun t -> Version.from_proto t))) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( repeated (1, string, not_packed) ^:: basic_opt (2, string) ^:: repeated (15, (message (fun t -> Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.from_proto_exn t)), not_packed) ^:: basic_opt (3, (message (fun t -> Version.from_proto_exn t))) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in - fun writer -> deserialize writer |> Runtime'.Result.open_error + fun writer -> deserialize writer + let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) end and CodeGeneratorResponse : sig module rec Feature : sig type t = FEATURE_NONE | FEATURE_PROTO3_OPTIONAL val to_int: t -> int - val from_int: int -> (t, [> Runtime'.Result.error]) result + val from_int: int -> t Runtime'.Result.t + val from_int_exn: int -> t end and File : sig val name': unit -> string @@ -201,28 +98,32 @@ end = struct val make : ?name:string -> ?insertion_point:string -> ?content:string -> ?generated_code_info:Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.t -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end val name': unit -> string - type t = { error: string option; supported_features: int option; file: File.t list } - val make : ?error:string -> ?supported_features:int -> ?file:File.t list -> unit -> t + type t = { error: string option; supported_features: int option; file: CodeGeneratorResponse.File.t list } + val make : ?error:string -> ?supported_features:int -> ?file:CodeGeneratorResponse.File.t list -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end = struct module rec Feature : sig type t = FEATURE_NONE | FEATURE_PROTO3_OPTIONAL val to_int: t -> int - val from_int: int -> (t, [> Runtime'.Result.error]) result + val from_int: int -> t Runtime'.Result.t + val from_int_exn: int -> t end = struct type t = FEATURE_NONE | FEATURE_PROTO3_OPTIONAL let to_int = function | FEATURE_NONE -> 0 | FEATURE_PROTO3_OPTIONAL -> 1 - let from_int = function - | 0 -> Ok FEATURE_NONE - | 1 -> Ok FEATURE_PROTO3_OPTIONAL - | n -> Error (`Unknown_enum_value n) + let from_int_exn = function + | 0 -> FEATURE_NONE + | 1 -> FEATURE_PROTO3_OPTIONAL + | n -> Runtime'.Result.raise (`Unknown_enum_value n) + let from_int e = Runtime'.Result.catch (fun () -> from_int_exn e) end and File : sig val name': unit -> string @@ -230,6 +131,7 @@ end = struct val make : ?name:string -> ?insertion_point:string -> ?content:string -> ?generated_code_info:Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.t -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t end = struct let name' () = "plugin.google.protobuf.compiler.CodeGeneratorResponse.File" type t = { name: string option; insertion_point: string option; content: string option; generated_code_info: Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.t option } @@ -244,15 +146,16 @@ end = struct let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - let from_proto = + let from_proto_exn = let constructor = fun _extensions name insertion_point content generated_code_info -> { name; insertion_point; content; generated_code_info } in - let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (2, string) ^:: basic_opt (15, string) ^:: basic_opt (16, (message (fun t -> Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.from_proto t))) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (2, string) ^:: basic_opt (15, string) ^:: basic_opt (16, (message (fun t -> Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.from_proto_exn t))) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in - fun writer -> deserialize writer |> Runtime'.Result.open_error + fun writer -> deserialize writer + let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) end let name' () = "plugin.google.protobuf.compiler.CodeGeneratorResponse" - type t = { error: string option; supported_features: int option; file: File.t list } + type t = { error: string option; supported_features: int option; file: CodeGeneratorResponse.File.t list } let make = fun ?error ?supported_features ?file () -> let file = match file with Some v -> v | None -> [] in @@ -260,15 +163,16 @@ end = struct let to_proto = let apply = fun ~f:f' { error; supported_features; file } -> f' [] error supported_features file in - let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (2, uint64_int) ^:: repeated (15, (message (fun t -> File.to_proto t)), not_packed) ^:: nil ) in + let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (2, uint64_int) ^:: repeated (15, (message (fun t -> CodeGeneratorResponse.File.to_proto t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - let from_proto = + let from_proto_exn = let constructor = fun _extensions error supported_features file -> { error; supported_features; file } in - let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (2, uint64_int) ^:: repeated (15, (message (fun t -> File.from_proto t)), not_packed) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (2, uint64_int) ^:: repeated (15, (message (fun t -> CodeGeneratorResponse.File.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in - fun writer -> deserialize writer |> Runtime'.Result.open_error + fun writer -> deserialize writer + let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) end end From 94edbe00537c53cc4b655d1f849924f4189feccb Mon Sep 17 00:00:00 2001 From: Anders Fugmann Date: Sun, 31 Dec 2023 09:58:36 +0100 Subject: [PATCH 03/30] Trim space of all emitted lines and rerun bootstrap --- src/plugin/code.ml | 16 +- src/spec/descriptor.ml | 422 ++++++++++++++++++++--------------------- src/spec/options.ml | 20 +- src/spec/plugin.ml | 66 +++---- 4 files changed, 269 insertions(+), 255 deletions(-) diff --git a/src/plugin/code.ml b/src/plugin/code.ml index ffa2ece..a0b8f72 100644 --- a/src/plugin/code.ml +++ b/src/plugin/code.ml @@ -14,9 +14,23 @@ let decr t = | false -> failwith "Cannot decr indentation level at this point" let emit t indent fmt = + let trim_end ~char s = + let len = String.length s in + let rcount s = + let rec inner = function + | 0 -> len + | n when s.[n - 1] = char -> inner (n - 1) + | n -> len - n + in + inner len + in + match rcount s with + | 0 -> s + | n -> String.sub ~pos:0 ~len:(String.length s - n) s + in let prepend s = String.split_on_char ~sep:'\n' s - |> List.iter ~f:(fun s -> t.code <- (t.indent ^ s) :: t.code) + |> List.iter ~f:(fun s -> t.code <- (trim_end ~char:' ' (t.indent ^ s)) :: t.code) in let emit s = match indent with diff --git a/src/spec/descriptor.ml b/src/spec/descriptor.ml index 34eee2d..7628525 100644 --- a/src/spec/descriptor.ml +++ b/src/spec/descriptor.ml @@ -22,45 +22,45 @@ module Google = struct module Protobuf = struct module rec FileDescriptorSet : sig val name': unit -> string - type t = FileDescriptorProto.t list + type t = FileDescriptorProto.t list val make : ?file:FileDescriptorProto.t list -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t - end = struct + end = struct let name' () = "descriptor.google.protobuf.FileDescriptorSet" type t = FileDescriptorProto.t list let make = - fun ?file () -> + fun ?file () -> let file = match file with Some v -> v | None -> [] in file - + let to_proto = let apply = fun ~f:f' file -> f' [] file in let spec = Runtime'.Serialize.C.( repeated (1, (message (fun t -> FileDescriptorProto.to_proto t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - + let from_proto_exn = let constructor = fun _extensions file -> file in let spec = Runtime'.Deserialize.C.( repeated (1, (message (fun t -> FileDescriptorProto.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) - + end and FileDescriptorProto : sig val name': unit -> string - type t = { name: string option; package: string option; dependency: string list; public_dependency: int list; weak_dependency: int list; message_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; service: ServiceDescriptorProto.t list; extension: FieldDescriptorProto.t list; options: FileOptions.t option; source_code_info: SourceCodeInfo.t option; syntax: string option } + type t = { name: string option; package: string option; dependency: string list; public_dependency: int list; weak_dependency: int list; message_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; service: ServiceDescriptorProto.t list; extension: FieldDescriptorProto.t list; options: FileOptions.t option; source_code_info: SourceCodeInfo.t option; syntax: string option } val make : ?name:string -> ?package:string -> ?dependency:string list -> ?public_dependency:int list -> ?weak_dependency:int list -> ?message_type:DescriptorProto.t list -> ?enum_type:EnumDescriptorProto.t list -> ?service:ServiceDescriptorProto.t list -> ?extension:FieldDescriptorProto.t list -> ?options:FileOptions.t -> ?source_code_info:SourceCodeInfo.t -> ?syntax:string -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t - end = struct + end = struct let name' () = "descriptor.google.protobuf.FileDescriptorProto" type t = { name: string option; package: string option; dependency: string list; public_dependency: int list; weak_dependency: int list; message_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; service: ServiceDescriptorProto.t list; extension: FieldDescriptorProto.t list; options: FileOptions.t option; source_code_info: SourceCodeInfo.t option; syntax: string option } let make = - fun ?name ?package ?dependency ?public_dependency ?weak_dependency ?message_type ?enum_type ?service ?extension ?options ?source_code_info ?syntax () -> + fun ?name ?package ?dependency ?public_dependency ?weak_dependency ?message_type ?enum_type ?service ?extension ?options ?source_code_info ?syntax () -> let dependency = match dependency with Some v -> v | None -> [] in let public_dependency = match public_dependency with Some v -> v | None -> [] in let weak_dependency = match weak_dependency with Some v -> v | None -> [] in @@ -69,25 +69,25 @@ module Google = struct let service = match service with Some v -> v | None -> [] in let extension = match extension with Some v -> v | None -> [] in { name; package; dependency; public_dependency; weak_dependency; message_type; enum_type; service; extension; options; source_code_info; syntax } - + let to_proto = let apply = fun ~f:f' { name; package; dependency; public_dependency; weak_dependency; message_type; enum_type; service; extension; options; source_code_info; syntax } -> f' [] name package dependency public_dependency weak_dependency message_type enum_type service extension options source_code_info syntax in let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (2, string) ^:: repeated (3, string, not_packed) ^:: repeated (10, int32_int, not_packed) ^:: repeated (11, int32_int, not_packed) ^:: repeated (4, (message (fun t -> DescriptorProto.to_proto t)), not_packed) ^:: repeated (5, (message (fun t -> EnumDescriptorProto.to_proto t)), not_packed) ^:: repeated (6, (message (fun t -> ServiceDescriptorProto.to_proto t)), not_packed) ^:: repeated (7, (message (fun t -> FieldDescriptorProto.to_proto t)), not_packed) ^:: basic_opt (8, (message (fun t -> FileOptions.to_proto t))) ^:: basic_opt (9, (message (fun t -> SourceCodeInfo.to_proto t))) ^:: basic_opt (12, string) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - + let from_proto_exn = let constructor = fun _extensions name package dependency public_dependency weak_dependency message_type enum_type service extension options source_code_info syntax -> { name; package; dependency; public_dependency; weak_dependency; message_type; enum_type; service; extension; options; source_code_info; syntax } in let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (2, string) ^:: repeated (3, string, not_packed) ^:: repeated (10, int32_int, not_packed) ^:: repeated (11, int32_int, not_packed) ^:: repeated (4, (message (fun t -> DescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (5, (message (fun t -> EnumDescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (6, (message (fun t -> ServiceDescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (7, (message (fun t -> FieldDescriptorProto.from_proto_exn t)), not_packed) ^:: basic_opt (8, (message (fun t -> FileOptions.from_proto_exn t))) ^:: basic_opt (9, (message (fun t -> SourceCodeInfo.from_proto_exn t))) ^:: basic_opt (12, string) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) - + end and DescriptorProto : sig module rec ExtensionRange : sig val name': unit -> string - type t = { start: int option; end': int option; options: ExtensionRangeOptions.t option } + type t = { start: int option; end': int option; options: ExtensionRangeOptions.t option } val make : ?start:int -> ?end':int -> ?options:ExtensionRangeOptions.t -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result @@ -95,81 +95,81 @@ module Google = struct end and ReservedRange : sig val name': unit -> string - type t = { start: int option; end': int option } + type t = { start: int option; end': int option } val make : ?start:int -> ?end':int -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t end val name': unit -> string - type t = { name: string option; field: FieldDescriptorProto.t list; extension: FieldDescriptorProto.t list; nested_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; extension_range: DescriptorProto.ExtensionRange.t list; oneof_decl: OneofDescriptorProto.t list; options: MessageOptions.t option; reserved_range: DescriptorProto.ReservedRange.t list; reserved_name: string list } + type t = { name: string option; field: FieldDescriptorProto.t list; extension: FieldDescriptorProto.t list; nested_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; extension_range: DescriptorProto.ExtensionRange.t list; oneof_decl: OneofDescriptorProto.t list; options: MessageOptions.t option; reserved_range: DescriptorProto.ReservedRange.t list; reserved_name: string list } val make : ?name:string -> ?field:FieldDescriptorProto.t list -> ?extension:FieldDescriptorProto.t list -> ?nested_type:DescriptorProto.t list -> ?enum_type:EnumDescriptorProto.t list -> ?extension_range:DescriptorProto.ExtensionRange.t list -> ?oneof_decl:OneofDescriptorProto.t list -> ?options:MessageOptions.t -> ?reserved_range:DescriptorProto.ReservedRange.t list -> ?reserved_name:string list -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t - end = struct + end = struct module rec ExtensionRange : sig val name': unit -> string - type t = { start: int option; end': int option; options: ExtensionRangeOptions.t option } + type t = { start: int option; end': int option; options: ExtensionRangeOptions.t option } val make : ?start:int -> ?end':int -> ?options:ExtensionRangeOptions.t -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t - end = struct + end = struct let name' () = "descriptor.google.protobuf.DescriptorProto.ExtensionRange" type t = { start: int option; end': int option; options: ExtensionRangeOptions.t option } let make = - fun ?start ?end' ?options () -> - + fun ?start ?end' ?options () -> + { start; end'; options } - + let to_proto = let apply = fun ~f:f' { start; end'; options } -> f' [] start end' options in let spec = Runtime'.Serialize.C.( basic_opt (1, int32_int) ^:: basic_opt (2, int32_int) ^:: basic_opt (3, (message (fun t -> ExtensionRangeOptions.to_proto t))) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - + let from_proto_exn = let constructor = fun _extensions start end' options -> { start; end'; options } in let spec = Runtime'.Deserialize.C.( basic_opt (1, int32_int) ^:: basic_opt (2, int32_int) ^:: basic_opt (3, (message (fun t -> ExtensionRangeOptions.from_proto_exn t))) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) - + end and ReservedRange : sig val name': unit -> string - type t = { start: int option; end': int option } + type t = { start: int option; end': int option } val make : ?start:int -> ?end':int -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t - end = struct + end = struct let name' () = "descriptor.google.protobuf.DescriptorProto.ReservedRange" type t = { start: int option; end': int option } let make = - fun ?start ?end' () -> - + fun ?start ?end' () -> + { start; end' } - + let to_proto = let apply = fun ~f:f' { start; end' } -> f' [] start end' in let spec = Runtime'.Serialize.C.( basic_opt (1, int32_int) ^:: basic_opt (2, int32_int) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - + let from_proto_exn = let constructor = fun _extensions start end' -> { start; end' } in let spec = Runtime'.Deserialize.C.( basic_opt (1, int32_int) ^:: basic_opt (2, int32_int) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) - + end let name' () = "descriptor.google.protobuf.DescriptorProto" type t = { name: string option; field: FieldDescriptorProto.t list; extension: FieldDescriptorProto.t list; nested_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; extension_range: DescriptorProto.ExtensionRange.t list; oneof_decl: OneofDescriptorProto.t list; options: MessageOptions.t option; reserved_range: DescriptorProto.ReservedRange.t list; reserved_name: string list } let make = - fun ?name ?field ?extension ?nested_type ?enum_type ?extension_range ?oneof_decl ?options ?reserved_range ?reserved_name () -> + fun ?name ?field ?extension ?nested_type ?enum_type ?extension_range ?oneof_decl ?options ?reserved_range ?reserved_name () -> let field = match field with Some v -> v | None -> [] in let extension = match extension with Some v -> v | None -> [] in let nested_type = match nested_type with Some v -> v | None -> [] in @@ -179,77 +179,77 @@ module Google = struct let reserved_range = match reserved_range with Some v -> v | None -> [] in let reserved_name = match reserved_name with Some v -> v | None -> [] in { name; field; extension; nested_type; enum_type; extension_range; oneof_decl; options; reserved_range; reserved_name } - + let to_proto = let apply = fun ~f:f' { name; field; extension; nested_type; enum_type; extension_range; oneof_decl; options; reserved_range; reserved_name } -> f' [] name field extension nested_type enum_type extension_range oneof_decl options reserved_range reserved_name in let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> FieldDescriptorProto.to_proto t)), not_packed) ^:: repeated (6, (message (fun t -> FieldDescriptorProto.to_proto t)), not_packed) ^:: repeated (3, (message (fun t -> DescriptorProto.to_proto t)), not_packed) ^:: repeated (4, (message (fun t -> EnumDescriptorProto.to_proto t)), not_packed) ^:: repeated (5, (message (fun t -> DescriptorProto.ExtensionRange.to_proto t)), not_packed) ^:: repeated (8, (message (fun t -> OneofDescriptorProto.to_proto t)), not_packed) ^:: basic_opt (7, (message (fun t -> MessageOptions.to_proto t))) ^:: repeated (9, (message (fun t -> DescriptorProto.ReservedRange.to_proto t)), not_packed) ^:: repeated (10, string, not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - + let from_proto_exn = let constructor = fun _extensions name field extension nested_type enum_type extension_range oneof_decl options reserved_range reserved_name -> { name; field; extension; nested_type; enum_type; extension_range; oneof_decl; options; reserved_range; reserved_name } in let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> FieldDescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (6, (message (fun t -> FieldDescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (3, (message (fun t -> DescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (4, (message (fun t -> EnumDescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (5, (message (fun t -> DescriptorProto.ExtensionRange.from_proto_exn t)), not_packed) ^:: repeated (8, (message (fun t -> OneofDescriptorProto.from_proto_exn t)), not_packed) ^:: basic_opt (7, (message (fun t -> MessageOptions.from_proto_exn t))) ^:: repeated (9, (message (fun t -> DescriptorProto.ReservedRange.from_proto_exn t)), not_packed) ^:: repeated (10, string, not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) - + end and ExtensionRangeOptions : sig val name': unit -> string - type t = { uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } val make : ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t - end = struct + end = struct let name' () = "descriptor.google.protobuf.ExtensionRangeOptions" type t = { uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } let make = - fun ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> + fun ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> let uninterpreted_option = match uninterpreted_option with Some v -> v | None -> [] in { uninterpreted_option; extensions' } - + let to_proto = let apply = fun ~f:f' { uninterpreted_option; extensions' } -> f' extensions' uninterpreted_option in let spec = Runtime'.Serialize.C.( repeated (999, (message (fun t -> UninterpretedOption.to_proto t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] (spec) in fun t -> apply ~f:serialize t - + let from_proto_exn = let constructor = fun extensions' uninterpreted_option -> { uninterpreted_option; extensions' } in let spec = Runtime'.Deserialize.C.( repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) - + end and FieldDescriptorProto : sig module rec Type : sig - type t = TYPE_DOUBLE | TYPE_FLOAT | TYPE_INT64 | TYPE_UINT64 | TYPE_INT32 | TYPE_FIXED64 | TYPE_FIXED32 | TYPE_BOOL | TYPE_STRING | TYPE_GROUP | TYPE_MESSAGE | TYPE_BYTES | TYPE_UINT32 | TYPE_ENUM | TYPE_SFIXED32 | TYPE_SFIXED64 | TYPE_SINT32 | TYPE_SINT64 + type t = TYPE_DOUBLE | TYPE_FLOAT | TYPE_INT64 | TYPE_UINT64 | TYPE_INT32 | TYPE_FIXED64 | TYPE_FIXED32 | TYPE_BOOL | TYPE_STRING | TYPE_GROUP | TYPE_MESSAGE | TYPE_BYTES | TYPE_UINT32 | TYPE_ENUM | TYPE_SFIXED32 | TYPE_SFIXED64 | TYPE_SINT32 | TYPE_SINT64 val to_int: t -> int val from_int: int -> t Runtime'.Result.t val from_int_exn: int -> t end and Label : sig - type t = LABEL_OPTIONAL | LABEL_REQUIRED | LABEL_REPEATED + type t = LABEL_OPTIONAL | LABEL_REQUIRED | LABEL_REPEATED val to_int: t -> int val from_int: int -> t Runtime'.Result.t val from_int_exn: int -> t end val name': unit -> string - type t = { name: string option; number: int option; label: FieldDescriptorProto.Label.t option; type': FieldDescriptorProto.Type.t option; type_name: string option; extendee: string option; default_value: string option; oneof_index: int option; json_name: string option; options: FieldOptions.t option; proto3_optional: bool option } + type t = { name: string option; number: int option; label: FieldDescriptorProto.Label.t option; type': FieldDescriptorProto.Type.t option; type_name: string option; extendee: string option; default_value: string option; oneof_index: int option; json_name: string option; options: FieldOptions.t option; proto3_optional: bool option } val make : ?name:string -> ?number:int -> ?label:FieldDescriptorProto.Label.t -> ?type':FieldDescriptorProto.Type.t -> ?type_name:string -> ?extendee:string -> ?default_value:string -> ?oneof_index:int -> ?json_name:string -> ?options:FieldOptions.t -> ?proto3_optional:bool -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t - end = struct + end = struct module rec Type : sig - type t = TYPE_DOUBLE | TYPE_FLOAT | TYPE_INT64 | TYPE_UINT64 | TYPE_INT32 | TYPE_FIXED64 | TYPE_FIXED32 | TYPE_BOOL | TYPE_STRING | TYPE_GROUP | TYPE_MESSAGE | TYPE_BYTES | TYPE_UINT32 | TYPE_ENUM | TYPE_SFIXED32 | TYPE_SFIXED64 | TYPE_SINT32 | TYPE_SINT64 + type t = TYPE_DOUBLE | TYPE_FLOAT | TYPE_INT64 | TYPE_UINT64 | TYPE_INT32 | TYPE_FIXED64 | TYPE_FIXED32 | TYPE_BOOL | TYPE_STRING | TYPE_GROUP | TYPE_MESSAGE | TYPE_BYTES | TYPE_UINT32 | TYPE_ENUM | TYPE_SFIXED32 | TYPE_SFIXED64 | TYPE_SINT32 | TYPE_SINT64 val to_int: t -> int val from_int: int -> t Runtime'.Result.t val from_int_exn: int -> t - end = struct - type t = TYPE_DOUBLE | TYPE_FLOAT | TYPE_INT64 | TYPE_UINT64 | TYPE_INT32 | TYPE_FIXED64 | TYPE_FIXED32 | TYPE_BOOL | TYPE_STRING | TYPE_GROUP | TYPE_MESSAGE | TYPE_BYTES | TYPE_UINT32 | TYPE_ENUM | TYPE_SFIXED32 | TYPE_SFIXED64 | TYPE_SINT32 | TYPE_SINT64 + end = struct + type t = TYPE_DOUBLE | TYPE_FLOAT | TYPE_INT64 | TYPE_UINT64 | TYPE_INT32 | TYPE_FIXED64 | TYPE_FIXED32 | TYPE_BOOL | TYPE_STRING | TYPE_GROUP | TYPE_MESSAGE | TYPE_BYTES | TYPE_UINT32 | TYPE_ENUM | TYPE_SFIXED32 | TYPE_SFIXED64 | TYPE_SINT32 | TYPE_SINT64 let to_int = function | TYPE_DOUBLE -> 1 | TYPE_FLOAT -> 2 @@ -269,7 +269,7 @@ module Google = struct | TYPE_SFIXED64 -> 16 | TYPE_SINT32 -> 17 | TYPE_SINT64 -> 18 - + let from_int_exn = function | 1 -> TYPE_DOUBLE | 2 -> TYPE_FLOAT @@ -290,273 +290,273 @@ module Google = struct | 17 -> TYPE_SINT32 | 18 -> TYPE_SINT64 | n -> Runtime'.Result.raise (`Unknown_enum_value n) - + let from_int e = Runtime'.Result.catch (fun () -> from_int_exn e) end and Label : sig - type t = LABEL_OPTIONAL | LABEL_REQUIRED | LABEL_REPEATED + type t = LABEL_OPTIONAL | LABEL_REQUIRED | LABEL_REPEATED val to_int: t -> int val from_int: int -> t Runtime'.Result.t val from_int_exn: int -> t - end = struct - type t = LABEL_OPTIONAL | LABEL_REQUIRED | LABEL_REPEATED + end = struct + type t = LABEL_OPTIONAL | LABEL_REQUIRED | LABEL_REPEATED let to_int = function | LABEL_OPTIONAL -> 1 | LABEL_REQUIRED -> 2 | LABEL_REPEATED -> 3 - + let from_int_exn = function | 1 -> LABEL_OPTIONAL | 2 -> LABEL_REQUIRED | 3 -> LABEL_REPEATED | n -> Runtime'.Result.raise (`Unknown_enum_value n) - + let from_int e = Runtime'.Result.catch (fun () -> from_int_exn e) end let name' () = "descriptor.google.protobuf.FieldDescriptorProto" type t = { name: string option; number: int option; label: FieldDescriptorProto.Label.t option; type': FieldDescriptorProto.Type.t option; type_name: string option; extendee: string option; default_value: string option; oneof_index: int option; json_name: string option; options: FieldOptions.t option; proto3_optional: bool option } let make = - fun ?name ?number ?label ?type' ?type_name ?extendee ?default_value ?oneof_index ?json_name ?options ?proto3_optional () -> - + fun ?name ?number ?label ?type' ?type_name ?extendee ?default_value ?oneof_index ?json_name ?options ?proto3_optional () -> + { name; number; label; type'; type_name; extendee; default_value; oneof_index; json_name; options; proto3_optional } - + let to_proto = let apply = fun ~f:f' { name; number; label; type'; type_name; extendee; default_value; oneof_index; json_name; options; proto3_optional } -> f' [] name number label type' type_name extendee default_value oneof_index json_name options proto3_optional in let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (3, int32_int) ^:: basic_opt (4, (enum FieldDescriptorProto.Label.to_int)) ^:: basic_opt (5, (enum FieldDescriptorProto.Type.to_int)) ^:: basic_opt (6, string) ^:: basic_opt (2, string) ^:: basic_opt (7, string) ^:: basic_opt (9, int32_int) ^:: basic_opt (10, string) ^:: basic_opt (8, (message (fun t -> FieldOptions.to_proto t))) ^:: basic_opt (17, bool) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - + let from_proto_exn = let constructor = fun _extensions name number label type' type_name extendee default_value oneof_index json_name options proto3_optional -> { name; number; label; type'; type_name; extendee; default_value; oneof_index; json_name; options; proto3_optional } in let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (3, int32_int) ^:: basic_opt (4, (enum FieldDescriptorProto.Label.from_int_exn)) ^:: basic_opt (5, (enum FieldDescriptorProto.Type.from_int_exn)) ^:: basic_opt (6, string) ^:: basic_opt (2, string) ^:: basic_opt (7, string) ^:: basic_opt (9, int32_int) ^:: basic_opt (10, string) ^:: basic_opt (8, (message (fun t -> FieldOptions.from_proto_exn t))) ^:: basic_opt (17, bool) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) - + end and OneofDescriptorProto : sig val name': unit -> string - type t = { name: string option; options: OneofOptions.t option } + type t = { name: string option; options: OneofOptions.t option } val make : ?name:string -> ?options:OneofOptions.t -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t - end = struct + end = struct let name' () = "descriptor.google.protobuf.OneofDescriptorProto" type t = { name: string option; options: OneofOptions.t option } let make = - fun ?name ?options () -> - + fun ?name ?options () -> + { name; options } - + let to_proto = let apply = fun ~f:f' { name; options } -> f' [] name options in let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (2, (message (fun t -> OneofOptions.to_proto t))) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - + let from_proto_exn = let constructor = fun _extensions name options -> { name; options } in let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (2, (message (fun t -> OneofOptions.from_proto_exn t))) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) - + end and EnumDescriptorProto : sig module rec EnumReservedRange : sig val name': unit -> string - type t = { start: int option; end': int option } + type t = { start: int option; end': int option } val make : ?start:int -> ?end':int -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t end val name': unit -> string - type t = { name: string option; value: EnumValueDescriptorProto.t list; options: EnumOptions.t option; reserved_range: EnumDescriptorProto.EnumReservedRange.t list; reserved_name: string list } + type t = { name: string option; value: EnumValueDescriptorProto.t list; options: EnumOptions.t option; reserved_range: EnumDescriptorProto.EnumReservedRange.t list; reserved_name: string list } val make : ?name:string -> ?value:EnumValueDescriptorProto.t list -> ?options:EnumOptions.t -> ?reserved_range:EnumDescriptorProto.EnumReservedRange.t list -> ?reserved_name:string list -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t - end = struct + end = struct module rec EnumReservedRange : sig val name': unit -> string - type t = { start: int option; end': int option } + type t = { start: int option; end': int option } val make : ?start:int -> ?end':int -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t - end = struct + end = struct let name' () = "descriptor.google.protobuf.EnumDescriptorProto.EnumReservedRange" type t = { start: int option; end': int option } let make = - fun ?start ?end' () -> - + fun ?start ?end' () -> + { start; end' } - + let to_proto = let apply = fun ~f:f' { start; end' } -> f' [] start end' in let spec = Runtime'.Serialize.C.( basic_opt (1, int32_int) ^:: basic_opt (2, int32_int) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - + let from_proto_exn = let constructor = fun _extensions start end' -> { start; end' } in let spec = Runtime'.Deserialize.C.( basic_opt (1, int32_int) ^:: basic_opt (2, int32_int) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) - + end let name' () = "descriptor.google.protobuf.EnumDescriptorProto" type t = { name: string option; value: EnumValueDescriptorProto.t list; options: EnumOptions.t option; reserved_range: EnumDescriptorProto.EnumReservedRange.t list; reserved_name: string list } let make = - fun ?name ?value ?options ?reserved_range ?reserved_name () -> + fun ?name ?value ?options ?reserved_range ?reserved_name () -> let value = match value with Some v -> v | None -> [] in let reserved_range = match reserved_range with Some v -> v | None -> [] in let reserved_name = match reserved_name with Some v -> v | None -> [] in { name; value; options; reserved_range; reserved_name } - + let to_proto = let apply = fun ~f:f' { name; value; options; reserved_range; reserved_name } -> f' [] name value options reserved_range reserved_name in let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> EnumValueDescriptorProto.to_proto t)), not_packed) ^:: basic_opt (3, (message (fun t -> EnumOptions.to_proto t))) ^:: repeated (4, (message (fun t -> EnumDescriptorProto.EnumReservedRange.to_proto t)), not_packed) ^:: repeated (5, string, not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - + let from_proto_exn = let constructor = fun _extensions name value options reserved_range reserved_name -> { name; value; options; reserved_range; reserved_name } in let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> EnumValueDescriptorProto.from_proto_exn t)), not_packed) ^:: basic_opt (3, (message (fun t -> EnumOptions.from_proto_exn t))) ^:: repeated (4, (message (fun t -> EnumDescriptorProto.EnumReservedRange.from_proto_exn t)), not_packed) ^:: repeated (5, string, not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) - + end and EnumValueDescriptorProto : sig val name': unit -> string - type t = { name: string option; number: int option; options: EnumValueOptions.t option } + type t = { name: string option; number: int option; options: EnumValueOptions.t option } val make : ?name:string -> ?number:int -> ?options:EnumValueOptions.t -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t - end = struct + end = struct let name' () = "descriptor.google.protobuf.EnumValueDescriptorProto" type t = { name: string option; number: int option; options: EnumValueOptions.t option } let make = - fun ?name ?number ?options () -> - + fun ?name ?number ?options () -> + { name; number; options } - + let to_proto = let apply = fun ~f:f' { name; number; options } -> f' [] name number options in let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (2, int32_int) ^:: basic_opt (3, (message (fun t -> EnumValueOptions.to_proto t))) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - + let from_proto_exn = let constructor = fun _extensions name number options -> { name; number; options } in let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (2, int32_int) ^:: basic_opt (3, (message (fun t -> EnumValueOptions.from_proto_exn t))) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) - + end and ServiceDescriptorProto : sig val name': unit -> string - type t = { name: string option; method': MethodDescriptorProto.t list; options: ServiceOptions.t option } + type t = { name: string option; method': MethodDescriptorProto.t list; options: ServiceOptions.t option } val make : ?name:string -> ?method':MethodDescriptorProto.t list -> ?options:ServiceOptions.t -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t - end = struct + end = struct let name' () = "descriptor.google.protobuf.ServiceDescriptorProto" type t = { name: string option; method': MethodDescriptorProto.t list; options: ServiceOptions.t option } let make = - fun ?name ?method' ?options () -> + fun ?name ?method' ?options () -> let method' = match method' with Some v -> v | None -> [] in { name; method'; options } - + let to_proto = let apply = fun ~f:f' { name; method'; options } -> f' [] name method' options in let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> MethodDescriptorProto.to_proto t)), not_packed) ^:: basic_opt (3, (message (fun t -> ServiceOptions.to_proto t))) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - + let from_proto_exn = let constructor = fun _extensions name method' options -> { name; method'; options } in let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> MethodDescriptorProto.from_proto_exn t)), not_packed) ^:: basic_opt (3, (message (fun t -> ServiceOptions.from_proto_exn t))) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) - + end and MethodDescriptorProto : sig val name': unit -> string - type t = { name: string option; input_type: string option; output_type: string option; options: MethodOptions.t option; client_streaming: bool; server_streaming: bool } + type t = { name: string option; input_type: string option; output_type: string option; options: MethodOptions.t option; client_streaming: bool; server_streaming: bool } val make : ?name:string -> ?input_type:string -> ?output_type:string -> ?options:MethodOptions.t -> ?client_streaming:bool -> ?server_streaming:bool -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t - end = struct + end = struct let name' () = "descriptor.google.protobuf.MethodDescriptorProto" type t = { name: string option; input_type: string option; output_type: string option; options: MethodOptions.t option; client_streaming: bool; server_streaming: bool } let make = - fun ?name ?input_type ?output_type ?options ?client_streaming ?server_streaming () -> + fun ?name ?input_type ?output_type ?options ?client_streaming ?server_streaming () -> let client_streaming = match client_streaming with Some v -> v | None -> false in let server_streaming = match server_streaming with Some v -> v | None -> false in { name; input_type; output_type; options; client_streaming; server_streaming } - + let to_proto = let apply = fun ~f:f' { name; input_type; output_type; options; client_streaming; server_streaming } -> f' [] name input_type output_type options client_streaming server_streaming in let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (2, string) ^:: basic_opt (3, string) ^:: basic_opt (4, (message (fun t -> MethodOptions.to_proto t))) ^:: basic (5, bool, proto2 (false)) ^:: basic (6, bool, proto2 (false)) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - + let from_proto_exn = let constructor = fun _extensions name input_type output_type options client_streaming server_streaming -> { name; input_type; output_type; options; client_streaming; server_streaming } in let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (2, string) ^:: basic_opt (3, string) ^:: basic_opt (4, (message (fun t -> MethodOptions.from_proto_exn t))) ^:: basic (5, bool, proto2 (false)) ^:: basic (6, bool, proto2 (false)) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) - + end and FileOptions : sig module rec OptimizeMode : sig - type t = SPEED | CODE_SIZE | LITE_RUNTIME + type t = SPEED | CODE_SIZE | LITE_RUNTIME val to_int: t -> int val from_int: int -> t Runtime'.Result.t val from_int_exn: int -> t end val name': unit -> string - type t = { java_package: string option; java_outer_classname: string option; java_multiple_files: bool; java_generate_equals_and_hash: bool option; java_string_check_utf8: bool; optimize_for: FileOptions.OptimizeMode.t; go_package: string option; cc_generic_services: bool; java_generic_services: bool; py_generic_services: bool; php_generic_services: bool; deprecated: bool; cc_enable_arenas: bool; objc_class_prefix: string option; csharp_namespace: string option; swift_prefix: string option; php_class_prefix: string option; php_namespace: string option; php_metadata_namespace: string option; ruby_package: string option; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { java_package: string option; java_outer_classname: string option; java_multiple_files: bool; java_generate_equals_and_hash: bool option; java_string_check_utf8: bool; optimize_for: FileOptions.OptimizeMode.t; go_package: string option; cc_generic_services: bool; java_generic_services: bool; py_generic_services: bool; php_generic_services: bool; deprecated: bool; cc_enable_arenas: bool; objc_class_prefix: string option; csharp_namespace: string option; swift_prefix: string option; php_class_prefix: string option; php_namespace: string option; php_metadata_namespace: string option; ruby_package: string option; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } val make : ?java_package:string -> ?java_outer_classname:string -> ?java_multiple_files:bool -> ?java_generate_equals_and_hash:bool -> ?java_string_check_utf8:bool -> ?optimize_for:FileOptions.OptimizeMode.t -> ?go_package:string -> ?cc_generic_services:bool -> ?java_generic_services:bool -> ?py_generic_services:bool -> ?php_generic_services:bool -> ?deprecated:bool -> ?cc_enable_arenas:bool -> ?objc_class_prefix:string -> ?csharp_namespace:string -> ?swift_prefix:string -> ?php_class_prefix:string -> ?php_namespace:string -> ?php_metadata_namespace:string -> ?ruby_package:string -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t - end = struct + end = struct module rec OptimizeMode : sig - type t = SPEED | CODE_SIZE | LITE_RUNTIME + type t = SPEED | CODE_SIZE | LITE_RUNTIME val to_int: t -> int val from_int: int -> t Runtime'.Result.t val from_int_exn: int -> t - end = struct - type t = SPEED | CODE_SIZE | LITE_RUNTIME + end = struct + type t = SPEED | CODE_SIZE | LITE_RUNTIME let to_int = function | SPEED -> 1 | CODE_SIZE -> 2 | LITE_RUNTIME -> 3 - + let from_int_exn = function | 1 -> SPEED | 2 -> CODE_SIZE | 3 -> LITE_RUNTIME | n -> Runtime'.Result.raise (`Unknown_enum_value n) - + let from_int e = Runtime'.Result.catch (fun () -> from_int_exn e) end let name' () = "descriptor.google.protobuf.FileOptions" type t = { java_package: string option; java_outer_classname: string option; java_multiple_files: bool; java_generate_equals_and_hash: bool option; java_string_check_utf8: bool; optimize_for: FileOptions.OptimizeMode.t; go_package: string option; cc_generic_services: bool; java_generic_services: bool; py_generic_services: bool; php_generic_services: bool; deprecated: bool; cc_enable_arenas: bool; objc_class_prefix: string option; csharp_namespace: string option; swift_prefix: string option; php_class_prefix: string option; php_namespace: string option; php_metadata_namespace: string option; ruby_package: string option; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } let make = - fun ?java_package ?java_outer_classname ?java_multiple_files ?java_generate_equals_and_hash ?java_string_check_utf8 ?optimize_for ?go_package ?cc_generic_services ?java_generic_services ?py_generic_services ?php_generic_services ?deprecated ?cc_enable_arenas ?objc_class_prefix ?csharp_namespace ?swift_prefix ?php_class_prefix ?php_namespace ?php_metadata_namespace ?ruby_package ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> + fun ?java_package ?java_outer_classname ?java_multiple_files ?java_generate_equals_and_hash ?java_string_check_utf8 ?optimize_for ?go_package ?cc_generic_services ?java_generic_services ?py_generic_services ?php_generic_services ?deprecated ?cc_enable_arenas ?objc_class_prefix ?csharp_namespace ?swift_prefix ?php_class_prefix ?php_namespace ?php_metadata_namespace ?ruby_package ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> let java_multiple_files = match java_multiple_files with Some v -> v | None -> false in let java_string_check_utf8 = match java_string_check_utf8 with Some v -> v | None -> false in let optimize_for = match optimize_for with Some v -> v | None -> FileOptions.OptimizeMode.SPEED in @@ -568,117 +568,117 @@ module Google = struct let cc_enable_arenas = match cc_enable_arenas with Some v -> v | None -> true in let uninterpreted_option = match uninterpreted_option with Some v -> v | None -> [] in { java_package; java_outer_classname; java_multiple_files; java_generate_equals_and_hash; java_string_check_utf8; optimize_for; go_package; cc_generic_services; java_generic_services; py_generic_services; php_generic_services; deprecated; cc_enable_arenas; objc_class_prefix; csharp_namespace; swift_prefix; php_class_prefix; php_namespace; php_metadata_namespace; ruby_package; uninterpreted_option; extensions' } - + let to_proto = let apply = fun ~f:f' { java_package; java_outer_classname; java_multiple_files; java_generate_equals_and_hash; java_string_check_utf8; optimize_for; go_package; cc_generic_services; java_generic_services; py_generic_services; php_generic_services; deprecated; cc_enable_arenas; objc_class_prefix; csharp_namespace; swift_prefix; php_class_prefix; php_namespace; php_metadata_namespace; ruby_package; uninterpreted_option; extensions' } -> f' extensions' java_package java_outer_classname java_multiple_files java_generate_equals_and_hash java_string_check_utf8 optimize_for go_package cc_generic_services java_generic_services py_generic_services php_generic_services deprecated cc_enable_arenas objc_class_prefix csharp_namespace swift_prefix php_class_prefix php_namespace php_metadata_namespace ruby_package uninterpreted_option in let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (8, string) ^:: basic (10, bool, proto2 (false)) ^:: basic_opt (20, bool) ^:: basic (27, bool, proto2 (false)) ^:: basic (9, (enum FileOptions.OptimizeMode.to_int), proto2 (FileOptions.OptimizeMode.SPEED)) ^:: basic_opt (11, string) ^:: basic (16, bool, proto2 (false)) ^:: basic (17, bool, proto2 (false)) ^:: basic (18, bool, proto2 (false)) ^:: basic (42, bool, proto2 (false)) ^:: basic (23, bool, proto2 (false)) ^:: basic (31, bool, proto2 (true)) ^:: basic_opt (36, string) ^:: basic_opt (37, string) ^:: basic_opt (39, string) ^:: basic_opt (40, string) ^:: basic_opt (41, string) ^:: basic_opt (44, string) ^:: basic_opt (45, string) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] (spec) in fun t -> apply ~f:serialize t - + let from_proto_exn = let constructor = fun extensions' java_package java_outer_classname java_multiple_files java_generate_equals_and_hash java_string_check_utf8 optimize_for go_package cc_generic_services java_generic_services py_generic_services php_generic_services deprecated cc_enable_arenas objc_class_prefix csharp_namespace swift_prefix php_class_prefix php_namespace php_metadata_namespace ruby_package uninterpreted_option -> { java_package; java_outer_classname; java_multiple_files; java_generate_equals_and_hash; java_string_check_utf8; optimize_for; go_package; cc_generic_services; java_generic_services; py_generic_services; php_generic_services; deprecated; cc_enable_arenas; objc_class_prefix; csharp_namespace; swift_prefix; php_class_prefix; php_namespace; php_metadata_namespace; ruby_package; uninterpreted_option; extensions' } in let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (8, string) ^:: basic (10, bool, proto2 (false)) ^:: basic_opt (20, bool) ^:: basic (27, bool, proto2 (false)) ^:: basic (9, (enum FileOptions.OptimizeMode.from_int_exn), proto2 (FileOptions.OptimizeMode.SPEED)) ^:: basic_opt (11, string) ^:: basic (16, bool, proto2 (false)) ^:: basic (17, bool, proto2 (false)) ^:: basic (18, bool, proto2 (false)) ^:: basic (42, bool, proto2 (false)) ^:: basic (23, bool, proto2 (false)) ^:: basic (31, bool, proto2 (true)) ^:: basic_opt (36, string) ^:: basic_opt (37, string) ^:: basic_opt (39, string) ^:: basic_opt (40, string) ^:: basic_opt (41, string) ^:: basic_opt (44, string) ^:: basic_opt (45, string) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) - + end and MessageOptions : sig val name': unit -> string - type t = { message_set_wire_format: bool; no_standard_descriptor_accessor: bool; deprecated: bool; map_entry: bool option; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { message_set_wire_format: bool; no_standard_descriptor_accessor: bool; deprecated: bool; map_entry: bool option; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } val make : ?message_set_wire_format:bool -> ?no_standard_descriptor_accessor:bool -> ?deprecated:bool -> ?map_entry:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t - end = struct + end = struct let name' () = "descriptor.google.protobuf.MessageOptions" type t = { message_set_wire_format: bool; no_standard_descriptor_accessor: bool; deprecated: bool; map_entry: bool option; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } let make = - fun ?message_set_wire_format ?no_standard_descriptor_accessor ?deprecated ?map_entry ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> + fun ?message_set_wire_format ?no_standard_descriptor_accessor ?deprecated ?map_entry ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> let message_set_wire_format = match message_set_wire_format with Some v -> v | None -> false in let no_standard_descriptor_accessor = match no_standard_descriptor_accessor with Some v -> v | None -> false in let deprecated = match deprecated with Some v -> v | None -> false in let uninterpreted_option = match uninterpreted_option with Some v -> v | None -> [] in { message_set_wire_format; no_standard_descriptor_accessor; deprecated; map_entry; uninterpreted_option; extensions' } - + let to_proto = let apply = fun ~f:f' { message_set_wire_format; no_standard_descriptor_accessor; deprecated; map_entry; uninterpreted_option; extensions' } -> f' extensions' message_set_wire_format no_standard_descriptor_accessor deprecated map_entry uninterpreted_option in let spec = Runtime'.Serialize.C.( basic (1, bool, proto2 (false)) ^:: basic (2, bool, proto2 (false)) ^:: basic (3, bool, proto2 (false)) ^:: basic_opt (7, bool) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] (spec) in fun t -> apply ~f:serialize t - + let from_proto_exn = let constructor = fun extensions' message_set_wire_format no_standard_descriptor_accessor deprecated map_entry uninterpreted_option -> { message_set_wire_format; no_standard_descriptor_accessor; deprecated; map_entry; uninterpreted_option; extensions' } in let spec = Runtime'.Deserialize.C.( basic (1, bool, proto2 (false)) ^:: basic (2, bool, proto2 (false)) ^:: basic (3, bool, proto2 (false)) ^:: basic_opt (7, bool) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) - + end and FieldOptions : sig module rec CType : sig - type t = STRING | CORD | STRING_PIECE + type t = STRING | CORD | STRING_PIECE val to_int: t -> int val from_int: int -> t Runtime'.Result.t val from_int_exn: int -> t end and JSType : sig - type t = JS_NORMAL | JS_STRING | JS_NUMBER + type t = JS_NORMAL | JS_STRING | JS_NUMBER val to_int: t -> int val from_int: int -> t Runtime'.Result.t val from_int_exn: int -> t end val name': unit -> string - type t = { ctype: FieldOptions.CType.t; packed: bool option; jstype: FieldOptions.JSType.t; lazy': bool; unverified_lazy: bool; deprecated: bool; weak: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { ctype: FieldOptions.CType.t; packed: bool option; jstype: FieldOptions.JSType.t; lazy': bool; unverified_lazy: bool; deprecated: bool; weak: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } val make : ?ctype:FieldOptions.CType.t -> ?packed:bool -> ?jstype:FieldOptions.JSType.t -> ?lazy':bool -> ?unverified_lazy:bool -> ?deprecated:bool -> ?weak:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t - end = struct + end = struct module rec CType : sig - type t = STRING | CORD | STRING_PIECE + type t = STRING | CORD | STRING_PIECE val to_int: t -> int val from_int: int -> t Runtime'.Result.t val from_int_exn: int -> t - end = struct - type t = STRING | CORD | STRING_PIECE + end = struct + type t = STRING | CORD | STRING_PIECE let to_int = function | STRING -> 0 | CORD -> 1 | STRING_PIECE -> 2 - + let from_int_exn = function | 0 -> STRING | 1 -> CORD | 2 -> STRING_PIECE | n -> Runtime'.Result.raise (`Unknown_enum_value n) - + let from_int e = Runtime'.Result.catch (fun () -> from_int_exn e) end and JSType : sig - type t = JS_NORMAL | JS_STRING | JS_NUMBER + type t = JS_NORMAL | JS_STRING | JS_NUMBER val to_int: t -> int val from_int: int -> t Runtime'.Result.t val from_int_exn: int -> t - end = struct - type t = JS_NORMAL | JS_STRING | JS_NUMBER + end = struct + type t = JS_NORMAL | JS_STRING | JS_NUMBER let to_int = function | JS_NORMAL -> 0 | JS_STRING -> 1 | JS_NUMBER -> 2 - + let from_int_exn = function | 0 -> JS_NORMAL | 1 -> JS_STRING | 2 -> JS_NUMBER | n -> Runtime'.Result.raise (`Unknown_enum_value n) - + let from_int e = Runtime'.Result.catch (fun () -> from_int_exn e) end let name' () = "descriptor.google.protobuf.FieldOptions" type t = { ctype: FieldOptions.CType.t; packed: bool option; jstype: FieldOptions.JSType.t; lazy': bool; unverified_lazy: bool; deprecated: bool; weak: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } let make = - fun ?ctype ?packed ?jstype ?lazy' ?unverified_lazy ?deprecated ?weak ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> + fun ?ctype ?packed ?jstype ?lazy' ?unverified_lazy ?deprecated ?weak ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> let ctype = match ctype with Some v -> v | None -> FieldOptions.CType.STRING in let jstype = match jstype with Some v -> v | None -> FieldOptions.JSType.JS_NORMAL in let lazy' = match lazy' with Some v -> v | None -> false in @@ -687,396 +687,396 @@ module Google = struct let weak = match weak with Some v -> v | None -> false in let uninterpreted_option = match uninterpreted_option with Some v -> v | None -> [] in { ctype; packed; jstype; lazy'; unverified_lazy; deprecated; weak; uninterpreted_option; extensions' } - + let to_proto = let apply = fun ~f:f' { ctype; packed; jstype; lazy'; unverified_lazy; deprecated; weak; uninterpreted_option; extensions' } -> f' extensions' ctype packed jstype lazy' unverified_lazy deprecated weak uninterpreted_option in let spec = Runtime'.Serialize.C.( basic (1, (enum FieldOptions.CType.to_int), proto2 (FieldOptions.CType.STRING)) ^:: basic_opt (2, bool) ^:: basic (6, (enum FieldOptions.JSType.to_int), proto2 (FieldOptions.JSType.JS_NORMAL)) ^:: basic (5, bool, proto2 (false)) ^:: basic (15, bool, proto2 (false)) ^:: basic (3, bool, proto2 (false)) ^:: basic (10, bool, proto2 (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] (spec) in fun t -> apply ~f:serialize t - + let from_proto_exn = let constructor = fun extensions' ctype packed jstype lazy' unverified_lazy deprecated weak uninterpreted_option -> { ctype; packed; jstype; lazy'; unverified_lazy; deprecated; weak; uninterpreted_option; extensions' } in let spec = Runtime'.Deserialize.C.( basic (1, (enum FieldOptions.CType.from_int_exn), proto2 (FieldOptions.CType.STRING)) ^:: basic_opt (2, bool) ^:: basic (6, (enum FieldOptions.JSType.from_int_exn), proto2 (FieldOptions.JSType.JS_NORMAL)) ^:: basic (5, bool, proto2 (false)) ^:: basic (15, bool, proto2 (false)) ^:: basic (3, bool, proto2 (false)) ^:: basic (10, bool, proto2 (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) - + end and OneofOptions : sig val name': unit -> string - type t = { uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } val make : ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t - end = struct + end = struct let name' () = "descriptor.google.protobuf.OneofOptions" type t = { uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } let make = - fun ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> + fun ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> let uninterpreted_option = match uninterpreted_option with Some v -> v | None -> [] in { uninterpreted_option; extensions' } - + let to_proto = let apply = fun ~f:f' { uninterpreted_option; extensions' } -> f' extensions' uninterpreted_option in let spec = Runtime'.Serialize.C.( repeated (999, (message (fun t -> UninterpretedOption.to_proto t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] (spec) in fun t -> apply ~f:serialize t - + let from_proto_exn = let constructor = fun extensions' uninterpreted_option -> { uninterpreted_option; extensions' } in let spec = Runtime'.Deserialize.C.( repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) - + end and EnumOptions : sig val name': unit -> string - type t = { allow_alias: bool option; deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { allow_alias: bool option; deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } val make : ?allow_alias:bool -> ?deprecated:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t - end = struct + end = struct let name' () = "descriptor.google.protobuf.EnumOptions" type t = { allow_alias: bool option; deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } let make = - fun ?allow_alias ?deprecated ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> + fun ?allow_alias ?deprecated ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> let deprecated = match deprecated with Some v -> v | None -> false in let uninterpreted_option = match uninterpreted_option with Some v -> v | None -> [] in { allow_alias; deprecated; uninterpreted_option; extensions' } - + let to_proto = let apply = fun ~f:f' { allow_alias; deprecated; uninterpreted_option; extensions' } -> f' extensions' allow_alias deprecated uninterpreted_option in let spec = Runtime'.Serialize.C.( basic_opt (2, bool) ^:: basic (3, bool, proto2 (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] (spec) in fun t -> apply ~f:serialize t - + let from_proto_exn = let constructor = fun extensions' allow_alias deprecated uninterpreted_option -> { allow_alias; deprecated; uninterpreted_option; extensions' } in let spec = Runtime'.Deserialize.C.( basic_opt (2, bool) ^:: basic (3, bool, proto2 (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) - + end and EnumValueOptions : sig val name': unit -> string - type t = { deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } val make : ?deprecated:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t - end = struct + end = struct let name' () = "descriptor.google.protobuf.EnumValueOptions" type t = { deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } let make = - fun ?deprecated ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> + fun ?deprecated ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> let deprecated = match deprecated with Some v -> v | None -> false in let uninterpreted_option = match uninterpreted_option with Some v -> v | None -> [] in { deprecated; uninterpreted_option; extensions' } - + let to_proto = let apply = fun ~f:f' { deprecated; uninterpreted_option; extensions' } -> f' extensions' deprecated uninterpreted_option in let spec = Runtime'.Serialize.C.( basic (1, bool, proto2 (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] (spec) in fun t -> apply ~f:serialize t - + let from_proto_exn = let constructor = fun extensions' deprecated uninterpreted_option -> { deprecated; uninterpreted_option; extensions' } in let spec = Runtime'.Deserialize.C.( basic (1, bool, proto2 (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) - + end and ServiceOptions : sig val name': unit -> string - type t = { deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } val make : ?deprecated:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t - end = struct + end = struct let name' () = "descriptor.google.protobuf.ServiceOptions" type t = { deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } let make = - fun ?deprecated ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> + fun ?deprecated ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> let deprecated = match deprecated with Some v -> v | None -> false in let uninterpreted_option = match uninterpreted_option with Some v -> v | None -> [] in { deprecated; uninterpreted_option; extensions' } - + let to_proto = let apply = fun ~f:f' { deprecated; uninterpreted_option; extensions' } -> f' extensions' deprecated uninterpreted_option in let spec = Runtime'.Serialize.C.( basic (33, bool, proto2 (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] (spec) in fun t -> apply ~f:serialize t - + let from_proto_exn = let constructor = fun extensions' deprecated uninterpreted_option -> { deprecated; uninterpreted_option; extensions' } in let spec = Runtime'.Deserialize.C.( basic (33, bool, proto2 (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) - + end and MethodOptions : sig module rec IdempotencyLevel : sig - type t = IDEMPOTENCY_UNKNOWN | NO_SIDE_EFFECTS | IDEMPOTENT + type t = IDEMPOTENCY_UNKNOWN | NO_SIDE_EFFECTS | IDEMPOTENT val to_int: t -> int val from_int: int -> t Runtime'.Result.t val from_int_exn: int -> t end val name': unit -> string - type t = { deprecated: bool; idempotency_level: MethodOptions.IdempotencyLevel.t; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { deprecated: bool; idempotency_level: MethodOptions.IdempotencyLevel.t; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } val make : ?deprecated:bool -> ?idempotency_level:MethodOptions.IdempotencyLevel.t -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t - end = struct + end = struct module rec IdempotencyLevel : sig - type t = IDEMPOTENCY_UNKNOWN | NO_SIDE_EFFECTS | IDEMPOTENT + type t = IDEMPOTENCY_UNKNOWN | NO_SIDE_EFFECTS | IDEMPOTENT val to_int: t -> int val from_int: int -> t Runtime'.Result.t val from_int_exn: int -> t - end = struct - type t = IDEMPOTENCY_UNKNOWN | NO_SIDE_EFFECTS | IDEMPOTENT + end = struct + type t = IDEMPOTENCY_UNKNOWN | NO_SIDE_EFFECTS | IDEMPOTENT let to_int = function | IDEMPOTENCY_UNKNOWN -> 0 | NO_SIDE_EFFECTS -> 1 | IDEMPOTENT -> 2 - + let from_int_exn = function | 0 -> IDEMPOTENCY_UNKNOWN | 1 -> NO_SIDE_EFFECTS | 2 -> IDEMPOTENT | n -> Runtime'.Result.raise (`Unknown_enum_value n) - + let from_int e = Runtime'.Result.catch (fun () -> from_int_exn e) end let name' () = "descriptor.google.protobuf.MethodOptions" type t = { deprecated: bool; idempotency_level: MethodOptions.IdempotencyLevel.t; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } let make = - fun ?deprecated ?idempotency_level ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> + fun ?deprecated ?idempotency_level ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> let deprecated = match deprecated with Some v -> v | None -> false in let idempotency_level = match idempotency_level with Some v -> v | None -> MethodOptions.IdempotencyLevel.IDEMPOTENCY_UNKNOWN in let uninterpreted_option = match uninterpreted_option with Some v -> v | None -> [] in { deprecated; idempotency_level; uninterpreted_option; extensions' } - + let to_proto = let apply = fun ~f:f' { deprecated; idempotency_level; uninterpreted_option; extensions' } -> f' extensions' deprecated idempotency_level uninterpreted_option in let spec = Runtime'.Serialize.C.( basic (33, bool, proto2 (false)) ^:: basic (34, (enum MethodOptions.IdempotencyLevel.to_int), proto2 (MethodOptions.IdempotencyLevel.IDEMPOTENCY_UNKNOWN)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] (spec) in fun t -> apply ~f:serialize t - + let from_proto_exn = let constructor = fun extensions' deprecated idempotency_level uninterpreted_option -> { deprecated; idempotency_level; uninterpreted_option; extensions' } in let spec = Runtime'.Deserialize.C.( basic (33, bool, proto2 (false)) ^:: basic (34, (enum MethodOptions.IdempotencyLevel.from_int_exn), proto2 (MethodOptions.IdempotencyLevel.IDEMPOTENCY_UNKNOWN)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) - + end and UninterpretedOption : sig module rec NamePart : sig val name': unit -> string - type t = { name_part: string; is_extension: bool } + type t = { name_part: string; is_extension: bool } val make : name_part:string -> is_extension:bool -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t end val name': unit -> string - type t = { name: UninterpretedOption.NamePart.t list; identifier_value: string option; positive_int_value: int option; negative_int_value: int option; double_value: float option; string_value: bytes option; aggregate_value: string option } + type t = { name: UninterpretedOption.NamePart.t list; identifier_value: string option; positive_int_value: int option; negative_int_value: int option; double_value: float option; string_value: bytes option; aggregate_value: string option } val make : ?name:UninterpretedOption.NamePart.t list -> ?identifier_value:string -> ?positive_int_value:int -> ?negative_int_value:int -> ?double_value:float -> ?string_value:bytes -> ?aggregate_value:string -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t - end = struct + end = struct module rec NamePart : sig val name': unit -> string - type t = { name_part: string; is_extension: bool } + type t = { name_part: string; is_extension: bool } val make : name_part:string -> is_extension:bool -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t - end = struct + end = struct let name' () = "descriptor.google.protobuf.UninterpretedOption.NamePart" type t = { name_part: string; is_extension: bool } let make = - fun ~name_part ~is_extension () -> - + fun ~name_part ~is_extension () -> + { name_part; is_extension } - + let to_proto = let apply = fun ~f:f' { name_part; is_extension } -> f' [] name_part is_extension in let spec = Runtime'.Serialize.C.( basic (1, string, required) ^:: basic (2, bool, required) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - + let from_proto_exn = let constructor = fun _extensions name_part is_extension -> { name_part; is_extension } in let spec = Runtime'.Deserialize.C.( basic (1, string, required) ^:: basic (2, bool, required) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) - + end let name' () = "descriptor.google.protobuf.UninterpretedOption" type t = { name: UninterpretedOption.NamePart.t list; identifier_value: string option; positive_int_value: int option; negative_int_value: int option; double_value: float option; string_value: bytes option; aggregate_value: string option } let make = - fun ?name ?identifier_value ?positive_int_value ?negative_int_value ?double_value ?string_value ?aggregate_value () -> + fun ?name ?identifier_value ?positive_int_value ?negative_int_value ?double_value ?string_value ?aggregate_value () -> let name = match name with Some v -> v | None -> [] in { name; identifier_value; positive_int_value; negative_int_value; double_value; string_value; aggregate_value } - + let to_proto = let apply = fun ~f:f' { name; identifier_value; positive_int_value; negative_int_value; double_value; string_value; aggregate_value } -> f' [] name identifier_value positive_int_value negative_int_value double_value string_value aggregate_value in let spec = Runtime'.Serialize.C.( repeated (2, (message (fun t -> UninterpretedOption.NamePart.to_proto t)), not_packed) ^:: basic_opt (3, string) ^:: basic_opt (4, uint64_int) ^:: basic_opt (5, int64_int) ^:: basic_opt (6, double) ^:: basic_opt (7, bytes) ^:: basic_opt (8, string) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - + let from_proto_exn = let constructor = fun _extensions name identifier_value positive_int_value negative_int_value double_value string_value aggregate_value -> { name; identifier_value; positive_int_value; negative_int_value; double_value; string_value; aggregate_value } in let spec = Runtime'.Deserialize.C.( repeated (2, (message (fun t -> UninterpretedOption.NamePart.from_proto_exn t)), not_packed) ^:: basic_opt (3, string) ^:: basic_opt (4, uint64_int) ^:: basic_opt (5, int64_int) ^:: basic_opt (6, double) ^:: basic_opt (7, bytes) ^:: basic_opt (8, string) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) - + end and SourceCodeInfo : sig module rec Location : sig val name': unit -> string - type t = { path: int list; span: int list; leading_comments: string option; trailing_comments: string option; leading_detached_comments: string list } + type t = { path: int list; span: int list; leading_comments: string option; trailing_comments: string option; leading_detached_comments: string list } val make : ?path:int list -> ?span:int list -> ?leading_comments:string -> ?trailing_comments:string -> ?leading_detached_comments:string list -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t end val name': unit -> string - type t = SourceCodeInfo.Location.t list + type t = SourceCodeInfo.Location.t list val make : ?location:SourceCodeInfo.Location.t list -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t - end = struct + end = struct module rec Location : sig val name': unit -> string - type t = { path: int list; span: int list; leading_comments: string option; trailing_comments: string option; leading_detached_comments: string list } + type t = { path: int list; span: int list; leading_comments: string option; trailing_comments: string option; leading_detached_comments: string list } val make : ?path:int list -> ?span:int list -> ?leading_comments:string -> ?trailing_comments:string -> ?leading_detached_comments:string list -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t - end = struct + end = struct let name' () = "descriptor.google.protobuf.SourceCodeInfo.Location" type t = { path: int list; span: int list; leading_comments: string option; trailing_comments: string option; leading_detached_comments: string list } let make = - fun ?path ?span ?leading_comments ?trailing_comments ?leading_detached_comments () -> + fun ?path ?span ?leading_comments ?trailing_comments ?leading_detached_comments () -> let path = match path with Some v -> v | None -> [] in let span = match span with Some v -> v | None -> [] in let leading_detached_comments = match leading_detached_comments with Some v -> v | None -> [] in { path; span; leading_comments; trailing_comments; leading_detached_comments } - + let to_proto = let apply = fun ~f:f' { path; span; leading_comments; trailing_comments; leading_detached_comments } -> f' [] path span leading_comments trailing_comments leading_detached_comments in let spec = Runtime'.Serialize.C.( repeated (1, int32_int, packed) ^:: repeated (2, int32_int, packed) ^:: basic_opt (3, string) ^:: basic_opt (4, string) ^:: repeated (6, string, not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - + let from_proto_exn = let constructor = fun _extensions path span leading_comments trailing_comments leading_detached_comments -> { path; span; leading_comments; trailing_comments; leading_detached_comments } in let spec = Runtime'.Deserialize.C.( repeated (1, int32_int, packed) ^:: repeated (2, int32_int, packed) ^:: basic_opt (3, string) ^:: basic_opt (4, string) ^:: repeated (6, string, not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) - + end let name' () = "descriptor.google.protobuf.SourceCodeInfo" type t = SourceCodeInfo.Location.t list let make = - fun ?location () -> + fun ?location () -> let location = match location with Some v -> v | None -> [] in location - + let to_proto = let apply = fun ~f:f' location -> f' [] location in let spec = Runtime'.Serialize.C.( repeated (1, (message (fun t -> SourceCodeInfo.Location.to_proto t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - + let from_proto_exn = let constructor = fun _extensions location -> location in let spec = Runtime'.Deserialize.C.( repeated (1, (message (fun t -> SourceCodeInfo.Location.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) - + end and GeneratedCodeInfo : sig module rec Annotation : sig val name': unit -> string - type t = { path: int list; source_file: string option; begin': int option; end': int option } + type t = { path: int list; source_file: string option; begin': int option; end': int option } val make : ?path:int list -> ?source_file:string -> ?begin':int -> ?end':int -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t end val name': unit -> string - type t = GeneratedCodeInfo.Annotation.t list + type t = GeneratedCodeInfo.Annotation.t list val make : ?annotation:GeneratedCodeInfo.Annotation.t list -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t - end = struct + end = struct module rec Annotation : sig val name': unit -> string - type t = { path: int list; source_file: string option; begin': int option; end': int option } + type t = { path: int list; source_file: string option; begin': int option; end': int option } val make : ?path:int list -> ?source_file:string -> ?begin':int -> ?end':int -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t - end = struct + end = struct let name' () = "descriptor.google.protobuf.GeneratedCodeInfo.Annotation" type t = { path: int list; source_file: string option; begin': int option; end': int option } let make = - fun ?path ?source_file ?begin' ?end' () -> + fun ?path ?source_file ?begin' ?end' () -> let path = match path with Some v -> v | None -> [] in { path; source_file; begin'; end' } - + let to_proto = let apply = fun ~f:f' { path; source_file; begin'; end' } -> f' [] path source_file begin' end' in let spec = Runtime'.Serialize.C.( repeated (1, int32_int, packed) ^:: basic_opt (2, string) ^:: basic_opt (3, int32_int) ^:: basic_opt (4, int32_int) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - + let from_proto_exn = let constructor = fun _extensions path source_file begin' end' -> { path; source_file; begin'; end' } in let spec = Runtime'.Deserialize.C.( repeated (1, int32_int, packed) ^:: basic_opt (2, string) ^:: basic_opt (3, int32_int) ^:: basic_opt (4, int32_int) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) - + end let name' () = "descriptor.google.protobuf.GeneratedCodeInfo" type t = GeneratedCodeInfo.Annotation.t list let make = - fun ?annotation () -> + fun ?annotation () -> let annotation = match annotation with Some v -> v | None -> [] in annotation - + let to_proto = let apply = fun ~f:f' annotation -> f' [] annotation in let spec = Runtime'.Serialize.C.( repeated (1, (message (fun t -> GeneratedCodeInfo.Annotation.to_proto t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - + let from_proto_exn = let constructor = fun _extensions annotation -> annotation in let spec = Runtime'.Deserialize.C.( repeated (1, (message (fun t -> GeneratedCodeInfo.Annotation.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) - + end end end \ No newline at end of file diff --git a/src/spec/options.ml b/src/spec/options.ml index 7028b65..2f53a4f 100644 --- a/src/spec/options.ml +++ b/src/spec/options.ml @@ -25,44 +25,44 @@ end (**/**) module rec Options : sig val name': unit -> string - type t = bool + type t = bool val make : ?mangle_names:bool -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t -end = struct +end = struct let name' () = "options.Options" type t = bool let make = - fun ?mangle_names () -> + fun ?mangle_names () -> let mangle_names = match mangle_names with Some v -> v | None -> false in mangle_names - + let to_proto = let apply = fun ~f:f' mangle_names -> f' [] mangle_names in let spec = Runtime'.Serialize.C.( basic (1, bool, proto3) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - + let from_proto_exn = let constructor = fun _extensions mangle_names -> mangle_names in let spec = Runtime'.Deserialize.C.( basic (1, bool, proto3) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) - + end and Ocaml_options : sig - type t = Options.t option + type t = Options.t option val get_exn: Imported'modules.Descriptor.Google.Protobuf.FileOptions.t -> Options.t option val get: Imported'modules.Descriptor.Google.Protobuf.FileOptions.t -> (Options.t option, [> Runtime'.Result.error]) result val set: Imported'modules.Descriptor.Google.Protobuf.FileOptions.t -> Options.t option -> Imported'modules.Descriptor.Google.Protobuf.FileOptions.t -end = struct - type t = Options.t option +end = struct + type t = Options.t option let get_exn extendee = Runtime'.Extensions.get Runtime'.Deserialize.C.( basic_opt (1074, (message (fun t -> Options.from_proto_exn t))) ^:: nil ) (extendee.Imported'modules.Descriptor.Google.Protobuf.FileOptions.extensions') let get extendee = Runtime'.Result.catch (fun () -> get_exn extendee) let set extendee t = let extensions' = Runtime'.Extensions.set (Runtime'.Serialize.C.( basic_opt (1074, (message (fun t -> Options.to_proto t))) ^:: nil )) (extendee.Imported'modules.Descriptor.Google.Protobuf.FileOptions.extensions') t in { extendee with Imported'modules.Descriptor.Google.Protobuf.FileOptions.extensions' = extensions' } - + end \ No newline at end of file diff --git a/src/spec/plugin.ml b/src/spec/plugin.ml index c861d59..daed7a3 100644 --- a/src/spec/plugin.ml +++ b/src/spec/plugin.ml @@ -28,152 +28,152 @@ module Google = struct module Compiler = struct module rec Version : sig val name': unit -> string - type t = { major: int option; minor: int option; patch: int option; suffix: string option } + type t = { major: int option; minor: int option; patch: int option; suffix: string option } val make : ?major:int -> ?minor:int -> ?patch:int -> ?suffix:string -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t - end = struct + end = struct let name' () = "plugin.google.protobuf.compiler.Version" type t = { major: int option; minor: int option; patch: int option; suffix: string option } let make = - fun ?major ?minor ?patch ?suffix () -> - + fun ?major ?minor ?patch ?suffix () -> + { major; minor; patch; suffix } - + let to_proto = let apply = fun ~f:f' { major; minor; patch; suffix } -> f' [] major minor patch suffix in let spec = Runtime'.Serialize.C.( basic_opt (1, int32_int) ^:: basic_opt (2, int32_int) ^:: basic_opt (3, int32_int) ^:: basic_opt (4, string) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - + let from_proto_exn = let constructor = fun _extensions major minor patch suffix -> { major; minor; patch; suffix } in let spec = Runtime'.Deserialize.C.( basic_opt (1, int32_int) ^:: basic_opt (2, int32_int) ^:: basic_opt (3, int32_int) ^:: basic_opt (4, string) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) - + end and CodeGeneratorRequest : sig val name': unit -> string - type t = { file_to_generate: string list; parameter: string option; proto_file: Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list; compiler_version: Version.t option } + type t = { file_to_generate: string list; parameter: string option; proto_file: Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list; compiler_version: Version.t option } val make : ?file_to_generate:string list -> ?parameter:string -> ?proto_file:Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list -> ?compiler_version:Version.t -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t - end = struct + end = struct let name' () = "plugin.google.protobuf.compiler.CodeGeneratorRequest" type t = { file_to_generate: string list; parameter: string option; proto_file: Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list; compiler_version: Version.t option } let make = - fun ?file_to_generate ?parameter ?proto_file ?compiler_version () -> + fun ?file_to_generate ?parameter ?proto_file ?compiler_version () -> let file_to_generate = match file_to_generate with Some v -> v | None -> [] in let proto_file = match proto_file with Some v -> v | None -> [] in { file_to_generate; parameter; proto_file; compiler_version } - + let to_proto = let apply = fun ~f:f' { file_to_generate; parameter; proto_file; compiler_version } -> f' [] file_to_generate parameter proto_file compiler_version in let spec = Runtime'.Serialize.C.( repeated (1, string, not_packed) ^:: basic_opt (2, string) ^:: repeated (15, (message (fun t -> Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.to_proto t)), not_packed) ^:: basic_opt (3, (message (fun t -> Version.to_proto t))) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - + let from_proto_exn = let constructor = fun _extensions file_to_generate parameter proto_file compiler_version -> { file_to_generate; parameter; proto_file; compiler_version } in let spec = Runtime'.Deserialize.C.( repeated (1, string, not_packed) ^:: basic_opt (2, string) ^:: repeated (15, (message (fun t -> Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.from_proto_exn t)), not_packed) ^:: basic_opt (3, (message (fun t -> Version.from_proto_exn t))) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) - + end and CodeGeneratorResponse : sig module rec Feature : sig - type t = FEATURE_NONE | FEATURE_PROTO3_OPTIONAL + type t = FEATURE_NONE | FEATURE_PROTO3_OPTIONAL val to_int: t -> int val from_int: int -> t Runtime'.Result.t val from_int_exn: int -> t end and File : sig val name': unit -> string - type t = { name: string option; insertion_point: string option; content: string option; generated_code_info: Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.t option } + type t = { name: string option; insertion_point: string option; content: string option; generated_code_info: Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.t option } val make : ?name:string -> ?insertion_point:string -> ?content:string -> ?generated_code_info:Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.t -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t end val name': unit -> string - type t = { error: string option; supported_features: int option; file: CodeGeneratorResponse.File.t list } + type t = { error: string option; supported_features: int option; file: CodeGeneratorResponse.File.t list } val make : ?error:string -> ?supported_features:int -> ?file:CodeGeneratorResponse.File.t list -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t - end = struct + end = struct module rec Feature : sig - type t = FEATURE_NONE | FEATURE_PROTO3_OPTIONAL + type t = FEATURE_NONE | FEATURE_PROTO3_OPTIONAL val to_int: t -> int val from_int: int -> t Runtime'.Result.t val from_int_exn: int -> t - end = struct - type t = FEATURE_NONE | FEATURE_PROTO3_OPTIONAL + end = struct + type t = FEATURE_NONE | FEATURE_PROTO3_OPTIONAL let to_int = function | FEATURE_NONE -> 0 | FEATURE_PROTO3_OPTIONAL -> 1 - + let from_int_exn = function | 0 -> FEATURE_NONE | 1 -> FEATURE_PROTO3_OPTIONAL | n -> Runtime'.Result.raise (`Unknown_enum_value n) - + let from_int e = Runtime'.Result.catch (fun () -> from_int_exn e) end and File : sig val name': unit -> string - type t = { name: string option; insertion_point: string option; content: string option; generated_code_info: Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.t option } + type t = { name: string option; insertion_point: string option; content: string option; generated_code_info: Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.t option } val make : ?name:string -> ?insertion_point:string -> ?content:string -> ?generated_code_info:Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.t -> unit -> t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t - end = struct + end = struct let name' () = "plugin.google.protobuf.compiler.CodeGeneratorResponse.File" type t = { name: string option; insertion_point: string option; content: string option; generated_code_info: Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.t option } let make = - fun ?name ?insertion_point ?content ?generated_code_info () -> - + fun ?name ?insertion_point ?content ?generated_code_info () -> + { name; insertion_point; content; generated_code_info } - + let to_proto = let apply = fun ~f:f' { name; insertion_point; content; generated_code_info } -> f' [] name insertion_point content generated_code_info in let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (2, string) ^:: basic_opt (15, string) ^:: basic_opt (16, (message (fun t -> Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.to_proto t))) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - + let from_proto_exn = let constructor = fun _extensions name insertion_point content generated_code_info -> { name; insertion_point; content; generated_code_info } in let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (2, string) ^:: basic_opt (15, string) ^:: basic_opt (16, (message (fun t -> Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.from_proto_exn t))) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) - + end let name' () = "plugin.google.protobuf.compiler.CodeGeneratorResponse" type t = { error: string option; supported_features: int option; file: CodeGeneratorResponse.File.t list } let make = - fun ?error ?supported_features ?file () -> + fun ?error ?supported_features ?file () -> let file = match file with Some v -> v | None -> [] in { error; supported_features; file } - + let to_proto = let apply = fun ~f:f' { error; supported_features; file } -> f' [] error supported_features file in let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (2, uint64_int) ^:: repeated (15, (message (fun t -> CodeGeneratorResponse.File.to_proto t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] (spec) in fun t -> apply ~f:serialize t - + let from_proto_exn = let constructor = fun _extensions error supported_features file -> { error; supported_features; file } in let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (2, uint64_int) ^:: repeated (15, (message (fun t -> CodeGeneratorResponse.File.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) - + end end end From 7fd0910e409c7dfe73adc51c68d192d91e9ba8af Mon Sep 17 00:00:00 2001 From: Anders Fugmann Date: Sun, 31 Dec 2023 11:32:51 +0100 Subject: [PATCH 04/30] Remove unneeded anonymous functions, and introduce a Varint_unboxed to avoid int<->int64 conversions --- src/ocaml_protoc_plugin/field.ml | 5 ++ src/ocaml_protoc_plugin/reader.ml | 101 +++++++++++++++------------ src/ocaml_protoc_plugin/serialize.ml | 7 -- src/ocaml_protoc_plugin/writer.ml | 45 +++++++++--- 4 files changed, 96 insertions(+), 62 deletions(-) diff --git a/src/ocaml_protoc_plugin/field.ml b/src/ocaml_protoc_plugin/field.ml index b587cc7..b308f83 100644 --- a/src/ocaml_protoc_plugin/field.ml +++ b/src/ocaml_protoc_plugin/field.ml @@ -7,6 +7,7 @@ type t = data : string; } (* string, bytes, embedded messages, packed repeated fields *) | Fixed_32_bit of Int32.t (* fixed32, sfixed32, float *) + | Varint_unboxed of int let varint v = Varint v let fixed_32_bit v = Fixed_32_bit v @@ -18,6 +19,10 @@ let length_delimited ?(offset=0) ?length data = let pp: Format.formatter -> t -> unit = fun fmt -> function + | Varint_unboxed a0 -> + (Format.fprintf fmt "(@[<2>Field.Varint_unboxed@ "; + (Format.fprintf fmt "%d") a0; + Format.fprintf fmt "@])") | Varint a0 -> (Format.fprintf fmt "(@[<2>Field.Varint@ "; (Format.fprintf fmt "%LdL") a0; diff --git a/src/ocaml_protoc_plugin/reader.ml b/src/ocaml_protoc_plugin/reader.ml index 3bf4245..403f2a5 100644 --- a/src/ocaml_protoc_plugin/reader.ml +++ b/src/ocaml_protoc_plugin/reader.ml @@ -18,87 +18,96 @@ let create ?(offset = 0) ?length data = assert (String.length data >= end_offset); {offset; end_offset; data} -(** Return an error if there is not enough data in input *) +[@@inline] let validate_capacity t count = match t.offset + count <= t.end_offset with | true -> () | false -> Result.raise `Premature_end_of_input -(** Test if there is more data in the buffer to be read *) +[@@inline] let has_more t = t.offset < t.end_offset +[@@inline] let read_byte t = - validate_capacity t 1 |> fun () -> - let v = t.data.[t.offset] in - t.offset <- t.offset + 1; - (Char.code v) + validate_capacity t 1; + let v = String.get_uint8 t.data t.offset in + t.offset <- t.offset + 1; + v let read_raw_varint t = let open Infix.Int64 in - let rec inner acc = - read_byte t |> fun v -> - let v = Int64.of_int v in - let acc = (v land 0x7FL) :: acc in - match v > 127L with - | true -> - (* Still More data *) - inner acc - | false -> acc + let rec inner n acc = + let v = Int64.of_int (read_byte t) in + let v' = (v land 0x7FL) lsl n in + let acc = acc + v' in + match v > 127L with + | true -> + (* Still More data *) + inner (Int.add n 7) acc + | false -> acc in - inner [] |> - List.fold_left ~init:0L ~f:(fun acc c -> (acc lsl 7) + c) + inner 0 0L -let read_varint t = read_raw_varint t |> fun v -> Varint v +let read_raw_varint_unboxed t = + let rec inner n acc = + let v = read_byte t in + let v' = (v land 0x7F) lsl n in + let acc = acc + v' in + match v > 127 with + | true -> + (* Still More data *) + inner (n + 7) acc + | false -> acc + in + inner 0 0 -let read_field_header : t -> int * int = - fun t -> - let open Infix.Int64 in - read_raw_varint t |> fun v -> - let tpe = v land 0x7L |> Int64.to_int in - let field_number = v / 8L |> Int64.to_int in - (tpe, field_number) +[@@inline] +let read_varint t = Varint (read_raw_varint t) +let read_field_header : t -> int * int = fun t -> + let v = read_raw_varint_unboxed t in + let tpe = v land 0x7 in + let field_number = v / 8 in + (tpe, field_number) let read_length_delimited t = - read_raw_varint t |> fun length -> - let length = Int64.to_int length in - validate_capacity t length |> fun () -> - let v = Length_delimited {offset = t.offset; length; data = t.data} in - t.offset <- t.offset + length; - v + let length = read_raw_varint_unboxed t in + validate_capacity t length; + let v = Length_delimited {offset = t.offset; length; data = t.data} in + t.offset <- t.offset + length; + v (* Implement little endian ourselves *) let read_fixed32 t = let size = 4 in - validate_capacity t size |> fun () -> + validate_capacity t size; let v = Bytes.get_int32_le (Bytes.unsafe_of_string t.data) t.offset in t.offset <- t.offset + size; (Fixed_32_bit v) let read_fixed64 t = let size = 8 in - validate_capacity t size |> fun () -> + validate_capacity t size; let v = Bytes.get_int64_le (Bytes.unsafe_of_string t.data) t.offset in t.offset <- t.offset + size; (Fixed_64_bit v) -let read_field : t -> int * Field.t = - fun t -> - read_field_header t |> (fun (field_type, field_number) -> - (match field_type with - | 0 -> read_varint t - | 1 -> read_fixed64 t - | 2 -> read_length_delimited t - | 5 -> read_fixed32 t - | n -> Result.raise (`Unknown_field_type n)) - |> fun field -> (field_number, field) - ) +let read_field : t -> int * Field.t = fun t -> + let (field_type, field_number) = read_field_header t in + let field = match field_type with + | 0 -> read_varint t + | 1 -> read_fixed64 t + | 2 -> read_length_delimited t + | 5 -> read_fixed32 t + | n -> Result.raise (`Unknown_field_type n) + in + (field_number, field) + let to_list: t -> (int * Field.t) list = fun t -> let rec inner acc = match has_more t with - | true -> read_field t |> fun v -> - inner (v :: acc) + | true -> inner (read_field t :: acc) | false -> List.rev acc in inner [] diff --git a/src/ocaml_protoc_plugin/serialize.ml b/src/ocaml_protoc_plugin/serialize.ml index 6f415e9..83c3073 100644 --- a/src/ocaml_protoc_plugin/serialize.ml +++ b/src/ocaml_protoc_plugin/serialize.ml @@ -5,13 +5,6 @@ module S = Spec.Serialize module C = S.C open S -(* Take a list of fields and return a field *) -let serialize_message : (int * Field.t) list -> string = - fun fields -> - let writer = Writer.init () in - List.iter ~f:(fun (index, field) -> Writer.write_field writer index field) fields; - Writer.contents writer - let unsigned_varint v = Field.Varint v let signed_varint v = diff --git a/src/ocaml_protoc_plugin/writer.ml b/src/ocaml_protoc_plugin/writer.ml index 6df8823..d637f93 100644 --- a/src/ocaml_protoc_plugin/writer.ml +++ b/src/ocaml_protoc_plugin/writer.ml @@ -31,14 +31,25 @@ let init () = {fields = Nil; size = 0;} let rec size_of_field = function - | Varint v when v > 0L -> - let bits = int_of_float (log (Int64.to_float v) /. log 2.0) + 1 in - ((bits - 1) / 7) + 1 - | Varint v when v < 0L -> 10 - | Varint _ -> 1 + | Varint v -> begin + match v with + | v when v < 0L -> 10 + | 0L -> 1 + | v (* when v > 0L *) -> + let bits = int_of_float (log (Int64.to_float v) /. log 2.0) in + (bits / 7) + 1 + end + | Varint_unboxed v -> begin + match v with + | v when v < 0 -> 10 + | 0 -> 1 + | v (* when v > 0L *) -> + let bits = int_of_float (log (Int.to_float v) /. log 2.0) in + (bits / 7) + 1 + end | Fixed_32_bit _ -> 4 | Fixed_64_bit _ -> 8 - | Length_delimited {length; _} -> size_of_field (Varint (Int64.of_int length)) + length + | Length_delimited {length; _} -> size_of_field (Varint_unboxed length) + length let size t = t.size @@ -57,6 +68,20 @@ let write_varint buffer ~offset v = in inner ~offset v +let write_varint_unboxed buffer ~offset v = + let rec inner ~offset v : int = + let (++) = (+) in + match v land 0x7F, v lsr 7 with + | v, 0 -> + Bytes.set buffer offset (v |> Char.chr); + (offset ++ 1) + | v, rem -> + Bytes.set buffer offset (v lor 0x80 |> Char.chr); + inner ~offset:(offset ++ 1) rem + in + inner ~offset v + + let write_fixed32 buffer ~offset v = Bytes.set_int32_le buffer offset v; offset + 4 @@ -66,11 +91,12 @@ let write_fixed64 buffer ~offset v = offset + 8 let write_length_delimited buffer ~offset ~src ~src_pos ~len = - let offset = write_varint buffer ~offset (Int64.of_int len) in + let offset = write_varint_unboxed buffer ~offset len in Bytes.blit ~src:(Bytes.of_string src) ~src_pos ~dst:buffer ~dst_pos:offset ~len; offset + len let write_field buffer ~offset = function + | Varint_unboxed v -> write_varint_unboxed buffer ~offset v | Varint v -> write_varint buffer ~offset v | Fixed_32_bit v -> write_fixed32 buffer ~offset v | Fixed_64_bit v -> write_fixed64 buffer ~offset v @@ -101,13 +127,14 @@ let concat t ~src = let write_field_header : t -> int -> int -> unit = fun t index field_type -> let header = (index lsl 3) + field_type in - add_field t (Varint (Int64.of_int header)) + add_field t (Varint_unboxed (header)) let write_field : t -> int -> Field.t -> unit = fun t index field -> let field_type = match field with | Varint _ -> 0 + | Varint_unboxed _ -> 0 | Fixed_64_bit _ -> 1 | Length_delimited _ -> 2 | Fixed_32_bit _ -> 5 @@ -119,7 +146,7 @@ let write_field : t -> int -> Field.t -> unit = let concat_as_length_delimited t ~src index = let size = size src in write_field_header t index 2; - add_field t (Varint (Int64.of_int size)); + add_field t (Varint_unboxed size); concat t ~src let dump t = From d2cc24feffe0a764cc2c515cd080a1e5e68841fd Mon Sep 17 00:00:00 2001 From: Anders Fugmann Date: Mon, 1 Jan 2024 00:59:10 +0100 Subject: [PATCH 05/30] Serialize and Deserialize to Int.t unless using native types --- bench/bench.ml | 19 ++-- src/ocaml_protoc_plugin/deserialize.ml | 130 +++++++++++++++++-------- src/ocaml_protoc_plugin/field.ml | 3 +- src/ocaml_protoc_plugin/reader.ml | 77 ++++++++------- src/ocaml_protoc_plugin/reader.mli | 7 +- src/ocaml_protoc_plugin/serialize.ml | 29 +++--- src/ocaml_protoc_plugin/writer.ml | 70 ++++++------- src/plugin/protoc_gen_ocaml.ml | 5 +- 8 files changed, 206 insertions(+), 134 deletions(-) diff --git a/bench/bench.ml b/bench/bench.ml index 794dcfe..01f2fd4 100644 --- a/bench/bench.ml +++ b/bench/bench.ml @@ -7,7 +7,12 @@ module type Protobuf = sig val encode : t -> string val decode : string -> t end -let _ = Random.init 0 +let _ = + Random.init 0; + let module Gc = Stdlib.Gc in + Gc.full_major (); + let control = Gc.get () in + Gc.set { control with minor_heap_size=4000_1000; space_overhead=500 } module Protoc_mod : Protobuf = struct type t = Protoc.Bench.btree @@ -96,11 +101,10 @@ let make_tests data_str = [ make_test (module Protoc_mod) data_str; make_test (module Plugin_mod) data_str ] |> Bechamel.Test.make_grouped ~name:"Protobuf" - let benchmark tests = let open Bechamel in let instances = Bechamel_perf.Instance.[ cpu_clock ] in - let cfg = Benchmark.cfg ~limit:10000 ~stabilize:true ~compaction:true + let cfg = Benchmark.cfg ~limit:1000 ~stabilize:true ~compaction:true ~quota:(Time.second 2.5) () in Benchmark.all cfg instances tests @@ -132,7 +136,7 @@ let print_bench_results results = img (window, results) |> eol |> output_image let _ = - let data = create_test_data ~depth:4 () in + let data = create_test_data ~depth:2 () in let data = Option.value_exn data in let proto_str = Plugin_mod.encode data in let _data = Plugin_mod.decode proto_str in @@ -140,11 +144,8 @@ let _ = let data_str' = Protoc_mod.encode data_protoc in let data' = Plugin_mod.decode data_str' in let data_str' = Plugin_mod.encode data' in - printf "Data length: %d / %d %b\n%!" (String.length proto_str) (String.length data_str') (String.equal proto_str data_str'); - let module Gc = Stdlib.Gc in - Gc.full_major (); - let control = Gc.get () in - Gc.set { control with minor_heap_size = 1024*1024*10; space_overhead=5 }; + assert (String.equal data_str' proto_str); + printf "Data length: %d\n%!" (String.length proto_str); make_tests proto_str |> benchmark diff --git a/src/ocaml_protoc_plugin/deserialize.ml b/src/ocaml_protoc_plugin/deserialize.ml index f2beb05..0096161 100644 --- a/src/ocaml_protoc_plugin/deserialize.ml +++ b/src/ocaml_protoc_plugin/deserialize.ml @@ -30,6 +30,18 @@ let read_varint ~signed ~type_name = end | field -> error_wrong_field type_name field +let rec read_varint_unboxed ~signed ~type_name = function + | Field.Varint_unboxed v -> begin + let v = match signed with + | true when v land 0x01 = 0 -> v / 2 + | true -> (v / 2 * -1) - 1 + | false -> v + in + v + end + | Field.Varint v -> read_varint_unboxed ~signed ~type_name (Field.Varint_unboxed (Int64.to_int v)) + | field -> error_wrong_field type_name field + let read_varint32 ~signed ~type_name field = read_varint ~signed ~type_name field |> Int64.to_int32 @@ -84,26 +96,25 @@ let rec type_of_spec: type a. a spec -> 'b * a decoder = | Field.Fixed_32_bit v -> Int32.float_of_bits v | field -> error_wrong_field "float" field) | Int32 -> (`Varint, read_varint32 ~signed:false ~type_name:"int32") - | Int32_int -> int_of_int32 Int32 + | Int32_int -> (`Varint_unboxed, read_varint_unboxed ~signed:false ~type_name:"int32") | Int64 -> (`Varint, read_varint ~signed:false ~type_name:"int64") - | Int64_int -> int_of_int64 Int64 + | Int64_int -> (`Varint_unboxed, read_varint_unboxed ~signed:false ~type_name:"int64") | UInt32 -> (`Varint, read_varint32 ~signed:false ~type_name:"uint32") - | UInt32_int -> int_of_uint32 UInt32 + | UInt32_int -> (`Varint_unboxed, read_varint_unboxed ~signed:false ~type_name:"uint32") | UInt64 -> (`Varint, read_varint ~signed:false ~type_name:"uint64") - | UInt64_int -> int_of_uint64 UInt64 + | UInt64_int -> (`Varint_unboxed, read_varint_unboxed ~signed:false ~type_name:"uint64") | SInt32 -> (`Varint, read_varint32 ~signed:true ~type_name:"sint32") - | SInt32_int -> int_of_int32 SInt32 + | SInt32_int -> (`Varint_unboxed, read_varint_unboxed ~signed:true ~type_name:"sint32") | SInt64 -> (`Varint, read_varint ~signed:true ~type_name:"sint64") - | SInt64_int -> int_of_int64 SInt64 + | SInt64_int -> (`Varint_unboxed, read_varint_unboxed ~signed:true ~type_name:"sint64") | Fixed32 -> (`Fixed_32_bit, function | Field.Fixed_32_bit v -> v | field -> error_wrong_field "fixed32" field) - | Fixed32_int -> int_of_int32 Fixed32 + | Fixed32_int -> int_of_uint32 Fixed32 | Fixed64 -> (`Fixed_64_bit, function | Field.Fixed_64_bit v -> v | field -> error_wrong_field "fixed64" field) - | Fixed64_int -> int_of_int64 Fixed64 - + | Fixed64_int -> int_of_uint64 Fixed64 | SFixed32 -> (`Fixed_32_bit, function | Field.Fixed_32_bit v -> v | field -> error_wrong_field "sfixed32" field) @@ -112,18 +123,20 @@ let rec type_of_spec: type a. a spec -> 'b * a decoder = | Field.Fixed_64_bit v -> v | field -> error_wrong_field "sfixed64" field) | SFixed64_int -> int_of_int64 SFixed64 - | Bool -> (`Varint, function + | Bool -> (`Varint_unboxed, function + | Field.Varint_unboxed v -> v != 0 | Field.Varint v -> Int64.equal v 0L |> not | field -> error_wrong_field "bool" field) - | Enum of_int -> (`Varint, function - | Field.Varint v -> of_int (Int64.to_int v) + | Enum of_int -> (`Varint_unboxed, function + | Field.Varint_unboxed v -> of_int v + | Field.Varint v -> Int64.to_int v |> of_int | field -> error_wrong_field "enum" field) | String -> (`Length_delimited, function | Field.Length_delimited {offset; length; data} -> String.sub ~pos:offset ~len:length data | field -> error_wrong_field "string" field) | Bytes -> (`Length_delimited, function | Field.Length_delimited {offset; length; data} -> String.sub ~pos:offset ~len:length data |> Bytes.of_string - | field -> error_wrong_field "string" field) + | field -> error_wrong_field "bytes" field) | Message from_proto -> (`Length_delimited, function | Field.Length_delimited {offset; length; data} -> from_proto (Reader.create ~offset ~length data) | field -> error_wrong_field "message" field) @@ -133,8 +146,24 @@ let default_of_field_type = function | `Fixed_64_bit -> Field.fixed_64_bit Int64.zero | `Length_delimited -> Field.length_delimited "" | `Varint -> Field.varint 0L + | `Varint_unboxed -> Field.varint_unboxed 0 + +type expect = [ `Fixed_32_bit + | `Fixed_64_bit + | `Length_delimited + | `Varint + | `Varint_unboxed + | `Any ] -let sentinal: type a. a compound -> (int * unit decoder) list * a sentinal = function + +let get_boxed_type = function + | `Varint -> Reader.Boxed + | `Varint_unboxed -> Reader.Unboxed + | `Fixed_32_bit -> Reader.Boxed + | `Fixed_64_bit -> Reader.Boxed + | `Length_delimited -> Reader.Unboxed + +let sentinal: type a. a compound -> (int * (unit decoder * Reader.boxed)) list * a sentinal = function (* This is the same as required, so we should just use that! *) | Basic (index, (Message deser), _) -> let v = ref None in @@ -148,9 +177,10 @@ let sentinal: type a. a compound -> (int * unit decoder) list * a sentinal = fun deser reader |> fun message -> v := Some message | field -> error_wrong_field "message" field in - ([index, read], get) + ([index, (read, Unboxed)], get) | Basic (index, spec, Required) -> - let _, read = type_of_spec spec in + let expect, read = type_of_spec spec in + let boxed = get_boxed_type expect in let v = ref None in let get () = match !v with | Some v -> v @@ -159,9 +189,10 @@ let sentinal: type a. a compound -> (int * unit decoder) list * a sentinal = fun let read field = read field |> fun value -> v := Some value in - ([index, read], get) + ([index, (read, boxed)], get) | Basic (index, spec, default) -> let field_type, read = type_of_spec spec in + let boxed = get_boxed_type field_type in let default = match default with | Proto2 default -> default | Required @@ -175,23 +206,26 @@ let sentinal: type a. a compound -> (int * unit decoder) list * a sentinal = fun let read field = read field |> fun value -> v := value in - ([index, read], get) + ([index, (read, boxed)], get) | Basic_opt (index, spec) -> - let _, read = type_of_spec spec in + let field_type, read = type_of_spec spec in + let boxed = get_boxed_type field_type in let v = ref None in let get () = !v in let read field = read field |> fun value -> v := Some value in - ([index, read], get) + ([index, (read, boxed)], get) | Repeated (index, spec, _) -> let read_field = function | `Length_delimited -> None | `Varint -> Some Reader.read_varint + | `Varint_unboxed -> Some Reader.read_varint_unboxed | `Fixed_64_bit -> Some Reader.read_fixed64 | `Fixed_32_bit -> Some Reader.read_fixed32 in - let rec read_repeated reader decode read_f = match Reader.has_more reader with + let rec read_repeated reader decode read_f = + match Reader.has_more reader with | false -> () | true -> decode reader |> fun field -> @@ -199,23 +233,26 @@ let sentinal: type a. a compound -> (int * unit decoder) list * a sentinal = fun read_repeated reader decode read_f in let (field_type, read_type) = type_of_spec spec in + let boxed = get_boxed_type field_type in + let read_field_type = read_field field_type in let v = ref [] in let get () = List.rev !v in - let rec read field = match field, read_field field_type with + let rec read field = match field, read_field_type with | (Field.Length_delimited _ as field), None -> read_type field |> fun v' -> v := v' :: !v | Field.Length_delimited { offset; length; data }, Some read_field -> read_repeated (Reader.create ~offset ~length data) read_field read | field, _ -> read_type field |> fun v' -> v := v' :: !v in - ([index, read], get) + ([index, (read, boxed)], get) | Oneof oneofs -> - let make_reader: a ref -> a oneof -> (int * unit decoder) = fun v (Oneof_elem (index, spec, constr)) -> - let _, read = type_of_spec spec in + let make_reader: a ref -> a oneof -> (int * (unit decoder * Reader.boxed)) = fun v (Oneof_elem (index, spec, constr)) -> + let field_type, read = type_of_spec spec in + let boxed = get_boxed_type field_type in let read field = read field |> fun value -> v := (constr value) in - (index, read) + (index, (read, boxed)) in let v = ref `not_set in let get () = !v in @@ -235,23 +272,32 @@ let in_extension_ranges extension_ranges index = List.exists ~f:(fun (start, end') -> index >= start && index <= end') extension_ranges (** Read fields - map based for nlogn lookup *) +(* The reader list should contain expected type to be read, so we know if it should be unboxed or not *) let read_fields_map extension_ranges reader_list = let extensions = ref [] in let map = Map.of_alist_exn reader_list in + let read_field_content_boxed = Reader.read_field_content Reader.Boxed in let rec read reader = match Reader.has_more reader with | false -> List.rev !extensions | true -> begin - let (index, field) = Reader.read_field reader in - match Map.find_opt index map with - | Some f -> - f field |> fun () -> + let (field_type, field_number) = Reader.read_field_header reader in + match Map.find_opt field_number map with + | Some (f, boxed) -> + let field = Reader.read_field_content boxed field_type reader in + f field; read reader - | None when in_extension_ranges extension_ranges index -> - extensions := (index, field) :: !extensions; + | None when in_extension_ranges extension_ranges field_number -> + (* Dont really know what to set expect to here. It really depends on the options *) + (* Maybe we should just construct the reader based on boxing or not boxing *) + (* When is this reading done??? We could just examine the spec string and derive the boxing or unboxing *) + (* We really need to have this information at the get-go. *) + let field = read_field_content_boxed field_type reader in + extensions := (field_number, field) :: !extensions; read reader | None -> + let _ = read_field_content_boxed field_type reader in read reader end in @@ -260,27 +306,31 @@ let read_fields_map extension_ranges reader_list = (** Read fields - array based for O(1) lookup *) let read_fields_array extension_ranges max_index reader_list = let extensions = ref [] in - let default index field = + let default_f index field = match in_extension_ranges extension_ranges index with | true -> extensions := (index, field) :: !extensions; () | false -> () in - let readers = Array.init (max_index + 1) ~f:(fun _ -> default) in - List.iter ~f:(fun (idx, f) -> readers.(idx) <- (fun _ -> f)) reader_list; + let readers = Array.init (max_index + 1) ~f:(fun _ -> Reader.Boxed, default_f) in + List.iter ~f:(fun (idx, (f, expect)) -> readers.(idx) <- expect, fun _ -> f) reader_list; + let read_field_content_boxed = Reader.read_field_content Reader.Boxed in let rec read reader = match Reader.has_more reader with | false -> List.rev !extensions | true -> begin - let (index, field) = Reader.read_field reader in - match index <= max_index with + let field_type, field_index = Reader.read_field_header reader in + match field_index <= max_index with | true -> - readers.(index) index field |> fun () -> + let (boxed, f) = readers.(field_index) in + let field = Reader.read_field_content boxed field_type reader in + f field_index field; read reader | false -> - default index field |> fun () -> + let field = read_field_content_boxed field_type reader in + default_f field_index field; read reader end in @@ -330,7 +380,7 @@ let deserialize: type constr t. (int * int) list -> (constr, t) compound_list -> | SNil -> constr in (* We first make a list of sentinal_getters, which we can map to the constr *) - let rec make_sentinals: type a b. (a, b) compound_list -> (a, b) sentinal_list * (int * unit decoder) list = function + let rec make_sentinals: type a b. (a, b) compound_list -> (a, b) sentinal_list * (int * (unit decoder * Reader.boxed)) list = function | Cons (spec, rest) -> let (readers, sentinal) = sentinal spec in let (sentinals, reader_list) = make_sentinals rest in diff --git a/src/ocaml_protoc_plugin/field.ml b/src/ocaml_protoc_plugin/field.ml index b308f83..1c12eb7 100644 --- a/src/ocaml_protoc_plugin/field.ml +++ b/src/ocaml_protoc_plugin/field.ml @@ -1,5 +1,6 @@ type t = | Varint of Int64.t (* int32, int64, uint32, uint64, sint32, sint64, bool, enum *) + | Varint_unboxed of int | Fixed_64_bit of Int64.t (* fixed64, sfixed64, double *) | Length_delimited of { offset : int; @@ -7,9 +8,9 @@ type t = data : string; } (* string, bytes, embedded messages, packed repeated fields *) | Fixed_32_bit of Int32.t (* fixed32, sfixed32, float *) - | Varint_unboxed of int let varint v = Varint v +let varint_unboxed v = Varint_unboxed v let fixed_32_bit v = Fixed_32_bit v let fixed_64_bit v = Fixed_64_bit v let length_delimited ?(offset=0) ?length data = diff --git a/src/ocaml_protoc_plugin/reader.ml b/src/ocaml_protoc_plugin/reader.ml index 403f2a5..808c362 100644 --- a/src/ocaml_protoc_plugin/reader.ml +++ b/src/ocaml_protoc_plugin/reader.ml @@ -3,6 +3,8 @@ open StdLabels open Field +type boxed = Boxed | Unboxed + type t = { mutable offset : int; end_offset : int; @@ -39,8 +41,7 @@ let read_raw_varint t = let open Infix.Int64 in let rec inner n acc = let v = Int64.of_int (read_byte t) in - let v' = (v land 0x7FL) lsl n in - let acc = acc + v' in + let acc = acc + (v land 0x7FL) lsl n in match v > 127L with | true -> (* Still More data *) @@ -52,8 +53,7 @@ let read_raw_varint t = let read_raw_varint_unboxed t = let rec inner n acc = let v = read_byte t in - let v' = (v land 0x7F) lsl n in - let acc = acc + v' in + let acc = acc + (v land 0x7F) lsl n in match v > 127 with | true -> (* Still More data *) @@ -64,19 +64,7 @@ let read_raw_varint_unboxed t = [@@inline] let read_varint t = Varint (read_raw_varint t) - -let read_field_header : t -> int * int = fun t -> - let v = read_raw_varint_unboxed t in - let tpe = v land 0x7 in - let field_number = v / 8 in - (tpe, field_number) - -let read_length_delimited t = - let length = read_raw_varint_unboxed t in - validate_capacity t length; - let v = Length_delimited {offset = t.offset; length; data = t.data} in - t.offset <- t.offset + length; - v +let read_varint_unboxed t = Varint_unboxed (read_raw_varint_unboxed t) (* Implement little endian ourselves *) let read_fixed32 t = @@ -93,21 +81,44 @@ let read_fixed64 t = t.offset <- t.offset + size; (Fixed_64_bit v) -let read_field : t -> int * Field.t = fun t -> - let (field_type, field_number) = read_field_header t in - let field = match field_type with - | 0 -> read_varint t - | 1 -> read_fixed64 t - | 2 -> read_length_delimited t - | 5 -> read_fixed32 t - | n -> Result.raise (`Unknown_field_type n) - in - (field_number, field) - - -let to_list: t -> (int * Field.t) list = fun t -> - let rec inner acc = match has_more t with - | true -> inner (read_field t :: acc) - | false -> List.rev acc +let read_length_delimited t = + let length = read_raw_varint_unboxed t in + validate_capacity t length; + let v = Length_delimited {offset = t.offset; length; data = t.data} in + t.offset <- t.offset + length; + v + +let read_field_header : t -> int * int = fun t -> + let v = read_raw_varint_unboxed t in + let tpe = v land 0x7 in + let field_number = v / 8 in + (tpe, field_number) + +let read_field_content = fun boxed -> + let read_varint = match boxed with + | Boxed -> read_varint + | Unboxed -> read_varint_unboxed in + function + | 0 -> read_varint + | 1 -> read_fixed64 + | 2 -> read_length_delimited + | 5 -> read_fixed32 + | n -> fun _ -> Result.raise (`Unknown_field_type n) + + +let read_field : boxed -> t -> int * Field.t = fun boxed -> + let read_field_content = read_field_content boxed in + fun t -> + let (field_type, field_number) = read_field_header t in + field_number, read_field_content field_type t + + +let to_list: t -> (int * Field.t) list = + let read_field = read_field Boxed in + fun t -> + let rec inner acc = match has_more t with + | true -> inner (read_field t :: acc) + | false -> List.rev acc + in inner [] diff --git a/src/ocaml_protoc_plugin/reader.mli b/src/ocaml_protoc_plugin/reader.mli index e191899..f7d8912 100644 --- a/src/ocaml_protoc_plugin/reader.mli +++ b/src/ocaml_protoc_plugin/reader.mli @@ -3,12 +3,17 @@ type t (** Create a reader from a string, to be used when deserializing a protobuf type *) val create : ?offset:int -> ?length:int -> string -> t +type boxed = Boxed | Unboxed + (**/**) val has_more : t -> bool val to_list : t -> (int * Field.t) list val read_varint : t -> Field.t +val read_varint_unboxed : t -> Field.t val read_length_delimited : t -> Field.t val read_fixed32 : t -> Field.t val read_fixed64 : t -> Field.t -val read_field : t -> (int * Field.t) +val read_field_header : t -> (int * int) +val read_field_content : boxed -> int -> t -> Field.t +val read_field : boxed -> t -> (int * Field.t) (**/**) diff --git a/src/ocaml_protoc_plugin/serialize.ml b/src/ocaml_protoc_plugin/serialize.ml index 83c3073..0d33363 100644 --- a/src/ocaml_protoc_plugin/serialize.ml +++ b/src/ocaml_protoc_plugin/serialize.ml @@ -6,6 +6,7 @@ module C = S.C open S let unsigned_varint v = Field.Varint v +let unsigned_varint_unboxed v = Field.Varint_unboxed v let signed_varint v = let open! Infix.Int64 in @@ -16,22 +17,29 @@ let signed_varint v = in Field.Varint v +let signed_varint_unboxed v = + let v = + match v with + | v when v < 0 -> v lsl 1 lxor -1 + | v -> v lsl 1 + in + Field.Varint_unboxed v let rec field_of_spec: type a. a spec -> a -> Field.t = function | Double -> fun v -> Fixed_64_bit (Int64.bits_of_float v) | Float -> fun v -> Fixed_32_bit (Int32.bits_of_float v) | Int64 -> unsigned_varint - | Int64_int -> fun v -> unsigned_varint (Int64.of_int v) + | Int64_int -> unsigned_varint_unboxed | UInt64 -> unsigned_varint - | UInt64_int -> fun v -> unsigned_varint (Int64.of_int v) + | UInt64_int -> unsigned_varint_unboxed | SInt64 -> signed_varint - | SInt64_int -> fun v -> signed_varint (Int64.of_int v) + | SInt64_int -> signed_varint_unboxed | Int32 -> fun v -> unsigned_varint (Int64.of_int32 v) - | Int32_int -> fun v -> unsigned_varint (Int64.of_int v) + | Int32_int -> unsigned_varint_unboxed | UInt32 -> fun v -> unsigned_varint (Int64.of_int32 v) - | UInt32_int -> fun v -> unsigned_varint (Int64.of_int v) + | UInt32_int -> unsigned_varint_unboxed | SInt32 -> fun v -> signed_varint (Int64.of_int32 v) - | SInt32_int -> fun v -> signed_varint (Int64.of_int v) + | SInt32_int -> signed_varint_unboxed | Fixed64 -> fixed_64_bit | Fixed64_int -> fun v -> Fixed_64_bit (Int64.of_int v) @@ -42,12 +50,12 @@ let rec field_of_spec: type a. a spec -> a -> Field.t = function | SFixed32 -> fixed_32_bit | SFixed32_int -> fun v -> Fixed_32_bit (Int32.of_int v) - | Bool -> fun v -> unsigned_varint (match v with | true -> 1L | false -> 0L) + | Bool -> fun v -> unsigned_varint_unboxed (match v with | true -> 1 | false -> 0) | String -> fun v -> Length_delimited {offset = 0; length = String.length v; data = v} | Bytes -> fun v -> Length_delimited {offset = 0; length = Bytes.length v; data = Bytes.to_string v} | Enum f -> - let to_field = field_of_spec UInt64 in - fun v -> f v |> Int64.of_int |> to_field + let to_field = field_of_spec UInt64_int in + fun v -> f v |> to_field | Message to_proto -> fun v -> let writer = to_proto v in @@ -87,6 +95,7 @@ let rec write: type a. a compound -> Writer.t -> a -> unit = function | Proto3 -> begin fun writer v -> match f v with | Varint 0L -> () + | Varint_unboxed 0 -> () | Fixed_64_bit 0L -> () | Fixed_32_bit 0l -> () | Length_delimited {length = 0; _} -> () @@ -126,7 +135,6 @@ let rec serialize : type a. (a, Writer.t) compound_list -> Writer.t -> a = funct let in_extension_ranges extension_ranges index = List.exists ~f:(fun (start, end') -> index >= start && index <= end') extension_ranges - let serialize extension_ranges spec = let serialize = serialize spec in fun extensions -> @@ -137,7 +145,6 @@ let serialize extension_ranges spec = ) extensions; serialize writer - let%expect_test "signed varint" = let test v = let vl = Int64.of_int v in diff --git a/src/ocaml_protoc_plugin/writer.ml b/src/ocaml_protoc_plugin/writer.ml index d637f93..4a41e9a 100644 --- a/src/ocaml_protoc_plugin/writer.ml +++ b/src/ocaml_protoc_plugin/writer.ml @@ -16,7 +16,6 @@ type t = { mutable size: int; } -(** Yes. But it would be nicer to just iter over them *) let rev_fields fields = let rec inner acc = function | Nil -> acc @@ -29,59 +28,60 @@ let rev_fields fields = let init () = {fields = Nil; size = 0;} +(** Get index of most significant bit. *) +let varint_size v = + let rec inner acc = function + | 0 -> acc + | v -> inner (acc + 1) (v lsr 1) + in + match v with + | v when v < 0 -> 10 + | 0 -> 1 + | v -> (6 + inner 0 v) / 7 let rec size_of_field = function - | Varint v -> begin - match v with - | v when v < 0L -> 10 - | 0L -> 1 - | v (* when v > 0L *) -> - let bits = int_of_float (log (Int64.to_float v) /. log 2.0) in - (bits / 7) + 1 - end - | Varint_unboxed v -> begin - match v with - | v when v < 0 -> 10 - | 0 -> 1 - | v (* when v > 0L *) -> - let bits = int_of_float (log (Int.to_float v) /. log 2.0) in - (bits / 7) + 1 - end + | Varint v -> varint_size (Int64.to_int v) + | Varint_unboxed v -> varint_size v | Fixed_32_bit _ -> 4 | Fixed_64_bit _ -> 8 | Length_delimited {length; _} -> size_of_field (Varint_unboxed length) + length - +[@@inline] let size t = t.size let write_varint buffer ~offset v = let rec inner ~offset v : int = - let (++) = (+) in + let next_offset = offset + 1 in let open Infix.Int64 in - match v land 0x7FL, v lsr 7 with - | v, 0L -> - Bytes.set buffer offset (v |> Int64.to_int |> Char.chr); - (offset ++ 1) - | v, rem -> - Bytes.set buffer offset (v lor 0x80L |> Int64.to_int |> Char.chr); - inner ~offset:(offset ++ 1) rem + match v lsr 7 with + | 0L -> + Bytes.set_uint8 buffer offset (Int64.to_int v); + next_offset + | rem -> + Bytes.set_uint8 buffer offset (Int.logor (Int64.to_int v |> Int.logand 0x7F) 0x80); + inner ~offset:next_offset rem in inner ~offset v let write_varint_unboxed buffer ~offset v = + let is_negative = v < 0 in let rec inner ~offset v : int = - let (++) = (+) in - match v land 0x7F, v lsr 7 with - | v, 0 -> - Bytes.set buffer offset (v |> Char.chr); - (offset ++ 1) - | v, rem -> - Bytes.set buffer offset (v lor 0x80 |> Char.chr); - inner ~offset:(offset ++ 1) rem + let next_offset = offset + 1 in + match v lsr 7 with + | 0 when is_negative -> (* Emulate 64 bit signed integer *) + Bytes.set_uint8 buffer offset (v lor 0x80); + Bytes.set_uint8 buffer next_offset 0x01; + next_offset + 1 + | 0 -> + Bytes.set_uint8 buffer offset v; + next_offset + | rem -> + let v' = v land 0x7F lor 0x80 in + Bytes.set_uint8 buffer offset v'; + inner ~offset:next_offset rem in inner ~offset v - let write_fixed32 buffer ~offset v = Bytes.set_int32_le buffer offset v; offset + 4 diff --git a/src/plugin/protoc_gen_ocaml.ml b/src/plugin/protoc_gen_ocaml.ml index d6b2419..78a25de 100644 --- a/src/plugin/protoc_gen_ocaml.ml +++ b/src/plugin/protoc_gen_ocaml.ml @@ -19,10 +19,7 @@ let read_all in_channel = let read () = read_all stdin |> Ocaml_protoc_plugin.Reader.create - |> Plugin.CodeGeneratorRequest.from_proto - |> function - | Ok v -> v - | Error _ -> failwith "Could not decode generator request" + |> Plugin.CodeGeneratorRequest.from_proto_exn (* Write to stdout *) let write response = From bd69efde1f46ea308ff58c91415a01236fafddfb Mon Sep 17 00:00:00 2001 From: Anders Fugmann Date: Mon, 1 Jan 2024 12:33:20 +0100 Subject: [PATCH 06/30] Change default dune target to only include install targets --- dune | 4 ++++ 1 file changed, 4 insertions(+) create mode 100644 dune diff --git a/dune b/dune new file mode 100644 index 0000000..98d0701 --- /dev/null +++ b/dune @@ -0,0 +1,4 @@ +(alias + (name default) + (deps (alias_rec install)) +) From 67b34e187e1ac2f92babbbd5f7702ff638ba1c3b Mon Sep 17 00:00:00 2001 From: Anders Fugmann Date: Mon, 1 Jan 2024 15:01:37 +0100 Subject: [PATCH 07/30] Update tests --- src/ocaml_protoc_plugin/reader.ml | 11 ++- src/ocaml_protoc_plugin/serialize.ml | 132 +++++++++++++++++++-------- 2 files changed, 101 insertions(+), 42 deletions(-) diff --git a/src/ocaml_protoc_plugin/reader.ml b/src/ocaml_protoc_plugin/reader.ml index 808c362..2781676 100644 --- a/src/ocaml_protoc_plugin/reader.ml +++ b/src/ocaml_protoc_plugin/reader.ml @@ -117,8 +117,9 @@ let read_field : boxed -> t -> int * Field.t = fun boxed -> let to_list: t -> (int * Field.t) list = let read_field = read_field Boxed in fun t -> - let rec inner acc = match has_more t with - | true -> inner (read_field t :: acc) - | false -> List.rev acc - in - inner [] + (* Make this tailrec *) + let[@tail_mod_cons] rec inner () = match has_more t with + | true -> read_field t :: inner () + | false -> [] + in + inner () diff --git a/src/ocaml_protoc_plugin/serialize.ml b/src/ocaml_protoc_plugin/serialize.ml index 0d33363..3f4cb61 100644 --- a/src/ocaml_protoc_plugin/serialize.ml +++ b/src/ocaml_protoc_plugin/serialize.ml @@ -5,41 +5,39 @@ module S = Spec.Serialize module C = S.C open S -let unsigned_varint v = Field.Varint v -let unsigned_varint_unboxed v = Field.Varint_unboxed v - -let signed_varint v = - let open! Infix.Int64 in - let v = - match v with - | v when v < 0L -> v lsl 1 lxor (-1L) - | v -> v lsl 1 +let varint ~signed v = + let open Infix.Int64 in + let v = match signed with + | true when v < 0L -> v lsl 1 lxor (-1L) + | true -> v lsl 1 + | false -> v in Field.Varint v -let signed_varint_unboxed v = - let v = - match v with - | v when v < 0 -> v lsl 1 lxor -1 - | v -> v lsl 1 +let varint_unboxed ~signed v = + let v = match signed with + | true when v < 0 -> v lsl 1 lxor (-1) + | true -> v lsl 1 + | false -> v in Field.Varint_unboxed v + let rec field_of_spec: type a. a spec -> a -> Field.t = function | Double -> fun v -> Fixed_64_bit (Int64.bits_of_float v) | Float -> fun v -> Fixed_32_bit (Int32.bits_of_float v) - | Int64 -> unsigned_varint - | Int64_int -> unsigned_varint_unboxed - | UInt64 -> unsigned_varint - | UInt64_int -> unsigned_varint_unboxed - | SInt64 -> signed_varint - | SInt64_int -> signed_varint_unboxed - | Int32 -> fun v -> unsigned_varint (Int64.of_int32 v) - | Int32_int -> unsigned_varint_unboxed - | UInt32 -> fun v -> unsigned_varint (Int64.of_int32 v) - | UInt32_int -> unsigned_varint_unboxed - | SInt32 -> fun v -> signed_varint (Int64.of_int32 v) - | SInt32_int -> signed_varint_unboxed + | Int64 -> varint ~signed:false + | Int64_int -> varint_unboxed ~signed:false + | UInt64 -> varint ~signed:false + | UInt64_int -> varint_unboxed ~signed:false + | SInt64 -> varint ~signed:true + | SInt64_int -> varint_unboxed ~signed:true + | Int32 -> fun v -> varint ~signed:false (Int64.of_int32 v) + | Int32_int -> varint_unboxed ~signed:false + | UInt32 -> fun v -> varint ~signed:false (Int64.of_int32 v) + | UInt32_int -> varint_unboxed ~signed:false + | SInt32 -> fun v -> varint ~signed:true (Int64.of_int32 v) + | SInt32_int -> varint_unboxed ~signed:true | Fixed64 -> fixed_64_bit | Fixed64_int -> fun v -> Fixed_64_bit (Int64.of_int v) @@ -50,7 +48,7 @@ let rec field_of_spec: type a. a spec -> a -> Field.t = function | SFixed32 -> fixed_32_bit | SFixed32_int -> fun v -> Fixed_32_bit (Int32.of_int v) - | Bool -> fun v -> unsigned_varint_unboxed (match v with | true -> 1 | false -> 0) + | Bool -> fun v -> varint_unboxed ~signed:false (match v with | true -> 1 | false -> 0) | String -> fun v -> Length_delimited {offset = 0; length = String.length v; data = v} | Bytes -> fun v -> Length_delimited {offset = 0; length = Bytes.length v; data = Bytes.to_string v} | Enum f -> @@ -61,7 +59,6 @@ let rec field_of_spec: type a. a spec -> a -> Field.t = function let writer = to_proto v in Field.length_delimited (Writer.contents writer) - let is_scalar: type a. a spec -> bool = function | String -> false | Bytes -> false @@ -146,17 +143,78 @@ let serialize extension_ranges spec = serialize writer let%expect_test "signed varint" = + let test v = let vl = Int64.of_int v in - Printf.printf "signed_varint %LdL = %s\n" vl (signed_varint vl |> Field.show); + Printf.printf "varint ~signed:true %LdL = %s\n" vl (varint ~signed:true vl |> Field.show); + Printf.printf "varint_unboxed ~signed:true %d = %s\n" v (varint_unboxed ~signed:true v |> Field.show); + + let vl' = (varint ~signed:true vl |> Deserialize.read_varint ~signed:true ~type_name:"") in + Printf.printf "Signed: %LdL = %LdL (%b)\n" vl vl' (vl = vl'); + + let vl' = (varint ~signed:false vl |> Deserialize.read_varint ~signed:false ~type_name:"") in + Printf.printf "Unsigned: %LdL = %LdL (%b)\n" vl vl' (vl = vl'); + + let v' = (varint_unboxed ~signed:true v |> Deserialize.read_varint_unboxed ~signed:true ~type_name:"") in + Printf.printf "Signed unboxed: %d = %d (%b)\n" v v' (v = v'); + + let v' = (varint_unboxed ~signed:false v |> Deserialize.read_varint_unboxed ~signed:false ~type_name:"") in + Printf.printf "Unsigned unboxed: %d = %d (%b)\n" v v' (v=v'); () in - List.iter ~f:test [0; -1; 1; -2; 2; 2147483647; -2147483648]; + List.iter ~f:test [0; -1; 1; -2; 2; 2147483647; -2147483648; Int.max_int; Int.min_int; ]; [%expect {| - signed_varint 0L = (Field.Varint 0L) - signed_varint -1L = (Field.Varint 1L) - signed_varint 1L = (Field.Varint 2L) - signed_varint -2L = (Field.Varint 3L) - signed_varint 2L = (Field.Varint 4L) - signed_varint 2147483647L = (Field.Varint 4294967294L) - signed_varint -2147483648L = (Field.Varint 4294967295L) |}] + varint ~signed:true 0L = (Field.Varint 0L) + varint_unboxed ~signed:true 0 = (Field.Varint_unboxed 0) + Signed: 0L = 0L (true) + Unsigned: 0L = 0L (true) + Signed unboxed: 0 = 0 (true) + Unsigned unboxed: 0 = 0 (true) + varint ~signed:true -1L = (Field.Varint 1L) + varint_unboxed ~signed:true -1 = (Field.Varint_unboxed 1) + Signed: -1L = -1L (true) + Unsigned: -1L = -1L (true) + Signed unboxed: -1 = -1 (true) + Unsigned unboxed: -1 = -1 (true) + varint ~signed:true 1L = (Field.Varint 2L) + varint_unboxed ~signed:true 1 = (Field.Varint_unboxed 2) + Signed: 1L = 1L (true) + Unsigned: 1L = 1L (true) + Signed unboxed: 1 = 1 (true) + Unsigned unboxed: 1 = 1 (true) + varint ~signed:true -2L = (Field.Varint 3L) + varint_unboxed ~signed:true -2 = (Field.Varint_unboxed 3) + Signed: -2L = -2L (true) + Unsigned: -2L = -2L (true) + Signed unboxed: -2 = -2 (true) + Unsigned unboxed: -2 = -2 (true) + varint ~signed:true 2L = (Field.Varint 4L) + varint_unboxed ~signed:true 2 = (Field.Varint_unboxed 4) + Signed: 2L = 2L (true) + Unsigned: 2L = 2L (true) + Signed unboxed: 2 = 2 (true) + Unsigned unboxed: 2 = 2 (true) + varint ~signed:true 2147483647L = (Field.Varint 4294967294L) + varint_unboxed ~signed:true 2147483647 = (Field.Varint_unboxed 4294967294) + Signed: 2147483647L = 2147483647L (true) + Unsigned: 2147483647L = 2147483647L (true) + Signed unboxed: 2147483647 = 2147483647 (true) + Unsigned unboxed: 2147483647 = 2147483647 (true) + varint ~signed:true -2147483648L = (Field.Varint 4294967295L) + varint_unboxed ~signed:true -2147483648 = (Field.Varint_unboxed 4294967295) + Signed: -2147483648L = -2147483648L (true) + Unsigned: -2147483648L = -2147483648L (true) + Signed unboxed: -2147483648 = -2147483648 (true) + Unsigned unboxed: -2147483648 = -2147483648 (true) + varint ~signed:true 4611686018427387903L = (Field.Varint 9223372036854775806L) + varint_unboxed ~signed:true 4611686018427387903 = (Field.Varint_unboxed -2) + Signed: 4611686018427387903L = 4611686018427387903L (true) + Unsigned: 4611686018427387903L = 4611686018427387903L (true) + Signed unboxed: 4611686018427387903 = -1 (false) + Unsigned unboxed: 4611686018427387903 = 4611686018427387903 (true) + varint ~signed:true -4611686018427387904L = (Field.Varint 9223372036854775807L) + varint_unboxed ~signed:true -4611686018427387904 = (Field.Varint_unboxed -1) + Signed: -4611686018427387904L = -4611686018427387904L (true) + Unsigned: -4611686018427387904L = -4611686018427387904L (true) + Signed unboxed: -4611686018427387904 = -1 (false) + Unsigned unboxed: -4611686018427387904 = -4611686018427387904 (true) |}] From dcacf7230379ec3ea49db6f9ecee8ea78c05566d Mon Sep 17 00:00:00 2001 From: Anders Fugmann Date: Mon, 1 Jan 2024 17:45:42 +0100 Subject: [PATCH 08/30] Allow writing substructures directly to output buffers. This improves serialization and is now within a factor of x2 of ocaml-protoc in terms of serialization and deserialization speed --- src/ocaml_protoc_plugin/deserialize.ml | 4 +- src/ocaml_protoc_plugin/extensions.ml | 4 +- src/ocaml_protoc_plugin/serialize.ml | 23 +- src/ocaml_protoc_plugin/spec.ml | 2 +- src/ocaml_protoc_plugin/writer.ml | 103 ++++---- src/ocaml_protoc_plugin/writer.mli | 2 +- src/plugin/emit.ml | 10 +- src/plugin/types.ml | 4 +- src/spec/descriptor.ml | 347 ++++++++++++++++--------- src/spec/options.ml | 13 +- src/spec/plugin.ml | 51 ++-- 11 files changed, 341 insertions(+), 222 deletions(-) diff --git a/src/ocaml_protoc_plugin/deserialize.ml b/src/ocaml_protoc_plugin/deserialize.ml index 0096161..d924575 100644 --- a/src/ocaml_protoc_plugin/deserialize.ml +++ b/src/ocaml_protoc_plugin/deserialize.ml @@ -63,7 +63,7 @@ let rec type_of_spec: type a. a spec -> 'b * a decoder = (* If the high bit is set, we cannot represent it anyways *) Int32.to_int v | 64 -> - let move = int_of_string "0x1_0000_0000" in + let move = 0x1_0000_0000 in let i = Int32.to_int v in (if i < 0 then i + move else i) | _ -> assert false ) @@ -135,7 +135,7 @@ let rec type_of_spec: type a. a spec -> 'b * a decoder = | Field.Length_delimited {offset; length; data} -> String.sub ~pos:offset ~len:length data | field -> error_wrong_field "string" field) | Bytes -> (`Length_delimited, function - | Field.Length_delimited {offset; length; data} -> String.sub ~pos:offset ~len:length data |> Bytes.of_string + | Field.Length_delimited {offset; length; data} -> Bytes.sub ~pos:offset ~len:length (Bytes.unsafe_of_string data) | field -> error_wrong_field "bytes" field) | Message from_proto -> (`Length_delimited, function | Field.Length_delimited {offset; length; data} -> from_proto (Reader.create ~offset ~length data) diff --git a/src/ocaml_protoc_plugin/extensions.ml b/src/ocaml_protoc_plugin/extensions.ml index b16645e..49fea96 100644 --- a/src/ocaml_protoc_plugin/extensions.ml +++ b/src/ocaml_protoc_plugin/extensions.ml @@ -9,12 +9,12 @@ let compare _ _ = 0 let get: ('b -> 'b, 'b) Deserialize.S.compound_list -> t -> 'b = fun spec t -> let writer = Writer.of_list t in - (* Back and forth - its the same, no? *) let reader = Writer.contents writer |> Reader.create in Deserialize.deserialize [] spec (fun _ a -> a) reader let set: ('a -> Writer.t, Writer.t) Serialize.S.compound_list -> t -> 'a -> t = fun spec t v -> - let writer = Serialize.serialize [] spec [] v in + let writer = Writer.init () in + let writer = Serialize.serialize [] spec [] writer v in let reader = Writer.contents writer |> Reader.create in match Reader.to_list reader with | (((index, _) :: _) as fields) -> diff --git a/src/ocaml_protoc_plugin/serialize.ml b/src/ocaml_protoc_plugin/serialize.ml index 3f4cb61..a0afb0d 100644 --- a/src/ocaml_protoc_plugin/serialize.ml +++ b/src/ocaml_protoc_plugin/serialize.ml @@ -50,14 +50,15 @@ let rec field_of_spec: type a. a spec -> a -> Field.t = function | Bool -> fun v -> varint_unboxed ~signed:false (match v with | true -> 1 | false -> 0) | String -> fun v -> Length_delimited {offset = 0; length = String.length v; data = v} - | Bytes -> fun v -> Length_delimited {offset = 0; length = Bytes.length v; data = Bytes.to_string v} + | Bytes -> fun v -> Length_delimited {offset = 0; length = Bytes.length v; data = Bytes.unsafe_to_string v} | Enum f -> let to_field = field_of_spec UInt64_int in fun v -> f v |> to_field - | Message to_proto -> + | Message to_proto -> (* Consider inlining this into write *) fun v -> - let writer = to_proto v in - Field.length_delimited (Writer.contents writer) + let writer = Writer.init () in + let writer = to_proto writer v in + length_delimited (Writer.contents writer) let is_scalar: type a. a spec -> bool = function | String -> false @@ -68,8 +69,9 @@ let is_scalar: type a. a spec -> bool = function let rec write: type a. a compound -> Writer.t -> a -> unit = function | Basic (index, Message (to_proto), _) -> begin fun writer v -> - let v = to_proto v in - Writer.concat_as_length_delimited writer ~src:v index + let done_f = Writer.add_length_delimited_field_header writer index in + let _writer = to_proto writer v in + done_f () end | Repeated (index, Message to_proto, _) -> let write = write (Basic (index, Message to_proto, Required)) in @@ -79,9 +81,9 @@ let rec write: type a. a compound -> Writer.t -> a -> unit = function fun writer -> function | [] -> () | vs -> - let writer' = Writer.init () in - List.iter ~f:(fun v -> Writer.add_field writer' (f v)) vs; - Writer.concat_as_length_delimited writer ~src:writer' index + let done_f = Writer.add_length_delimited_field_header writer index in + List.iter ~f:(fun v -> Writer.add_field writer (f v)) vs; + done_f () end | Repeated (index, spec, _) -> let f = field_of_spec spec in @@ -134,8 +136,7 @@ let in_extension_ranges extension_ranges index = let serialize extension_ranges spec = let serialize = serialize spec in - fun extensions -> - let writer = Writer.init () in + fun extensions writer -> List.iter ~f:(function | (index, field) when in_extension_ranges extension_ranges index -> Writer.write_field writer index field | _ -> () diff --git a/src/ocaml_protoc_plugin/spec.ml b/src/ocaml_protoc_plugin/spec.ml index 6863706..fd7754a 100644 --- a/src/ocaml_protoc_plugin/spec.ml +++ b/src/ocaml_protoc_plugin/spec.ml @@ -39,7 +39,7 @@ module Make(T : T) = struct | String : string spec | Bytes : bytes spec | Enum : ('a, int -> 'a, 'a -> int) T.dir -> 'a spec - | Message : ('a, Reader.t -> 'a, 'a -> Writer.t) T.dir -> 'a spec + | Message : ('a, Reader.t -> 'a, Writer.t -> 'a -> Writer.t) T.dir -> 'a spec type _ oneof = | Oneof_elem : int * 'b spec * ('a, ('b -> 'a), 'b) T.dir -> 'a oneof diff --git a/src/ocaml_protoc_plugin/writer.ml b/src/ocaml_protoc_plugin/writer.ml index 4a41e9a..e3f6f4b 100644 --- a/src/ocaml_protoc_plugin/writer.ml +++ b/src/ocaml_protoc_plugin/writer.ml @@ -6,27 +6,21 @@ open Field let sprintf = Printf.sprintf let printf = Printf.printf -type field_list = - | Nil - | Cons_field of (Field.t * field_list) - | Cons_fields of (field_list * field_list) +(** Bytes allocated at end of any data block to reduce number of allocated blocks *) +let space_overhead = 256 -type t = { - mutable fields : field_list; - mutable size: int; -} +(** Hold multiple short strings in a list *) +type substring = { mutable offset: int; buffer: Bytes.t } -let rev_fields fields = +type t = { mutable data: substring list } + +let init () = { data = [] } +let size t = let rec inner acc = function - | Nil -> acc - | Cons_field (hd, tl) -> - inner (hd :: acc) tl - | Cons_fields (hd, tl) -> - inner (inner acc hd) tl + | [] -> acc + | { offset; _} :: tl -> inner (offset + acc) tl in - inner [] fields - -let init () = {fields = Nil; size = 0;} + inner 0 t.data (** Get index of most significant bit. *) let varint_size v = @@ -46,9 +40,6 @@ let rec size_of_field = function | Fixed_64_bit _ -> 8 | Length_delimited {length; _} -> size_of_field (Varint_unboxed length) + length -[@@inline] -let size t = t.size - let write_varint buffer ~offset v = let rec inner ~offset v : int = let next_offset = offset + 1 in @@ -95,7 +86,7 @@ let write_length_delimited buffer ~offset ~src ~src_pos ~len = Bytes.blit ~src:(Bytes.of_string src) ~src_pos ~dst:buffer ~dst_pos:offset ~len; offset + len -let write_field buffer ~offset = function +let write_naked_field buffer ~offset = function | Varint_unboxed v -> write_varint_unboxed buffer ~offset v | Varint v -> write_varint buffer ~offset v | Fixed_32_bit v -> write_fixed32 buffer ~offset v @@ -103,25 +94,16 @@ let write_field buffer ~offset = function | Length_delimited {offset = src_pos; length; data} -> write_length_delimited buffer ~offset ~src:data ~src_pos ~len:length -let contents t = - let size = size t in - let t = rev_fields t.fields in - let buffer = Bytes.create size in - let next_offset = - List.fold_left ~init:0 ~f:(fun offset field -> write_field buffer ~offset field) t - in - assert (next_offset = size); - Bytes.to_string buffer - let add_field t field = - t.fields <- Cons_field(field, t.fields); - t.size <- t.size + size_of_field field; - () - -(** Add the contents of src as is *) -let concat t ~src = - t.fields <- Cons_fields(src.fields, t.fields); - t.size <- t.size + src.size; + let size = size_of_field field in + let elem, tl = match t.data with + | { offset; buffer } as elem :: tl when Bytes.length buffer - offset >= size -> elem, tl + | tl -> { offset = 0; buffer = Bytes.create (size + space_overhead) }, tl + in + (* Write *) + let offset = write_naked_field elem.buffer ~offset:elem.offset field in + elem.offset <- offset; + t.data <- elem :: tl; () let write_field_header : t -> int -> int -> unit = @@ -142,12 +124,37 @@ let write_field : t -> int -> Field.t -> unit = write_field_header t index field_type; add_field t field -(** Add the contents of src as a length_delimited field *) -let concat_as_length_delimited t ~src index = - let size = size src in +let add_length_delimited_field_header t index = + let sentinel = { offset = 0; buffer = Bytes.create 20; } in + t.data <- sentinel :: t.data; write_field_header t index 2; - add_field t (Varint_unboxed size); - concat t ~src + let offset = sentinel.offset in + sentinel.offset <- 20; (* Make sure nothing is written to this again *) + let rec size_data_added acc = function + | [] -> failwith "End of list reached. This is impossible" + | x :: _ when x == sentinel -> acc + | { offset; _ } :: xs -> size_data_added (offset + acc) xs + in + (* Return a function to use when done *) + fun () -> + let size = size_data_added 0 t.data in + let offset = write_naked_field sentinel.buffer ~offset (Varint_unboxed size) in + sentinel.offset <- offset; + () + +let contents t = + let size = size t in + let contents = Bytes.create size in + let rec inner offset = function + | [] -> offset + | { offset = o; buffer} :: tl -> + let next_offset = offset - o in + Bytes.blit ~src:buffer ~src_pos:0 ~dst:contents ~dst_pos:next_offset ~len:o; + inner (next_offset) tl + in + let offset = inner size t.data in + assert (offset = 0); + Bytes.unsafe_to_string contents let dump t = let string_contents = contents t in @@ -164,6 +171,10 @@ let of_list: (int * Field.t) list -> t = fun fields -> let%expect_test "Writefield" = let buffer = init () in - write_field buffer 1 (Varint 1L); + write_field buffer 1 (Varint 3L); + write_field buffer 2 (Varint 5L); + write_field buffer 3 (Varint 7L); + write_field buffer 4 (Varint 11L); + dump buffer; - [%expect {| Buffer: 08-01 |}] + [%expect {| Buffer: 08-03-10-05-18-07-20-0b |}] diff --git a/src/ocaml_protoc_plugin/writer.mli b/src/ocaml_protoc_plugin/writer.mli index 505d6b4..cb554cf 100644 --- a/src/ocaml_protoc_plugin/writer.mli +++ b/src/ocaml_protoc_plugin/writer.mli @@ -18,6 +18,6 @@ val write_length_delimited : val write_field : t -> int -> Field.t -> unit val add_field : t -> Field.t -> unit -val concat_as_length_delimited : t -> src:t -> int -> unit +val add_length_delimited_field_header : t -> int -> (unit -> unit) val dump : t -> unit (**/**) diff --git a/src/plugin/emit.ml b/src/plugin/emit.ml index 80f8076..0422777 100644 --- a/src/plugin/emit.ml +++ b/src/plugin/emit.ml @@ -225,6 +225,7 @@ let rec emit_message ~params ~syntax scope Code.emit signature `None "val name': unit -> string"; Code.emit signature `None "type t = %s %s" type' params.annot; Code.emit signature `None "val make : %s" default_constructor_sig; + Code.emit signature `None "val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t"; Code.emit signature `None "val to_proto: t -> Runtime'.Writer.t"; Code.emit signature `None "val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result"; Code.emit signature `None "val from_proto_exn: Runtime'.Reader.t -> t"; @@ -235,12 +236,15 @@ let rec emit_message ~params ~syntax scope Code.emit implementation `None "%s" default_constructor_impl; Code.emit implementation `End ""; - Code.emit implementation `Begin "let to_proto ="; + Code.emit implementation `Begin "let to_proto' ="; Code.emit implementation `None "let apply = %s in" apply; Code.emit implementation `None "let spec = %s in" serialize_spec; - Code.emit implementation `None "let serialize = Runtime'.Serialize.serialize %s (spec) in" extension_ranges; - Code.emit implementation `None "fun t -> apply ~f:serialize t"; + Code.emit implementation `None "let serialize = Runtime'.Serialize.serialize %s spec in" extension_ranges; + Code.emit implementation `None "fun writer t -> apply ~f:serialize writer t"; Code.emit implementation `End ""; + Code.emit implementation `Begin "let to_proto t = to_proto' (Runtime'.Writer.init ()) t"; + Code.emit implementation `End ""; + Code.emit implementation `Begin "let from_proto_exn ="; Code.emit implementation `None "let constructor = %s in" constructor; diff --git a/src/plugin/types.ml b/src/plugin/types.ml index 0965040..9f67fad 100644 --- a/src/plugin/types.ml +++ b/src/plugin/types.ml @@ -222,7 +222,7 @@ let type_of_spec: type a. a spec -> string = function let spec_of_message ~scope type_name = let type' = Scope.get_scoped_name ~postfix:"t" scope type_name in let deserialize_func = Scope.get_scoped_name ~postfix:"from_proto_exn" scope type_name in - let serialize_func = Scope.get_scoped_name ~postfix:"to_proto" scope type_name in + let serialize_func = Scope.get_scoped_name ~postfix:"to_proto'" scope type_name in Message (type', deserialize_func, serialize_func, None) let spec_of_enum ~scope type_name default = @@ -600,7 +600,7 @@ let make ~params ~syntax ~is_cyclic ~is_map_entry ~has_extensions ~scope ~fields (if has_extensions then "extensions'" else "_extensions") args (type_destr fields) in let apply = - sprintf "fun ~f:f' %s -> f' %s %s" + sprintf "fun ~f:f' writer %s -> f' %s writer %s" (type_destr fields) (if has_extensions then "extensions'" else "[]") args in diff --git a/src/spec/descriptor.ml b/src/spec/descriptor.ml index 7628525..5f03ceb 100644 --- a/src/spec/descriptor.ml +++ b/src/spec/descriptor.ml @@ -24,6 +24,7 @@ module Google = struct val name': unit -> string type t = FileDescriptorProto.t list val make : ?file:FileDescriptorProto.t list -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -35,11 +36,13 @@ module Google = struct let file = match file with Some v -> v | None -> [] in file - let to_proto = - let apply = fun ~f:f' file -> f' [] file in - let spec = Runtime'.Serialize.C.( repeated (1, (message (fun t -> FileDescriptorProto.to_proto t)), not_packed) ^:: nil ) in - let serialize = Runtime'.Serialize.serialize [] (spec) in - fun t -> apply ~f:serialize t + let to_proto' = + let apply = fun ~f:f' writer file -> f' [] writer file in + let spec = Runtime'.Serialize.C.( repeated (1, (message (fun t -> FileDescriptorProto.to_proto' t)), not_packed) ^:: nil ) in + let serialize = Runtime'.Serialize.serialize [] spec in + fun writer t -> apply ~f:serialize writer t + + let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = let constructor = fun _extensions file -> file in @@ -53,6 +56,7 @@ module Google = struct val name': unit -> string type t = { name: string option; package: string option; dependency: string list; public_dependency: int list; weak_dependency: int list; message_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; service: ServiceDescriptorProto.t list; extension: FieldDescriptorProto.t list; options: FileOptions.t option; source_code_info: SourceCodeInfo.t option; syntax: string option } val make : ?name:string -> ?package:string -> ?dependency:string list -> ?public_dependency:int list -> ?weak_dependency:int list -> ?message_type:DescriptorProto.t list -> ?enum_type:EnumDescriptorProto.t list -> ?service:ServiceDescriptorProto.t list -> ?extension:FieldDescriptorProto.t list -> ?options:FileOptions.t -> ?source_code_info:SourceCodeInfo.t -> ?syntax:string -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -70,11 +74,13 @@ module Google = struct let extension = match extension with Some v -> v | None -> [] in { name; package; dependency; public_dependency; weak_dependency; message_type; enum_type; service; extension; options; source_code_info; syntax } - let to_proto = - let apply = fun ~f:f' { name; package; dependency; public_dependency; weak_dependency; message_type; enum_type; service; extension; options; source_code_info; syntax } -> f' [] name package dependency public_dependency weak_dependency message_type enum_type service extension options source_code_info syntax in - let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (2, string) ^:: repeated (3, string, not_packed) ^:: repeated (10, int32_int, not_packed) ^:: repeated (11, int32_int, not_packed) ^:: repeated (4, (message (fun t -> DescriptorProto.to_proto t)), not_packed) ^:: repeated (5, (message (fun t -> EnumDescriptorProto.to_proto t)), not_packed) ^:: repeated (6, (message (fun t -> ServiceDescriptorProto.to_proto t)), not_packed) ^:: repeated (7, (message (fun t -> FieldDescriptorProto.to_proto t)), not_packed) ^:: basic_opt (8, (message (fun t -> FileOptions.to_proto t))) ^:: basic_opt (9, (message (fun t -> SourceCodeInfo.to_proto t))) ^:: basic_opt (12, string) ^:: nil ) in - let serialize = Runtime'.Serialize.serialize [] (spec) in - fun t -> apply ~f:serialize t + let to_proto' = + let apply = fun ~f:f' writer { name; package; dependency; public_dependency; weak_dependency; message_type; enum_type; service; extension; options; source_code_info; syntax } -> f' [] writer name package dependency public_dependency weak_dependency message_type enum_type service extension options source_code_info syntax in + let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (2, string) ^:: repeated (3, string, not_packed) ^:: repeated (10, int32_int, not_packed) ^:: repeated (11, int32_int, not_packed) ^:: repeated (4, (message (fun t -> DescriptorProto.to_proto' t)), not_packed) ^:: repeated (5, (message (fun t -> EnumDescriptorProto.to_proto' t)), not_packed) ^:: repeated (6, (message (fun t -> ServiceDescriptorProto.to_proto' t)), not_packed) ^:: repeated (7, (message (fun t -> FieldDescriptorProto.to_proto' t)), not_packed) ^:: basic_opt (8, (message (fun t -> FileOptions.to_proto' t))) ^:: basic_opt (9, (message (fun t -> SourceCodeInfo.to_proto' t))) ^:: basic_opt (12, string) ^:: nil ) in + let serialize = Runtime'.Serialize.serialize [] spec in + fun writer t -> apply ~f:serialize writer t + + let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = let constructor = fun _extensions name package dependency public_dependency weak_dependency message_type enum_type service extension options source_code_info syntax -> { name; package; dependency; public_dependency; weak_dependency; message_type; enum_type; service; extension; options; source_code_info; syntax } in @@ -89,6 +95,7 @@ module Google = struct val name': unit -> string type t = { start: int option; end': int option; options: ExtensionRangeOptions.t option } val make : ?start:int -> ?end':int -> ?options:ExtensionRangeOptions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -97,6 +104,7 @@ module Google = struct val name': unit -> string type t = { start: int option; end': int option } val make : ?start:int -> ?end':int -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -104,6 +112,7 @@ module Google = struct val name': unit -> string type t = { name: string option; field: FieldDescriptorProto.t list; extension: FieldDescriptorProto.t list; nested_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; extension_range: DescriptorProto.ExtensionRange.t list; oneof_decl: OneofDescriptorProto.t list; options: MessageOptions.t option; reserved_range: DescriptorProto.ReservedRange.t list; reserved_name: string list } val make : ?name:string -> ?field:FieldDescriptorProto.t list -> ?extension:FieldDescriptorProto.t list -> ?nested_type:DescriptorProto.t list -> ?enum_type:EnumDescriptorProto.t list -> ?extension_range:DescriptorProto.ExtensionRange.t list -> ?oneof_decl:OneofDescriptorProto.t list -> ?options:MessageOptions.t -> ?reserved_range:DescriptorProto.ReservedRange.t list -> ?reserved_name:string list -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -112,6 +121,7 @@ module Google = struct val name': unit -> string type t = { start: int option; end': int option; options: ExtensionRangeOptions.t option } val make : ?start:int -> ?end':int -> ?options:ExtensionRangeOptions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -123,11 +133,13 @@ module Google = struct { start; end'; options } - let to_proto = - let apply = fun ~f:f' { start; end'; options } -> f' [] start end' options in - let spec = Runtime'.Serialize.C.( basic_opt (1, int32_int) ^:: basic_opt (2, int32_int) ^:: basic_opt (3, (message (fun t -> ExtensionRangeOptions.to_proto t))) ^:: nil ) in - let serialize = Runtime'.Serialize.serialize [] (spec) in - fun t -> apply ~f:serialize t + let to_proto' = + let apply = fun ~f:f' writer { start; end'; options } -> f' [] writer start end' options in + let spec = Runtime'.Serialize.C.( basic_opt (1, int32_int) ^:: basic_opt (2, int32_int) ^:: basic_opt (3, (message (fun t -> ExtensionRangeOptions.to_proto' t))) ^:: nil ) in + let serialize = Runtime'.Serialize.serialize [] spec in + fun writer t -> apply ~f:serialize writer t + + let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = let constructor = fun _extensions start end' options -> { start; end'; options } in @@ -141,6 +153,7 @@ module Google = struct val name': unit -> string type t = { start: int option; end': int option } val make : ?start:int -> ?end':int -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -152,11 +165,13 @@ module Google = struct { start; end' } - let to_proto = - let apply = fun ~f:f' { start; end' } -> f' [] start end' in + let to_proto' = + let apply = fun ~f:f' writer { start; end' } -> f' [] writer start end' in let spec = Runtime'.Serialize.C.( basic_opt (1, int32_int) ^:: basic_opt (2, int32_int) ^:: nil ) in - let serialize = Runtime'.Serialize.serialize [] (spec) in - fun t -> apply ~f:serialize t + let serialize = Runtime'.Serialize.serialize [] spec in + fun writer t -> apply ~f:serialize writer t + + let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = let constructor = fun _extensions start end' -> { start; end' } in @@ -180,11 +195,13 @@ module Google = struct let reserved_name = match reserved_name with Some v -> v | None -> [] in { name; field; extension; nested_type; enum_type; extension_range; oneof_decl; options; reserved_range; reserved_name } - let to_proto = - let apply = fun ~f:f' { name; field; extension; nested_type; enum_type; extension_range; oneof_decl; options; reserved_range; reserved_name } -> f' [] name field extension nested_type enum_type extension_range oneof_decl options reserved_range reserved_name in - let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> FieldDescriptorProto.to_proto t)), not_packed) ^:: repeated (6, (message (fun t -> FieldDescriptorProto.to_proto t)), not_packed) ^:: repeated (3, (message (fun t -> DescriptorProto.to_proto t)), not_packed) ^:: repeated (4, (message (fun t -> EnumDescriptorProto.to_proto t)), not_packed) ^:: repeated (5, (message (fun t -> DescriptorProto.ExtensionRange.to_proto t)), not_packed) ^:: repeated (8, (message (fun t -> OneofDescriptorProto.to_proto t)), not_packed) ^:: basic_opt (7, (message (fun t -> MessageOptions.to_proto t))) ^:: repeated (9, (message (fun t -> DescriptorProto.ReservedRange.to_proto t)), not_packed) ^:: repeated (10, string, not_packed) ^:: nil ) in - let serialize = Runtime'.Serialize.serialize [] (spec) in - fun t -> apply ~f:serialize t + let to_proto' = + let apply = fun ~f:f' writer { name; field; extension; nested_type; enum_type; extension_range; oneof_decl; options; reserved_range; reserved_name } -> f' [] writer name field extension nested_type enum_type extension_range oneof_decl options reserved_range reserved_name in + let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> FieldDescriptorProto.to_proto' t)), not_packed) ^:: repeated (6, (message (fun t -> FieldDescriptorProto.to_proto' t)), not_packed) ^:: repeated (3, (message (fun t -> DescriptorProto.to_proto' t)), not_packed) ^:: repeated (4, (message (fun t -> EnumDescriptorProto.to_proto' t)), not_packed) ^:: repeated (5, (message (fun t -> DescriptorProto.ExtensionRange.to_proto' t)), not_packed) ^:: repeated (8, (message (fun t -> OneofDescriptorProto.to_proto' t)), not_packed) ^:: basic_opt (7, (message (fun t -> MessageOptions.to_proto' t))) ^:: repeated (9, (message (fun t -> DescriptorProto.ReservedRange.to_proto' t)), not_packed) ^:: repeated (10, string, not_packed) ^:: nil ) in + let serialize = Runtime'.Serialize.serialize [] spec in + fun writer t -> apply ~f:serialize writer t + + let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = let constructor = fun _extensions name field extension nested_type enum_type extension_range oneof_decl options reserved_range reserved_name -> { name; field; extension; nested_type; enum_type; extension_range; oneof_decl; options; reserved_range; reserved_name } in @@ -198,6 +215,7 @@ module Google = struct val name': unit -> string type t = { uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } val make : ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -209,11 +227,13 @@ module Google = struct let uninterpreted_option = match uninterpreted_option with Some v -> v | None -> [] in { uninterpreted_option; extensions' } - let to_proto = - let apply = fun ~f:f' { uninterpreted_option; extensions' } -> f' extensions' uninterpreted_option in - let spec = Runtime'.Serialize.C.( repeated (999, (message (fun t -> UninterpretedOption.to_proto t)), not_packed) ^:: nil ) in - let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] (spec) in - fun t -> apply ~f:serialize t + let to_proto' = + let apply = fun ~f:f' writer { uninterpreted_option; extensions' } -> f' extensions' writer uninterpreted_option in + let spec = Runtime'.Serialize.C.( repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in + let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] spec in + fun writer t -> apply ~f:serialize writer t + + let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = let constructor = fun extensions' uninterpreted_option -> { uninterpreted_option; extensions' } in @@ -239,6 +259,7 @@ module Google = struct val name': unit -> string type t = { name: string option; number: int option; label: FieldDescriptorProto.Label.t option; type': FieldDescriptorProto.Type.t option; type_name: string option; extendee: string option; default_value: string option; oneof_index: int option; json_name: string option; options: FieldOptions.t option; proto3_optional: bool option } val make : ?name:string -> ?number:int -> ?label:FieldDescriptorProto.Label.t -> ?type':FieldDescriptorProto.Type.t -> ?type_name:string -> ?extendee:string -> ?default_value:string -> ?oneof_index:int -> ?json_name:string -> ?options:FieldOptions.t -> ?proto3_optional:bool -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -320,11 +341,13 @@ module Google = struct { name; number; label; type'; type_name; extendee; default_value; oneof_index; json_name; options; proto3_optional } - let to_proto = - let apply = fun ~f:f' { name; number; label; type'; type_name; extendee; default_value; oneof_index; json_name; options; proto3_optional } -> f' [] name number label type' type_name extendee default_value oneof_index json_name options proto3_optional in - let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (3, int32_int) ^:: basic_opt (4, (enum FieldDescriptorProto.Label.to_int)) ^:: basic_opt (5, (enum FieldDescriptorProto.Type.to_int)) ^:: basic_opt (6, string) ^:: basic_opt (2, string) ^:: basic_opt (7, string) ^:: basic_opt (9, int32_int) ^:: basic_opt (10, string) ^:: basic_opt (8, (message (fun t -> FieldOptions.to_proto t))) ^:: basic_opt (17, bool) ^:: nil ) in - let serialize = Runtime'.Serialize.serialize [] (spec) in - fun t -> apply ~f:serialize t + let to_proto' = + let apply = fun ~f:f' writer { name; number; label; type'; type_name; extendee; default_value; oneof_index; json_name; options; proto3_optional } -> f' [] writer name number label type' type_name extendee default_value oneof_index json_name options proto3_optional in + let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (3, int32_int) ^:: basic_opt (4, (enum FieldDescriptorProto.Label.to_int)) ^:: basic_opt (5, (enum FieldDescriptorProto.Type.to_int)) ^:: basic_opt (6, string) ^:: basic_opt (2, string) ^:: basic_opt (7, string) ^:: basic_opt (9, int32_int) ^:: basic_opt (10, string) ^:: basic_opt (8, (message (fun t -> FieldOptions.to_proto' t))) ^:: basic_opt (17, bool) ^:: nil ) in + let serialize = Runtime'.Serialize.serialize [] spec in + fun writer t -> apply ~f:serialize writer t + + let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = let constructor = fun _extensions name number label type' type_name extendee default_value oneof_index json_name options proto3_optional -> { name; number; label; type'; type_name; extendee; default_value; oneof_index; json_name; options; proto3_optional } in @@ -338,6 +361,7 @@ module Google = struct val name': unit -> string type t = { name: string option; options: OneofOptions.t option } val make : ?name:string -> ?options:OneofOptions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -349,11 +373,13 @@ module Google = struct { name; options } - let to_proto = - let apply = fun ~f:f' { name; options } -> f' [] name options in - let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (2, (message (fun t -> OneofOptions.to_proto t))) ^:: nil ) in - let serialize = Runtime'.Serialize.serialize [] (spec) in - fun t -> apply ~f:serialize t + let to_proto' = + let apply = fun ~f:f' writer { name; options } -> f' [] writer name options in + let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (2, (message (fun t -> OneofOptions.to_proto' t))) ^:: nil ) in + let serialize = Runtime'.Serialize.serialize [] spec in + fun writer t -> apply ~f:serialize writer t + + let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = let constructor = fun _extensions name options -> { name; options } in @@ -368,6 +394,7 @@ module Google = struct val name': unit -> string type t = { start: int option; end': int option } val make : ?start:int -> ?end':int -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -375,6 +402,7 @@ module Google = struct val name': unit -> string type t = { name: string option; value: EnumValueDescriptorProto.t list; options: EnumOptions.t option; reserved_range: EnumDescriptorProto.EnumReservedRange.t list; reserved_name: string list } val make : ?name:string -> ?value:EnumValueDescriptorProto.t list -> ?options:EnumOptions.t -> ?reserved_range:EnumDescriptorProto.EnumReservedRange.t list -> ?reserved_name:string list -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -383,6 +411,7 @@ module Google = struct val name': unit -> string type t = { start: int option; end': int option } val make : ?start:int -> ?end':int -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -394,11 +423,13 @@ module Google = struct { start; end' } - let to_proto = - let apply = fun ~f:f' { start; end' } -> f' [] start end' in + let to_proto' = + let apply = fun ~f:f' writer { start; end' } -> f' [] writer start end' in let spec = Runtime'.Serialize.C.( basic_opt (1, int32_int) ^:: basic_opt (2, int32_int) ^:: nil ) in - let serialize = Runtime'.Serialize.serialize [] (spec) in - fun t -> apply ~f:serialize t + let serialize = Runtime'.Serialize.serialize [] spec in + fun writer t -> apply ~f:serialize writer t + + let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = let constructor = fun _extensions start end' -> { start; end' } in @@ -417,11 +448,13 @@ module Google = struct let reserved_name = match reserved_name with Some v -> v | None -> [] in { name; value; options; reserved_range; reserved_name } - let to_proto = - let apply = fun ~f:f' { name; value; options; reserved_range; reserved_name } -> f' [] name value options reserved_range reserved_name in - let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> EnumValueDescriptorProto.to_proto t)), not_packed) ^:: basic_opt (3, (message (fun t -> EnumOptions.to_proto t))) ^:: repeated (4, (message (fun t -> EnumDescriptorProto.EnumReservedRange.to_proto t)), not_packed) ^:: repeated (5, string, not_packed) ^:: nil ) in - let serialize = Runtime'.Serialize.serialize [] (spec) in - fun t -> apply ~f:serialize t + let to_proto' = + let apply = fun ~f:f' writer { name; value; options; reserved_range; reserved_name } -> f' [] writer name value options reserved_range reserved_name in + let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> EnumValueDescriptorProto.to_proto' t)), not_packed) ^:: basic_opt (3, (message (fun t -> EnumOptions.to_proto' t))) ^:: repeated (4, (message (fun t -> EnumDescriptorProto.EnumReservedRange.to_proto' t)), not_packed) ^:: repeated (5, string, not_packed) ^:: nil ) in + let serialize = Runtime'.Serialize.serialize [] spec in + fun writer t -> apply ~f:serialize writer t + + let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = let constructor = fun _extensions name value options reserved_range reserved_name -> { name; value; options; reserved_range; reserved_name } in @@ -435,6 +468,7 @@ module Google = struct val name': unit -> string type t = { name: string option; number: int option; options: EnumValueOptions.t option } val make : ?name:string -> ?number:int -> ?options:EnumValueOptions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -446,11 +480,13 @@ module Google = struct { name; number; options } - let to_proto = - let apply = fun ~f:f' { name; number; options } -> f' [] name number options in - let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (2, int32_int) ^:: basic_opt (3, (message (fun t -> EnumValueOptions.to_proto t))) ^:: nil ) in - let serialize = Runtime'.Serialize.serialize [] (spec) in - fun t -> apply ~f:serialize t + let to_proto' = + let apply = fun ~f:f' writer { name; number; options } -> f' [] writer name number options in + let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (2, int32_int) ^:: basic_opt (3, (message (fun t -> EnumValueOptions.to_proto' t))) ^:: nil ) in + let serialize = Runtime'.Serialize.serialize [] spec in + fun writer t -> apply ~f:serialize writer t + + let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = let constructor = fun _extensions name number options -> { name; number; options } in @@ -464,6 +500,7 @@ module Google = struct val name': unit -> string type t = { name: string option; method': MethodDescriptorProto.t list; options: ServiceOptions.t option } val make : ?name:string -> ?method':MethodDescriptorProto.t list -> ?options:ServiceOptions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -475,11 +512,13 @@ module Google = struct let method' = match method' with Some v -> v | None -> [] in { name; method'; options } - let to_proto = - let apply = fun ~f:f' { name; method'; options } -> f' [] name method' options in - let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> MethodDescriptorProto.to_proto t)), not_packed) ^:: basic_opt (3, (message (fun t -> ServiceOptions.to_proto t))) ^:: nil ) in - let serialize = Runtime'.Serialize.serialize [] (spec) in - fun t -> apply ~f:serialize t + let to_proto' = + let apply = fun ~f:f' writer { name; method'; options } -> f' [] writer name method' options in + let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> MethodDescriptorProto.to_proto' t)), not_packed) ^:: basic_opt (3, (message (fun t -> ServiceOptions.to_proto' t))) ^:: nil ) in + let serialize = Runtime'.Serialize.serialize [] spec in + fun writer t -> apply ~f:serialize writer t + + let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = let constructor = fun _extensions name method' options -> { name; method'; options } in @@ -493,6 +532,7 @@ module Google = struct val name': unit -> string type t = { name: string option; input_type: string option; output_type: string option; options: MethodOptions.t option; client_streaming: bool; server_streaming: bool } val make : ?name:string -> ?input_type:string -> ?output_type:string -> ?options:MethodOptions.t -> ?client_streaming:bool -> ?server_streaming:bool -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -505,11 +545,13 @@ module Google = struct let server_streaming = match server_streaming with Some v -> v | None -> false in { name; input_type; output_type; options; client_streaming; server_streaming } - let to_proto = - let apply = fun ~f:f' { name; input_type; output_type; options; client_streaming; server_streaming } -> f' [] name input_type output_type options client_streaming server_streaming in - let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (2, string) ^:: basic_opt (3, string) ^:: basic_opt (4, (message (fun t -> MethodOptions.to_proto t))) ^:: basic (5, bool, proto2 (false)) ^:: basic (6, bool, proto2 (false)) ^:: nil ) in - let serialize = Runtime'.Serialize.serialize [] (spec) in - fun t -> apply ~f:serialize t + let to_proto' = + let apply = fun ~f:f' writer { name; input_type; output_type; options; client_streaming; server_streaming } -> f' [] writer name input_type output_type options client_streaming server_streaming in + let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (2, string) ^:: basic_opt (3, string) ^:: basic_opt (4, (message (fun t -> MethodOptions.to_proto' t))) ^:: basic (5, bool, proto2 (false)) ^:: basic (6, bool, proto2 (false)) ^:: nil ) in + let serialize = Runtime'.Serialize.serialize [] spec in + fun writer t -> apply ~f:serialize writer t + + let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = let constructor = fun _extensions name input_type output_type options client_streaming server_streaming -> { name; input_type; output_type; options; client_streaming; server_streaming } in @@ -529,6 +571,7 @@ module Google = struct val name': unit -> string type t = { java_package: string option; java_outer_classname: string option; java_multiple_files: bool; java_generate_equals_and_hash: bool option; java_string_check_utf8: bool; optimize_for: FileOptions.OptimizeMode.t; go_package: string option; cc_generic_services: bool; java_generic_services: bool; py_generic_services: bool; php_generic_services: bool; deprecated: bool; cc_enable_arenas: bool; objc_class_prefix: string option; csharp_namespace: string option; swift_prefix: string option; php_class_prefix: string option; php_namespace: string option; php_metadata_namespace: string option; ruby_package: string option; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } val make : ?java_package:string -> ?java_outer_classname:string -> ?java_multiple_files:bool -> ?java_generate_equals_and_hash:bool -> ?java_string_check_utf8:bool -> ?optimize_for:FileOptions.OptimizeMode.t -> ?go_package:string -> ?cc_generic_services:bool -> ?java_generic_services:bool -> ?py_generic_services:bool -> ?php_generic_services:bool -> ?deprecated:bool -> ?cc_enable_arenas:bool -> ?objc_class_prefix:string -> ?csharp_namespace:string -> ?swift_prefix:string -> ?php_class_prefix:string -> ?php_namespace:string -> ?php_metadata_namespace:string -> ?ruby_package:string -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -569,11 +612,13 @@ module Google = struct let uninterpreted_option = match uninterpreted_option with Some v -> v | None -> [] in { java_package; java_outer_classname; java_multiple_files; java_generate_equals_and_hash; java_string_check_utf8; optimize_for; go_package; cc_generic_services; java_generic_services; py_generic_services; php_generic_services; deprecated; cc_enable_arenas; objc_class_prefix; csharp_namespace; swift_prefix; php_class_prefix; php_namespace; php_metadata_namespace; ruby_package; uninterpreted_option; extensions' } - let to_proto = - let apply = fun ~f:f' { java_package; java_outer_classname; java_multiple_files; java_generate_equals_and_hash; java_string_check_utf8; optimize_for; go_package; cc_generic_services; java_generic_services; py_generic_services; php_generic_services; deprecated; cc_enable_arenas; objc_class_prefix; csharp_namespace; swift_prefix; php_class_prefix; php_namespace; php_metadata_namespace; ruby_package; uninterpreted_option; extensions' } -> f' extensions' java_package java_outer_classname java_multiple_files java_generate_equals_and_hash java_string_check_utf8 optimize_for go_package cc_generic_services java_generic_services py_generic_services php_generic_services deprecated cc_enable_arenas objc_class_prefix csharp_namespace swift_prefix php_class_prefix php_namespace php_metadata_namespace ruby_package uninterpreted_option in - let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (8, string) ^:: basic (10, bool, proto2 (false)) ^:: basic_opt (20, bool) ^:: basic (27, bool, proto2 (false)) ^:: basic (9, (enum FileOptions.OptimizeMode.to_int), proto2 (FileOptions.OptimizeMode.SPEED)) ^:: basic_opt (11, string) ^:: basic (16, bool, proto2 (false)) ^:: basic (17, bool, proto2 (false)) ^:: basic (18, bool, proto2 (false)) ^:: basic (42, bool, proto2 (false)) ^:: basic (23, bool, proto2 (false)) ^:: basic (31, bool, proto2 (true)) ^:: basic_opt (36, string) ^:: basic_opt (37, string) ^:: basic_opt (39, string) ^:: basic_opt (40, string) ^:: basic_opt (41, string) ^:: basic_opt (44, string) ^:: basic_opt (45, string) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto t)), not_packed) ^:: nil ) in - let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] (spec) in - fun t -> apply ~f:serialize t + let to_proto' = + let apply = fun ~f:f' writer { java_package; java_outer_classname; java_multiple_files; java_generate_equals_and_hash; java_string_check_utf8; optimize_for; go_package; cc_generic_services; java_generic_services; py_generic_services; php_generic_services; deprecated; cc_enable_arenas; objc_class_prefix; csharp_namespace; swift_prefix; php_class_prefix; php_namespace; php_metadata_namespace; ruby_package; uninterpreted_option; extensions' } -> f' extensions' writer java_package java_outer_classname java_multiple_files java_generate_equals_and_hash java_string_check_utf8 optimize_for go_package cc_generic_services java_generic_services py_generic_services php_generic_services deprecated cc_enable_arenas objc_class_prefix csharp_namespace swift_prefix php_class_prefix php_namespace php_metadata_namespace ruby_package uninterpreted_option in + let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (8, string) ^:: basic (10, bool, proto2 (false)) ^:: basic_opt (20, bool) ^:: basic (27, bool, proto2 (false)) ^:: basic (9, (enum FileOptions.OptimizeMode.to_int), proto2 (FileOptions.OptimizeMode.SPEED)) ^:: basic_opt (11, string) ^:: basic (16, bool, proto2 (false)) ^:: basic (17, bool, proto2 (false)) ^:: basic (18, bool, proto2 (false)) ^:: basic (42, bool, proto2 (false)) ^:: basic (23, bool, proto2 (false)) ^:: basic (31, bool, proto2 (true)) ^:: basic_opt (36, string) ^:: basic_opt (37, string) ^:: basic_opt (39, string) ^:: basic_opt (40, string) ^:: basic_opt (41, string) ^:: basic_opt (44, string) ^:: basic_opt (45, string) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in + let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] spec in + fun writer t -> apply ~f:serialize writer t + + let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = let constructor = fun extensions' java_package java_outer_classname java_multiple_files java_generate_equals_and_hash java_string_check_utf8 optimize_for go_package cc_generic_services java_generic_services py_generic_services php_generic_services deprecated cc_enable_arenas objc_class_prefix csharp_namespace swift_prefix php_class_prefix php_namespace php_metadata_namespace ruby_package uninterpreted_option -> { java_package; java_outer_classname; java_multiple_files; java_generate_equals_and_hash; java_string_check_utf8; optimize_for; go_package; cc_generic_services; java_generic_services; py_generic_services; php_generic_services; deprecated; cc_enable_arenas; objc_class_prefix; csharp_namespace; swift_prefix; php_class_prefix; php_namespace; php_metadata_namespace; ruby_package; uninterpreted_option; extensions' } in @@ -587,6 +632,7 @@ module Google = struct val name': unit -> string type t = { message_set_wire_format: bool; no_standard_descriptor_accessor: bool; deprecated: bool; map_entry: bool option; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } val make : ?message_set_wire_format:bool -> ?no_standard_descriptor_accessor:bool -> ?deprecated:bool -> ?map_entry:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -601,11 +647,13 @@ module Google = struct let uninterpreted_option = match uninterpreted_option with Some v -> v | None -> [] in { message_set_wire_format; no_standard_descriptor_accessor; deprecated; map_entry; uninterpreted_option; extensions' } - let to_proto = - let apply = fun ~f:f' { message_set_wire_format; no_standard_descriptor_accessor; deprecated; map_entry; uninterpreted_option; extensions' } -> f' extensions' message_set_wire_format no_standard_descriptor_accessor deprecated map_entry uninterpreted_option in - let spec = Runtime'.Serialize.C.( basic (1, bool, proto2 (false)) ^:: basic (2, bool, proto2 (false)) ^:: basic (3, bool, proto2 (false)) ^:: basic_opt (7, bool) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto t)), not_packed) ^:: nil ) in - let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] (spec) in - fun t -> apply ~f:serialize t + let to_proto' = + let apply = fun ~f:f' writer { message_set_wire_format; no_standard_descriptor_accessor; deprecated; map_entry; uninterpreted_option; extensions' } -> f' extensions' writer message_set_wire_format no_standard_descriptor_accessor deprecated map_entry uninterpreted_option in + let spec = Runtime'.Serialize.C.( basic (1, bool, proto2 (false)) ^:: basic (2, bool, proto2 (false)) ^:: basic (3, bool, proto2 (false)) ^:: basic_opt (7, bool) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in + let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] spec in + fun writer t -> apply ~f:serialize writer t + + let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = let constructor = fun extensions' message_set_wire_format no_standard_descriptor_accessor deprecated map_entry uninterpreted_option -> { message_set_wire_format; no_standard_descriptor_accessor; deprecated; map_entry; uninterpreted_option; extensions' } in @@ -631,6 +679,7 @@ module Google = struct val name': unit -> string type t = { ctype: FieldOptions.CType.t; packed: bool option; jstype: FieldOptions.JSType.t; lazy': bool; unverified_lazy: bool; deprecated: bool; weak: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } val make : ?ctype:FieldOptions.CType.t -> ?packed:bool -> ?jstype:FieldOptions.JSType.t -> ?lazy':bool -> ?unverified_lazy:bool -> ?deprecated:bool -> ?weak:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -688,11 +737,13 @@ module Google = struct let uninterpreted_option = match uninterpreted_option with Some v -> v | None -> [] in { ctype; packed; jstype; lazy'; unverified_lazy; deprecated; weak; uninterpreted_option; extensions' } - let to_proto = - let apply = fun ~f:f' { ctype; packed; jstype; lazy'; unverified_lazy; deprecated; weak; uninterpreted_option; extensions' } -> f' extensions' ctype packed jstype lazy' unverified_lazy deprecated weak uninterpreted_option in - let spec = Runtime'.Serialize.C.( basic (1, (enum FieldOptions.CType.to_int), proto2 (FieldOptions.CType.STRING)) ^:: basic_opt (2, bool) ^:: basic (6, (enum FieldOptions.JSType.to_int), proto2 (FieldOptions.JSType.JS_NORMAL)) ^:: basic (5, bool, proto2 (false)) ^:: basic (15, bool, proto2 (false)) ^:: basic (3, bool, proto2 (false)) ^:: basic (10, bool, proto2 (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto t)), not_packed) ^:: nil ) in - let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] (spec) in - fun t -> apply ~f:serialize t + let to_proto' = + let apply = fun ~f:f' writer { ctype; packed; jstype; lazy'; unverified_lazy; deprecated; weak; uninterpreted_option; extensions' } -> f' extensions' writer ctype packed jstype lazy' unverified_lazy deprecated weak uninterpreted_option in + let spec = Runtime'.Serialize.C.( basic (1, (enum FieldOptions.CType.to_int), proto2 (FieldOptions.CType.STRING)) ^:: basic_opt (2, bool) ^:: basic (6, (enum FieldOptions.JSType.to_int), proto2 (FieldOptions.JSType.JS_NORMAL)) ^:: basic (5, bool, proto2 (false)) ^:: basic (15, bool, proto2 (false)) ^:: basic (3, bool, proto2 (false)) ^:: basic (10, bool, proto2 (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in + let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] spec in + fun writer t -> apply ~f:serialize writer t + + let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = let constructor = fun extensions' ctype packed jstype lazy' unverified_lazy deprecated weak uninterpreted_option -> { ctype; packed; jstype; lazy'; unverified_lazy; deprecated; weak; uninterpreted_option; extensions' } in @@ -706,6 +757,7 @@ module Google = struct val name': unit -> string type t = { uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } val make : ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -717,11 +769,13 @@ module Google = struct let uninterpreted_option = match uninterpreted_option with Some v -> v | None -> [] in { uninterpreted_option; extensions' } - let to_proto = - let apply = fun ~f:f' { uninterpreted_option; extensions' } -> f' extensions' uninterpreted_option in - let spec = Runtime'.Serialize.C.( repeated (999, (message (fun t -> UninterpretedOption.to_proto t)), not_packed) ^:: nil ) in - let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] (spec) in - fun t -> apply ~f:serialize t + let to_proto' = + let apply = fun ~f:f' writer { uninterpreted_option; extensions' } -> f' extensions' writer uninterpreted_option in + let spec = Runtime'.Serialize.C.( repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in + let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] spec in + fun writer t -> apply ~f:serialize writer t + + let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = let constructor = fun extensions' uninterpreted_option -> { uninterpreted_option; extensions' } in @@ -735,6 +789,7 @@ module Google = struct val name': unit -> string type t = { allow_alias: bool option; deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } val make : ?allow_alias:bool -> ?deprecated:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -747,11 +802,13 @@ module Google = struct let uninterpreted_option = match uninterpreted_option with Some v -> v | None -> [] in { allow_alias; deprecated; uninterpreted_option; extensions' } - let to_proto = - let apply = fun ~f:f' { allow_alias; deprecated; uninterpreted_option; extensions' } -> f' extensions' allow_alias deprecated uninterpreted_option in - let spec = Runtime'.Serialize.C.( basic_opt (2, bool) ^:: basic (3, bool, proto2 (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto t)), not_packed) ^:: nil ) in - let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] (spec) in - fun t -> apply ~f:serialize t + let to_proto' = + let apply = fun ~f:f' writer { allow_alias; deprecated; uninterpreted_option; extensions' } -> f' extensions' writer allow_alias deprecated uninterpreted_option in + let spec = Runtime'.Serialize.C.( basic_opt (2, bool) ^:: basic (3, bool, proto2 (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in + let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] spec in + fun writer t -> apply ~f:serialize writer t + + let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = let constructor = fun extensions' allow_alias deprecated uninterpreted_option -> { allow_alias; deprecated; uninterpreted_option; extensions' } in @@ -765,6 +822,7 @@ module Google = struct val name': unit -> string type t = { deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } val make : ?deprecated:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -777,11 +835,13 @@ module Google = struct let uninterpreted_option = match uninterpreted_option with Some v -> v | None -> [] in { deprecated; uninterpreted_option; extensions' } - let to_proto = - let apply = fun ~f:f' { deprecated; uninterpreted_option; extensions' } -> f' extensions' deprecated uninterpreted_option in - let spec = Runtime'.Serialize.C.( basic (1, bool, proto2 (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto t)), not_packed) ^:: nil ) in - let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] (spec) in - fun t -> apply ~f:serialize t + let to_proto' = + let apply = fun ~f:f' writer { deprecated; uninterpreted_option; extensions' } -> f' extensions' writer deprecated uninterpreted_option in + let spec = Runtime'.Serialize.C.( basic (1, bool, proto2 (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in + let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] spec in + fun writer t -> apply ~f:serialize writer t + + let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = let constructor = fun extensions' deprecated uninterpreted_option -> { deprecated; uninterpreted_option; extensions' } in @@ -795,6 +855,7 @@ module Google = struct val name': unit -> string type t = { deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } val make : ?deprecated:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -807,11 +868,13 @@ module Google = struct let uninterpreted_option = match uninterpreted_option with Some v -> v | None -> [] in { deprecated; uninterpreted_option; extensions' } - let to_proto = - let apply = fun ~f:f' { deprecated; uninterpreted_option; extensions' } -> f' extensions' deprecated uninterpreted_option in - let spec = Runtime'.Serialize.C.( basic (33, bool, proto2 (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto t)), not_packed) ^:: nil ) in - let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] (spec) in - fun t -> apply ~f:serialize t + let to_proto' = + let apply = fun ~f:f' writer { deprecated; uninterpreted_option; extensions' } -> f' extensions' writer deprecated uninterpreted_option in + let spec = Runtime'.Serialize.C.( basic (33, bool, proto2 (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in + let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] spec in + fun writer t -> apply ~f:serialize writer t + + let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = let constructor = fun extensions' deprecated uninterpreted_option -> { deprecated; uninterpreted_option; extensions' } in @@ -831,6 +894,7 @@ module Google = struct val name': unit -> string type t = { deprecated: bool; idempotency_level: MethodOptions.IdempotencyLevel.t; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } val make : ?deprecated:bool -> ?idempotency_level:MethodOptions.IdempotencyLevel.t -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -864,11 +928,13 @@ module Google = struct let uninterpreted_option = match uninterpreted_option with Some v -> v | None -> [] in { deprecated; idempotency_level; uninterpreted_option; extensions' } - let to_proto = - let apply = fun ~f:f' { deprecated; idempotency_level; uninterpreted_option; extensions' } -> f' extensions' deprecated idempotency_level uninterpreted_option in - let spec = Runtime'.Serialize.C.( basic (33, bool, proto2 (false)) ^:: basic (34, (enum MethodOptions.IdempotencyLevel.to_int), proto2 (MethodOptions.IdempotencyLevel.IDEMPOTENCY_UNKNOWN)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto t)), not_packed) ^:: nil ) in - let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] (spec) in - fun t -> apply ~f:serialize t + let to_proto' = + let apply = fun ~f:f' writer { deprecated; idempotency_level; uninterpreted_option; extensions' } -> f' extensions' writer deprecated idempotency_level uninterpreted_option in + let spec = Runtime'.Serialize.C.( basic (33, bool, proto2 (false)) ^:: basic (34, (enum MethodOptions.IdempotencyLevel.to_int), proto2 (MethodOptions.IdempotencyLevel.IDEMPOTENCY_UNKNOWN)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in + let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] spec in + fun writer t -> apply ~f:serialize writer t + + let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = let constructor = fun extensions' deprecated idempotency_level uninterpreted_option -> { deprecated; idempotency_level; uninterpreted_option; extensions' } in @@ -883,6 +949,7 @@ module Google = struct val name': unit -> string type t = { name_part: string; is_extension: bool } val make : name_part:string -> is_extension:bool -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -890,6 +957,7 @@ module Google = struct val name': unit -> string type t = { name: UninterpretedOption.NamePart.t list; identifier_value: string option; positive_int_value: int option; negative_int_value: int option; double_value: float option; string_value: bytes option; aggregate_value: string option } val make : ?name:UninterpretedOption.NamePart.t list -> ?identifier_value:string -> ?positive_int_value:int -> ?negative_int_value:int -> ?double_value:float -> ?string_value:bytes -> ?aggregate_value:string -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -898,6 +966,7 @@ module Google = struct val name': unit -> string type t = { name_part: string; is_extension: bool } val make : name_part:string -> is_extension:bool -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -909,11 +978,13 @@ module Google = struct { name_part; is_extension } - let to_proto = - let apply = fun ~f:f' { name_part; is_extension } -> f' [] name_part is_extension in + let to_proto' = + let apply = fun ~f:f' writer { name_part; is_extension } -> f' [] writer name_part is_extension in let spec = Runtime'.Serialize.C.( basic (1, string, required) ^:: basic (2, bool, required) ^:: nil ) in - let serialize = Runtime'.Serialize.serialize [] (spec) in - fun t -> apply ~f:serialize t + let serialize = Runtime'.Serialize.serialize [] spec in + fun writer t -> apply ~f:serialize writer t + + let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = let constructor = fun _extensions name_part is_extension -> { name_part; is_extension } in @@ -930,11 +1001,13 @@ module Google = struct let name = match name with Some v -> v | None -> [] in { name; identifier_value; positive_int_value; negative_int_value; double_value; string_value; aggregate_value } - let to_proto = - let apply = fun ~f:f' { name; identifier_value; positive_int_value; negative_int_value; double_value; string_value; aggregate_value } -> f' [] name identifier_value positive_int_value negative_int_value double_value string_value aggregate_value in - let spec = Runtime'.Serialize.C.( repeated (2, (message (fun t -> UninterpretedOption.NamePart.to_proto t)), not_packed) ^:: basic_opt (3, string) ^:: basic_opt (4, uint64_int) ^:: basic_opt (5, int64_int) ^:: basic_opt (6, double) ^:: basic_opt (7, bytes) ^:: basic_opt (8, string) ^:: nil ) in - let serialize = Runtime'.Serialize.serialize [] (spec) in - fun t -> apply ~f:serialize t + let to_proto' = + let apply = fun ~f:f' writer { name; identifier_value; positive_int_value; negative_int_value; double_value; string_value; aggregate_value } -> f' [] writer name identifier_value positive_int_value negative_int_value double_value string_value aggregate_value in + let spec = Runtime'.Serialize.C.( repeated (2, (message (fun t -> UninterpretedOption.NamePart.to_proto' t)), not_packed) ^:: basic_opt (3, string) ^:: basic_opt (4, uint64_int) ^:: basic_opt (5, int64_int) ^:: basic_opt (6, double) ^:: basic_opt (7, bytes) ^:: basic_opt (8, string) ^:: nil ) in + let serialize = Runtime'.Serialize.serialize [] spec in + fun writer t -> apply ~f:serialize writer t + + let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = let constructor = fun _extensions name identifier_value positive_int_value negative_int_value double_value string_value aggregate_value -> { name; identifier_value; positive_int_value; negative_int_value; double_value; string_value; aggregate_value } in @@ -949,6 +1022,7 @@ module Google = struct val name': unit -> string type t = { path: int list; span: int list; leading_comments: string option; trailing_comments: string option; leading_detached_comments: string list } val make : ?path:int list -> ?span:int list -> ?leading_comments:string -> ?trailing_comments:string -> ?leading_detached_comments:string list -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -956,6 +1030,7 @@ module Google = struct val name': unit -> string type t = SourceCodeInfo.Location.t list val make : ?location:SourceCodeInfo.Location.t list -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -964,6 +1039,7 @@ module Google = struct val name': unit -> string type t = { path: int list; span: int list; leading_comments: string option; trailing_comments: string option; leading_detached_comments: string list } val make : ?path:int list -> ?span:int list -> ?leading_comments:string -> ?trailing_comments:string -> ?leading_detached_comments:string list -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -977,11 +1053,13 @@ module Google = struct let leading_detached_comments = match leading_detached_comments with Some v -> v | None -> [] in { path; span; leading_comments; trailing_comments; leading_detached_comments } - let to_proto = - let apply = fun ~f:f' { path; span; leading_comments; trailing_comments; leading_detached_comments } -> f' [] path span leading_comments trailing_comments leading_detached_comments in + let to_proto' = + let apply = fun ~f:f' writer { path; span; leading_comments; trailing_comments; leading_detached_comments } -> f' [] writer path span leading_comments trailing_comments leading_detached_comments in let spec = Runtime'.Serialize.C.( repeated (1, int32_int, packed) ^:: repeated (2, int32_int, packed) ^:: basic_opt (3, string) ^:: basic_opt (4, string) ^:: repeated (6, string, not_packed) ^:: nil ) in - let serialize = Runtime'.Serialize.serialize [] (spec) in - fun t -> apply ~f:serialize t + let serialize = Runtime'.Serialize.serialize [] spec in + fun writer t -> apply ~f:serialize writer t + + let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = let constructor = fun _extensions path span leading_comments trailing_comments leading_detached_comments -> { path; span; leading_comments; trailing_comments; leading_detached_comments } in @@ -998,11 +1076,13 @@ module Google = struct let location = match location with Some v -> v | None -> [] in location - let to_proto = - let apply = fun ~f:f' location -> f' [] location in - let spec = Runtime'.Serialize.C.( repeated (1, (message (fun t -> SourceCodeInfo.Location.to_proto t)), not_packed) ^:: nil ) in - let serialize = Runtime'.Serialize.serialize [] (spec) in - fun t -> apply ~f:serialize t + let to_proto' = + let apply = fun ~f:f' writer location -> f' [] writer location in + let spec = Runtime'.Serialize.C.( repeated (1, (message (fun t -> SourceCodeInfo.Location.to_proto' t)), not_packed) ^:: nil ) in + let serialize = Runtime'.Serialize.serialize [] spec in + fun writer t -> apply ~f:serialize writer t + + let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = let constructor = fun _extensions location -> location in @@ -1017,6 +1097,7 @@ module Google = struct val name': unit -> string type t = { path: int list; source_file: string option; begin': int option; end': int option } val make : ?path:int list -> ?source_file:string -> ?begin':int -> ?end':int -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -1024,6 +1105,7 @@ module Google = struct val name': unit -> string type t = GeneratedCodeInfo.Annotation.t list val make : ?annotation:GeneratedCodeInfo.Annotation.t list -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -1032,6 +1114,7 @@ module Google = struct val name': unit -> string type t = { path: int list; source_file: string option; begin': int option; end': int option } val make : ?path:int list -> ?source_file:string -> ?begin':int -> ?end':int -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -1043,11 +1126,13 @@ module Google = struct let path = match path with Some v -> v | None -> [] in { path; source_file; begin'; end' } - let to_proto = - let apply = fun ~f:f' { path; source_file; begin'; end' } -> f' [] path source_file begin' end' in + let to_proto' = + let apply = fun ~f:f' writer { path; source_file; begin'; end' } -> f' [] writer path source_file begin' end' in let spec = Runtime'.Serialize.C.( repeated (1, int32_int, packed) ^:: basic_opt (2, string) ^:: basic_opt (3, int32_int) ^:: basic_opt (4, int32_int) ^:: nil ) in - let serialize = Runtime'.Serialize.serialize [] (spec) in - fun t -> apply ~f:serialize t + let serialize = Runtime'.Serialize.serialize [] spec in + fun writer t -> apply ~f:serialize writer t + + let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = let constructor = fun _extensions path source_file begin' end' -> { path; source_file; begin'; end' } in @@ -1064,11 +1149,13 @@ module Google = struct let annotation = match annotation with Some v -> v | None -> [] in annotation - let to_proto = - let apply = fun ~f:f' annotation -> f' [] annotation in - let spec = Runtime'.Serialize.C.( repeated (1, (message (fun t -> GeneratedCodeInfo.Annotation.to_proto t)), not_packed) ^:: nil ) in - let serialize = Runtime'.Serialize.serialize [] (spec) in - fun t -> apply ~f:serialize t + let to_proto' = + let apply = fun ~f:f' writer annotation -> f' [] writer annotation in + let spec = Runtime'.Serialize.C.( repeated (1, (message (fun t -> GeneratedCodeInfo.Annotation.to_proto' t)), not_packed) ^:: nil ) in + let serialize = Runtime'.Serialize.serialize [] spec in + fun writer t -> apply ~f:serialize writer t + + let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = let constructor = fun _extensions annotation -> annotation in diff --git a/src/spec/options.ml b/src/spec/options.ml index 2f53a4f..071846d 100644 --- a/src/spec/options.ml +++ b/src/spec/options.ml @@ -27,6 +27,7 @@ module rec Options : sig val name': unit -> string type t = bool val make : ?mangle_names:bool -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -38,11 +39,13 @@ end = struct let mangle_names = match mangle_names with Some v -> v | None -> false in mangle_names - let to_proto = - let apply = fun ~f:f' mangle_names -> f' [] mangle_names in + let to_proto' = + let apply = fun ~f:f' writer mangle_names -> f' [] writer mangle_names in let spec = Runtime'.Serialize.C.( basic (1, bool, proto3) ^:: nil ) in - let serialize = Runtime'.Serialize.serialize [] (spec) in - fun t -> apply ~f:serialize t + let serialize = Runtime'.Serialize.serialize [] spec in + fun writer t -> apply ~f:serialize writer t + + let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = let constructor = fun _extensions mangle_names -> mangle_names in @@ -62,7 +65,7 @@ end = struct let get_exn extendee = Runtime'.Extensions.get Runtime'.Deserialize.C.( basic_opt (1074, (message (fun t -> Options.from_proto_exn t))) ^:: nil ) (extendee.Imported'modules.Descriptor.Google.Protobuf.FileOptions.extensions') let get extendee = Runtime'.Result.catch (fun () -> get_exn extendee) let set extendee t = - let extensions' = Runtime'.Extensions.set (Runtime'.Serialize.C.( basic_opt (1074, (message (fun t -> Options.to_proto t))) ^:: nil )) (extendee.Imported'modules.Descriptor.Google.Protobuf.FileOptions.extensions') t in + let extensions' = Runtime'.Extensions.set (Runtime'.Serialize.C.( basic_opt (1074, (message (fun t -> Options.to_proto' t))) ^:: nil )) (extendee.Imported'modules.Descriptor.Google.Protobuf.FileOptions.extensions') t in { extendee with Imported'modules.Descriptor.Google.Protobuf.FileOptions.extensions' = extensions' } end \ No newline at end of file diff --git a/src/spec/plugin.ml b/src/spec/plugin.ml index daed7a3..6cb1d0d 100644 --- a/src/spec/plugin.ml +++ b/src/spec/plugin.ml @@ -30,6 +30,7 @@ module Google = struct val name': unit -> string type t = { major: int option; minor: int option; patch: int option; suffix: string option } val make : ?major:int -> ?minor:int -> ?patch:int -> ?suffix:string -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -41,11 +42,13 @@ module Google = struct { major; minor; patch; suffix } - let to_proto = - let apply = fun ~f:f' { major; minor; patch; suffix } -> f' [] major minor patch suffix in + let to_proto' = + let apply = fun ~f:f' writer { major; minor; patch; suffix } -> f' [] writer major minor patch suffix in let spec = Runtime'.Serialize.C.( basic_opt (1, int32_int) ^:: basic_opt (2, int32_int) ^:: basic_opt (3, int32_int) ^:: basic_opt (4, string) ^:: nil ) in - let serialize = Runtime'.Serialize.serialize [] (spec) in - fun t -> apply ~f:serialize t + let serialize = Runtime'.Serialize.serialize [] spec in + fun writer t -> apply ~f:serialize writer t + + let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = let constructor = fun _extensions major minor patch suffix -> { major; minor; patch; suffix } in @@ -59,6 +62,7 @@ module Google = struct val name': unit -> string type t = { file_to_generate: string list; parameter: string option; proto_file: Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list; compiler_version: Version.t option } val make : ?file_to_generate:string list -> ?parameter:string -> ?proto_file:Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list -> ?compiler_version:Version.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -71,11 +75,13 @@ module Google = struct let proto_file = match proto_file with Some v -> v | None -> [] in { file_to_generate; parameter; proto_file; compiler_version } - let to_proto = - let apply = fun ~f:f' { file_to_generate; parameter; proto_file; compiler_version } -> f' [] file_to_generate parameter proto_file compiler_version in - let spec = Runtime'.Serialize.C.( repeated (1, string, not_packed) ^:: basic_opt (2, string) ^:: repeated (15, (message (fun t -> Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.to_proto t)), not_packed) ^:: basic_opt (3, (message (fun t -> Version.to_proto t))) ^:: nil ) in - let serialize = Runtime'.Serialize.serialize [] (spec) in - fun t -> apply ~f:serialize t + let to_proto' = + let apply = fun ~f:f' writer { file_to_generate; parameter; proto_file; compiler_version } -> f' [] writer file_to_generate parameter proto_file compiler_version in + let spec = Runtime'.Serialize.C.( repeated (1, string, not_packed) ^:: basic_opt (2, string) ^:: repeated (15, (message (fun t -> Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.to_proto' t)), not_packed) ^:: basic_opt (3, (message (fun t -> Version.to_proto' t))) ^:: nil ) in + let serialize = Runtime'.Serialize.serialize [] spec in + fun writer t -> apply ~f:serialize writer t + + let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = let constructor = fun _extensions file_to_generate parameter proto_file compiler_version -> { file_to_generate; parameter; proto_file; compiler_version } in @@ -96,6 +102,7 @@ module Google = struct val name': unit -> string type t = { name: string option; insertion_point: string option; content: string option; generated_code_info: Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.t option } val make : ?name:string -> ?insertion_point:string -> ?content:string -> ?generated_code_info:Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -103,6 +110,7 @@ module Google = struct val name': unit -> string type t = { error: string option; supported_features: int option; file: CodeGeneratorResponse.File.t list } val make : ?error:string -> ?supported_features:int -> ?file:CodeGeneratorResponse.File.t list -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -129,6 +137,7 @@ module Google = struct val name': unit -> string type t = { name: string option; insertion_point: string option; content: string option; generated_code_info: Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.t option } val make : ?name:string -> ?insertion_point:string -> ?content:string -> ?generated_code_info:Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t @@ -140,11 +149,13 @@ module Google = struct { name; insertion_point; content; generated_code_info } - let to_proto = - let apply = fun ~f:f' { name; insertion_point; content; generated_code_info } -> f' [] name insertion_point content generated_code_info in - let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (2, string) ^:: basic_opt (15, string) ^:: basic_opt (16, (message (fun t -> Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.to_proto t))) ^:: nil ) in - let serialize = Runtime'.Serialize.serialize [] (spec) in - fun t -> apply ~f:serialize t + let to_proto' = + let apply = fun ~f:f' writer { name; insertion_point; content; generated_code_info } -> f' [] writer name insertion_point content generated_code_info in + let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (2, string) ^:: basic_opt (15, string) ^:: basic_opt (16, (message (fun t -> Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.to_proto' t))) ^:: nil ) in + let serialize = Runtime'.Serialize.serialize [] spec in + fun writer t -> apply ~f:serialize writer t + + let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = let constructor = fun _extensions name insertion_point content generated_code_info -> { name; insertion_point; content; generated_code_info } in @@ -161,11 +172,13 @@ module Google = struct let file = match file with Some v -> v | None -> [] in { error; supported_features; file } - let to_proto = - let apply = fun ~f:f' { error; supported_features; file } -> f' [] error supported_features file in - let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (2, uint64_int) ^:: repeated (15, (message (fun t -> CodeGeneratorResponse.File.to_proto t)), not_packed) ^:: nil ) in - let serialize = Runtime'.Serialize.serialize [] (spec) in - fun t -> apply ~f:serialize t + let to_proto' = + let apply = fun ~f:f' writer { error; supported_features; file } -> f' [] writer error supported_features file in + let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (2, uint64_int) ^:: repeated (15, (message (fun t -> CodeGeneratorResponse.File.to_proto' t)), not_packed) ^:: nil ) in + let serialize = Runtime'.Serialize.serialize [] spec in + fun writer t -> apply ~f:serialize writer t + + let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = let constructor = fun _extensions error supported_features file -> { error; supported_features; file } in From f1f2c36919e6f2a3a8d34519e636db0cb4d71f26 Mon Sep 17 00:00:00 2001 From: Anders Fugmann Date: Tue, 2 Jan 2024 19:41:23 +0100 Subject: [PATCH 09/30] Extend benchmarks --- bench/bench.ml | 133 +++++++++++++++++++++------------------- bench/bench.proto | 6 +- bench/enum.proto | 13 ++++ bench/enum_list.proto | 13 ++++ bench/float.proto | 5 ++ bench/float_list.proto | 5 ++ bench/int64.proto | 5 ++ bench/int64_list.proto | 5 ++ bench/plugin/dune | 17 +++-- bench/protoc/dune | 19 ++++-- bench/string.proto | 5 ++ bench/string_list.proto | 5 ++ 12 files changed, 153 insertions(+), 78 deletions(-) create mode 100644 bench/enum.proto create mode 100644 bench/enum_list.proto create mode 100644 bench/float.proto create mode 100644 bench/float_list.proto create mode 100644 bench/int64.proto create mode 100644 bench/int64_list.proto create mode 100644 bench/string.proto create mode 100644 bench/string_list.proto diff --git a/bench/bench.ml b/bench/bench.ml index 01f2fd4..bd96e38 100644 --- a/bench/bench.ml +++ b/bench/bench.ml @@ -1,12 +1,50 @@ open Base open Stdio +[@@@ocaml.warning "-32"] -module type Protobuf = sig - type t - val name : string - val encode : t -> string - val decode : string -> t +module type Protoc_impl = sig + type m + val encode_pb_m: m -> Pbrt.Encoder.t -> unit + val decode_pb_m: Pbrt.Decoder.t -> m end + +module type Plugin_impl = sig + module M : sig + type t + val name' : unit -> string + val to_proto: t -> Ocaml_protoc_plugin.Writer.t + val from_proto_exn: Ocaml_protoc_plugin.Reader.t -> t + end +end + +let make_tests (type v) (module Protoc: Protoc_impl) (module Plugin: Plugin_impl with type M.t = v) v_plugin = + let data = Plugin.M.to_proto v_plugin |> Ocaml_protoc_plugin.Writer.contents in + (* Assert decoding works *) + let v_protoc = Protoc.decode_pb_m (Pbrt.Decoder.of_string data) in + let protoc_encoder = Pbrt.Encoder.create () in + let () = Protoc.encode_pb_m v_protoc protoc_encoder in + let data_protoc = Pbrt.Encoder.to_string protoc_encoder in + let _v_plugin' = Plugin.M.from_proto_exn (Ocaml_protoc_plugin.Reader.create data_protoc) in + (* assert (Poly.equal v_plugin v_plugin'); *) + printf "%16s: Data length: %5d /%5d\n%!" (Plugin.M.name' ()) (String.length data) (String.length data_protoc); + + let open Bechamel in + let test_encode = + Test.make_grouped ~name:"Encode" + [ + Test.make ~name:"Plugin" (Staged.stage @@ fun () -> Plugin.M.to_proto v_plugin); + Test.make ~name:"Protoc" (Staged.stage @@ fun () -> Protoc.encode_pb_m v_protoc (Pbrt.Encoder.create ())) + ] + in + let test_decode = + Test.make_grouped ~name:"Decode" + [ + Test.make ~name:"Plugin" (Staged.stage @@ fun () -> Plugin.M.from_proto_exn (Ocaml_protoc_plugin.Reader.create data)); + Test.make ~name:"Protoc" (Staged.stage @@ fun () -> Protoc.decode_pb_m (Pbrt.Decoder.of_string data)) + ] + in + Test.make_grouped ~name:(Plugin.M.name' ()) [test_encode; test_decode] + let _ = Random.init 0; let module Gc = Stdlib.Gc in @@ -14,48 +52,22 @@ let _ = let control = Gc.get () in Gc.set { control with minor_heap_size=4000_1000; space_overhead=500 } -module Protoc_mod : Protobuf = struct - type t = Protoc.Bench.btree - let name = "Protoc" - let encode t = - let encoder = Pbrt.Encoder.create () in - Protoc.Bench.encode_pb_btree t encoder; - Pbrt.Encoder.to_string encoder - - let decode data = - let decoder = Pbrt.Decoder.of_string data in - Protoc.Bench.decode_pb_btree decoder -end -module Plugin_mod : Protobuf with type t = Plugin.Bench.Bench.Btree.t = struct - type t = Plugin.Bench.Bench.Btree.t - let name = "Plugin" - let encode t = - let writer = Plugin.Bench.Bench.Btree.to_proto t in - Ocaml_protoc_plugin.Writer.contents writer +let random_list ?(len=100) ~f () = + List.init (Random.int len) ~f:(fun _ -> f ()) - let decode data = - let reader = Ocaml_protoc_plugin.Reader.create data in - Plugin.Bench.Bench.Btree.from_proto reader |> Ocaml_protoc_plugin.Result.get ~msg:"Unable to decode" -end +let random_string () = + String.init (Random.int 20) ~f:(fun _ -> Random.char ()) let create_test_data ~depth () = - let module Btree = Plugin.Bench.Bench.Btree in - let module Data = Plugin.Bench.Bench.Data in - let module Enum = Plugin.Bench.Bench.Enum in + let module M = Plugin.Bench.M in + let module Data = Plugin.Bench.Data in + let module Enum = Plugin.Bench.Enum in let optional ~f () = match (Random.int 4 = 0) with | true -> None | false -> Some (f ()) in - let random_string () = - String.init (Random.int 20) ~f:(fun _ -> Random.char ()) - in - - let random_list ?(len=100) ~f () = - List.init (Random.int len) ~f:(fun _ -> f ()) - in - let create_data () = let random_enum () = @@ -86,20 +98,10 @@ let create_test_data ~depth () = let children = random_list ~len:8 ~f:(create_btree (n - 1)) () |> List.filter_opt in - Btree.make ~children ~data () |> Option.some + M.make ~children ~data () |> Option.some in create_btree depth () -let make_test (module P : Protobuf) data_str = - let data = P.decode data_str in - let open Bechamel in - let test_decode = Test.make ~name:"decode" (Staged.stage @@ fun () -> P.decode data_str) in - let test_encode = Test.make ~name:"encode" (Staged.stage @@ fun () -> P.encode data) in - Test.make_grouped ~name:P.name [test_decode; test_encode] - -let make_tests data_str = - [ make_test (module Protoc_mod) data_str; make_test (module Plugin_mod) data_str ] - |> Bechamel.Test.make_grouped ~name:"Protobuf" let benchmark tests = let open Bechamel in @@ -136,18 +138,21 @@ let print_bench_results results = img (window, results) |> eol |> output_image let _ = - let data = create_test_data ~depth:2 () in - let data = Option.value_exn data in - let proto_str = Plugin_mod.encode data in - let _data = Plugin_mod.decode proto_str in - let data_protoc = Protoc_mod.decode proto_str in - let data_str' = Protoc_mod.encode data_protoc in - let data' = Plugin_mod.decode data_str' in - let data_str' = Plugin_mod.encode data' in - assert (String.equal data_str' proto_str); - printf "Data length: %d\n%!" (String.length proto_str); - - make_tests proto_str - |> benchmark - |> analyze - |> print_bench_results + let v_plugin = create_test_data ~depth:2 () |> Option.value_exn in + [ make_tests (module Protoc.Bench) (module Plugin.Bench) v_plugin; + make_tests (module Protoc.Int64) (module Plugin.Int64) 27; + make_tests (module Protoc.Float) (module Plugin.Float) 27.0; + make_tests (module Protoc.String) (module Plugin.String) "Benchmark"; + make_tests (module Protoc.Enum) (module Plugin.Enum) Plugin.Enum.Enum.ED; + + random_list ~len:100 ~f:(fun () -> Random.int 1000) () |> make_tests (module Protoc.Int64_list) (module Plugin.Int64_list); + random_list ~len:100 ~f:(fun () -> Random.float 1000.0) () |> make_tests (module Protoc.Float_list) (module Plugin.Float_list); + random_list ~len:100 ~f:random_string () |> make_tests (module Protoc.String_list) (module Plugin.String_list); + (* random_list ~len:100 ~f:(fun () -> Plugin.Enum_list.Enum.ED) () |> make_tests (module Protoc.Enum_list) (module Plugin.Enum_list); *) + ] + |> List.iter ~f:(fun test -> + test + |> benchmark + |> analyze + |> print_bench_results + ) diff --git a/bench/bench.proto b/bench/bench.proto index 584fe5a..eeb69d3 100644 --- a/bench/bench.proto +++ b/bench/bench.proto @@ -1,7 +1,5 @@ syntax = "proto3"; -package bench; - enum Enum { EA = 0; EB = 1; @@ -20,7 +18,7 @@ message data { //repeated Enum e = 7; } -message btree { - repeated btree children = 1; +message M { + repeated M children = 1; repeated data data = 2; } diff --git a/bench/enum.proto b/bench/enum.proto new file mode 100644 index 0000000..ea0f7f8 --- /dev/null +++ b/bench/enum.proto @@ -0,0 +1,13 @@ +syntax = "proto3"; + +enum Enum { + EA = 0; + EB = 1; + EC = 2; + ED = 3; + EE = 4; +} + +message M { + Enum i = 1; +} diff --git a/bench/enum_list.proto b/bench/enum_list.proto new file mode 100644 index 0000000..03eb0a3 --- /dev/null +++ b/bench/enum_list.proto @@ -0,0 +1,13 @@ +syntax = "proto3"; + +enum Enum { + EA = 0; + EB = 1; + EC = 2; + ED = 3; + EE = 4; +} + +message M { + repeated Enum i = 1; +} diff --git a/bench/float.proto b/bench/float.proto new file mode 100644 index 0000000..2610e18 --- /dev/null +++ b/bench/float.proto @@ -0,0 +1,5 @@ +syntax = "proto3"; + +message M { + float i = 1; +} diff --git a/bench/float_list.proto b/bench/float_list.proto new file mode 100644 index 0000000..9d9e4cf --- /dev/null +++ b/bench/float_list.proto @@ -0,0 +1,5 @@ +syntax = "proto3"; + +message M { + repeated float i = 1; +} diff --git a/bench/int64.proto b/bench/int64.proto new file mode 100644 index 0000000..289fc78 --- /dev/null +++ b/bench/int64.proto @@ -0,0 +1,5 @@ +syntax = "proto3"; + +message M { + int64 i = 1; +} diff --git a/bench/int64_list.proto b/bench/int64_list.proto new file mode 100644 index 0000000..67f9d23 --- /dev/null +++ b/bench/int64_list.proto @@ -0,0 +1,5 @@ +syntax = "proto3"; + +message M { + repeated int64 i = 1; +} diff --git a/bench/plugin/dune b/bench/plugin/dune index 181a017..b9f6414 100644 --- a/bench/plugin/dune +++ b/bench/plugin/dune @@ -1,12 +1,19 @@ (rule - (targets bench.ml) + (targets + bench.ml + int64.ml string.ml float.ml enum.ml + int64_list.ml string_list.ml float_list.ml enum_list.ml + ) (deps + (:proto + ../bench.proto + ../int64.proto ../string.proto ../float.proto ../enum.proto + ../int64_list.proto ../string_list.proto ../float_list.proto ../enum_list.proto) (:plugin ../../src/plugin/protoc_gen_ocaml.exe) - (:proto ../bench.proto)) + ) (action - (run protoc -I .. - "--plugin=protoc-gen-ocaml=%{plugin}" - "--ocaml_out=." %{proto}))) + (bash "for p in %{proto}; do protoc -I .. --plugin=protoc-gen-ocaml=%{plugin} --ocaml_out=. $p; done"))) + (library (name plugin) (libraries ocaml_protoc_plugin)) diff --git a/bench/protoc/dune b/bench/protoc/dune index 14b36fc..0d2f913 100644 --- a/bench/protoc/dune +++ b/bench/protoc/dune @@ -1,10 +1,19 @@ (rule - (targets bench.ml bench.mli) + (targets + bench.ml bench.mli + int64.ml string.ml float.ml enum.ml + int64.mli string.mli float.mli enum.mli + int64_list.ml string_list.ml float_list.ml enum_list.ml + int64_list.mli string_list.mli float_list.mli enum_list.mli + ) (deps - (:proto ../bench.proto)) + (:proto + ../bench.proto + ../int64.proto ../string.proto ../float.proto ../enum.proto + ../int64_list.proto ../string_list.proto ../float_list.proto ../enum_list.proto)) (action - (run ocaml-protoc --binary --ml_out . %{proto}))) + (bash "for p in %{proto}; do ocaml-protoc --binary --int32_type int_t --int64_type int_t --ml_out . $p; done"))) (library - (name protoc) - (libraries pbrt)) + (name protoc) + (libraries pbrt)) diff --git a/bench/string.proto b/bench/string.proto new file mode 100644 index 0000000..6ea3801 --- /dev/null +++ b/bench/string.proto @@ -0,0 +1,5 @@ +syntax = "proto3"; + +message M { + string i = 1; +} diff --git a/bench/string_list.proto b/bench/string_list.proto new file mode 100644 index 0000000..26c6411 --- /dev/null +++ b/bench/string_list.proto @@ -0,0 +1,5 @@ +syntax = "proto3"; + +message M { + repeated string i = 1; +} From dbdf04949598019338e89a519e77ae2d3ed71c4f Mon Sep 17 00:00:00 2001 From: Anders Fugmann Date: Wed, 3 Jan 2024 23:55:32 +0100 Subject: [PATCH 10/30] Add default value to enums for proto3, which allows for removal of distinction between proto2 and proto3 in the spec --- bench/bench.ml | 30 +++--- bench/plugin/dune | 7 +- bench/protoc/dune | 2 +- src/ocaml_protoc_plugin/deserialize.ml | 8 +- src/ocaml_protoc_plugin/serialize.ml | 27 +++-- src/ocaml_protoc_plugin/spec.ml | 8 +- src/plugin/scope.ml | 38 +++++-- src/plugin/scope.mli | 3 + src/plugin/types.ml | 131 ++++++++++++++----------- src/spec/descriptor.ml | 36 +++---- src/spec/options.ml | 4 +- 11 files changed, 169 insertions(+), 125 deletions(-) diff --git a/bench/bench.ml b/bench/bench.ml index bd96e38..95ae654 100644 --- a/bench/bench.ml +++ b/bench/bench.ml @@ -1,7 +1,6 @@ open Base open Stdio [@@@ocaml.warning "-32"] - module type Protoc_impl = sig type m val encode_pb_m: m -> Pbrt.Encoder.t -> unit @@ -12,6 +11,8 @@ module type Plugin_impl = sig module M : sig type t val name' : unit -> string + val show: t -> string + val equal: t -> t -> bool val to_proto: t -> Ocaml_protoc_plugin.Writer.t val from_proto_exn: Ocaml_protoc_plugin.Reader.t -> t end @@ -19,14 +20,22 @@ end let make_tests (type v) (module Protoc: Protoc_impl) (module Plugin: Plugin_impl with type M.t = v) v_plugin = let data = Plugin.M.to_proto v_plugin |> Ocaml_protoc_plugin.Writer.contents in + (* We need to reconstruct the data, as we might loose precision when using floats (32bit, compared to doubles) (64 bit) *) + let v_plugin = Plugin.M.from_proto_exn (Ocaml_protoc_plugin.Reader.create data) in (* Assert decoding works *) let v_protoc = Protoc.decode_pb_m (Pbrt.Decoder.of_string data) in let protoc_encoder = Pbrt.Encoder.create () in let () = Protoc.encode_pb_m v_protoc protoc_encoder in let data_protoc = Pbrt.Encoder.to_string protoc_encoder in - let _v_plugin' = Plugin.M.from_proto_exn (Ocaml_protoc_plugin.Reader.create data_protoc) in - (* assert (Poly.equal v_plugin v_plugin'); *) - printf "%16s: Data length: %5d /%5d\n%!" (Plugin.M.name' ()) (String.length data) (String.length data_protoc); + let v_plugin' = Plugin.M.from_proto_exn (Ocaml_protoc_plugin.Reader.create data_protoc) in + let () = match Plugin.M.equal v_plugin v_plugin' with + | true -> () + | false -> + eprintf "Orig: %s\n" (Plugin.M.show v_plugin); + eprintf "New: %s\n" (Plugin.M.show v_plugin'); + failwith "Data not the same" + in + printf "%16s: Data length: %5d /%5d (%b)\n%!" (Plugin.M.name' ()) (String.length data) (String.length data_protoc) (Poly.equal v_plugin v_plugin'); let open Bechamel in let test_encode = @@ -71,13 +80,7 @@ let create_test_data ~depth () = let create_data () = let random_enum () = - match Random.int 5 with - | 0 -> Enum.EA - | 1 -> Enum.EB - | 2 -> Enum.EC - | 3 -> Enum.ED - | 4 -> Enum.EE - | _ -> failwith "Impossible value" + Array.random_element_exn [| Enum.EA; Enum.EB; Enum.EC; Enum.ED; Enum.EE; |] in let s1 = optional ~f:random_string () in let n1 = optional ~f:(random_list ~f:(fun () -> Random.int 1_000)) () in @@ -106,8 +109,7 @@ let create_test_data ~depth () = let benchmark tests = let open Bechamel in let instances = Bechamel_perf.Instance.[ cpu_clock ] in - let cfg = Benchmark.cfg ~limit:1000 ~stabilize:true ~compaction:true - ~quota:(Time.second 2.5) () in + let cfg = Benchmark.cfg ~stabilize:true ~compaction:true () in Benchmark.all cfg instances tests let analyze results = @@ -141,7 +143,7 @@ let _ = let v_plugin = create_test_data ~depth:2 () |> Option.value_exn in [ make_tests (module Protoc.Bench) (module Plugin.Bench) v_plugin; make_tests (module Protoc.Int64) (module Plugin.Int64) 27; - make_tests (module Protoc.Float) (module Plugin.Float) 27.0; + make_tests (module Protoc.Float) (module Plugin.Float) 27.0001; make_tests (module Protoc.String) (module Plugin.String) "Benchmark"; make_tests (module Protoc.Enum) (module Plugin.Enum) Plugin.Enum.Enum.ED; diff --git a/bench/plugin/dune b/bench/plugin/dune index b9f6414..6f7c7de 100644 --- a/bench/plugin/dune +++ b/bench/plugin/dune @@ -12,8 +12,11 @@ (:plugin ../../src/plugin/protoc_gen_ocaml.exe) ) (action - (bash "for p in %{proto}; do protoc -I .. --plugin=protoc-gen-ocaml=%{plugin} --ocaml_out=. $p; done"))) + (bash "for p in %{proto}; do protoc -I .. --plugin=protoc-gen-ocaml=%{plugin} \"--ocaml_out=annot=[@@deriving show { with_path = false },eq]:.\" $p; done"))) (library (name plugin) - (libraries ocaml_protoc_plugin)) + (libraries ocaml_protoc_plugin) + (preprocess + (pps ppx_deriving.show ppx_deriving.eq ppx_deriving.ord)) +) diff --git a/bench/protoc/dune b/bench/protoc/dune index 0d2f913..0932bb6 100644 --- a/bench/protoc/dune +++ b/bench/protoc/dune @@ -12,7 +12,7 @@ ../int64.proto ../string.proto ../float.proto ../enum.proto ../int64_list.proto ../string_list.proto ../float_list.proto ../enum_list.proto)) (action - (bash "for p in %{proto}; do ocaml-protoc --binary --int32_type int_t --int64_type int_t --ml_out . $p; done"))) + (bash "for p in %{proto}; do ocaml-protoc -I .. --binary --int32_type int_t --int64_type int_t --ml_out . $p; done"))) (library (name protoc) diff --git a/src/ocaml_protoc_plugin/deserialize.ml b/src/ocaml_protoc_plugin/deserialize.ml index d924575..092b92a 100644 --- a/src/ocaml_protoc_plugin/deserialize.ml +++ b/src/ocaml_protoc_plugin/deserialize.ml @@ -178,7 +178,7 @@ let sentinal: type a. a compound -> (int * (unit decoder * Reader.boxed)) list * | field -> error_wrong_field "message" field in ([index, (read, Unboxed)], get) - | Basic (index, spec, Required) -> + | Basic (index, spec, None) -> let expect, read = type_of_spec spec in let boxed = get_boxed_type expect in let v = ref None in @@ -194,9 +194,9 @@ let sentinal: type a. a compound -> (int * (unit decoder * Reader.boxed)) list * let field_type, read = type_of_spec spec in let boxed = get_boxed_type field_type in let default = match default with - | Proto2 default -> default - | Required - | Proto3 -> begin + + | Some default -> default + | None -> begin default_of_field_type field_type |> fun v -> try read v with Result.Error _ -> failwith "Cannot decode default field value" end diff --git a/src/ocaml_protoc_plugin/serialize.ml b/src/ocaml_protoc_plugin/serialize.ml index a0afb0d..5acec33 100644 --- a/src/ocaml_protoc_plugin/serialize.ml +++ b/src/ocaml_protoc_plugin/serialize.ml @@ -67,14 +67,14 @@ let is_scalar: type a. a spec -> bool = function | _ -> true let rec write: type a. a compound -> Writer.t -> a -> unit = function - | Basic (index, Message (to_proto), _) -> begin + | Basic (index, Message to_proto, _) -> begin fun writer v -> let done_f = Writer.add_length_delimited_field_header writer index in let _writer = to_proto writer v in done_f () end | Repeated (index, Message to_proto, _) -> - let write = write (Basic (index, Message to_proto, Required)) in + let write = write (Basic (index, Message to_proto, None)) in fun writer vs -> List.iter ~f:(fun v -> write writer v) vs | Repeated (index, spec, Packed) when is_scalar spec -> begin let f = field_of_spec spec in @@ -91,21 +91,20 @@ let rec write: type a. a compound -> Writer.t -> a -> unit = function | Basic (index, spec, default) -> begin let f = field_of_spec spec in match default with - | Proto3 -> begin - fun writer v -> match f v with - | Varint 0L -> () - | Varint_unboxed 0 -> () - | Fixed_64_bit 0L -> () - | Fixed_32_bit 0l -> () - | Length_delimited {length = 0; _} -> () - | field -> Writer.write_field writer index field - end - | Proto2 default -> fun writer -> begin + | Some default -> fun writer -> begin function | v when v = default -> () | v -> Writer.write_field writer index (f v) end - | Required -> fun writer v -> Writer.write_field writer index (f v) + | None -> fun writer v -> Writer.write_field writer index (f v) + end + | Basic_opt (index, Message to_proto) -> begin + fun writer -> function + | Some v -> + let done_f = Writer.add_length_delimited_field_header writer index in + let _ = to_proto writer v in + done_f () + | None -> () end | Basic_opt (index, spec) -> begin let f = field_of_spec spec in @@ -118,7 +117,7 @@ let rec write: type a. a compound -> Writer.t -> a -> unit = function | `not_set -> () | v -> let Oneof_elem (index, spec, v) = f v in - write (Basic (index, spec, Required)) writer v + write (Basic (index, spec, None)) writer v end (** Allow emitted code to present a protobuf specification. *) diff --git a/src/ocaml_protoc_plugin/spec.ml b/src/ocaml_protoc_plugin/spec.ml index fd7754a..34e6087 100644 --- a/src/ocaml_protoc_plugin/spec.ml +++ b/src/ocaml_protoc_plugin/spec.ml @@ -4,7 +4,6 @@ end module Make(T : T) = struct - type 'a proto_type = Proto3 | Proto2 of 'a | Required type packed = Packed | Not_packed type _ spec = @@ -45,7 +44,7 @@ module Make(T : T) = struct | Oneof_elem : int * 'b spec * ('a, ('b -> 'a), 'b) T.dir -> 'a oneof type _ compound = - | Basic : int * 'a spec * 'a proto_type -> 'a compound + | Basic : int * 'a spec * 'a option -> 'a compound | Basic_opt : int * 'a spec -> 'a option compound | Repeated : int * 'a spec * packed -> 'a list compound | Oneof : ('a, 'a oneof list, 'a -> unit oneof) T.dir -> ([> `not_set ] as 'a) compound @@ -87,10 +86,7 @@ module Make(T : T) = struct let some v = Some v let none = None - let proto2 v = Proto2 v - let proto2_bytes v = Proto2 (Some (Bytes.of_string v)) - let proto3 = Proto3 - let required = Required + let default_bytes v = (Some (Bytes.of_string v)) let repeated (i, s, p) = Repeated (i, s, p) let basic (i, s, d) = Basic (i, s, d) diff --git a/src/plugin/scope.ml b/src/plugin/scope.ml index f884b72..5fdcea9 100644 --- a/src/plugin/scope.ml +++ b/src/plugin/scope.ml @@ -40,7 +40,7 @@ end open Spec.Descriptor.Google.Protobuf -type element = { module_name: string; ocaml_name: string; cyclic: bool } +type element = { module_name: string; ocaml_name: string; cyclic: bool; default_enum: string option; } let import_module_name = "Imported'modules" @@ -59,7 +59,13 @@ let has_mangle_option options = | Some (Error _e) -> failwith "Could not parse ocaml-protoc-plugin options with id 1074" module Type_tree = struct - type t = { name: string; types: t list; depends: string list; fields: string list * string list list; enum_names: string list; service_names: string list } + type t = { name: string; + types: t list; + depends: string list; + fields: string list * string list list; + enum_names: string list; + service_names: string list + } type file = { module_name: string; types: t list } let map_enum EnumDescriptorProto.{ name; value = values; _ } = @@ -144,7 +150,10 @@ module Type_tree = struct let types = enums @ messages @ services @ extensions in let module_name = Option.value_exn ~message:"File descriptor must have a name" name in let packages = Option.value_map ~default:[] ~f:(String.split_on_char ~sep:'.') package in - let types = List.fold_right ~init:types ~f:(fun name types -> [ { name; types; depends = []; fields = [], []; enum_names = []; service_names = [] } ]) packages in + + let types = List.fold_right ~init:types ~f:(fun name types -> + [ { name; types; depends = []; fields = [], []; enum_names = []; service_names = [] } ]) packages in + { module_name; types } let create_cyclic_map { module_name = _ ; types } = @@ -226,13 +235,13 @@ module Type_tree = struct StringMap.fold ~init:map ~f:(fun ~key ~data map -> StringMap.add_uniq ~key:(path ^ "." ^ key) - ~data:{ module_name; ocaml_name = ocaml_name ^ "." ^ data; cyclic = false } + ~data:{ module_name; ocaml_name = ocaml_name ^ "." ^ data; default_enum = None; cyclic = false } map ) names in let rec traverse_types map path types = - let map_type ~map ~name_map path { name; types; fields = (plain_fields, oneof_fields); enum_names; service_names; _} = + let map_type ~map ~name_map path { name; types; fields = (plain_fields, oneof_fields); enum_names; service_names; _ } = let ocaml_name = let ocaml_name = StringMap.find name name_map in match StringMap.find path map with @@ -264,6 +273,9 @@ module Type_tree = struct enum_names |> add_names ~path ~ocaml_name map in + let default_enum = + List.nth_opt enum_names 0 + in let map = create_name_map @@ -272,7 +284,8 @@ module Type_tree = struct service_names |> add_names ~path ~ocaml_name map in - let map = StringMap.add_uniq ~key:path ~data:{ module_name; ocaml_name; cyclic } map in + + let map = StringMap.add_uniq ~key:path ~data:{ module_name; ocaml_name; cyclic; default_enum } map in traverse_types map path types in @@ -285,7 +298,7 @@ module Type_tree = struct List.fold_left ~init:map ~f:(fun map type_ -> map_type ~map ~name_map path type_) types in - let map = StringMap.singleton "" { ocaml_name = ""; module_name; cyclic = false } in + let map = StringMap.singleton "" { ocaml_name = ""; module_name; default_enum = None; cyclic = false } in traverse_types map "" types let create_db (files : FileDescriptorProto.t list)= @@ -313,8 +326,8 @@ type t = { module_name: string; let dump_type_map type_map = Printf.eprintf "Type map:\n"; - StringMap.iter ~f:(fun ~key ~data:{module_name; ocaml_name; cyclic; _ } -> - Printf.eprintf " %s -> %s#%s, C:%b\n%!" key module_name ocaml_name cyclic + StringMap.iter ~f:(fun ~key ~data:{module_name; ocaml_name; cyclic; default_enum; _ } -> + Printf.eprintf " %s -> %s#%s, C:%b D:%s\n%!" key module_name ocaml_name cyclic (Option.value ~default:"" default_enum) ) type_map; Printf.eprintf "Type map end.\n%!" @@ -426,6 +439,11 @@ let get_scoped_name ?postfix t name = | None, type_name -> type_name | Some postfix, type_name -> Printf.sprintf "%s.%s" type_name postfix +let get_scoped_enum_name t name = + let name = Option.value_exn ~message:"Does not contain a name" name in + let { default_enum; _ } = StringMap.find name t.type_db in + get_scoped_name t (Some (Printf.sprintf "%s.%s" name (Option.value_exn ~message:"Type is not an enum" default_enum))) + let get_name t name = let path = Printf.sprintf "%s.%s" (get_proto_path t) name in match StringMap.find_opt path t.type_db with @@ -436,6 +454,8 @@ let get_name_exn t name = let name = Option.value_exn ~message:"Does not contain a name" name in get_name t name + + let get_current_scope t = let { module_name; ocaml_name = _; _ } = StringMap.find (get_proto_path t) t.type_db in (String.lowercase_ascii module_name) ^ (get_proto_path t) diff --git a/src/plugin/scope.mli b/src/plugin/scope.mli index 9a52138..ac6a527 100644 --- a/src/plugin/scope.mli +++ b/src/plugin/scope.mli @@ -21,6 +21,9 @@ val import_module_name: string (** Get the ocaml name of the given proto type name, based on the current scope *) val get_scoped_name : ?postfix:string -> t -> string option -> string +(** Get the ocaml name of the default enum *) +val get_scoped_enum_name : t -> string option -> string + (** Get the ocaml name of the given proto type name, based on the current scope *) val get_name : t -> string -> string diff --git a/src/plugin/types.ml b/src/plugin/types.ml index 9f67fad..4cab879 100644 --- a/src/plugin/types.ml +++ b/src/plugin/types.ml @@ -1,4 +1,9 @@ open StdLabels +(* Extend scope to have a map over default enum values. enum type string -> enum default value string *) +(* That should be in the type db, and possibly a different map. *) +(* We have the full type name (I assume), so we can take the first in the list, and strip the last . off to get the name. *) +(* We should also have proto name -> proto default name. Then we can lookup, as we already do *) + (* This module is a bit elaborate. The idea is to construct the actual types needed @@ -111,41 +116,42 @@ let string_of_default: type a. a spec -> a -> string = function | Bool -> string_of_bool | String -> sprintf "{|%s|}" | Bytes -> fun bytes -> sprintf "(Bytes.of_string {|%s|})" (Bytes.to_string bytes) - | Enum (_, _, _, s) -> fun _ -> Option.value_exn s + | Enum (_, _, _, Some s) -> fun _ -> s + | Enum (s', s, _, None) -> fun _ -> sprintf "(%s 0 (* And its an %s *))" s' s (* Is this the ocaml name???. Maybe we need the protoc name *) | Message _ -> failwith "Messages defaults are not relevant" -let default_of_spec: type a. a spec -> string = fun spec -> match spec with - | Double -> string_of_default spec 0.0 - | Float -> string_of_default spec 0.0 - - | Int32 -> string_of_default spec 0l - | UInt32 -> string_of_default spec 0l - | SInt32 -> string_of_default spec 0l - | Fixed32 -> string_of_default spec 0l - | SFixed32 -> string_of_default spec 0l - - | Int32_int -> string_of_default spec 0 - | UInt32_int -> string_of_default spec 0 - | SInt32_int -> string_of_default spec 0 - | Fixed32_int -> string_of_default spec 0 - | SFixed32_int -> string_of_default spec 0 - - | Int64 -> string_of_default spec 0L - | UInt64 -> string_of_default spec 0L - | SInt64 -> string_of_default spec 0L - | Fixed64 -> string_of_default spec 0L - | SFixed64 -> string_of_default spec 0L - - | UInt64_int -> string_of_default spec 0 - | Int64_int -> string_of_default spec 0 - | SInt64_int -> string_of_default spec 0 - | Fixed64_int -> string_of_default spec 0 - | SFixed64_int -> string_of_default spec 0 - - | Bool -> string_of_default spec false - | String -> string_of_default spec "" - | Bytes -> string_of_default spec (Bytes.of_string "") - | Enum (_ , s, _, _) -> sprintf {|(%s 0)|} s +let default_of_spec: type a. a spec -> a = fun spec -> match spec with + | Double -> 0.0 + | Float -> 0.0 + + | Int32 -> 0l + | UInt32 -> 0l + | SInt32 -> 0l + | Fixed32 -> 0l + | SFixed32 -> 0l + + | Int32_int -> 0 + | UInt32_int -> 0 + | SInt32_int -> 0 + | Fixed32_int -> 0 + | SFixed32_int -> 0 + + | Int64 -> 0L + | UInt64 -> 0L + | SInt64 -> 0L + | Fixed64 -> 0L + | SFixed64 -> 0L + + | UInt64_int -> 0 + | Int64_int -> 0 + | SInt64_int -> 0 + | Fixed64_int -> 0 + | SFixed64_int -> 0 + + | Bool -> false + | String -> "" + | Bytes -> Bytes.of_string "" + | Enum _-> failwith "Enums not handled here" | Message _ -> failwith "Messages defaults are not relevant" let string_of_spec: type a. [`Deserialize | `Serialize] -> a spec -> string = fun dir spec -> @@ -229,8 +235,17 @@ let spec_of_enum ~scope type_name default = let type' = Scope.get_scoped_name ~postfix:"t" scope type_name in let deserialize_func = Scope.get_scoped_name ~postfix:"from_int_exn" scope type_name in let serialize_func = Scope.get_scoped_name ~postfix:"to_int" scope type_name in - let default = Option.map ~f:(fun default -> Scope.get_scoped_name ~postfix:default scope type_name) default in - Enum (type', deserialize_func, serialize_func, default) + let default = + match default with + | Some default -> + Option.value_exn type_name + |> (fun type_name -> sprintf "%s.%s" type_name default) + |> Option.some + |> Scope.get_scoped_name scope + | None -> + Scope.get_scoped_enum_name scope type_name + in + (type', deserialize_func, serialize_func, Some default) open Parameters let spec_of_type ~params ~scope type_name default = @@ -271,17 +286,16 @@ let spec_of_type ~params ~scope type_name default = | TYPE_GROUP -> failwith "Groups not supported" | TYPE_MESSAGE -> Espec (spec_of_message ~scope type_name) - | TYPE_ENUM -> Espec (spec_of_enum ~scope type_name default) + | TYPE_ENUM -> Espec (Enum (spec_of_enum ~scope type_name default)) let string_of_oneof_elem dir (Oneof_elem (index, spec, (_, deser, ser, _))) = let spec_string = string_of_spec dir spec in let s = match dir with `Deserialize -> deser | `Serialize -> ser in sprintf "oneof_elem (%d, %s, %s)" index spec_string s -let string_of_proto_type: type a. a spec -> a proto_type -> string = fun spec -> function - | Proto3 -> "proto3" - | Proto2 default -> sprintf "proto2 (%s)" (string_of_default spec default) - | Required -> "required" +let string_of_proto_type: type a. a spec -> a option -> string = fun spec -> function + | Some s -> sprintf "Some (%s)" (string_of_default spec s) + | None -> "None" let string_of_packed = function | Packed -> "packed" @@ -289,15 +303,14 @@ let string_of_packed = function let c_of_compound: type a. string -> a compound -> c = fun name compound -> match compound with - | Basic (index, spec, proto_type) -> - let deserialize_spec = sprintf "basic (%d, %s, %s)" index (string_of_spec `Deserialize spec) (string_of_proto_type spec proto_type) in - let serialize_spec = sprintf "basic (%d, %s, %s)" index (string_of_spec `Serialize spec) (string_of_proto_type spec proto_type) in + | Basic (index, spec, default) -> + let deserialize_spec = sprintf "basic (%d, %s, %s)" index (string_of_spec `Deserialize spec) (string_of_proto_type spec default) in + let serialize_spec = sprintf "basic (%d, %s, %s)" index (string_of_spec `Serialize spec) (string_of_proto_type spec default) in let modifier = - match spec, proto_type with - | _, Required -> Required + match spec, default with + | _, None-> Required | Message _, _ -> Optional - | _, Proto3 -> No_modifier (default_of_spec spec) - | _, Proto2 v -> No_modifier (string_of_default spec v) + | _, Some v -> No_modifier (string_of_default spec v) in let type' = { name = type_of_spec spec; modifier } in { name; type'; deserialize_spec; serialize_spec } @@ -344,38 +357,38 @@ let c_of_field ~params ~syntax ~scope field = (* Required message *) | `Proto2, { label = Some Label.LABEL_REQUIRED; type' = Some TYPE_MESSAGE; type_name; _ } -> let spec = spec_of_message ~scope type_name in - Basic (number, spec, Required) + Basic (number, spec, None) |> c_of_compound name (* Enum under proto2 with a default value *) | `Proto2, { label = Some Label.LABEL_OPTIONAL; type' = Some TYPE_ENUM; type_name; default_value = Some default; _ } -> let spec = spec_of_enum ~scope type_name (Some default) in - Basic (number, spec, Proto2 (Some default)) + Basic (number, Enum spec, Some default) |> c_of_compound name (* Enum under proto2 with no default value *) | `Proto2, { label = Some Label.LABEL_OPTIONAL; type' = Some TYPE_ENUM; type_name; default_value = None; _ } -> let spec = spec_of_enum ~scope type_name None in - Basic_opt (number, spec) + Basic_opt (number, Enum spec) |> c_of_compound name (* Required Enum under proto2 *) | `Proto2, { label = Some Label.LABEL_REQUIRED; type' = Some TYPE_ENUM; type_name; _ } -> let spec = spec_of_enum ~scope type_name None in - Basic (number, spec, Required) + Basic (number, Enum spec, None) |> c_of_compound name (* Required fields under proto2 *) | `Proto2, { label = Some Label.LABEL_REQUIRED; type' = Some type'; type_name; _ } -> let Espec spec = spec_of_type ~params ~scope type_name None type' in - Basic (number, spec, Required) + Basic (number, spec, None) |> c_of_compound name (* Proto2 optional fields with a default *) | `Proto2, { label = Some Label.LABEL_OPTIONAL; type' = Some type'; type_name; default_value = Some default; _ } -> let Espec spec = spec_of_type ~params ~scope type_name (Some default) type' in let default = make_default spec default in - Basic (number, spec, Proto2 default) + Basic (number, spec, Some default) |> c_of_compound name (* Proto2 optional fields - no default *) @@ -390,10 +403,18 @@ let c_of_field ~params ~syntax ~scope field = Basic_opt (number, spec) |> c_of_compound name + (* Proto3 enum implicitly optional field *) + | `Proto3, { label = Some Label.LABEL_OPTIONAL; type' = Some TYPE_ENUM; type_name; _} -> + let spec = spec_of_enum ~scope type_name None in + let (_, _, _, default) = spec in + Basic (number, Enum spec, default) + |> c_of_compound name + (* Proto3 implicitly optional field *) | `Proto3, { label = Some Label.LABEL_OPTIONAL; type' = Some type'; type_name; _} -> let Espec spec = spec_of_type ~params ~scope type_name None type' in - Basic (number, spec, Proto3) + let default = default_of_spec spec in + Basic (number, spec, Some default) |> c_of_compound name (* Repeated fields cannot have a default *) @@ -414,7 +435,7 @@ let c_of_field ~params ~syntax ~scope field = | `Proto2, _ -> Not_packed | `Proto3, _ -> Packed in - Repeated (number, spec, packed) + Repeated (number, Enum spec, packed) |> c_of_compound name (* Repeated basic type *) diff --git a/src/spec/descriptor.ml b/src/spec/descriptor.ml index 5f03ceb..5baaca3 100644 --- a/src/spec/descriptor.ml +++ b/src/spec/descriptor.ml @@ -547,7 +547,7 @@ module Google = struct let to_proto' = let apply = fun ~f:f' writer { name; input_type; output_type; options; client_streaming; server_streaming } -> f' [] writer name input_type output_type options client_streaming server_streaming in - let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (2, string) ^:: basic_opt (3, string) ^:: basic_opt (4, (message (fun t -> MethodOptions.to_proto' t))) ^:: basic (5, bool, proto2 (false)) ^:: basic (6, bool, proto2 (false)) ^:: nil ) in + let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (2, string) ^:: basic_opt (3, string) ^:: basic_opt (4, (message (fun t -> MethodOptions.to_proto' t))) ^:: basic (5, bool, Some (false)) ^:: basic (6, bool, Some (false)) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] spec in fun writer t -> apply ~f:serialize writer t @@ -555,7 +555,7 @@ module Google = struct let from_proto_exn = let constructor = fun _extensions name input_type output_type options client_streaming server_streaming -> { name; input_type; output_type; options; client_streaming; server_streaming } in - let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (2, string) ^:: basic_opt (3, string) ^:: basic_opt (4, (message (fun t -> MethodOptions.from_proto_exn t))) ^:: basic (5, bool, proto2 (false)) ^:: basic (6, bool, proto2 (false)) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (2, string) ^:: basic_opt (3, string) ^:: basic_opt (4, (message (fun t -> MethodOptions.from_proto_exn t))) ^:: basic (5, bool, Some (false)) ^:: basic (6, bool, Some (false)) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) @@ -614,7 +614,7 @@ module Google = struct let to_proto' = let apply = fun ~f:f' writer { java_package; java_outer_classname; java_multiple_files; java_generate_equals_and_hash; java_string_check_utf8; optimize_for; go_package; cc_generic_services; java_generic_services; py_generic_services; php_generic_services; deprecated; cc_enable_arenas; objc_class_prefix; csharp_namespace; swift_prefix; php_class_prefix; php_namespace; php_metadata_namespace; ruby_package; uninterpreted_option; extensions' } -> f' extensions' writer java_package java_outer_classname java_multiple_files java_generate_equals_and_hash java_string_check_utf8 optimize_for go_package cc_generic_services java_generic_services py_generic_services php_generic_services deprecated cc_enable_arenas objc_class_prefix csharp_namespace swift_prefix php_class_prefix php_namespace php_metadata_namespace ruby_package uninterpreted_option in - let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (8, string) ^:: basic (10, bool, proto2 (false)) ^:: basic_opt (20, bool) ^:: basic (27, bool, proto2 (false)) ^:: basic (9, (enum FileOptions.OptimizeMode.to_int), proto2 (FileOptions.OptimizeMode.SPEED)) ^:: basic_opt (11, string) ^:: basic (16, bool, proto2 (false)) ^:: basic (17, bool, proto2 (false)) ^:: basic (18, bool, proto2 (false)) ^:: basic (42, bool, proto2 (false)) ^:: basic (23, bool, proto2 (false)) ^:: basic (31, bool, proto2 (true)) ^:: basic_opt (36, string) ^:: basic_opt (37, string) ^:: basic_opt (39, string) ^:: basic_opt (40, string) ^:: basic_opt (41, string) ^:: basic_opt (44, string) ^:: basic_opt (45, string) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in + let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (8, string) ^:: basic (10, bool, Some (false)) ^:: basic_opt (20, bool) ^:: basic (27, bool, Some (false)) ^:: basic (9, (enum FileOptions.OptimizeMode.to_int), Some (FileOptions.OptimizeMode.SPEED)) ^:: basic_opt (11, string) ^:: basic (16, bool, Some (false)) ^:: basic (17, bool, Some (false)) ^:: basic (18, bool, Some (false)) ^:: basic (42, bool, Some (false)) ^:: basic (23, bool, Some (false)) ^:: basic (31, bool, Some (true)) ^:: basic_opt (36, string) ^:: basic_opt (37, string) ^:: basic_opt (39, string) ^:: basic_opt (40, string) ^:: basic_opt (41, string) ^:: basic_opt (44, string) ^:: basic_opt (45, string) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] spec in fun writer t -> apply ~f:serialize writer t @@ -622,7 +622,7 @@ module Google = struct let from_proto_exn = let constructor = fun extensions' java_package java_outer_classname java_multiple_files java_generate_equals_and_hash java_string_check_utf8 optimize_for go_package cc_generic_services java_generic_services py_generic_services php_generic_services deprecated cc_enable_arenas objc_class_prefix csharp_namespace swift_prefix php_class_prefix php_namespace php_metadata_namespace ruby_package uninterpreted_option -> { java_package; java_outer_classname; java_multiple_files; java_generate_equals_and_hash; java_string_check_utf8; optimize_for; go_package; cc_generic_services; java_generic_services; py_generic_services; php_generic_services; deprecated; cc_enable_arenas; objc_class_prefix; csharp_namespace; swift_prefix; php_class_prefix; php_namespace; php_metadata_namespace; ruby_package; uninterpreted_option; extensions' } in - let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (8, string) ^:: basic (10, bool, proto2 (false)) ^:: basic_opt (20, bool) ^:: basic (27, bool, proto2 (false)) ^:: basic (9, (enum FileOptions.OptimizeMode.from_int_exn), proto2 (FileOptions.OptimizeMode.SPEED)) ^:: basic_opt (11, string) ^:: basic (16, bool, proto2 (false)) ^:: basic (17, bool, proto2 (false)) ^:: basic (18, bool, proto2 (false)) ^:: basic (42, bool, proto2 (false)) ^:: basic (23, bool, proto2 (false)) ^:: basic (31, bool, proto2 (true)) ^:: basic_opt (36, string) ^:: basic_opt (37, string) ^:: basic_opt (39, string) ^:: basic_opt (40, string) ^:: basic_opt (41, string) ^:: basic_opt (44, string) ^:: basic_opt (45, string) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (8, string) ^:: basic (10, bool, Some (false)) ^:: basic_opt (20, bool) ^:: basic (27, bool, Some (false)) ^:: basic (9, (enum FileOptions.OptimizeMode.from_int_exn), Some (FileOptions.OptimizeMode.SPEED)) ^:: basic_opt (11, string) ^:: basic (16, bool, Some (false)) ^:: basic (17, bool, Some (false)) ^:: basic (18, bool, Some (false)) ^:: basic (42, bool, Some (false)) ^:: basic (23, bool, Some (false)) ^:: basic (31, bool, Some (true)) ^:: basic_opt (36, string) ^:: basic_opt (37, string) ^:: basic_opt (39, string) ^:: basic_opt (40, string) ^:: basic_opt (41, string) ^:: basic_opt (44, string) ^:: basic_opt (45, string) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) @@ -649,7 +649,7 @@ module Google = struct let to_proto' = let apply = fun ~f:f' writer { message_set_wire_format; no_standard_descriptor_accessor; deprecated; map_entry; uninterpreted_option; extensions' } -> f' extensions' writer message_set_wire_format no_standard_descriptor_accessor deprecated map_entry uninterpreted_option in - let spec = Runtime'.Serialize.C.( basic (1, bool, proto2 (false)) ^:: basic (2, bool, proto2 (false)) ^:: basic (3, bool, proto2 (false)) ^:: basic_opt (7, bool) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in + let spec = Runtime'.Serialize.C.( basic (1, bool, Some (false)) ^:: basic (2, bool, Some (false)) ^:: basic (3, bool, Some (false)) ^:: basic_opt (7, bool) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] spec in fun writer t -> apply ~f:serialize writer t @@ -657,7 +657,7 @@ module Google = struct let from_proto_exn = let constructor = fun extensions' message_set_wire_format no_standard_descriptor_accessor deprecated map_entry uninterpreted_option -> { message_set_wire_format; no_standard_descriptor_accessor; deprecated; map_entry; uninterpreted_option; extensions' } in - let spec = Runtime'.Deserialize.C.( basic (1, bool, proto2 (false)) ^:: basic (2, bool, proto2 (false)) ^:: basic (3, bool, proto2 (false)) ^:: basic_opt (7, bool) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic (1, bool, Some (false)) ^:: basic (2, bool, Some (false)) ^:: basic (3, bool, Some (false)) ^:: basic_opt (7, bool) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) @@ -739,7 +739,7 @@ module Google = struct let to_proto' = let apply = fun ~f:f' writer { ctype; packed; jstype; lazy'; unverified_lazy; deprecated; weak; uninterpreted_option; extensions' } -> f' extensions' writer ctype packed jstype lazy' unverified_lazy deprecated weak uninterpreted_option in - let spec = Runtime'.Serialize.C.( basic (1, (enum FieldOptions.CType.to_int), proto2 (FieldOptions.CType.STRING)) ^:: basic_opt (2, bool) ^:: basic (6, (enum FieldOptions.JSType.to_int), proto2 (FieldOptions.JSType.JS_NORMAL)) ^:: basic (5, bool, proto2 (false)) ^:: basic (15, bool, proto2 (false)) ^:: basic (3, bool, proto2 (false)) ^:: basic (10, bool, proto2 (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in + let spec = Runtime'.Serialize.C.( basic (1, (enum FieldOptions.CType.to_int), Some (FieldOptions.CType.STRING)) ^:: basic_opt (2, bool) ^:: basic (6, (enum FieldOptions.JSType.to_int), Some (FieldOptions.JSType.JS_NORMAL)) ^:: basic (5, bool, Some (false)) ^:: basic (15, bool, Some (false)) ^:: basic (3, bool, Some (false)) ^:: basic (10, bool, Some (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] spec in fun writer t -> apply ~f:serialize writer t @@ -747,7 +747,7 @@ module Google = struct let from_proto_exn = let constructor = fun extensions' ctype packed jstype lazy' unverified_lazy deprecated weak uninterpreted_option -> { ctype; packed; jstype; lazy'; unverified_lazy; deprecated; weak; uninterpreted_option; extensions' } in - let spec = Runtime'.Deserialize.C.( basic (1, (enum FieldOptions.CType.from_int_exn), proto2 (FieldOptions.CType.STRING)) ^:: basic_opt (2, bool) ^:: basic (6, (enum FieldOptions.JSType.from_int_exn), proto2 (FieldOptions.JSType.JS_NORMAL)) ^:: basic (5, bool, proto2 (false)) ^:: basic (15, bool, proto2 (false)) ^:: basic (3, bool, proto2 (false)) ^:: basic (10, bool, proto2 (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic (1, (enum FieldOptions.CType.from_int_exn), Some (FieldOptions.CType.STRING)) ^:: basic_opt (2, bool) ^:: basic (6, (enum FieldOptions.JSType.from_int_exn), Some (FieldOptions.JSType.JS_NORMAL)) ^:: basic (5, bool, Some (false)) ^:: basic (15, bool, Some (false)) ^:: basic (3, bool, Some (false)) ^:: basic (10, bool, Some (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) @@ -804,7 +804,7 @@ module Google = struct let to_proto' = let apply = fun ~f:f' writer { allow_alias; deprecated; uninterpreted_option; extensions' } -> f' extensions' writer allow_alias deprecated uninterpreted_option in - let spec = Runtime'.Serialize.C.( basic_opt (2, bool) ^:: basic (3, bool, proto2 (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in + let spec = Runtime'.Serialize.C.( basic_opt (2, bool) ^:: basic (3, bool, Some (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] spec in fun writer t -> apply ~f:serialize writer t @@ -812,7 +812,7 @@ module Google = struct let from_proto_exn = let constructor = fun extensions' allow_alias deprecated uninterpreted_option -> { allow_alias; deprecated; uninterpreted_option; extensions' } in - let spec = Runtime'.Deserialize.C.( basic_opt (2, bool) ^:: basic (3, bool, proto2 (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic_opt (2, bool) ^:: basic (3, bool, Some (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) @@ -837,7 +837,7 @@ module Google = struct let to_proto' = let apply = fun ~f:f' writer { deprecated; uninterpreted_option; extensions' } -> f' extensions' writer deprecated uninterpreted_option in - let spec = Runtime'.Serialize.C.( basic (1, bool, proto2 (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in + let spec = Runtime'.Serialize.C.( basic (1, bool, Some (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] spec in fun writer t -> apply ~f:serialize writer t @@ -845,7 +845,7 @@ module Google = struct let from_proto_exn = let constructor = fun extensions' deprecated uninterpreted_option -> { deprecated; uninterpreted_option; extensions' } in - let spec = Runtime'.Deserialize.C.( basic (1, bool, proto2 (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic (1, bool, Some (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) @@ -870,7 +870,7 @@ module Google = struct let to_proto' = let apply = fun ~f:f' writer { deprecated; uninterpreted_option; extensions' } -> f' extensions' writer deprecated uninterpreted_option in - let spec = Runtime'.Serialize.C.( basic (33, bool, proto2 (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in + let spec = Runtime'.Serialize.C.( basic (33, bool, Some (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] spec in fun writer t -> apply ~f:serialize writer t @@ -878,7 +878,7 @@ module Google = struct let from_proto_exn = let constructor = fun extensions' deprecated uninterpreted_option -> { deprecated; uninterpreted_option; extensions' } in - let spec = Runtime'.Deserialize.C.( basic (33, bool, proto2 (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic (33, bool, Some (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) @@ -930,7 +930,7 @@ module Google = struct let to_proto' = let apply = fun ~f:f' writer { deprecated; idempotency_level; uninterpreted_option; extensions' } -> f' extensions' writer deprecated idempotency_level uninterpreted_option in - let spec = Runtime'.Serialize.C.( basic (33, bool, proto2 (false)) ^:: basic (34, (enum MethodOptions.IdempotencyLevel.to_int), proto2 (MethodOptions.IdempotencyLevel.IDEMPOTENCY_UNKNOWN)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in + let spec = Runtime'.Serialize.C.( basic (33, bool, Some (false)) ^:: basic (34, (enum MethodOptions.IdempotencyLevel.to_int), Some (MethodOptions.IdempotencyLevel.IDEMPOTENCY_UNKNOWN)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] spec in fun writer t -> apply ~f:serialize writer t @@ -938,7 +938,7 @@ module Google = struct let from_proto_exn = let constructor = fun extensions' deprecated idempotency_level uninterpreted_option -> { deprecated; idempotency_level; uninterpreted_option; extensions' } in - let spec = Runtime'.Deserialize.C.( basic (33, bool, proto2 (false)) ^:: basic (34, (enum MethodOptions.IdempotencyLevel.from_int_exn), proto2 (MethodOptions.IdempotencyLevel.IDEMPOTENCY_UNKNOWN)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic (33, bool, Some (false)) ^:: basic (34, (enum MethodOptions.IdempotencyLevel.from_int_exn), Some (MethodOptions.IdempotencyLevel.IDEMPOTENCY_UNKNOWN)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) @@ -980,7 +980,7 @@ module Google = struct let to_proto' = let apply = fun ~f:f' writer { name_part; is_extension } -> f' [] writer name_part is_extension in - let spec = Runtime'.Serialize.C.( basic (1, string, required) ^:: basic (2, bool, required) ^:: nil ) in + let spec = Runtime'.Serialize.C.( basic (1, string, None) ^:: basic (2, bool, None) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] spec in fun writer t -> apply ~f:serialize writer t @@ -988,7 +988,7 @@ module Google = struct let from_proto_exn = let constructor = fun _extensions name_part is_extension -> { name_part; is_extension } in - let spec = Runtime'.Deserialize.C.( basic (1, string, required) ^:: basic (2, bool, required) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic (1, string, None) ^:: basic (2, bool, None) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) diff --git a/src/spec/options.ml b/src/spec/options.ml index 071846d..170862a 100644 --- a/src/spec/options.ml +++ b/src/spec/options.ml @@ -41,7 +41,7 @@ end = struct let to_proto' = let apply = fun ~f:f' writer mangle_names -> f' [] writer mangle_names in - let spec = Runtime'.Serialize.C.( basic (1, bool, proto3) ^:: nil ) in + let spec = Runtime'.Serialize.C.( basic (1, bool, Some (false)) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] spec in fun writer t -> apply ~f:serialize writer t @@ -49,7 +49,7 @@ end = struct let from_proto_exn = let constructor = fun _extensions mangle_names -> mangle_names in - let spec = Runtime'.Deserialize.C.( basic (1, bool, proto3) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic (1, bool, Some (false)) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) From c093c77fd1c65f9b7be1565b57ee9fdeebc1d29a Mon Sep 17 00:00:00 2001 From: Anders Fugmann Date: Thu, 4 Jan 2024 22:05:13 +0100 Subject: [PATCH 11/30] Write directly to the output buffer to avoid creation of Field.t types. Also loop unroll varint encoding and add tests to verify correct encoding for varints. --- bench/bench.ml | 29 ++- src/ocaml_protoc_plugin/serialize.ml | 330 ++++++++++++++------------- src/ocaml_protoc_plugin/spec.ml | 34 +++ src/ocaml_protoc_plugin/writer.ml | 315 ++++++++++++++++++++++++- src/ocaml_protoc_plugin/writer.mli | 15 +- test/protocol_test.ml | 30 +-- 6 files changed, 556 insertions(+), 197 deletions(-) diff --git a/bench/bench.ml b/bench/bench.ml index 95ae654..58560e3 100644 --- a/bench/bench.ml +++ b/bench/bench.ml @@ -19,7 +19,8 @@ module type Plugin_impl = sig end let make_tests (type v) (module Protoc: Protoc_impl) (module Plugin: Plugin_impl with type M.t = v) v_plugin = - let data = Plugin.M.to_proto v_plugin |> Ocaml_protoc_plugin.Writer.contents in + let contents = Plugin.M.to_proto v_plugin in + let data = contents |> Ocaml_protoc_plugin.Writer.contents in (* We need to reconstruct the data, as we might loose precision when using floats (32bit, compared to doubles) (64 bit) *) let v_plugin = Plugin.M.from_proto_exn (Ocaml_protoc_plugin.Reader.create data) in (* Assert decoding works *) @@ -35,7 +36,7 @@ let make_tests (type v) (module Protoc: Protoc_impl) (module Plugin: Plugin_impl eprintf "New: %s\n" (Plugin.M.show v_plugin'); failwith "Data not the same" in - printf "%16s: Data length: %5d /%5d (%b)\n%!" (Plugin.M.name' ()) (String.length data) (String.length data_protoc) (Poly.equal v_plugin v_plugin'); + printf "%16s: Data length: %5d /%5d (%b). Waste: %5d\n%!" (Plugin.M.name' ()) (String.length data) (String.length data_protoc) (Poly.equal v_plugin v_plugin') (Ocaml_protoc_plugin.Writer.unused contents); let open Bechamel in let test_encode = @@ -139,8 +140,30 @@ let print_bench_results results = | None -> { Bechamel_notty.w= 80; h= 1; } in img (window, results) |> eol |> output_image + +let test_unroll () = + let open Bechamel in + let values = List.init 9 ~f:(fun idx -> Int64.shift_left 1L (idx*7)) in + let buffer = Bytes.create 10 in + List.mapi ~f:(fun index vl -> + let v = Int64.to_int_exn vl in + Test.make_grouped ~name:(Printf.sprintf "bits %d" (index*7)) [ + Test.make ~name:"Varint unboxed unrolled" (Staged.stage @@ fun () -> + Ocaml_protoc_plugin.Writer.write_varint_unboxed buffer ~offset:0 v |> ignore); + Test.make ~name:"Varint unboxed reference" (Staged.stage @@ fun () -> + Ocaml_protoc_plugin.Writer.write_varint_unboxed_reference buffer ~offset:0 v |> ignore); + + Test.make ~name:"Varint unrolled" (Staged.stage @@ fun () -> + Ocaml_protoc_plugin.Writer.write_varint buffer ~offset:0 vl |> ignore); + Test.make ~name:"Varint reference" (Staged.stage @@ fun () -> + Ocaml_protoc_plugin.Writer.write_varint_reference buffer ~offset:0 vl |> ignore); + + ]) values + + let _ = let v_plugin = create_test_data ~depth:2 () |> Option.value_exn in + test_unroll () @ [ make_tests (module Protoc.Bench) (module Plugin.Bench) v_plugin; make_tests (module Protoc.Int64) (module Plugin.Int64) 27; make_tests (module Protoc.Float) (module Plugin.Float) 27.0001; @@ -152,7 +175,7 @@ let _ = random_list ~len:100 ~f:random_string () |> make_tests (module Protoc.String_list) (module Plugin.String_list); (* random_list ~len:100 ~f:(fun () -> Plugin.Enum_list.Enum.ED) () |> make_tests (module Protoc.Enum_list) (module Plugin.Enum_list); *) ] - |> List.iter ~f:(fun test -> + |> List.rev |> List.iter ~f:(fun test -> test |> benchmark |> analyze diff --git a/src/ocaml_protoc_plugin/serialize.ml b/src/ocaml_protoc_plugin/serialize.ml index 5acec33..a844294 100644 --- a/src/ocaml_protoc_plugin/serialize.ml +++ b/src/ocaml_protoc_plugin/serialize.ml @@ -1,64 +1,135 @@ open StdLabels -open Field module S = Spec.Serialize module C = S.C open S -let varint ~signed v = +let rec size_of_field: type a. a spec -> a -> int = function + (* We could just assume 10 bytes for a varint to speed it up *) + | Double | Fixed64 | SFixed64 | Fixed64_int | SFixed64_int -> fun _ -> 8 + | Float | Fixed32 | SFixed32 | Fixed32_int | SFixed32_int -> fun _ -> 4 + | Int64 -> fun v -> Writer.varint_size (Int64.to_int v) + | UInt64 -> fun v -> Writer.varint_size (Int64.to_int v) + | SInt64 -> fun v -> Writer.varint_size (Int64.to_int v) + + | Int32 -> fun v -> Writer.varint_size (Int32.to_int v) + | UInt32 -> fun v -> Writer.varint_size (Int32.to_int v) + | SInt32 -> fun v -> Writer.varint_size (Int32.to_int v) + + | Int64_int -> Writer.varint_size + | UInt64_int -> Writer.varint_size + | Int32_int -> Writer.varint_size + | UInt32_int -> Writer.varint_size + | SInt64_int -> Writer.varint_size + | SInt32_int -> Writer.varint_size + + | Bool -> let size = size_of_field Int64_int 1 in fun _ -> size + | String -> let size = size_of_field Int64_int in fun v -> let length = String.length v in (size length) + length + | Bytes -> let size = size_of_field Int64_int in fun v -> let length = Bytes.length v in (size length) + length + | Enum _ -> failwith "Enums must be converted to varint" + | Message _ -> failwith "Message sizes should not be pre-computed as we have a continuation and don't need to preallocate" + +let field_type: type a. a spec -> int = function + | Int64 | UInt64 | SInt64 | Int32 | UInt32 | SInt32 + | Int64_int | UInt64_int | Int32_int | UInt32_int | SInt64_int | SInt32_int + | Bool | Enum _ -> 0 (* Varint *) + | String | Bytes | Message _ -> 2 (* Length delimited *) + | Double | Fixed64 | SFixed64 | Fixed64_int | SFixed64_int -> 1 (* Fixed 64 bit *) + | Float | Fixed32 | SFixed32 | Fixed32_int | SFixed32_int -> 5 (* Fixed 32 bit *) + +let write_fixed64 ~f v = + let size = 8 in + let writer = Writer.write_fixed64 in + Writer.write_value ~size ~writer (f v) + +let write_fixed32 ~f v = + let size = 4 in + let writer = Writer.write_fixed32 in + Writer.write_value ~size ~writer (f v) + +let zigzag_encoding v = let open Infix.Int64 in - let v = match signed with - | true when v < 0L -> v lsl 1 lxor (-1L) - | true -> v lsl 1 - | false -> v + let v = match v < 0L with + | true -> v lsl 1 lxor (-1L) + | false -> v lsl 1 in - Field.Varint v + v -let varint_unboxed ~signed v = - let v = match signed with - | true when v < 0 -> v lsl 1 lxor (-1) - | true -> v lsl 1 - | false -> v +let zigzag_encoding_unboxed v = + let v = match v < 0 with + | true -> v lsl 1 lxor (-1) + | false -> v lsl 1 in - Field.Varint_unboxed v - - -let rec field_of_spec: type a. a spec -> a -> Field.t = function - | Double -> fun v -> Fixed_64_bit (Int64.bits_of_float v) - | Float -> fun v -> Fixed_32_bit (Int32.bits_of_float v) - | Int64 -> varint ~signed:false - | Int64_int -> varint_unboxed ~signed:false - | UInt64 -> varint ~signed:false - | UInt64_int -> varint_unboxed ~signed:false - | SInt64 -> varint ~signed:true - | SInt64_int -> varint_unboxed ~signed:true - | Int32 -> fun v -> varint ~signed:false (Int64.of_int32 v) - | Int32_int -> varint_unboxed ~signed:false - | UInt32 -> fun v -> varint ~signed:false (Int64.of_int32 v) - | UInt32_int -> varint_unboxed ~signed:false - | SInt32 -> fun v -> varint ~signed:true (Int64.of_int32 v) - | SInt32_int -> varint_unboxed ~signed:true - - | Fixed64 -> fixed_64_bit - | Fixed64_int -> fun v -> Fixed_64_bit (Int64.of_int v) - | SFixed64 -> fixed_64_bit - | SFixed64_int -> fun v -> Fixed_64_bit (Int64.of_int v) - | Fixed32 -> fixed_32_bit - | Fixed32_int -> fun v -> Fixed_32_bit (Int32.of_int v) - | SFixed32 -> fixed_32_bit - | SFixed32_int -> fun v -> Fixed_32_bit (Int32.of_int v) - - | Bool -> fun v -> varint_unboxed ~signed:false (match v with | true -> 1 | false -> 0) - | String -> fun v -> Length_delimited {offset = 0; length = String.length v; data = v} - | Bytes -> fun v -> Length_delimited {offset = 0; length = Bytes.length v; data = Bytes.unsafe_to_string v} - | Enum f -> - let to_field = field_of_spec UInt64_int in - fun v -> f v |> to_field - | Message to_proto -> (* Consider inlining this into write *) - fun v -> - let writer = Writer.init () in - let writer = to_proto writer v in - length_delimited (Writer.contents writer) + v + +let write_varint ~f v = + let v = f v in + let size = Writer.varint_size (Int64.to_int v) in + let writer = Writer.write_varint in + Writer.write_value ~size ~writer v + +let write_varint_unboxed ~f v = + let v = f v in + let size = Writer.varint_size v in + let writer = Writer.write_varint_unboxed in + Writer.write_value ~size ~writer v + +(* Can only write a string *) +let write_string ~f v = + let v = f v in + let write_length = write_varint_unboxed ~f:String.length v in + let write_string = Writer.write_string in + fun t -> + write_length t; + Writer.write_value ~size:(String.length v) ~writer:write_string v t + +let write_message ~f v writer = + Writer.write_length_delimited_value ~write:f v writer + +let id x = x +let (@@) a b = fun v -> b (a v) + +let write_value : type a. a spec -> a -> Writer.t -> unit = function + | Double -> write_fixed64 ~f:Int64.bits_of_float + | Float -> write_fixed32 ~f:Int32.bits_of_float + | Fixed64 -> write_fixed64 ~f:id + | SFixed64 -> write_fixed64 ~f:id + | Fixed64_int -> write_fixed64 ~f:Int64.of_int + | SFixed64_int -> write_fixed64 ~f:Int64.of_int + | Fixed32 -> write_fixed32 ~f:id + | SFixed32 -> write_fixed32 ~f:id + | Fixed32_int -> write_fixed32 ~f:Int32.of_int + | SFixed32_int -> write_fixed32 ~f:Int32.of_int + | Int64 -> write_varint ~f:id + | UInt64 -> write_varint ~f:id + | SInt64 -> write_varint ~f:zigzag_encoding + | Int32 -> write_varint_unboxed ~f:Int32.to_int + | UInt32 -> write_varint_unboxed ~f:Int32.to_int + | SInt32 -> write_varint_unboxed ~f:(Int32.to_int @@ zigzag_encoding_unboxed) + | Int64_int -> write_varint_unboxed ~f:id + | UInt64_int -> write_varint_unboxed ~f:id + | Int32_int -> write_varint_unboxed ~f:id + | UInt32_int -> write_varint_unboxed ~f:id + | SInt64_int -> write_varint_unboxed ~f:zigzag_encoding_unboxed + | SInt32_int -> write_varint_unboxed ~f:zigzag_encoding_unboxed + + | Bool -> write_varint_unboxed ~f:(function true -> 1 | false -> 0) + | String -> write_string ~f:id + | Bytes -> write_string ~f:Bytes.unsafe_to_string + | Enum f -> write_varint_unboxed ~f + | Message to_proto -> write_message ~f:(fun v writer -> to_proto writer v |> ignore) + +let write_field_header: 'a spec -> int -> Writer.t -> unit = fun spec index -> + let field_type = field_type spec in + let header = (index lsl 3) + field_type in + write_value Int64_int header + +let write_field: type a. a spec -> int -> a -> Writer.t -> unit = fun spec index -> + let write_field_header = write_field_header spec index in + let write_value = write_value spec in + fun v writer -> + write_field_header writer; + write_value v writer let is_scalar: type a. a spec -> bool = function | String -> false @@ -66,54 +137,46 @@ let is_scalar: type a. a spec -> bool = function | Message _ -> false | _ -> true +(* Try remove the fold et. al. *) let rec write: type a. a compound -> Writer.t -> a -> unit = function - | Basic (index, Message to_proto, _) -> begin - fun writer v -> - let done_f = Writer.add_length_delimited_field_header writer index in - let _writer = to_proto writer v in - done_f () - end - | Repeated (index, Message to_proto, _) -> - let write = write (Basic (index, Message to_proto, None)) in - fun writer vs -> List.iter ~f:(fun v -> write writer v) vs | Repeated (index, spec, Packed) when is_scalar spec -> begin - let f = field_of_spec spec in - fun writer -> function - | [] -> () - | vs -> - let done_f = Writer.add_length_delimited_field_header writer index in - List.iter ~f:(fun v -> Writer.add_field writer (f v)) vs; - done_f () + let write = write_value spec in + let write vs writer = List.iter ~f:(fun v -> write v writer) vs in + let write_header = write_field_header String index in + fun writer vs -> + match vs with + | [] -> () + | vs -> + write_header writer; + Writer.write_length_delimited_value ~write vs writer end | Repeated (index, spec, _) -> - let f = field_of_spec spec in - fun writer vs -> List.iter ~f:(fun v -> Writer.write_field writer index (f v)) vs + let write = write_field spec index in + fun writer vs -> + List.iter ~f:(fun v -> write v writer) vs + | Basic (index, spec, default) -> begin - let f = field_of_spec spec in + let write = write_field spec index in match default with - | Some default -> fun writer -> begin - function - | v when v = default -> () - | v -> Writer.write_field writer index (f v) + | Some default -> + fun writer v -> begin + match v with + | v when v = default -> () + | v -> write v writer end - | None -> fun writer v -> Writer.write_field writer index (f v) - end - | Basic_opt (index, Message to_proto) -> begin - fun writer -> function - | Some v -> - let done_f = Writer.add_length_delimited_field_header writer index in - let _ = to_proto writer v in - done_f () - | None -> () + | None -> + fun writer v -> write v writer end | Basic_opt (index, spec) -> begin - let f = field_of_spec spec in - fun writer -> function - | Some v -> Writer.write_field writer index (f v) - | None -> () + let write = write_field spec index in + fun writer v -> + match v with + | Some v -> write v writer + | None -> () end | Oneof f -> begin - fun writer -> function + fun writer v -> + match v with | `not_set -> () | v -> let Oneof_elem (index, spec, v) = f v in @@ -142,79 +205,30 @@ let serialize extension_ranges spec = ) extensions; serialize writer -let%expect_test "signed varint" = +let%expect_test "zigzag encoding" = let test v = let vl = Int64.of_int v in - Printf.printf "varint ~signed:true %LdL = %s\n" vl (varint ~signed:true vl |> Field.show); - Printf.printf "varint_unboxed ~signed:true %d = %s\n" v (varint_unboxed ~signed:true v |> Field.show); - - let vl' = (varint ~signed:true vl |> Deserialize.read_varint ~signed:true ~type_name:"") in - Printf.printf "Signed: %LdL = %LdL (%b)\n" vl vl' (vl = vl'); - - let vl' = (varint ~signed:false vl |> Deserialize.read_varint ~signed:false ~type_name:"") in - Printf.printf "Unsigned: %LdL = %LdL (%b)\n" vl vl' (vl = vl'); - - let v' = (varint_unboxed ~signed:true v |> Deserialize.read_varint_unboxed ~signed:true ~type_name:"") in - Printf.printf "Signed unboxed: %d = %d (%b)\n" v v' (v = v'); - - let v' = (varint_unboxed ~signed:false v |> Deserialize.read_varint_unboxed ~signed:false ~type_name:"") in - Printf.printf "Unsigned unboxed: %d = %d (%b)\n" v v' (v=v'); - () + Printf.printf "zigzag_encoding(%LdL) = %LdL\n" vl (zigzag_encoding vl); + Printf.printf "zigzag_encoding_unboxed(%d) = %d\n" v (zigzag_encoding_unboxed v); in List.iter ~f:test [0; -1; 1; -2; 2; 2147483647; -2147483648; Int.max_int; Int.min_int; ]; [%expect {| - varint ~signed:true 0L = (Field.Varint 0L) - varint_unboxed ~signed:true 0 = (Field.Varint_unboxed 0) - Signed: 0L = 0L (true) - Unsigned: 0L = 0L (true) - Signed unboxed: 0 = 0 (true) - Unsigned unboxed: 0 = 0 (true) - varint ~signed:true -1L = (Field.Varint 1L) - varint_unboxed ~signed:true -1 = (Field.Varint_unboxed 1) - Signed: -1L = -1L (true) - Unsigned: -1L = -1L (true) - Signed unboxed: -1 = -1 (true) - Unsigned unboxed: -1 = -1 (true) - varint ~signed:true 1L = (Field.Varint 2L) - varint_unboxed ~signed:true 1 = (Field.Varint_unboxed 2) - Signed: 1L = 1L (true) - Unsigned: 1L = 1L (true) - Signed unboxed: 1 = 1 (true) - Unsigned unboxed: 1 = 1 (true) - varint ~signed:true -2L = (Field.Varint 3L) - varint_unboxed ~signed:true -2 = (Field.Varint_unboxed 3) - Signed: -2L = -2L (true) - Unsigned: -2L = -2L (true) - Signed unboxed: -2 = -2 (true) - Unsigned unboxed: -2 = -2 (true) - varint ~signed:true 2L = (Field.Varint 4L) - varint_unboxed ~signed:true 2 = (Field.Varint_unboxed 4) - Signed: 2L = 2L (true) - Unsigned: 2L = 2L (true) - Signed unboxed: 2 = 2 (true) - Unsigned unboxed: 2 = 2 (true) - varint ~signed:true 2147483647L = (Field.Varint 4294967294L) - varint_unboxed ~signed:true 2147483647 = (Field.Varint_unboxed 4294967294) - Signed: 2147483647L = 2147483647L (true) - Unsigned: 2147483647L = 2147483647L (true) - Signed unboxed: 2147483647 = 2147483647 (true) - Unsigned unboxed: 2147483647 = 2147483647 (true) - varint ~signed:true -2147483648L = (Field.Varint 4294967295L) - varint_unboxed ~signed:true -2147483648 = (Field.Varint_unboxed 4294967295) - Signed: -2147483648L = -2147483648L (true) - Unsigned: -2147483648L = -2147483648L (true) - Signed unboxed: -2147483648 = -2147483648 (true) - Unsigned unboxed: -2147483648 = -2147483648 (true) - varint ~signed:true 4611686018427387903L = (Field.Varint 9223372036854775806L) - varint_unboxed ~signed:true 4611686018427387903 = (Field.Varint_unboxed -2) - Signed: 4611686018427387903L = 4611686018427387903L (true) - Unsigned: 4611686018427387903L = 4611686018427387903L (true) - Signed unboxed: 4611686018427387903 = -1 (false) - Unsigned unboxed: 4611686018427387903 = 4611686018427387903 (true) - varint ~signed:true -4611686018427387904L = (Field.Varint 9223372036854775807L) - varint_unboxed ~signed:true -4611686018427387904 = (Field.Varint_unboxed -1) - Signed: -4611686018427387904L = -4611686018427387904L (true) - Unsigned: -4611686018427387904L = -4611686018427387904L (true) - Signed unboxed: -4611686018427387904 = -1 (false) - Unsigned unboxed: -4611686018427387904 = -4611686018427387904 (true) |}] + zigzag_encoding(0L) = 0L + zigzag_encoding_unboxed(0) = 0 + zigzag_encoding(-1L) = 1L + zigzag_encoding_unboxed(-1) = 1 + zigzag_encoding(1L) = 2L + zigzag_encoding_unboxed(1) = 2 + zigzag_encoding(-2L) = 3L + zigzag_encoding_unboxed(-2) = 3 + zigzag_encoding(2L) = 4L + zigzag_encoding_unboxed(2) = 4 + zigzag_encoding(2147483647L) = 4294967294L + zigzag_encoding_unboxed(2147483647) = 4294967294 + zigzag_encoding(-2147483648L) = 4294967295L + zigzag_encoding_unboxed(-2147483648) = 4294967295 + zigzag_encoding(4611686018427387903L) = 9223372036854775806L + zigzag_encoding_unboxed(4611686018427387903) = -2 + zigzag_encoding(-4611686018427387904L) = 9223372036854775807L + zigzag_encoding_unboxed(-4611686018427387904) = -1 |}] diff --git a/src/ocaml_protoc_plugin/spec.ml b/src/ocaml_protoc_plugin/spec.ml index 34e6087..0342ce7 100644 --- a/src/ocaml_protoc_plugin/spec.ml +++ b/src/ocaml_protoc_plugin/spec.ml @@ -99,6 +99,40 @@ module Make(T : T) = struct let ( ^:: ) a b = Cons (a, b) let nil = Nil + + let show: type a. a spec -> string = function + | Double -> "Double" + | Float -> "Float" + + | Int32 -> "Int32" + | UInt32 -> "UInt32" + | SInt32 -> "SInt32" + | Fixed32 -> "Fixed32" + | SFixed32 -> "SFixed32" + + | Int32_int -> "Int32_int" + | UInt32_int -> "UInt32_int" + | SInt32_int -> "SInt32_int" + | Fixed32_int -> "Fixed32_int" + | SFixed32_int -> "SFixed32_int" + + | UInt64 -> "UInt64" + | Int64 -> "Int64" + | SInt64 -> "SInt64" + | Fixed64 -> "Fixed64" + | SFixed64 -> "SFixed64" + + | UInt64_int -> "UInt64_int" + | Int64_int -> "Int64_int" + | SInt64_int -> "SInt64_int" + | Fixed64_int -> "Fixed64_int" + | SFixed64_int -> "SFixed64_int" + + | Bool -> "Bool" + | String -> "String" + | Bytes -> "Bytes" + | Enum _ -> "Enum" + | Message _ -> "Message" end end diff --git a/src/ocaml_protoc_plugin/writer.ml b/src/ocaml_protoc_plugin/writer.ml index e3f6f4b..c422bab 100644 --- a/src/ocaml_protoc_plugin/writer.ml +++ b/src/ocaml_protoc_plugin/writer.ml @@ -1,13 +1,13 @@ (** Some buffer to hold data, and to read and write data *) - open StdLabels open Field + let sprintf = Printf.sprintf let printf = Printf.printf (** Bytes allocated at end of any data block to reduce number of allocated blocks *) -let space_overhead = 256 +let space_overhead = 512 (** Hold multiple short strings in a list *) type substring = { mutable offset: int; buffer: Bytes.t } @@ -22,6 +22,13 @@ let size t = in inner 0 t.data +let unused t = + let rec inner = function + | { offset; buffer } :: xs -> (Bytes.length buffer) - offset + inner xs + | [] -> 0 + in + inner t.data + (** Get index of most significant bit. *) let varint_size v = let rec inner acc = function @@ -40,8 +47,225 @@ let rec size_of_field = function | Fixed_64_bit _ -> 8 | Length_delimited {length; _} -> size_of_field (Varint_unboxed length) + length -let write_varint buffer ~offset v = - let rec inner ~offset v : int = +(* Manually unroll *) +let write_varint_unboxed buffer ~offset = function + | v when v < 0 -> + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let offset = offset + 1 in + Bytes.set_uint8 buffer offset 0x01; + offset + 1 + + | v when v < 1 lsl (7*1) -> + Bytes.set_uint8 buffer offset v; + offset + 1 + + | v when v < 1 lsl (7*2) -> + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset v; + offset + 1 + + | v when v < 1 lsl (7*3) -> + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset v; + offset + 1 + + | v when v < 1 lsl (7*4) -> + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset v; + offset + 1 + + | v when v < 1 lsl (7*5) -> + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset v; + offset + 1 + + | v when v < 1 lsl (7*6) -> + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset v; + offset + 1 + + | v when v < 1 lsl (7*7) -> + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset v; + offset + 1 + + | v when v < 1 lsl (8*7) -> + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset v; + offset + 1 + + | v (* when v < 1 lsl (8*8) *) -> + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset v; + offset + 1 + +(* If we clear the top bit, then its not signed anymore... Maybe. *) +let write_varint buffer ~offset vl = + match Infix.Int64.(vl lsr 62 > 0L) with + | false -> write_varint_unboxed buffer ~offset (Int64.to_int vl) + | true -> + let v = Int64.to_int vl in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let offset = offset + 1 in + let offset = match vl < 0L with + | true -> + Bytes.set_uint8 buffer offset ((Int64.shift_right vl (8*7) |> Int64.to_int) lor 128); + let offset = offset + 1 in + Bytes.set_uint8 buffer offset 0x01; + offset + | false -> + Bytes.set_uint8 buffer offset (Int64.shift_right vl (8*7) |> Int64.to_int); + offset + in + offset + 1 + +let write_varint_reference buffer ~offset v = + let rec inner ~offset v = let next_offset = offset + 1 in let open Infix.Int64 in match v lsr 7 with @@ -54,14 +278,16 @@ let write_varint buffer ~offset v = in inner ~offset v -let write_varint_unboxed buffer ~offset v = +let write_varint_unboxed_reference buffer ~offset v = let is_negative = v < 0 in + let v = v land 0x7FFFFFFFFFFFFFFF in let rec inner ~offset v : int = let next_offset = offset + 1 in match v lsr 7 with + (* This is wrong. We need to know if we should clear bit 63 - and we can do that immediatly *) | 0 when is_negative -> (* Emulate 64 bit signed integer *) - Bytes.set_uint8 buffer offset (v lor 0x80); - Bytes.set_uint8 buffer next_offset 0x01; + Bytes.set_uint8 buffer offset (v lor 128); + Bytes.set_uint8 buffer next_offset 0x01; (* Setting the high bit (bit number 64 = 7*9+1 *) next_offset + 1 | 0 -> Bytes.set_uint8 buffer offset v; @@ -81,11 +307,27 @@ let write_fixed64 buffer ~offset v = Bytes.set_int64_le buffer offset v; offset + 8 +let write_string buffer ~offset v = + let len = String.length v in + Bytes.blit_string ~src:v ~src_pos:0 ~dst:buffer ~dst_pos:offset ~len; + offset + len + let write_length_delimited buffer ~offset ~src ~src_pos ~len = let offset = write_varint_unboxed buffer ~offset len in Bytes.blit ~src:(Bytes.of_string src) ~src_pos ~dst:buffer ~dst_pos:offset ~len; offset + len +let write_value: size:int -> writer:(Bytes.t -> offset:int -> 'a -> int) -> 'a -> t -> unit = + fun ~size ~writer v t -> + let elem, tl = match t.data with + | { offset; buffer } as elem :: tl when Bytes.length buffer - offset >= size -> elem, tl + | tl -> { offset = 0; buffer = Bytes.create (size + space_overhead) }, tl + in + let offset = writer elem.buffer ~offset:elem.offset v in + elem.offset <- offset; + t.data <- elem :: tl + + let write_naked_field buffer ~offset = function | Varint_unboxed v -> write_varint_unboxed buffer ~offset v | Varint v -> write_varint buffer ~offset v @@ -124,10 +366,32 @@ let write_field : t -> int -> Field.t -> unit = write_field_header t index field_type; add_field t field -let add_length_delimited_field_header t index = +let write_length_delimited_value ~write v writer = + let rec size_data_added sentinel acc = function + | [] -> failwith "End of list reached. This is impossible" + | x :: _ when x == sentinel -> acc + | { offset; _ } :: xs -> size_data_added sentinel (offset + acc) xs + in + let sentinel = match writer.data with + | { offset; buffer} as sentinel :: _ when offset + 10 <= Bytes.length buffer -> + sentinel + | _ -> + let sentinel = { offset = 0; buffer = Bytes.create 10; } in + writer.data <- sentinel :: writer.data; + sentinel + in + let offset = sentinel.offset in + (* Make sure nothing else is written to the sentinel *) + sentinel.offset <- Int.max_int; + write v writer; + let size = size_data_added sentinel 0 writer.data in + let offset = write_naked_field sentinel.buffer ~offset (Varint_unboxed size) in + sentinel.offset <- offset + +let _add_length_delimited_field_header t index = let sentinel = { offset = 0; buffer = Bytes.create 20; } in t.data <- sentinel :: t.data; - write_field_header t index 2; + write_field_header t index 2; (* Length delimited *) let offset = sentinel.offset in sentinel.offset <- 20; (* Make sure nothing is written to this again *) let rec size_data_added acc = function @@ -178,3 +442,36 @@ let%expect_test "Writefield" = dump buffer; [%expect {| Buffer: 08-03-10-05-18-07-20-0b |}] + +let%test "varint unrolled" = + let open Infix.Int64 in + let values = List.init ~len:64 ~f:(fun idx -> 1L lsl idx) in + List.fold_left ~init:true ~f:(fun acc v -> + List.fold_left ~init:acc ~f:(fun acc v -> + + let acc = + let b1 = Bytes.make 10 '\000' in + let b2 = Bytes.make 10 '\000' in + write_varint_unboxed_reference b1 ~offset:0 (Int64.to_int v) |> ignore; + write_varint_unboxed b2 ~offset:0 (Int64.to_int v) |> ignore; + match Bytes.equal b1 b2 with + | true -> acc + | false -> + Printf.printf "Unboxed: %16Lx (%20d): %S = %S\n" v (Int64.to_int v) (Bytes.to_string b1) (Bytes.to_string b2); + false + in + let acc = + let b1 = Bytes.make 10 '\000' in + let b2 = Bytes.make 10 '\000' in + write_varint_reference b1 ~offset:0 v |> ignore; + write_varint b2 ~offset:0 v |> ignore; + match Bytes.equal b1 b2 with + | true -> acc + | false -> + Printf.printf "Boxed: %16Lx: %S = %S\n" v (Bytes.to_string b1) (Bytes.to_string b2); + false + in + acc + + ) [v-2L; v-1L; v; v+1L; v+2L] + ) values diff --git a/src/ocaml_protoc_plugin/writer.mli b/src/ocaml_protoc_plugin/writer.mli index cb554cf..c8cd407 100644 --- a/src/ocaml_protoc_plugin/writer.mli +++ b/src/ocaml_protoc_plugin/writer.mli @@ -3,21 +3,24 @@ type t (** Create a new writer *) val init : unit -> t -(** Construct a writer from a list of fields *) -val of_list: (int * Field.t) list -> t - (** Get the protobuf encoded contents of the writer *) val contents : t -> string (**/**) val write_varint : bytes -> offset:int -> int64 -> int +val write_varint_reference : bytes -> offset:int -> int64 -> int +val write_varint_unboxed : bytes -> offset:int -> int -> int +val write_varint_unboxed_reference : bytes -> offset:int -> int -> int val write_fixed32 : bytes -> offset:int -> Int32.t -> int val write_fixed64 : bytes -> offset:int -> Int64.t -> int +val write_string : bytes -> offset:int -> string -> int val write_length_delimited : bytes -> offset:int -> src:string -> src_pos:int -> len:int -> int val write_field : t -> int -> Field.t -> unit - -val add_field : t -> Field.t -> unit -val add_length_delimited_field_header : t -> int -> (unit -> unit) +val write_length_delimited_value : write:('a -> t -> unit) -> 'a -> t -> unit +val of_list: (int * Field.t) list -> t val dump : t -> unit +val unused : t -> int +val varint_size: int -> int +val write_value: size:int -> writer:(Bytes.t -> offset:int -> 'a -> int) -> 'a -> t -> unit (**/**) diff --git a/test/protocol_test.ml b/test/protocol_test.ml index c2fa293..e6d9d5f 100644 --- a/test/protocol_test.ml +++ b/test/protocol_test.ml @@ -1,43 +1,31 @@ open Protocol -let%test "Last value kept" = +let%expect_test "Last value kept" = let messages = List.init 8 (fun i -> i) in let oneof_messages = [] in let t = Protocol.Old.{ messages; oneof_i = "Oneof_test"; oneof_j = 13; oneof_messages } in - let expect = Protocol.New.{ message = Some 7; oneof = `Oneof_j 13 } in let writer = Protocol.Old.to_proto t in let reader = Ocaml_protoc_plugin.Writer.contents writer |> Ocaml_protoc_plugin.Reader.create in + Printf.printf "%s\n" (Protocol.New.from_proto_exn reader |> Protocol.New.show); + [%expect {| { message = (Some 7); oneof = `Oneof_j (13) } |}] - match Protocol.New.from_proto reader with - | Ok t -> - Protocol.New.equal t expect - | Error _ -> false - -let%test "Last value kept - 2" = +let%expect_test "Last value kept - 2" = let messages = List.init 8 (fun i -> i) in let oneof_messages = [] in let t = Protocol.Old.{ messages; oneof_i = "Oneof_test"; oneof_j = 13; oneof_messages } in - let expect = Protocol.New.{ message = Some 7; oneof = `Oneof_j 13 } in let writer = Protocol.Old.to_proto t in let reader = Ocaml_protoc_plugin.Writer.contents writer ^ Ocaml_protoc_plugin.Writer.contents writer |> Ocaml_protoc_plugin.Reader.create in + Printf.printf "%s" (Protocol.New.from_proto_exn reader |> Protocol.New.show); + [%expect {| { message = (Some 7); oneof = `Oneof_j (13) } |}] - match Protocol.New.from_proto reader with - | Ok t -> - Protocol.New.equal t expect - | Error _ -> false - -let%test "Repeated fields kept as it should" = +let%expect_test "Repeated fields kept as it should" = let is1 = List.init 8 (fun i -> i + 6) in let is2 = List.init 8 (fun i -> i + 17) in let t1 = is1 in let t2 = is2 in - let expect = is1 @ is2 in let writer1 = Protocol.List.to_proto t1 in let writer2 = Protocol.List.to_proto t2 in let reader = Ocaml_protoc_plugin.Writer.contents writer1 ^ Ocaml_protoc_plugin.Writer.contents writer2 |> Ocaml_protoc_plugin.Reader.create in - match Protocol.List.from_proto reader with - | Ok t -> - Protocol.List.equal t expect - | Error _ -> - false + Printf.printf "%s" (Protocol.List.from_proto_exn reader |> Protocol.List.show); + [%expect {| [6; 7; 8; 9; 10; 11; 12; 13; 17; 18; 19; 20; 21; 22; 23; 24] |}] From ab81b0adcaaf920a0c8b0475ffe54bdd67dbeeca Mon Sep 17 00:00:00 2001 From: Anders Fugmann Date: Sun, 7 Jan 2024 09:16:36 +0100 Subject: [PATCH 12/30] Allow selecting serialization stragegy per writer and and optimize writing legth delimited fields, as well as loop unroll some functions. --- bench/bench.ml | 64 ++++----- bench/float.proto | 2 +- bench/protoc/dune | 1 + src/ocaml_protoc_plugin/serialize.ml | 63 ++++---- src/ocaml_protoc_plugin/writer.ml | 205 ++++++++++++++++++--------- src/ocaml_protoc_plugin/writer.mli | 29 ++-- 6 files changed, 216 insertions(+), 148 deletions(-) diff --git a/bench/bench.ml b/bench/bench.ml index 58560e3..c2f41c9 100644 --- a/bench/bench.ml +++ b/bench/bench.ml @@ -14,16 +14,32 @@ module type Plugin_impl = sig val show: t -> string val equal: t -> t -> bool val to_proto: t -> Ocaml_protoc_plugin.Writer.t + val to_proto': Ocaml_protoc_plugin.Writer.t -> t -> Ocaml_protoc_plugin.Writer.t val from_proto_exn: Ocaml_protoc_plugin.Reader.t -> t end end let make_tests (type v) (module Protoc: Protoc_impl) (module Plugin: Plugin_impl with type M.t = v) v_plugin = - let contents = Plugin.M.to_proto v_plugin in - let data = contents |> Ocaml_protoc_plugin.Writer.contents in - (* We need to reconstruct the data, as we might loose precision when using floats (32bit, compared to doubles) (64 bit) *) + + (* Verify *) + let verify_identity ~mode data = + let writer = Plugin.M.to_proto' (Ocaml_protoc_plugin.Writer.init ~mode ()) data in + let data' = Plugin.M.from_proto_exn (Ocaml_protoc_plugin.Reader.create (Ocaml_protoc_plugin.Writer.contents writer)) in + let () = match Plugin.M.equal data data' with + | true -> () + | false -> + eprintf "Orig: %s\n" (Plugin.M.show data); + eprintf "New: %s\n" (Plugin.M.show data'); + failwith "Data not the same" + in + Ocaml_protoc_plugin.Writer.contents writer |> String.length, + Ocaml_protoc_plugin.Writer.unused_space writer + in + let size_normal, unused_normal = verify_identity ~mode:Ocaml_protoc_plugin.Writer.Balanced v_plugin in + let size_speed, unused_speed = verify_identity ~mode:Ocaml_protoc_plugin.Writer.Speed v_plugin in + let size_space, unused_space = verify_identity ~mode:Ocaml_protoc_plugin.Writer.Space v_plugin in + let data = Plugin.M.to_proto' (Ocaml_protoc_plugin.Writer.init ()) v_plugin |> Ocaml_protoc_plugin.Writer.contents in let v_plugin = Plugin.M.from_proto_exn (Ocaml_protoc_plugin.Reader.create data) in - (* Assert decoding works *) let v_protoc = Protoc.decode_pb_m (Pbrt.Decoder.of_string data) in let protoc_encoder = Pbrt.Encoder.create () in let () = Protoc.encode_pb_m v_protoc protoc_encoder in @@ -36,13 +52,17 @@ let make_tests (type v) (module Protoc: Protoc_impl) (module Plugin: Plugin_impl eprintf "New: %s\n" (Plugin.M.show v_plugin'); failwith "Data not the same" in - printf "%16s: Data length: %5d /%5d (%b). Waste: %5d\n%!" (Plugin.M.name' ()) (String.length data) (String.length data_protoc) (Poly.equal v_plugin v_plugin') (Ocaml_protoc_plugin.Writer.unused contents); + printf "%-16s: %5d+%-5d(B) / %5d+%-5d(S) / %5d+%-5d(Sp) - %5d\n%!" (Plugin.M.name' ()) + size_normal unused_normal size_speed unused_speed size_space unused_space (String.length data_protoc); + let open Bechamel in let test_encode = Test.make_grouped ~name:"Encode" [ - Test.make ~name:"Plugin" (Staged.stage @@ fun () -> Plugin.M.to_proto v_plugin); + Test.make ~name:"Plugin balanced" (Staged.stage @@ fun () -> Plugin.M.to_proto' Ocaml_protoc_plugin.Writer.(init ~mode:Balanced ()) v_plugin); + Test.make ~name:"Plugin speed" (Staged.stage @@ fun () -> Plugin.M.to_proto' Ocaml_protoc_plugin.Writer.(init ~mode:Speed ()) v_plugin); + Test.make ~name:"Plugin space" (Staged.stage @@ fun () -> Plugin.M.to_proto' Ocaml_protoc_plugin.Writer.(init ~mode:Space ()) v_plugin); Test.make ~name:"Protoc" (Staged.stage @@ fun () -> Protoc.encode_pb_m v_protoc (Pbrt.Encoder.create ())) ] in @@ -106,16 +126,15 @@ let create_test_data ~depth () = in create_btree depth () - let benchmark tests = let open Bechamel in let instances = Bechamel_perf.Instance.[ cpu_clock ] in - let cfg = Benchmark.cfg ~stabilize:true ~compaction:true () in + let cfg = Benchmark.cfg ~limit:2000 ~quota:(Time.second 5.0) ~kde:(Some 1000) ~stabilize:true ~compaction:false () in Benchmark.all cfg instances tests let analyze results = let open Bechamel in - let ols = Analyze.ols ~bootstrap:0 ~r_square:true + let ols = Analyze.ols ~bootstrap:10 ~r_square:false ~predictors:[| Measure.run |] in let results = Analyze.all ols Bechamel_perf.Instance.cpu_clock results in Analyze.merge ols [ Bechamel_perf.Instance.cpu_clock ] [ results ] @@ -141,38 +160,17 @@ let print_bench_results results = img (window, results) |> eol |> output_image -let test_unroll () = - let open Bechamel in - let values = List.init 9 ~f:(fun idx -> Int64.shift_left 1L (idx*7)) in - let buffer = Bytes.create 10 in - List.mapi ~f:(fun index vl -> - let v = Int64.to_int_exn vl in - Test.make_grouped ~name:(Printf.sprintf "bits %d" (index*7)) [ - Test.make ~name:"Varint unboxed unrolled" (Staged.stage @@ fun () -> - Ocaml_protoc_plugin.Writer.write_varint_unboxed buffer ~offset:0 v |> ignore); - Test.make ~name:"Varint unboxed reference" (Staged.stage @@ fun () -> - Ocaml_protoc_plugin.Writer.write_varint_unboxed_reference buffer ~offset:0 v |> ignore); - - Test.make ~name:"Varint unrolled" (Staged.stage @@ fun () -> - Ocaml_protoc_plugin.Writer.write_varint buffer ~offset:0 vl |> ignore); - Test.make ~name:"Varint reference" (Staged.stage @@ fun () -> - Ocaml_protoc_plugin.Writer.write_varint_reference buffer ~offset:0 vl |> ignore); - - ]) values - - let _ = let v_plugin = create_test_data ~depth:2 () |> Option.value_exn in - test_unroll () @ [ make_tests (module Protoc.Bench) (module Plugin.Bench) v_plugin; make_tests (module Protoc.Int64) (module Plugin.Int64) 27; make_tests (module Protoc.Float) (module Plugin.Float) 27.0001; make_tests (module Protoc.String) (module Plugin.String) "Benchmark"; make_tests (module Protoc.Enum) (module Plugin.Enum) Plugin.Enum.Enum.ED; - random_list ~len:100 ~f:(fun () -> Random.int 1000) () |> make_tests (module Protoc.Int64_list) (module Plugin.Int64_list); - random_list ~len:100 ~f:(fun () -> Random.float 1000.0) () |> make_tests (module Protoc.Float_list) (module Plugin.Float_list); - random_list ~len:100 ~f:random_string () |> make_tests (module Protoc.String_list) (module Plugin.String_list); + List.init 1000 ~f:(fun i -> i) |> make_tests (module Protoc.Int64_list) (module Plugin.Int64_list); + List.init 1000 ~f:(fun i -> Float.of_int i) |> make_tests (module Protoc.Float_list) (module Plugin.Float_list); + List.init 1000 ~f:(fun _ -> random_string ()) |> make_tests (module Protoc.String_list) (module Plugin.String_list); (* random_list ~len:100 ~f:(fun () -> Plugin.Enum_list.Enum.ED) () |> make_tests (module Protoc.Enum_list) (module Plugin.Enum_list); *) ] |> List.rev |> List.iter ~f:(fun test -> diff --git a/bench/float.proto b/bench/float.proto index 2610e18..7ab6fe7 100644 --- a/bench/float.proto +++ b/bench/float.proto @@ -1,5 +1,5 @@ syntax = "proto3"; message M { - float i = 1; + double i = 1; } diff --git a/bench/protoc/dune b/bench/protoc/dune index 0932bb6..73ead0a 100644 --- a/bench/protoc/dune +++ b/bench/protoc/dune @@ -16,4 +16,5 @@ (library (name protoc) + (ocamlopt_flags :standard \ -unboxed-types) (libraries pbrt)) diff --git a/src/ocaml_protoc_plugin/serialize.ml b/src/ocaml_protoc_plugin/serialize.ml index a844294..4a43760 100644 --- a/src/ocaml_protoc_plugin/serialize.ml +++ b/src/ocaml_protoc_plugin/serialize.ml @@ -4,31 +4,6 @@ module S = Spec.Serialize module C = S.C open S -let rec size_of_field: type a. a spec -> a -> int = function - (* We could just assume 10 bytes for a varint to speed it up *) - | Double | Fixed64 | SFixed64 | Fixed64_int | SFixed64_int -> fun _ -> 8 - | Float | Fixed32 | SFixed32 | Fixed32_int | SFixed32_int -> fun _ -> 4 - | Int64 -> fun v -> Writer.varint_size (Int64.to_int v) - | UInt64 -> fun v -> Writer.varint_size (Int64.to_int v) - | SInt64 -> fun v -> Writer.varint_size (Int64.to_int v) - - | Int32 -> fun v -> Writer.varint_size (Int32.to_int v) - | UInt32 -> fun v -> Writer.varint_size (Int32.to_int v) - | SInt32 -> fun v -> Writer.varint_size (Int32.to_int v) - - | Int64_int -> Writer.varint_size - | UInt64_int -> Writer.varint_size - | Int32_int -> Writer.varint_size - | UInt32_int -> Writer.varint_size - | SInt64_int -> Writer.varint_size - | SInt32_int -> Writer.varint_size - - | Bool -> let size = size_of_field Int64_int 1 in fun _ -> size - | String -> let size = size_of_field Int64_int in fun v -> let length = String.length v in (size length) + length - | Bytes -> let size = size_of_field Int64_int in fun v -> let length = Bytes.length v in (size length) + length - | Enum _ -> failwith "Enums must be converted to varint" - | Message _ -> failwith "Message sizes should not be pre-computed as we have a continuation and don't need to preallocate" - let field_type: type a. a spec -> int = function | Int64 | UInt64 | SInt64 | Int32 | UInt32 | SInt32 | Int64_int | UInt64_int | Int32_int | UInt32_int | SInt64_int | SInt32_int @@ -74,7 +49,6 @@ let write_varint_unboxed ~f v = let writer = Writer.write_varint_unboxed in Writer.write_value ~size ~writer v -(* Can only write a string *) let write_string ~f v = let v = f v in let write_length = write_varint_unboxed ~f:String.length v in @@ -83,9 +57,6 @@ let write_string ~f v = write_length t; Writer.write_value ~size:(String.length v) ~writer:write_string v t -let write_message ~f v writer = - Writer.write_length_delimited_value ~write:f v writer - let id x = x let (@@) a b = fun v -> b (a v) @@ -117,12 +88,28 @@ let write_value : type a. a spec -> a -> Writer.t -> unit = function | String -> write_string ~f:id | Bytes -> write_string ~f:Bytes.unsafe_to_string | Enum f -> write_varint_unboxed ~f - | Message to_proto -> write_message ~f:(fun v writer -> to_proto writer v |> ignore) + | Message to_proto -> + (* + fun v writer -> + let cont = Writer.write_length_delimited_value_cont writer in + let _ = to_proto writer v in + cont () + *) + Writer.write_length_delimited_value ~write:to_proto + +(** Optimized when the value is given in advance, and the continuation is expected to be called multiple times *) +let write_value_const : type a. a spec -> a -> Writer.t -> unit = fun spec v -> + let write_value = write_value spec in + let writer = Writer.init () in + write_value v writer; + let data = Writer.contents writer in + let size = String.length data in + Writer.write_value ~size ~writer:Writer.write_string data let write_field_header: 'a spec -> int -> Writer.t -> unit = fun spec index -> let field_type = field_type spec in let header = (index lsl 3) + field_type in - write_value Int64_int header + write_value_const Int64_int header let write_field: type a. a spec -> int -> a -> Writer.t -> unit = fun spec index -> let write_field_header = write_field_header spec index in @@ -137,11 +124,9 @@ let is_scalar: type a. a spec -> bool = function | Message _ -> false | _ -> true -(* Try remove the fold et. al. *) let rec write: type a. a compound -> Writer.t -> a -> unit = function | Repeated (index, spec, Packed) when is_scalar spec -> begin - let write = write_value spec in - let write vs writer = List.iter ~f:(fun v -> write v writer) vs in + let write writer vs = List.iter ~f:(fun v -> write_value spec v writer) vs in let write_header = write_field_header String index in fun writer vs -> match vs with @@ -183,7 +168,6 @@ let rec write: type a. a compound -> Writer.t -> a -> unit = function write (Basic (index, spec, None)) writer v end -(** Allow emitted code to present a protobuf specification. *) let rec serialize : type a. (a, Writer.t) compound_list -> Writer.t -> a = function | Nil -> fun writer -> writer | Cons (compound, rest) -> @@ -198,12 +182,15 @@ let in_extension_ranges extension_ranges index = let serialize extension_ranges spec = let serialize = serialize spec in - fun extensions writer -> - List.iter ~f:(function + match extension_ranges with + | [] -> fun _ -> serialize + | extension_ranges -> + fun extensions writer -> + List.iter ~f:(function | (index, field) when in_extension_ranges extension_ranges index -> Writer.write_field writer index field | _ -> () ) extensions; - serialize writer + serialize writer let%expect_test "zigzag encoding" = diff --git a/src/ocaml_protoc_plugin/writer.ml b/src/ocaml_protoc_plugin/writer.ml index c422bab..b646be8 100644 --- a/src/ocaml_protoc_plugin/writer.ml +++ b/src/ocaml_protoc_plugin/writer.ml @@ -6,15 +6,17 @@ open Field let sprintf = Printf.sprintf let printf = Printf.printf -(** Bytes allocated at end of any data block to reduce number of allocated blocks *) -let space_overhead = 512 -(** Hold multiple short strings in a list *) +let length_delimited_size_field_length = 5 + type substring = { mutable offset: int; buffer: Bytes.t } -type t = { mutable data: substring list } +type mode = Balanced | Speed | Space +type t = { mutable data: substring list; mode: mode; block_size:int } + +let init ?(mode = Space) ?(block_size = 256) () = + { data = []; mode; block_size } -let init () = { data = [] } let size t = let rec inner acc = function | [] -> acc @@ -22,7 +24,7 @@ let size t = in inner 0 t.data -let unused t = +let unused_space t = let rec inner = function | { offset; buffer } :: xs -> (Bytes.length buffer) - offset + inner xs | [] -> 0 @@ -30,16 +32,29 @@ let unused t = inner t.data (** Get index of most significant bit. *) -let varint_size v = +let varint_size_reference v = let rec inner acc = function | 0 -> acc - | v -> inner (acc + 1) (v lsr 1) + | v -> inner (acc + 1) (v lsr 1) [@@ocaml.unrolled 10] in + match v with | v when v < 0 -> 10 | 0 -> 1 | v -> (6 + inner 0 v) / 7 +let varint_size = function + | v when v < 0 -> 10 + | v when v < 0x80 -> 1 + | v when v < 0x4000 -> 2 + | v when v < 0x200000 -> 3 + | v when v < 0x10000000 -> 4 + | v when v < 0x800000000 -> 5 + | v when v < 0x40000000000 -> 6 + | v when v < 0x2000000000000 -> 7 + | v when v < 0x100000000000000 -> 8 + | _ -> 9 + let rec size_of_field = function | Varint v -> varint_size (Int64.to_int v) | Varint_unboxed v -> varint_size v @@ -223,10 +238,33 @@ let write_varint_unboxed buffer ~offset = function Bytes.set_uint8 buffer offset v; offset + 1 +(* Write a field delimited length. + A delimited field length can be no larger than 2^31. + This function always write 5 bytes (7*5bits > 31bits). + This allows the field length to be statically allocated and written later +*) +let write_delimited_field_length_fixed_size buffer ~offset v = + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset (v lor 128); + let v = v lsr 7 in + let offset = offset + 1 in + Bytes.set_uint8 buffer offset v; + offset + 1 + (* If we clear the top bit, then its not signed anymore... Maybe. *) let write_varint buffer ~offset vl = match Infix.Int64.(vl lsr 62 > 0L) with - | false -> write_varint_unboxed buffer ~offset (Int64.to_int vl) + | false -> + (* Bits 63 or 64 are not set, so write as unboxed *) + write_varint_unboxed buffer ~offset (Int64.to_int vl) | true -> let v = Int64.to_int vl in Bytes.set_uint8 buffer offset (v lor 128); @@ -254,16 +292,19 @@ let write_varint buffer ~offset vl = let offset = offset + 1 in let offset = match vl < 0L with | true -> + (* Bit 64 (signed bit) set *) Bytes.set_uint8 buffer offset ((Int64.shift_right vl (8*7) |> Int64.to_int) lor 128); let offset = offset + 1 in Bytes.set_uint8 buffer offset 0x01; offset | false -> + (* Bit 64 not set so only write 9 bytes (9*7bit = 63bit)*) Bytes.set_uint8 buffer offset (Int64.shift_right vl (8*7) |> Int64.to_int); offset in offset + 1 +(** Reference implementation. Uses a loop which is slower than the manually unrolled version *) let write_varint_reference buffer ~offset v = let rec inner ~offset v = let next_offset = offset + 1 in @@ -274,30 +315,26 @@ let write_varint_reference buffer ~offset v = next_offset | rem -> Bytes.set_uint8 buffer offset (Int.logor (Int64.to_int v |> Int.logand 0x7F) 0x80); - inner ~offset:next_offset rem + inner ~offset:next_offset rem [@@ocaml.unrolled 10] in inner ~offset v +(** Reference implementation. Uses a loop which is slower than the manually unrolled version *) let write_varint_unboxed_reference buffer ~offset v = - let is_negative = v < 0 in - let v = v land 0x7FFFFFFFFFFFFFFF in - let rec inner ~offset v : int = - let next_offset = offset + 1 in + let rec inner ~is_negative ~offset v = match v lsr 7 with - (* This is wrong. We need to know if we should clear bit 63 - and we can do that immediatly *) - | 0 when is_negative -> (* Emulate 64 bit signed integer *) - Bytes.set_uint8 buffer offset (v lor 128); - Bytes.set_uint8 buffer next_offset 0x01; (* Setting the high bit (bit number 64 = 7*9+1 *) - next_offset + 1 + | 0 when is_negative -> + (* If the value was signed, set bit 63 and 64 *) + inner ~is_negative:false ~offset (v lor 0xC0) | 0 -> Bytes.set_uint8 buffer offset v; - next_offset + offset + 1 | rem -> let v' = v land 0x7F lor 0x80 in Bytes.set_uint8 buffer offset v'; - inner ~offset:next_offset rem + inner ~is_negative ~offset:(offset + 1) rem in - inner ~offset v + inner ~is_negative:(v < 0) ~offset v let write_fixed32 buffer ~offset v = Bytes.set_int32_le buffer offset v; @@ -314,19 +351,22 @@ let write_string buffer ~offset v = let write_length_delimited buffer ~offset ~src ~src_pos ~len = let offset = write_varint_unboxed buffer ~offset len in - Bytes.blit ~src:(Bytes.of_string src) ~src_pos ~dst:buffer ~dst_pos:offset ~len; + Bytes.blit_string ~src:src ~src_pos ~dst:buffer ~dst_pos:offset ~len; offset + len +let ensure_capacity ~size t = + match t.data with + | { offset; buffer } as elem :: _ when Bytes.length buffer - offset >= size -> elem + | tl -> + let elem = { offset = 0; buffer = Bytes.create (size + t.block_size) } in + t.data <- elem :: tl; + elem + let write_value: size:int -> writer:(Bytes.t -> offset:int -> 'a -> int) -> 'a -> t -> unit = fun ~size ~writer v t -> - let elem, tl = match t.data with - | { offset; buffer } as elem :: tl when Bytes.length buffer - offset >= size -> elem, tl - | tl -> { offset = 0; buffer = Bytes.create (size + space_overhead) }, tl - in + let elem = ensure_capacity ~size t in let offset = writer elem.buffer ~offset:elem.offset v in - elem.offset <- offset; - t.data <- elem :: tl - + elem.offset <- offset let write_naked_field buffer ~offset = function | Varint_unboxed v -> write_varint_unboxed buffer ~offset v @@ -338,14 +378,9 @@ let write_naked_field buffer ~offset = function let add_field t field = let size = size_of_field field in - let elem, tl = match t.data with - | { offset; buffer } as elem :: tl when Bytes.length buffer - offset >= size -> elem, tl - | tl -> { offset = 0; buffer = Bytes.create (size + space_overhead) }, tl - in - (* Write *) + let elem = ensure_capacity ~size t in let offset = write_naked_field elem.buffer ~offset:elem.offset field in elem.offset <- offset; - t.data <- elem :: tl; () let write_field_header : t -> int -> int -> unit = @@ -366,45 +401,65 @@ let write_field : t -> int -> Field.t -> unit = write_field_header t index field_type; add_field t field -let write_length_delimited_value ~write v writer = +let write_length_delimited_value ~write v t = let rec size_data_added sentinel acc = function | [] -> failwith "End of list reached. This is impossible" | x :: _ when x == sentinel -> acc | { offset; _ } :: xs -> size_data_added sentinel (offset + acc) xs in - let sentinel = match writer.data with - | { offset; buffer} as sentinel :: _ when offset + 10 <= Bytes.length buffer -> - sentinel - | _ -> - let sentinel = { offset = 0; buffer = Bytes.create 10; } in - writer.data <- sentinel :: writer.data; - sentinel + let write_balanced v t = + let sentinel = + match t.data with + | { offset; buffer} as sentinel :: _ when offset + length_delimited_size_field_length <= Bytes.length buffer -> + sentinel + | _ -> + let sentinel = { offset = 0; buffer = Bytes.create length_delimited_size_field_length; } in + t.data <- sentinel :: t.data; + sentinel + in + let offset = sentinel.offset in + (* Ensure no writes to the sentinel *) + sentinel.offset <- Int.max_int; + let _ = write t v in + let size = size_data_added sentinel 0 t.data in + let offset = write_varint_unboxed sentinel.buffer ~offset size in + sentinel.offset <- offset; + () in - let offset = sentinel.offset in - (* Make sure nothing else is written to the sentinel *) - sentinel.offset <- Int.max_int; - write v writer; - let size = size_data_added sentinel 0 writer.data in - let offset = write_naked_field sentinel.buffer ~offset (Varint_unboxed size) in - sentinel.offset <- offset - -let _add_length_delimited_field_header t index = - let sentinel = { offset = 0; buffer = Bytes.create 20; } in - t.data <- sentinel :: t.data; - write_field_header t index 2; (* Length delimited *) - let offset = sentinel.offset in - sentinel.offset <- 20; (* Make sure nothing is written to this again *) - let rec size_data_added acc = function - | [] -> failwith "End of list reached. This is impossible" - | x :: _ when x == sentinel -> acc - | { offset; _ } :: xs -> size_data_added (offset + acc) xs + let write_speed v t = + let sentinel = ensure_capacity ~size:length_delimited_size_field_length t in + let offset = sentinel.offset in + sentinel.offset <- sentinel.offset + length_delimited_size_field_length; + let _ = write t v in + let size = size_data_added sentinel (sentinel.offset - (offset + length_delimited_size_field_length)) t.data in + let _ = write_delimited_field_length_fixed_size sentinel.buffer ~offset size in + () in - (* Return a function to use when done *) - fun () -> - let size = size_data_added 0 t.data in - let offset = write_naked_field sentinel.buffer ~offset (Varint_unboxed size) in - sentinel.offset <- offset; + let write_space v t = + let sentinel = ensure_capacity ~size:length_delimited_size_field_length t in + let offset = sentinel.offset in + sentinel.offset <- sentinel.offset + length_delimited_size_field_length; + let _ = write t v in + let size = size_data_added sentinel (sentinel.offset - (offset + length_delimited_size_field_length)) t.data in + let offset' = write_varint_unboxed sentinel.buffer ~offset size in + (* Move data, to avoid holes *) + let () = match (offset + length_delimited_size_field_length = offset') with + | true -> () + | false -> + (* Offset points to the first new byte. *) + (* + Printf.eprintf "\nHole size: %d. %d, %d, %d\n" n offset offset' sentinel.offset; + Printf.eprintf "Bytes.blit ~src:sentinel.buffer ~src_pos:%d ~dst:sentinel.buffer ~dst_pos:%d ~len:%d\n" (offset+5) offset' (sentinel.offset - (offset + 5)); + *) + Bytes.blit ~src:sentinel.buffer ~src_pos:(offset+5) ~dst:sentinel.buffer ~dst_pos:offset' ~len:(sentinel.offset - (offset + 5)); + sentinel.offset <- sentinel.offset - (offset+5-offset'); + in () + in + match t.mode with + | Balanced -> write_balanced v t + | Speed -> write_speed v t + | Space -> write_space v t let contents t = let size = size t in @@ -475,3 +530,19 @@ let%test "varint unrolled" = ) [v-2L; v-1L; v; v+1L; v+2L] ) values + + +let%test "varint size unrolled" = + let open Infix.Int64 in + let values = List.init ~len:64 ~f:(fun idx -> 1L lsl idx) in + List.fold_left ~init:true ~f:(fun acc v -> + List.fold_left ~init:acc ~f:(fun acc v -> + let size_reference = varint_size_reference (Int64.to_int v) in + let size = varint_size (Int64.to_int v) in + match size = size_reference with + | true -> acc + | false -> + Printf.printf "varint_size(0x%Lx/%Ld/%d): %d = %d\n" v v (Int64.to_int v) size size_reference; + false + ) [v-2L; v-1L; v; v+1L; v+2L] + ) values diff --git a/src/ocaml_protoc_plugin/writer.mli b/src/ocaml_protoc_plugin/writer.mli index c8cd407..f2a7bd5 100644 --- a/src/ocaml_protoc_plugin/writer.mli +++ b/src/ocaml_protoc_plugin/writer.mli @@ -1,26 +1,37 @@ type t -(** Create a new writer *) -val init : unit -> t +type mode = Balanced | Speed | Space + +(** Create a new writer to hold serialized data. + The writer also controls how data is serialized and allows for different modes of operation though the [mode] parameter: + [Balanced]:: Serializes data in a strictly compliant mode. Balance space and speed. + [Speed]:: Applies optimization which is exploiting the protobuf wire format (but not violating it). Its believed to be safe, but may confuse other protobuf deserializers. The optimization mainly speeds up serialization of large recursive message types. Resulting protobuf serialization is slightly larger than needed, but is comparable to [Space] mode in terms of extra memory used while serialization. + [Space]:: Limits space overhead (space waste) caused when allocated datablocks cannot be fully filled. The mode causes multiple data copies while serializing to avoid space overhead. This is the default. + + [block_size] controls the minimum size of block allocation. Setting this to zero will significantly slow down serialization but reduce space overhead. Setting a high value may cause more space overhead, esp. for recursive message structures. The default is to allocate block of size 256. +*) +val init: ?mode:mode -> ?block_size:int -> unit -> t (** Get the protobuf encoded contents of the writer *) val contents : t -> string (**/**) +val varint_size : int -> int val write_varint : bytes -> offset:int -> int64 -> int -val write_varint_reference : bytes -> offset:int -> int64 -> int val write_varint_unboxed : bytes -> offset:int -> int -> int -val write_varint_unboxed_reference : bytes -> offset:int -> int -> int val write_fixed32 : bytes -> offset:int -> Int32.t -> int val write_fixed64 : bytes -> offset:int -> Int64.t -> int val write_string : bytes -> offset:int -> string -> int -val write_length_delimited : - bytes -> offset:int -> src:string -> src_pos:int -> len:int -> int +val write_length_delimited : bytes -> offset:int -> src:string -> src_pos:int -> len:int -> int val write_field : t -> int -> Field.t -> unit -val write_length_delimited_value : write:('a -> t -> unit) -> 'a -> t -> unit +val write_length_delimited_value : write:(t -> 'a -> 'b) -> 'a -> t -> unit + +(** Construct a writer from a field list *) val of_list: (int * Field.t) list -> t + +(** Dump contents of the writer to stdout *) val dump : t -> unit -val unused : t -> int -val varint_size: int -> int + +val unused_space : t -> int val write_value: size:int -> writer:(Bytes.t -> offset:int -> 'a -> int) -> 'a -> t -> unit (**/**) From 1a8cd34911294a5b0e186d3ed2a241313d7a8245 Mon Sep 17 00:00:00 2001 From: Anders Fugmann Date: Sun, 7 Jan 2024 20:54:47 +0100 Subject: [PATCH 13/30] Use Bytes.get_unit8 for compatibility with ocaml 4.08 --- src/ocaml_protoc_plugin/reader.ml | 6 +++--- src/ocaml_protoc_plugin/serialize.ml | 1 - 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/src/ocaml_protoc_plugin/reader.ml b/src/ocaml_protoc_plugin/reader.ml index 2781676..bbcb155 100644 --- a/src/ocaml_protoc_plugin/reader.ml +++ b/src/ocaml_protoc_plugin/reader.ml @@ -33,7 +33,7 @@ let has_more t = t.offset < t.end_offset [@@inline] let read_byte t = validate_capacity t 1; - let v = String.get_uint8 t.data t.offset in + let v = Bytes.get_uint8 (Bytes.unsafe_of_string t.data) t.offset in t.offset <- t.offset + 1; v @@ -41,7 +41,7 @@ let read_raw_varint t = let open Infix.Int64 in let rec inner n acc = let v = Int64.of_int (read_byte t) in - let acc = acc + (v land 0x7FL) lsl n in + let acc = acc + (v land 0x7fL) lsl n in match v > 127L with | true -> (* Still More data *) @@ -53,7 +53,7 @@ let read_raw_varint t = let read_raw_varint_unboxed t = let rec inner n acc = let v = read_byte t in - let acc = acc + (v land 0x7F) lsl n in + let acc = acc + (v land 0x7f) lsl n in match v > 127 with | true -> (* Still More data *) diff --git a/src/ocaml_protoc_plugin/serialize.ml b/src/ocaml_protoc_plugin/serialize.ml index 4a43760..46a2df5 100644 --- a/src/ocaml_protoc_plugin/serialize.ml +++ b/src/ocaml_protoc_plugin/serialize.ml @@ -192,7 +192,6 @@ let serialize extension_ranges spec = ) extensions; serialize writer - let%expect_test "zigzag encoding" = let test v = let vl = Int64.of_int v in From 076449f1fcf28f689b45aae4e6494daf58964bda Mon Sep 17 00:00:00 2001 From: Anders Fugmann Date: Sun, 7 Jan 2024 21:07:00 +0100 Subject: [PATCH 14/30] Benchmark should include generating the actual string --- bench/bench.ml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/bench/bench.ml b/bench/bench.ml index c2f41c9..b24485e 100644 --- a/bench/bench.ml +++ b/bench/bench.ml @@ -60,10 +60,10 @@ let make_tests (type v) (module Protoc: Protoc_impl) (module Plugin: Plugin_impl let test_encode = Test.make_grouped ~name:"Encode" [ - Test.make ~name:"Plugin balanced" (Staged.stage @@ fun () -> Plugin.M.to_proto' Ocaml_protoc_plugin.Writer.(init ~mode:Balanced ()) v_plugin); - Test.make ~name:"Plugin speed" (Staged.stage @@ fun () -> Plugin.M.to_proto' Ocaml_protoc_plugin.Writer.(init ~mode:Speed ()) v_plugin); - Test.make ~name:"Plugin space" (Staged.stage @@ fun () -> Plugin.M.to_proto' Ocaml_protoc_plugin.Writer.(init ~mode:Space ()) v_plugin); - Test.make ~name:"Protoc" (Staged.stage @@ fun () -> Protoc.encode_pb_m v_protoc (Pbrt.Encoder.create ())) + Test.make ~name:"Plugin balanced" (Staged.stage @@ fun () -> Plugin.M.to_proto' Ocaml_protoc_plugin.Writer.(init ~mode:Balanced ()) v_plugin |> Ocaml_protoc_plugin.Writer.contents); + Test.make ~name:"Plugin speed" (Staged.stage @@ fun () -> Plugin.M.to_proto' Ocaml_protoc_plugin.Writer.(init ~mode:Speed ()) v_plugin |> Ocaml_protoc_plugin.Writer.contents); + Test.make ~name:"Plugin space" (Staged.stage @@ fun () -> Plugin.M.to_proto' Ocaml_protoc_plugin.Writer.(init ~mode:Space ()) v_plugin |> Ocaml_protoc_plugin.Writer.contents); + Test.make ~name:"Protoc" (Staged.stage @@ fun () -> let encoder = Pbrt.Encoder.create () in Protoc.encode_pb_m v_protoc encoder; (Pbrt.Encoder.to_string encoder)) ] in let test_decode = From 0d87d67ff3e64c4871d44e76fb211543117d391c Mon Sep 17 00:00:00 2001 From: Anders Fugmann Date: Sun, 7 Jan 2024 23:26:09 +0100 Subject: [PATCH 15/30] Tail Modulo Constructor is only available from ocaml 4.13. Convert to use seq under the assumption that List.of_seq is well optimized. --- src/ocaml_protoc_plugin/extensions.ml | 4 ++-- src/ocaml_protoc_plugin/reader.ml | 12 +++++------- 2 files changed, 7 insertions(+), 9 deletions(-) diff --git a/src/ocaml_protoc_plugin/extensions.ml b/src/ocaml_protoc_plugin/extensions.ml index 49fea96..0610adc 100644 --- a/src/ocaml_protoc_plugin/extensions.ml +++ b/src/ocaml_protoc_plugin/extensions.ml @@ -17,7 +17,7 @@ let set: ('a -> Writer.t, Writer.t) Serialize.S.compound_list -> t -> 'a -> t = let writer = Serialize.serialize [] spec [] writer v in let reader = Writer.contents writer |> Reader.create in match Reader.to_list reader with - | (((index, _) :: _) as fields) -> - (List.filter ~f:(fun (i, _) -> i != index) t) @ fields + | ((index, _) :: _) as fields -> + (List.filter ~f:(fun (i, _) -> i != index) t) @ fields | [] -> t | exception Result.Error _ -> failwith "Internal serialization fail" diff --git a/src/ocaml_protoc_plugin/reader.ml b/src/ocaml_protoc_plugin/reader.ml index bbcb155..4889232 100644 --- a/src/ocaml_protoc_plugin/reader.ml +++ b/src/ocaml_protoc_plugin/reader.ml @@ -113,13 +113,11 @@ let read_field : boxed -> t -> int * Field.t = fun boxed -> let (field_type, field_number) = read_field_header t in field_number, read_field_content field_type t - let to_list: t -> (int * Field.t) list = let read_field = read_field Boxed in - fun t -> - (* Make this tailrec *) - let[@tail_mod_cons] rec inner () = match has_more t with - | true -> read_field t :: inner () - | false -> [] + let rec next t () = match has_more t with + | true -> Seq.Cons (read_field t, next t) + | false -> Seq.Nil in - inner () + fun t -> + next t |> List.of_seq From 17a6f0f2155d7c068dde6f3ab4a92353cfdaf373 Mon Sep 17 00:00:00 2001 From: Anders Fugmann Date: Mon, 8 Jan 2024 00:05:24 +0100 Subject: [PATCH 16/30] Run bootstrap to Update autogenerated files --- src/spec/descriptor.ml | 664 +++++++++++++++++++++++++++++++++++++---- src/spec/plugin.ml | 151 +++++++++- 2 files changed, 756 insertions(+), 59 deletions(-) diff --git a/src/spec/descriptor.ml b/src/spec/descriptor.ml index 5baaca3..9b7793e 100644 --- a/src/spec/descriptor.ml +++ b/src/spec/descriptor.ml @@ -18,8 +18,570 @@ *) open Ocaml_protoc_plugin.Runtime [@@warning "-33"] -module Google = struct - module Protobuf = struct +module rec Google : sig + module rec Protobuf : sig + module rec FileDescriptorSet : sig + val name': unit -> string + type t = FileDescriptorProto.t list + val make : ?file:FileDescriptorProto.t list -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and FileDescriptorProto : sig + val name': unit -> string + type t = { name: string option; package: string option; dependency: string list; public_dependency: int list; weak_dependency: int list; message_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; service: ServiceDescriptorProto.t list; extension: FieldDescriptorProto.t list; options: FileOptions.t option; source_code_info: SourceCodeInfo.t option; syntax: string option } + val make : ?name:string -> ?package:string -> ?dependency:string list -> ?public_dependency:int list -> ?weak_dependency:int list -> ?message_type:DescriptorProto.t list -> ?enum_type:EnumDescriptorProto.t list -> ?service:ServiceDescriptorProto.t list -> ?extension:FieldDescriptorProto.t list -> ?options:FileOptions.t -> ?source_code_info:SourceCodeInfo.t -> ?syntax:string -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and DescriptorProto : sig + module rec ExtensionRange : sig + val name': unit -> string + type t = { start: int option; end': int option; options: ExtensionRangeOptions.t option } + val make : ?start:int -> ?end':int -> ?options:ExtensionRangeOptions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and ReservedRange : sig + val name': unit -> string + type t = { start: int option; end': int option } + val make : ?start:int -> ?end':int -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + val name': unit -> string + type t = { name: string option; field: FieldDescriptorProto.t list; extension: FieldDescriptorProto.t list; nested_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; extension_range: ExtensionRange.t list; oneof_decl: OneofDescriptorProto.t list; options: MessageOptions.t option; reserved_range: ReservedRange.t list; reserved_name: string list } + val make : ?name:string -> ?field:FieldDescriptorProto.t list -> ?extension:FieldDescriptorProto.t list -> ?nested_type:DescriptorProto.t list -> ?enum_type:EnumDescriptorProto.t list -> ?extension_range:ExtensionRange.t list -> ?oneof_decl:OneofDescriptorProto.t list -> ?options:MessageOptions.t -> ?reserved_range:ReservedRange.t list -> ?reserved_name:string list -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and ExtensionRangeOptions : sig + val name': unit -> string + type t = { uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + val make : ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and FieldDescriptorProto : sig + module rec Type : sig + type t = TYPE_DOUBLE | TYPE_FLOAT | TYPE_INT64 | TYPE_UINT64 | TYPE_INT32 | TYPE_FIXED64 | TYPE_FIXED32 | TYPE_BOOL | TYPE_STRING | TYPE_GROUP | TYPE_MESSAGE | TYPE_BYTES | TYPE_UINT32 | TYPE_ENUM | TYPE_SFIXED32 | TYPE_SFIXED64 | TYPE_SINT32 | TYPE_SINT64 + val to_int: t -> int + val from_int: int -> t Runtime'.Result.t + val from_int_exn: int -> t + end + and Label : sig + type t = LABEL_OPTIONAL | LABEL_REQUIRED | LABEL_REPEATED + val to_int: t -> int + val from_int: int -> t Runtime'.Result.t + val from_int_exn: int -> t + end + val name': unit -> string + type t = { name: string option; number: int option; label: Label.t option; type': Type.t option; type_name: string option; extendee: string option; default_value: string option; oneof_index: int option; json_name: string option; options: FieldOptions.t option; proto3_optional: bool option } + val make : ?name:string -> ?number:int -> ?label:Label.t -> ?type':Type.t -> ?type_name:string -> ?extendee:string -> ?default_value:string -> ?oneof_index:int -> ?json_name:string -> ?options:FieldOptions.t -> ?proto3_optional:bool -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and OneofDescriptorProto : sig + val name': unit -> string + type t = { name: string option; options: OneofOptions.t option } + val make : ?name:string -> ?options:OneofOptions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and EnumDescriptorProto : sig + module rec EnumReservedRange : sig + val name': unit -> string + type t = { start: int option; end': int option } + val make : ?start:int -> ?end':int -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + val name': unit -> string + type t = { name: string option; value: EnumValueDescriptorProto.t list; options: EnumOptions.t option; reserved_range: EnumReservedRange.t list; reserved_name: string list } + val make : ?name:string -> ?value:EnumValueDescriptorProto.t list -> ?options:EnumOptions.t -> ?reserved_range:EnumReservedRange.t list -> ?reserved_name:string list -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and EnumValueDescriptorProto : sig + val name': unit -> string + type t = { name: string option; number: int option; options: EnumValueOptions.t option } + val make : ?name:string -> ?number:int -> ?options:EnumValueOptions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and ServiceDescriptorProto : sig + val name': unit -> string + type t = { name: string option; method': MethodDescriptorProto.t list; options: ServiceOptions.t option } + val make : ?name:string -> ?method':MethodDescriptorProto.t list -> ?options:ServiceOptions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and MethodDescriptorProto : sig + val name': unit -> string + type t = { name: string option; input_type: string option; output_type: string option; options: MethodOptions.t option; client_streaming: bool; server_streaming: bool } + val make : ?name:string -> ?input_type:string -> ?output_type:string -> ?options:MethodOptions.t -> ?client_streaming:bool -> ?server_streaming:bool -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and FileOptions : sig + module rec OptimizeMode : sig + type t = SPEED | CODE_SIZE | LITE_RUNTIME + val to_int: t -> int + val from_int: int -> t Runtime'.Result.t + val from_int_exn: int -> t + end + val name': unit -> string + type t = { java_package: string option; java_outer_classname: string option; java_multiple_files: bool; java_generate_equals_and_hash: bool option; java_string_check_utf8: bool; optimize_for: OptimizeMode.t; go_package: string option; cc_generic_services: bool; java_generic_services: bool; py_generic_services: bool; php_generic_services: bool; deprecated: bool; cc_enable_arenas: bool; objc_class_prefix: string option; csharp_namespace: string option; swift_prefix: string option; php_class_prefix: string option; php_namespace: string option; php_metadata_namespace: string option; ruby_package: string option; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + val make : ?java_package:string -> ?java_outer_classname:string -> ?java_multiple_files:bool -> ?java_generate_equals_and_hash:bool -> ?java_string_check_utf8:bool -> ?optimize_for:OptimizeMode.t -> ?go_package:string -> ?cc_generic_services:bool -> ?java_generic_services:bool -> ?py_generic_services:bool -> ?php_generic_services:bool -> ?deprecated:bool -> ?cc_enable_arenas:bool -> ?objc_class_prefix:string -> ?csharp_namespace:string -> ?swift_prefix:string -> ?php_class_prefix:string -> ?php_namespace:string -> ?php_metadata_namespace:string -> ?ruby_package:string -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and MessageOptions : sig + val name': unit -> string + type t = { message_set_wire_format: bool; no_standard_descriptor_accessor: bool; deprecated: bool; map_entry: bool option; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + val make : ?message_set_wire_format:bool -> ?no_standard_descriptor_accessor:bool -> ?deprecated:bool -> ?map_entry:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and FieldOptions : sig + module rec CType : sig + type t = STRING | CORD | STRING_PIECE + val to_int: t -> int + val from_int: int -> t Runtime'.Result.t + val from_int_exn: int -> t + end + and JSType : sig + type t = JS_NORMAL | JS_STRING | JS_NUMBER + val to_int: t -> int + val from_int: int -> t Runtime'.Result.t + val from_int_exn: int -> t + end + val name': unit -> string + type t = { ctype: CType.t; packed: bool option; jstype: JSType.t; lazy': bool; unverified_lazy: bool; deprecated: bool; weak: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + val make : ?ctype:CType.t -> ?packed:bool -> ?jstype:JSType.t -> ?lazy':bool -> ?unverified_lazy:bool -> ?deprecated:bool -> ?weak:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and OneofOptions : sig + val name': unit -> string + type t = { uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + val make : ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and EnumOptions : sig + val name': unit -> string + type t = { allow_alias: bool option; deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + val make : ?allow_alias:bool -> ?deprecated:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and EnumValueOptions : sig + val name': unit -> string + type t = { deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + val make : ?deprecated:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and ServiceOptions : sig + val name': unit -> string + type t = { deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + val make : ?deprecated:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and MethodOptions : sig + module rec IdempotencyLevel : sig + type t = IDEMPOTENCY_UNKNOWN | NO_SIDE_EFFECTS | IDEMPOTENT + val to_int: t -> int + val from_int: int -> t Runtime'.Result.t + val from_int_exn: int -> t + end + val name': unit -> string + type t = { deprecated: bool; idempotency_level: IdempotencyLevel.t; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + val make : ?deprecated:bool -> ?idempotency_level:IdempotencyLevel.t -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and UninterpretedOption : sig + module rec NamePart : sig + val name': unit -> string + type t = { name_part: string; is_extension: bool } + val make : name_part:string -> is_extension:bool -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + val name': unit -> string + type t = { name: NamePart.t list; identifier_value: string option; positive_int_value: int option; negative_int_value: int option; double_value: float option; string_value: bytes option; aggregate_value: string option } + val make : ?name:NamePart.t list -> ?identifier_value:string -> ?positive_int_value:int -> ?negative_int_value:int -> ?double_value:float -> ?string_value:bytes -> ?aggregate_value:string -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and SourceCodeInfo : sig + module rec Location : sig + val name': unit -> string + type t = { path: int list; span: int list; leading_comments: string option; trailing_comments: string option; leading_detached_comments: string list } + val make : ?path:int list -> ?span:int list -> ?leading_comments:string -> ?trailing_comments:string -> ?leading_detached_comments:string list -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + val name': unit -> string + type t = Location.t list + val make : ?location:Location.t list -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and GeneratedCodeInfo : sig + module rec Annotation : sig + val name': unit -> string + type t = { path: int list; source_file: string option; begin': int option; end': int option } + val make : ?path:int list -> ?source_file:string -> ?begin':int -> ?end':int -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + val name': unit -> string + type t = Annotation.t list + val make : ?annotation:Annotation.t list -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + end +end = struct + module rec Protobuf : sig + module rec FileDescriptorSet : sig + val name': unit -> string + type t = FileDescriptorProto.t list + val make : ?file:FileDescriptorProto.t list -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and FileDescriptorProto : sig + val name': unit -> string + type t = { name: string option; package: string option; dependency: string list; public_dependency: int list; weak_dependency: int list; message_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; service: ServiceDescriptorProto.t list; extension: FieldDescriptorProto.t list; options: FileOptions.t option; source_code_info: SourceCodeInfo.t option; syntax: string option } + val make : ?name:string -> ?package:string -> ?dependency:string list -> ?public_dependency:int list -> ?weak_dependency:int list -> ?message_type:DescriptorProto.t list -> ?enum_type:EnumDescriptorProto.t list -> ?service:ServiceDescriptorProto.t list -> ?extension:FieldDescriptorProto.t list -> ?options:FileOptions.t -> ?source_code_info:SourceCodeInfo.t -> ?syntax:string -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and DescriptorProto : sig + module rec ExtensionRange : sig + val name': unit -> string + type t = { start: int option; end': int option; options: ExtensionRangeOptions.t option } + val make : ?start:int -> ?end':int -> ?options:ExtensionRangeOptions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and ReservedRange : sig + val name': unit -> string + type t = { start: int option; end': int option } + val make : ?start:int -> ?end':int -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + val name': unit -> string + type t = { name: string option; field: FieldDescriptorProto.t list; extension: FieldDescriptorProto.t list; nested_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; extension_range: ExtensionRange.t list; oneof_decl: OneofDescriptorProto.t list; options: MessageOptions.t option; reserved_range: ReservedRange.t list; reserved_name: string list } + val make : ?name:string -> ?field:FieldDescriptorProto.t list -> ?extension:FieldDescriptorProto.t list -> ?nested_type:DescriptorProto.t list -> ?enum_type:EnumDescriptorProto.t list -> ?extension_range:ExtensionRange.t list -> ?oneof_decl:OneofDescriptorProto.t list -> ?options:MessageOptions.t -> ?reserved_range:ReservedRange.t list -> ?reserved_name:string list -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and ExtensionRangeOptions : sig + val name': unit -> string + type t = { uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + val make : ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and FieldDescriptorProto : sig + module rec Type : sig + type t = TYPE_DOUBLE | TYPE_FLOAT | TYPE_INT64 | TYPE_UINT64 | TYPE_INT32 | TYPE_FIXED64 | TYPE_FIXED32 | TYPE_BOOL | TYPE_STRING | TYPE_GROUP | TYPE_MESSAGE | TYPE_BYTES | TYPE_UINT32 | TYPE_ENUM | TYPE_SFIXED32 | TYPE_SFIXED64 | TYPE_SINT32 | TYPE_SINT64 + val to_int: t -> int + val from_int: int -> t Runtime'.Result.t + val from_int_exn: int -> t + end + and Label : sig + type t = LABEL_OPTIONAL | LABEL_REQUIRED | LABEL_REPEATED + val to_int: t -> int + val from_int: int -> t Runtime'.Result.t + val from_int_exn: int -> t + end + val name': unit -> string + type t = { name: string option; number: int option; label: Label.t option; type': Type.t option; type_name: string option; extendee: string option; default_value: string option; oneof_index: int option; json_name: string option; options: FieldOptions.t option; proto3_optional: bool option } + val make : ?name:string -> ?number:int -> ?label:Label.t -> ?type':Type.t -> ?type_name:string -> ?extendee:string -> ?default_value:string -> ?oneof_index:int -> ?json_name:string -> ?options:FieldOptions.t -> ?proto3_optional:bool -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and OneofDescriptorProto : sig + val name': unit -> string + type t = { name: string option; options: OneofOptions.t option } + val make : ?name:string -> ?options:OneofOptions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and EnumDescriptorProto : sig + module rec EnumReservedRange : sig + val name': unit -> string + type t = { start: int option; end': int option } + val make : ?start:int -> ?end':int -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + val name': unit -> string + type t = { name: string option; value: EnumValueDescriptorProto.t list; options: EnumOptions.t option; reserved_range: EnumReservedRange.t list; reserved_name: string list } + val make : ?name:string -> ?value:EnumValueDescriptorProto.t list -> ?options:EnumOptions.t -> ?reserved_range:EnumReservedRange.t list -> ?reserved_name:string list -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and EnumValueDescriptorProto : sig + val name': unit -> string + type t = { name: string option; number: int option; options: EnumValueOptions.t option } + val make : ?name:string -> ?number:int -> ?options:EnumValueOptions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and ServiceDescriptorProto : sig + val name': unit -> string + type t = { name: string option; method': MethodDescriptorProto.t list; options: ServiceOptions.t option } + val make : ?name:string -> ?method':MethodDescriptorProto.t list -> ?options:ServiceOptions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and MethodDescriptorProto : sig + val name': unit -> string + type t = { name: string option; input_type: string option; output_type: string option; options: MethodOptions.t option; client_streaming: bool; server_streaming: bool } + val make : ?name:string -> ?input_type:string -> ?output_type:string -> ?options:MethodOptions.t -> ?client_streaming:bool -> ?server_streaming:bool -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and FileOptions : sig + module rec OptimizeMode : sig + type t = SPEED | CODE_SIZE | LITE_RUNTIME + val to_int: t -> int + val from_int: int -> t Runtime'.Result.t + val from_int_exn: int -> t + end + val name': unit -> string + type t = { java_package: string option; java_outer_classname: string option; java_multiple_files: bool; java_generate_equals_and_hash: bool option; java_string_check_utf8: bool; optimize_for: OptimizeMode.t; go_package: string option; cc_generic_services: bool; java_generic_services: bool; py_generic_services: bool; php_generic_services: bool; deprecated: bool; cc_enable_arenas: bool; objc_class_prefix: string option; csharp_namespace: string option; swift_prefix: string option; php_class_prefix: string option; php_namespace: string option; php_metadata_namespace: string option; ruby_package: string option; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + val make : ?java_package:string -> ?java_outer_classname:string -> ?java_multiple_files:bool -> ?java_generate_equals_and_hash:bool -> ?java_string_check_utf8:bool -> ?optimize_for:OptimizeMode.t -> ?go_package:string -> ?cc_generic_services:bool -> ?java_generic_services:bool -> ?py_generic_services:bool -> ?php_generic_services:bool -> ?deprecated:bool -> ?cc_enable_arenas:bool -> ?objc_class_prefix:string -> ?csharp_namespace:string -> ?swift_prefix:string -> ?php_class_prefix:string -> ?php_namespace:string -> ?php_metadata_namespace:string -> ?ruby_package:string -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and MessageOptions : sig + val name': unit -> string + type t = { message_set_wire_format: bool; no_standard_descriptor_accessor: bool; deprecated: bool; map_entry: bool option; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + val make : ?message_set_wire_format:bool -> ?no_standard_descriptor_accessor:bool -> ?deprecated:bool -> ?map_entry:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and FieldOptions : sig + module rec CType : sig + type t = STRING | CORD | STRING_PIECE + val to_int: t -> int + val from_int: int -> t Runtime'.Result.t + val from_int_exn: int -> t + end + and JSType : sig + type t = JS_NORMAL | JS_STRING | JS_NUMBER + val to_int: t -> int + val from_int: int -> t Runtime'.Result.t + val from_int_exn: int -> t + end + val name': unit -> string + type t = { ctype: CType.t; packed: bool option; jstype: JSType.t; lazy': bool; unverified_lazy: bool; deprecated: bool; weak: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + val make : ?ctype:CType.t -> ?packed:bool -> ?jstype:JSType.t -> ?lazy':bool -> ?unverified_lazy:bool -> ?deprecated:bool -> ?weak:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and OneofOptions : sig + val name': unit -> string + type t = { uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + val make : ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and EnumOptions : sig + val name': unit -> string + type t = { allow_alias: bool option; deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + val make : ?allow_alias:bool -> ?deprecated:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and EnumValueOptions : sig + val name': unit -> string + type t = { deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + val make : ?deprecated:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and ServiceOptions : sig + val name': unit -> string + type t = { deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + val make : ?deprecated:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and MethodOptions : sig + module rec IdempotencyLevel : sig + type t = IDEMPOTENCY_UNKNOWN | NO_SIDE_EFFECTS | IDEMPOTENT + val to_int: t -> int + val from_int: int -> t Runtime'.Result.t + val from_int_exn: int -> t + end + val name': unit -> string + type t = { deprecated: bool; idempotency_level: IdempotencyLevel.t; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + val make : ?deprecated:bool -> ?idempotency_level:IdempotencyLevel.t -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and UninterpretedOption : sig + module rec NamePart : sig + val name': unit -> string + type t = { name_part: string; is_extension: bool } + val make : name_part:string -> is_extension:bool -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + val name': unit -> string + type t = { name: NamePart.t list; identifier_value: string option; positive_int_value: int option; negative_int_value: int option; double_value: float option; string_value: bytes option; aggregate_value: string option } + val make : ?name:NamePart.t list -> ?identifier_value:string -> ?positive_int_value:int -> ?negative_int_value:int -> ?double_value:float -> ?string_value:bytes -> ?aggregate_value:string -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and SourceCodeInfo : sig + module rec Location : sig + val name': unit -> string + type t = { path: int list; span: int list; leading_comments: string option; trailing_comments: string option; leading_detached_comments: string list } + val make : ?path:int list -> ?span:int list -> ?leading_comments:string -> ?trailing_comments:string -> ?leading_detached_comments:string list -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + val name': unit -> string + type t = Location.t list + val make : ?location:Location.t list -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and GeneratedCodeInfo : sig + module rec Annotation : sig + val name': unit -> string + type t = { path: int list; source_file: string option; begin': int option; end': int option } + val make : ?path:int list -> ?source_file:string -> ?begin':int -> ?end':int -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + val name': unit -> string + type t = Annotation.t list + val make : ?annotation:Annotation.t list -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + end = struct module rec FileDescriptorSet : sig val name': unit -> string type t = FileDescriptorProto.t list @@ -110,8 +672,8 @@ module Google = struct val from_proto_exn: Runtime'.Reader.t -> t end val name': unit -> string - type t = { name: string option; field: FieldDescriptorProto.t list; extension: FieldDescriptorProto.t list; nested_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; extension_range: DescriptorProto.ExtensionRange.t list; oneof_decl: OneofDescriptorProto.t list; options: MessageOptions.t option; reserved_range: DescriptorProto.ReservedRange.t list; reserved_name: string list } - val make : ?name:string -> ?field:FieldDescriptorProto.t list -> ?extension:FieldDescriptorProto.t list -> ?nested_type:DescriptorProto.t list -> ?enum_type:EnumDescriptorProto.t list -> ?extension_range:DescriptorProto.ExtensionRange.t list -> ?oneof_decl:OneofDescriptorProto.t list -> ?options:MessageOptions.t -> ?reserved_range:DescriptorProto.ReservedRange.t list -> ?reserved_name:string list -> unit -> t + type t = { name: string option; field: FieldDescriptorProto.t list; extension: FieldDescriptorProto.t list; nested_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; extension_range: ExtensionRange.t list; oneof_decl: OneofDescriptorProto.t list; options: MessageOptions.t option; reserved_range: ReservedRange.t list; reserved_name: string list } + val make : ?name:string -> ?field:FieldDescriptorProto.t list -> ?extension:FieldDescriptorProto.t list -> ?nested_type:DescriptorProto.t list -> ?enum_type:EnumDescriptorProto.t list -> ?extension_range:ExtensionRange.t list -> ?oneof_decl:OneofDescriptorProto.t list -> ?options:MessageOptions.t -> ?reserved_range:ReservedRange.t list -> ?reserved_name:string list -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result @@ -182,7 +744,7 @@ module Google = struct end let name' () = "descriptor.google.protobuf.DescriptorProto" - type t = { name: string option; field: FieldDescriptorProto.t list; extension: FieldDescriptorProto.t list; nested_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; extension_range: DescriptorProto.ExtensionRange.t list; oneof_decl: OneofDescriptorProto.t list; options: MessageOptions.t option; reserved_range: DescriptorProto.ReservedRange.t list; reserved_name: string list } + type t = { name: string option; field: FieldDescriptorProto.t list; extension: FieldDescriptorProto.t list; nested_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; extension_range: ExtensionRange.t list; oneof_decl: OneofDescriptorProto.t list; options: MessageOptions.t option; reserved_range: ReservedRange.t list; reserved_name: string list } let make = fun ?name ?field ?extension ?nested_type ?enum_type ?extension_range ?oneof_decl ?options ?reserved_range ?reserved_name () -> let field = match field with Some v -> v | None -> [] in @@ -197,7 +759,7 @@ module Google = struct let to_proto' = let apply = fun ~f:f' writer { name; field; extension; nested_type; enum_type; extension_range; oneof_decl; options; reserved_range; reserved_name } -> f' [] writer name field extension nested_type enum_type extension_range oneof_decl options reserved_range reserved_name in - let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> FieldDescriptorProto.to_proto' t)), not_packed) ^:: repeated (6, (message (fun t -> FieldDescriptorProto.to_proto' t)), not_packed) ^:: repeated (3, (message (fun t -> DescriptorProto.to_proto' t)), not_packed) ^:: repeated (4, (message (fun t -> EnumDescriptorProto.to_proto' t)), not_packed) ^:: repeated (5, (message (fun t -> DescriptorProto.ExtensionRange.to_proto' t)), not_packed) ^:: repeated (8, (message (fun t -> OneofDescriptorProto.to_proto' t)), not_packed) ^:: basic_opt (7, (message (fun t -> MessageOptions.to_proto' t))) ^:: repeated (9, (message (fun t -> DescriptorProto.ReservedRange.to_proto' t)), not_packed) ^:: repeated (10, string, not_packed) ^:: nil ) in + let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> FieldDescriptorProto.to_proto' t)), not_packed) ^:: repeated (6, (message (fun t -> FieldDescriptorProto.to_proto' t)), not_packed) ^:: repeated (3, (message (fun t -> DescriptorProto.to_proto' t)), not_packed) ^:: repeated (4, (message (fun t -> EnumDescriptorProto.to_proto' t)), not_packed) ^:: repeated (5, (message (fun t -> ExtensionRange.to_proto' t)), not_packed) ^:: repeated (8, (message (fun t -> OneofDescriptorProto.to_proto' t)), not_packed) ^:: basic_opt (7, (message (fun t -> MessageOptions.to_proto' t))) ^:: repeated (9, (message (fun t -> ReservedRange.to_proto' t)), not_packed) ^:: repeated (10, string, not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] spec in fun writer t -> apply ~f:serialize writer t @@ -205,7 +767,7 @@ module Google = struct let from_proto_exn = let constructor = fun _extensions name field extension nested_type enum_type extension_range oneof_decl options reserved_range reserved_name -> { name; field; extension; nested_type; enum_type; extension_range; oneof_decl; options; reserved_range; reserved_name } in - let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> FieldDescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (6, (message (fun t -> FieldDescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (3, (message (fun t -> DescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (4, (message (fun t -> EnumDescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (5, (message (fun t -> DescriptorProto.ExtensionRange.from_proto_exn t)), not_packed) ^:: repeated (8, (message (fun t -> OneofDescriptorProto.from_proto_exn t)), not_packed) ^:: basic_opt (7, (message (fun t -> MessageOptions.from_proto_exn t))) ^:: repeated (9, (message (fun t -> DescriptorProto.ReservedRange.from_proto_exn t)), not_packed) ^:: repeated (10, string, not_packed) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> FieldDescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (6, (message (fun t -> FieldDescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (3, (message (fun t -> DescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (4, (message (fun t -> EnumDescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (5, (message (fun t -> ExtensionRange.from_proto_exn t)), not_packed) ^:: repeated (8, (message (fun t -> OneofDescriptorProto.from_proto_exn t)), not_packed) ^:: basic_opt (7, (message (fun t -> MessageOptions.from_proto_exn t))) ^:: repeated (9, (message (fun t -> ReservedRange.from_proto_exn t)), not_packed) ^:: repeated (10, string, not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) @@ -257,8 +819,8 @@ module Google = struct val from_int_exn: int -> t end val name': unit -> string - type t = { name: string option; number: int option; label: FieldDescriptorProto.Label.t option; type': FieldDescriptorProto.Type.t option; type_name: string option; extendee: string option; default_value: string option; oneof_index: int option; json_name: string option; options: FieldOptions.t option; proto3_optional: bool option } - val make : ?name:string -> ?number:int -> ?label:FieldDescriptorProto.Label.t -> ?type':FieldDescriptorProto.Type.t -> ?type_name:string -> ?extendee:string -> ?default_value:string -> ?oneof_index:int -> ?json_name:string -> ?options:FieldOptions.t -> ?proto3_optional:bool -> unit -> t + type t = { name: string option; number: int option; label: Label.t option; type': Type.t option; type_name: string option; extendee: string option; default_value: string option; oneof_index: int option; json_name: string option; options: FieldOptions.t option; proto3_optional: bool option } + val make : ?name:string -> ?number:int -> ?label:Label.t -> ?type':Type.t -> ?type_name:string -> ?extendee:string -> ?default_value:string -> ?oneof_index:int -> ?json_name:string -> ?options:FieldOptions.t -> ?proto3_optional:bool -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result @@ -335,7 +897,7 @@ module Google = struct let from_int e = Runtime'.Result.catch (fun () -> from_int_exn e) end let name' () = "descriptor.google.protobuf.FieldDescriptorProto" - type t = { name: string option; number: int option; label: FieldDescriptorProto.Label.t option; type': FieldDescriptorProto.Type.t option; type_name: string option; extendee: string option; default_value: string option; oneof_index: int option; json_name: string option; options: FieldOptions.t option; proto3_optional: bool option } + type t = { name: string option; number: int option; label: Label.t option; type': Type.t option; type_name: string option; extendee: string option; default_value: string option; oneof_index: int option; json_name: string option; options: FieldOptions.t option; proto3_optional: bool option } let make = fun ?name ?number ?label ?type' ?type_name ?extendee ?default_value ?oneof_index ?json_name ?options ?proto3_optional () -> @@ -343,7 +905,7 @@ module Google = struct let to_proto' = let apply = fun ~f:f' writer { name; number; label; type'; type_name; extendee; default_value; oneof_index; json_name; options; proto3_optional } -> f' [] writer name number label type' type_name extendee default_value oneof_index json_name options proto3_optional in - let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (3, int32_int) ^:: basic_opt (4, (enum FieldDescriptorProto.Label.to_int)) ^:: basic_opt (5, (enum FieldDescriptorProto.Type.to_int)) ^:: basic_opt (6, string) ^:: basic_opt (2, string) ^:: basic_opt (7, string) ^:: basic_opt (9, int32_int) ^:: basic_opt (10, string) ^:: basic_opt (8, (message (fun t -> FieldOptions.to_proto' t))) ^:: basic_opt (17, bool) ^:: nil ) in + let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (3, int32_int) ^:: basic_opt (4, (enum Label.to_int)) ^:: basic_opt (5, (enum Type.to_int)) ^:: basic_opt (6, string) ^:: basic_opt (2, string) ^:: basic_opt (7, string) ^:: basic_opt (9, int32_int) ^:: basic_opt (10, string) ^:: basic_opt (8, (message (fun t -> FieldOptions.to_proto' t))) ^:: basic_opt (17, bool) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] spec in fun writer t -> apply ~f:serialize writer t @@ -351,7 +913,7 @@ module Google = struct let from_proto_exn = let constructor = fun _extensions name number label type' type_name extendee default_value oneof_index json_name options proto3_optional -> { name; number; label; type'; type_name; extendee; default_value; oneof_index; json_name; options; proto3_optional } in - let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (3, int32_int) ^:: basic_opt (4, (enum FieldDescriptorProto.Label.from_int_exn)) ^:: basic_opt (5, (enum FieldDescriptorProto.Type.from_int_exn)) ^:: basic_opt (6, string) ^:: basic_opt (2, string) ^:: basic_opt (7, string) ^:: basic_opt (9, int32_int) ^:: basic_opt (10, string) ^:: basic_opt (8, (message (fun t -> FieldOptions.from_proto_exn t))) ^:: basic_opt (17, bool) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (3, int32_int) ^:: basic_opt (4, (enum Label.from_int_exn)) ^:: basic_opt (5, (enum Type.from_int_exn)) ^:: basic_opt (6, string) ^:: basic_opt (2, string) ^:: basic_opt (7, string) ^:: basic_opt (9, int32_int) ^:: basic_opt (10, string) ^:: basic_opt (8, (message (fun t -> FieldOptions.from_proto_exn t))) ^:: basic_opt (17, bool) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) @@ -400,8 +962,8 @@ module Google = struct val from_proto_exn: Runtime'.Reader.t -> t end val name': unit -> string - type t = { name: string option; value: EnumValueDescriptorProto.t list; options: EnumOptions.t option; reserved_range: EnumDescriptorProto.EnumReservedRange.t list; reserved_name: string list } - val make : ?name:string -> ?value:EnumValueDescriptorProto.t list -> ?options:EnumOptions.t -> ?reserved_range:EnumDescriptorProto.EnumReservedRange.t list -> ?reserved_name:string list -> unit -> t + type t = { name: string option; value: EnumValueDescriptorProto.t list; options: EnumOptions.t option; reserved_range: EnumReservedRange.t list; reserved_name: string list } + val make : ?name:string -> ?value:EnumValueDescriptorProto.t list -> ?options:EnumOptions.t -> ?reserved_range:EnumReservedRange.t list -> ?reserved_name:string list -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result @@ -440,7 +1002,7 @@ module Google = struct end let name' () = "descriptor.google.protobuf.EnumDescriptorProto" - type t = { name: string option; value: EnumValueDescriptorProto.t list; options: EnumOptions.t option; reserved_range: EnumDescriptorProto.EnumReservedRange.t list; reserved_name: string list } + type t = { name: string option; value: EnumValueDescriptorProto.t list; options: EnumOptions.t option; reserved_range: EnumReservedRange.t list; reserved_name: string list } let make = fun ?name ?value ?options ?reserved_range ?reserved_name () -> let value = match value with Some v -> v | None -> [] in @@ -450,7 +1012,7 @@ module Google = struct let to_proto' = let apply = fun ~f:f' writer { name; value; options; reserved_range; reserved_name } -> f' [] writer name value options reserved_range reserved_name in - let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> EnumValueDescriptorProto.to_proto' t)), not_packed) ^:: basic_opt (3, (message (fun t -> EnumOptions.to_proto' t))) ^:: repeated (4, (message (fun t -> EnumDescriptorProto.EnumReservedRange.to_proto' t)), not_packed) ^:: repeated (5, string, not_packed) ^:: nil ) in + let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> EnumValueDescriptorProto.to_proto' t)), not_packed) ^:: basic_opt (3, (message (fun t -> EnumOptions.to_proto' t))) ^:: repeated (4, (message (fun t -> EnumReservedRange.to_proto' t)), not_packed) ^:: repeated (5, string, not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] spec in fun writer t -> apply ~f:serialize writer t @@ -458,7 +1020,7 @@ module Google = struct let from_proto_exn = let constructor = fun _extensions name value options reserved_range reserved_name -> { name; value; options; reserved_range; reserved_name } in - let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> EnumValueDescriptorProto.from_proto_exn t)), not_packed) ^:: basic_opt (3, (message (fun t -> EnumOptions.from_proto_exn t))) ^:: repeated (4, (message (fun t -> EnumDescriptorProto.EnumReservedRange.from_proto_exn t)), not_packed) ^:: repeated (5, string, not_packed) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> EnumValueDescriptorProto.from_proto_exn t)), not_packed) ^:: basic_opt (3, (message (fun t -> EnumOptions.from_proto_exn t))) ^:: repeated (4, (message (fun t -> EnumReservedRange.from_proto_exn t)), not_packed) ^:: repeated (5, string, not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) @@ -569,8 +1131,8 @@ module Google = struct val from_int_exn: int -> t end val name': unit -> string - type t = { java_package: string option; java_outer_classname: string option; java_multiple_files: bool; java_generate_equals_and_hash: bool option; java_string_check_utf8: bool; optimize_for: FileOptions.OptimizeMode.t; go_package: string option; cc_generic_services: bool; java_generic_services: bool; py_generic_services: bool; php_generic_services: bool; deprecated: bool; cc_enable_arenas: bool; objc_class_prefix: string option; csharp_namespace: string option; swift_prefix: string option; php_class_prefix: string option; php_namespace: string option; php_metadata_namespace: string option; ruby_package: string option; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } - val make : ?java_package:string -> ?java_outer_classname:string -> ?java_multiple_files:bool -> ?java_generate_equals_and_hash:bool -> ?java_string_check_utf8:bool -> ?optimize_for:FileOptions.OptimizeMode.t -> ?go_package:string -> ?cc_generic_services:bool -> ?java_generic_services:bool -> ?py_generic_services:bool -> ?php_generic_services:bool -> ?deprecated:bool -> ?cc_enable_arenas:bool -> ?objc_class_prefix:string -> ?csharp_namespace:string -> ?swift_prefix:string -> ?php_class_prefix:string -> ?php_namespace:string -> ?php_metadata_namespace:string -> ?ruby_package:string -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + type t = { java_package: string option; java_outer_classname: string option; java_multiple_files: bool; java_generate_equals_and_hash: bool option; java_string_check_utf8: bool; optimize_for: OptimizeMode.t; go_package: string option; cc_generic_services: bool; java_generic_services: bool; py_generic_services: bool; php_generic_services: bool; deprecated: bool; cc_enable_arenas: bool; objc_class_prefix: string option; csharp_namespace: string option; swift_prefix: string option; php_class_prefix: string option; php_namespace: string option; php_metadata_namespace: string option; ruby_package: string option; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + val make : ?java_package:string -> ?java_outer_classname:string -> ?java_multiple_files:bool -> ?java_generate_equals_and_hash:bool -> ?java_string_check_utf8:bool -> ?optimize_for:OptimizeMode.t -> ?go_package:string -> ?cc_generic_services:bool -> ?java_generic_services:bool -> ?py_generic_services:bool -> ?php_generic_services:bool -> ?deprecated:bool -> ?cc_enable_arenas:bool -> ?objc_class_prefix:string -> ?csharp_namespace:string -> ?swift_prefix:string -> ?php_class_prefix:string -> ?php_namespace:string -> ?php_metadata_namespace:string -> ?ruby_package:string -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result @@ -597,12 +1159,12 @@ module Google = struct let from_int e = Runtime'.Result.catch (fun () -> from_int_exn e) end let name' () = "descriptor.google.protobuf.FileOptions" - type t = { java_package: string option; java_outer_classname: string option; java_multiple_files: bool; java_generate_equals_and_hash: bool option; java_string_check_utf8: bool; optimize_for: FileOptions.OptimizeMode.t; go_package: string option; cc_generic_services: bool; java_generic_services: bool; py_generic_services: bool; php_generic_services: bool; deprecated: bool; cc_enable_arenas: bool; objc_class_prefix: string option; csharp_namespace: string option; swift_prefix: string option; php_class_prefix: string option; php_namespace: string option; php_metadata_namespace: string option; ruby_package: string option; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { java_package: string option; java_outer_classname: string option; java_multiple_files: bool; java_generate_equals_and_hash: bool option; java_string_check_utf8: bool; optimize_for: OptimizeMode.t; go_package: string option; cc_generic_services: bool; java_generic_services: bool; py_generic_services: bool; php_generic_services: bool; deprecated: bool; cc_enable_arenas: bool; objc_class_prefix: string option; csharp_namespace: string option; swift_prefix: string option; php_class_prefix: string option; php_namespace: string option; php_metadata_namespace: string option; ruby_package: string option; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } let make = fun ?java_package ?java_outer_classname ?java_multiple_files ?java_generate_equals_and_hash ?java_string_check_utf8 ?optimize_for ?go_package ?cc_generic_services ?java_generic_services ?py_generic_services ?php_generic_services ?deprecated ?cc_enable_arenas ?objc_class_prefix ?csharp_namespace ?swift_prefix ?php_class_prefix ?php_namespace ?php_metadata_namespace ?ruby_package ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> let java_multiple_files = match java_multiple_files with Some v -> v | None -> false in let java_string_check_utf8 = match java_string_check_utf8 with Some v -> v | None -> false in - let optimize_for = match optimize_for with Some v -> v | None -> FileOptions.OptimizeMode.SPEED in + let optimize_for = match optimize_for with Some v -> v | None -> OptimizeMode.SPEED in let cc_generic_services = match cc_generic_services with Some v -> v | None -> false in let java_generic_services = match java_generic_services with Some v -> v | None -> false in let py_generic_services = match py_generic_services with Some v -> v | None -> false in @@ -614,7 +1176,7 @@ module Google = struct let to_proto' = let apply = fun ~f:f' writer { java_package; java_outer_classname; java_multiple_files; java_generate_equals_and_hash; java_string_check_utf8; optimize_for; go_package; cc_generic_services; java_generic_services; py_generic_services; php_generic_services; deprecated; cc_enable_arenas; objc_class_prefix; csharp_namespace; swift_prefix; php_class_prefix; php_namespace; php_metadata_namespace; ruby_package; uninterpreted_option; extensions' } -> f' extensions' writer java_package java_outer_classname java_multiple_files java_generate_equals_and_hash java_string_check_utf8 optimize_for go_package cc_generic_services java_generic_services py_generic_services php_generic_services deprecated cc_enable_arenas objc_class_prefix csharp_namespace swift_prefix php_class_prefix php_namespace php_metadata_namespace ruby_package uninterpreted_option in - let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (8, string) ^:: basic (10, bool, Some (false)) ^:: basic_opt (20, bool) ^:: basic (27, bool, Some (false)) ^:: basic (9, (enum FileOptions.OptimizeMode.to_int), Some (FileOptions.OptimizeMode.SPEED)) ^:: basic_opt (11, string) ^:: basic (16, bool, Some (false)) ^:: basic (17, bool, Some (false)) ^:: basic (18, bool, Some (false)) ^:: basic (42, bool, Some (false)) ^:: basic (23, bool, Some (false)) ^:: basic (31, bool, Some (true)) ^:: basic_opt (36, string) ^:: basic_opt (37, string) ^:: basic_opt (39, string) ^:: basic_opt (40, string) ^:: basic_opt (41, string) ^:: basic_opt (44, string) ^:: basic_opt (45, string) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in + let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (8, string) ^:: basic (10, bool, Some (false)) ^:: basic_opt (20, bool) ^:: basic (27, bool, Some (false)) ^:: basic (9, (enum OptimizeMode.to_int), Some (OptimizeMode.SPEED)) ^:: basic_opt (11, string) ^:: basic (16, bool, Some (false)) ^:: basic (17, bool, Some (false)) ^:: basic (18, bool, Some (false)) ^:: basic (42, bool, Some (false)) ^:: basic (23, bool, Some (false)) ^:: basic (31, bool, Some (true)) ^:: basic_opt (36, string) ^:: basic_opt (37, string) ^:: basic_opt (39, string) ^:: basic_opt (40, string) ^:: basic_opt (41, string) ^:: basic_opt (44, string) ^:: basic_opt (45, string) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] spec in fun writer t -> apply ~f:serialize writer t @@ -622,7 +1184,7 @@ module Google = struct let from_proto_exn = let constructor = fun extensions' java_package java_outer_classname java_multiple_files java_generate_equals_and_hash java_string_check_utf8 optimize_for go_package cc_generic_services java_generic_services py_generic_services php_generic_services deprecated cc_enable_arenas objc_class_prefix csharp_namespace swift_prefix php_class_prefix php_namespace php_metadata_namespace ruby_package uninterpreted_option -> { java_package; java_outer_classname; java_multiple_files; java_generate_equals_and_hash; java_string_check_utf8; optimize_for; go_package; cc_generic_services; java_generic_services; py_generic_services; php_generic_services; deprecated; cc_enable_arenas; objc_class_prefix; csharp_namespace; swift_prefix; php_class_prefix; php_namespace; php_metadata_namespace; ruby_package; uninterpreted_option; extensions' } in - let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (8, string) ^:: basic (10, bool, Some (false)) ^:: basic_opt (20, bool) ^:: basic (27, bool, Some (false)) ^:: basic (9, (enum FileOptions.OptimizeMode.from_int_exn), Some (FileOptions.OptimizeMode.SPEED)) ^:: basic_opt (11, string) ^:: basic (16, bool, Some (false)) ^:: basic (17, bool, Some (false)) ^:: basic (18, bool, Some (false)) ^:: basic (42, bool, Some (false)) ^:: basic (23, bool, Some (false)) ^:: basic (31, bool, Some (true)) ^:: basic_opt (36, string) ^:: basic_opt (37, string) ^:: basic_opt (39, string) ^:: basic_opt (40, string) ^:: basic_opt (41, string) ^:: basic_opt (44, string) ^:: basic_opt (45, string) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (8, string) ^:: basic (10, bool, Some (false)) ^:: basic_opt (20, bool) ^:: basic (27, bool, Some (false)) ^:: basic (9, (enum OptimizeMode.from_int_exn), Some (OptimizeMode.SPEED)) ^:: basic_opt (11, string) ^:: basic (16, bool, Some (false)) ^:: basic (17, bool, Some (false)) ^:: basic (18, bool, Some (false)) ^:: basic (42, bool, Some (false)) ^:: basic (23, bool, Some (false)) ^:: basic (31, bool, Some (true)) ^:: basic_opt (36, string) ^:: basic_opt (37, string) ^:: basic_opt (39, string) ^:: basic_opt (40, string) ^:: basic_opt (41, string) ^:: basic_opt (44, string) ^:: basic_opt (45, string) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) @@ -677,8 +1239,8 @@ module Google = struct val from_int_exn: int -> t end val name': unit -> string - type t = { ctype: FieldOptions.CType.t; packed: bool option; jstype: FieldOptions.JSType.t; lazy': bool; unverified_lazy: bool; deprecated: bool; weak: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } - val make : ?ctype:FieldOptions.CType.t -> ?packed:bool -> ?jstype:FieldOptions.JSType.t -> ?lazy':bool -> ?unverified_lazy:bool -> ?deprecated:bool -> ?weak:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + type t = { ctype: CType.t; packed: bool option; jstype: JSType.t; lazy': bool; unverified_lazy: bool; deprecated: bool; weak: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + val make : ?ctype:CType.t -> ?packed:bool -> ?jstype:JSType.t -> ?lazy':bool -> ?unverified_lazy:bool -> ?deprecated:bool -> ?weak:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result @@ -725,11 +1287,11 @@ module Google = struct let from_int e = Runtime'.Result.catch (fun () -> from_int_exn e) end let name' () = "descriptor.google.protobuf.FieldOptions" - type t = { ctype: FieldOptions.CType.t; packed: bool option; jstype: FieldOptions.JSType.t; lazy': bool; unverified_lazy: bool; deprecated: bool; weak: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { ctype: CType.t; packed: bool option; jstype: JSType.t; lazy': bool; unverified_lazy: bool; deprecated: bool; weak: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } let make = fun ?ctype ?packed ?jstype ?lazy' ?unverified_lazy ?deprecated ?weak ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> - let ctype = match ctype with Some v -> v | None -> FieldOptions.CType.STRING in - let jstype = match jstype with Some v -> v | None -> FieldOptions.JSType.JS_NORMAL in + let ctype = match ctype with Some v -> v | None -> CType.STRING in + let jstype = match jstype with Some v -> v | None -> JSType.JS_NORMAL in let lazy' = match lazy' with Some v -> v | None -> false in let unverified_lazy = match unverified_lazy with Some v -> v | None -> false in let deprecated = match deprecated with Some v -> v | None -> false in @@ -739,7 +1301,7 @@ module Google = struct let to_proto' = let apply = fun ~f:f' writer { ctype; packed; jstype; lazy'; unverified_lazy; deprecated; weak; uninterpreted_option; extensions' } -> f' extensions' writer ctype packed jstype lazy' unverified_lazy deprecated weak uninterpreted_option in - let spec = Runtime'.Serialize.C.( basic (1, (enum FieldOptions.CType.to_int), Some (FieldOptions.CType.STRING)) ^:: basic_opt (2, bool) ^:: basic (6, (enum FieldOptions.JSType.to_int), Some (FieldOptions.JSType.JS_NORMAL)) ^:: basic (5, bool, Some (false)) ^:: basic (15, bool, Some (false)) ^:: basic (3, bool, Some (false)) ^:: basic (10, bool, Some (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in + let spec = Runtime'.Serialize.C.( basic (1, (enum CType.to_int), Some (CType.STRING)) ^:: basic_opt (2, bool) ^:: basic (6, (enum JSType.to_int), Some (JSType.JS_NORMAL)) ^:: basic (5, bool, Some (false)) ^:: basic (15, bool, Some (false)) ^:: basic (3, bool, Some (false)) ^:: basic (10, bool, Some (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] spec in fun writer t -> apply ~f:serialize writer t @@ -747,7 +1309,7 @@ module Google = struct let from_proto_exn = let constructor = fun extensions' ctype packed jstype lazy' unverified_lazy deprecated weak uninterpreted_option -> { ctype; packed; jstype; lazy'; unverified_lazy; deprecated; weak; uninterpreted_option; extensions' } in - let spec = Runtime'.Deserialize.C.( basic (1, (enum FieldOptions.CType.from_int_exn), Some (FieldOptions.CType.STRING)) ^:: basic_opt (2, bool) ^:: basic (6, (enum FieldOptions.JSType.from_int_exn), Some (FieldOptions.JSType.JS_NORMAL)) ^:: basic (5, bool, Some (false)) ^:: basic (15, bool, Some (false)) ^:: basic (3, bool, Some (false)) ^:: basic (10, bool, Some (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic (1, (enum CType.from_int_exn), Some (CType.STRING)) ^:: basic_opt (2, bool) ^:: basic (6, (enum JSType.from_int_exn), Some (JSType.JS_NORMAL)) ^:: basic (5, bool, Some (false)) ^:: basic (15, bool, Some (false)) ^:: basic (3, bool, Some (false)) ^:: basic (10, bool, Some (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) @@ -892,8 +1454,8 @@ module Google = struct val from_int_exn: int -> t end val name': unit -> string - type t = { deprecated: bool; idempotency_level: MethodOptions.IdempotencyLevel.t; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } - val make : ?deprecated:bool -> ?idempotency_level:MethodOptions.IdempotencyLevel.t -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + type t = { deprecated: bool; idempotency_level: IdempotencyLevel.t; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + val make : ?deprecated:bool -> ?idempotency_level:IdempotencyLevel.t -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result @@ -920,17 +1482,17 @@ module Google = struct let from_int e = Runtime'.Result.catch (fun () -> from_int_exn e) end let name' () = "descriptor.google.protobuf.MethodOptions" - type t = { deprecated: bool; idempotency_level: MethodOptions.IdempotencyLevel.t; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { deprecated: bool; idempotency_level: IdempotencyLevel.t; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } let make = fun ?deprecated ?idempotency_level ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> let deprecated = match deprecated with Some v -> v | None -> false in - let idempotency_level = match idempotency_level with Some v -> v | None -> MethodOptions.IdempotencyLevel.IDEMPOTENCY_UNKNOWN in + let idempotency_level = match idempotency_level with Some v -> v | None -> IdempotencyLevel.IDEMPOTENCY_UNKNOWN in let uninterpreted_option = match uninterpreted_option with Some v -> v | None -> [] in { deprecated; idempotency_level; uninterpreted_option; extensions' } let to_proto' = let apply = fun ~f:f' writer { deprecated; idempotency_level; uninterpreted_option; extensions' } -> f' extensions' writer deprecated idempotency_level uninterpreted_option in - let spec = Runtime'.Serialize.C.( basic (33, bool, Some (false)) ^:: basic (34, (enum MethodOptions.IdempotencyLevel.to_int), Some (MethodOptions.IdempotencyLevel.IDEMPOTENCY_UNKNOWN)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in + let spec = Runtime'.Serialize.C.( basic (33, bool, Some (false)) ^:: basic (34, (enum IdempotencyLevel.to_int), Some (IdempotencyLevel.IDEMPOTENCY_UNKNOWN)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] spec in fun writer t -> apply ~f:serialize writer t @@ -938,7 +1500,7 @@ module Google = struct let from_proto_exn = let constructor = fun extensions' deprecated idempotency_level uninterpreted_option -> { deprecated; idempotency_level; uninterpreted_option; extensions' } in - let spec = Runtime'.Deserialize.C.( basic (33, bool, Some (false)) ^:: basic (34, (enum MethodOptions.IdempotencyLevel.from_int_exn), Some (MethodOptions.IdempotencyLevel.IDEMPOTENCY_UNKNOWN)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic (33, bool, Some (false)) ^:: basic (34, (enum IdempotencyLevel.from_int_exn), Some (IdempotencyLevel.IDEMPOTENCY_UNKNOWN)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) @@ -955,8 +1517,8 @@ module Google = struct val from_proto_exn: Runtime'.Reader.t -> t end val name': unit -> string - type t = { name: UninterpretedOption.NamePart.t list; identifier_value: string option; positive_int_value: int option; negative_int_value: int option; double_value: float option; string_value: bytes option; aggregate_value: string option } - val make : ?name:UninterpretedOption.NamePart.t list -> ?identifier_value:string -> ?positive_int_value:int -> ?negative_int_value:int -> ?double_value:float -> ?string_value:bytes -> ?aggregate_value:string -> unit -> t + type t = { name: NamePart.t list; identifier_value: string option; positive_int_value: int option; negative_int_value: int option; double_value: float option; string_value: bytes option; aggregate_value: string option } + val make : ?name:NamePart.t list -> ?identifier_value:string -> ?positive_int_value:int -> ?negative_int_value:int -> ?double_value:float -> ?string_value:bytes -> ?aggregate_value:string -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result @@ -995,7 +1557,7 @@ module Google = struct end let name' () = "descriptor.google.protobuf.UninterpretedOption" - type t = { name: UninterpretedOption.NamePart.t list; identifier_value: string option; positive_int_value: int option; negative_int_value: int option; double_value: float option; string_value: bytes option; aggregate_value: string option } + type t = { name: NamePart.t list; identifier_value: string option; positive_int_value: int option; negative_int_value: int option; double_value: float option; string_value: bytes option; aggregate_value: string option } let make = fun ?name ?identifier_value ?positive_int_value ?negative_int_value ?double_value ?string_value ?aggregate_value () -> let name = match name with Some v -> v | None -> [] in @@ -1003,7 +1565,7 @@ module Google = struct let to_proto' = let apply = fun ~f:f' writer { name; identifier_value; positive_int_value; negative_int_value; double_value; string_value; aggregate_value } -> f' [] writer name identifier_value positive_int_value negative_int_value double_value string_value aggregate_value in - let spec = Runtime'.Serialize.C.( repeated (2, (message (fun t -> UninterpretedOption.NamePart.to_proto' t)), not_packed) ^:: basic_opt (3, string) ^:: basic_opt (4, uint64_int) ^:: basic_opt (5, int64_int) ^:: basic_opt (6, double) ^:: basic_opt (7, bytes) ^:: basic_opt (8, string) ^:: nil ) in + let spec = Runtime'.Serialize.C.( repeated (2, (message (fun t -> NamePart.to_proto' t)), not_packed) ^:: basic_opt (3, string) ^:: basic_opt (4, uint64_int) ^:: basic_opt (5, int64_int) ^:: basic_opt (6, double) ^:: basic_opt (7, bytes) ^:: basic_opt (8, string) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] spec in fun writer t -> apply ~f:serialize writer t @@ -1011,7 +1573,7 @@ module Google = struct let from_proto_exn = let constructor = fun _extensions name identifier_value positive_int_value negative_int_value double_value string_value aggregate_value -> { name; identifier_value; positive_int_value; negative_int_value; double_value; string_value; aggregate_value } in - let spec = Runtime'.Deserialize.C.( repeated (2, (message (fun t -> UninterpretedOption.NamePart.from_proto_exn t)), not_packed) ^:: basic_opt (3, string) ^:: basic_opt (4, uint64_int) ^:: basic_opt (5, int64_int) ^:: basic_opt (6, double) ^:: basic_opt (7, bytes) ^:: basic_opt (8, string) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( repeated (2, (message (fun t -> NamePart.from_proto_exn t)), not_packed) ^:: basic_opt (3, string) ^:: basic_opt (4, uint64_int) ^:: basic_opt (5, int64_int) ^:: basic_opt (6, double) ^:: basic_opt (7, bytes) ^:: basic_opt (8, string) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) @@ -1028,8 +1590,8 @@ module Google = struct val from_proto_exn: Runtime'.Reader.t -> t end val name': unit -> string - type t = SourceCodeInfo.Location.t list - val make : ?location:SourceCodeInfo.Location.t list -> unit -> t + type t = Location.t list + val make : ?location:Location.t list -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result @@ -1070,7 +1632,7 @@ module Google = struct end let name' () = "descriptor.google.protobuf.SourceCodeInfo" - type t = SourceCodeInfo.Location.t list + type t = Location.t list let make = fun ?location () -> let location = match location with Some v -> v | None -> [] in @@ -1078,7 +1640,7 @@ module Google = struct let to_proto' = let apply = fun ~f:f' writer location -> f' [] writer location in - let spec = Runtime'.Serialize.C.( repeated (1, (message (fun t -> SourceCodeInfo.Location.to_proto' t)), not_packed) ^:: nil ) in + let spec = Runtime'.Serialize.C.( repeated (1, (message (fun t -> Location.to_proto' t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] spec in fun writer t -> apply ~f:serialize writer t @@ -1086,7 +1648,7 @@ module Google = struct let from_proto_exn = let constructor = fun _extensions location -> location in - let spec = Runtime'.Deserialize.C.( repeated (1, (message (fun t -> SourceCodeInfo.Location.from_proto_exn t)), not_packed) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( repeated (1, (message (fun t -> Location.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) @@ -1103,8 +1665,8 @@ module Google = struct val from_proto_exn: Runtime'.Reader.t -> t end val name': unit -> string - type t = GeneratedCodeInfo.Annotation.t list - val make : ?annotation:GeneratedCodeInfo.Annotation.t list -> unit -> t + type t = Annotation.t list + val make : ?annotation:Annotation.t list -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result @@ -1143,7 +1705,7 @@ module Google = struct end let name' () = "descriptor.google.protobuf.GeneratedCodeInfo" - type t = GeneratedCodeInfo.Annotation.t list + type t = Annotation.t list let make = fun ?annotation () -> let annotation = match annotation with Some v -> v | None -> [] in @@ -1151,7 +1713,7 @@ module Google = struct let to_proto' = let apply = fun ~f:f' writer annotation -> f' [] writer annotation in - let spec = Runtime'.Serialize.C.( repeated (1, (message (fun t -> GeneratedCodeInfo.Annotation.to_proto' t)), not_packed) ^:: nil ) in + let spec = Runtime'.Serialize.C.( repeated (1, (message (fun t -> Annotation.to_proto' t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] spec in fun writer t -> apply ~f:serialize writer t @@ -1159,7 +1721,7 @@ module Google = struct let from_proto_exn = let constructor = fun _extensions annotation -> annotation in - let spec = Runtime'.Deserialize.C.( repeated (1, (message (fun t -> GeneratedCodeInfo.Annotation.from_proto_exn t)), not_packed) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( repeated (1, (message (fun t -> Annotation.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) diff --git a/src/spec/plugin.ml b/src/spec/plugin.ml index 6cb1d0d..21c0e8f 100644 --- a/src/spec/plugin.ml +++ b/src/spec/plugin.ml @@ -23,9 +23,144 @@ module Imported'modules = struct module Descriptor = Descriptor end (**/**) -module Google = struct - module Protobuf = struct - module Compiler = struct +module rec Google : sig + module rec Protobuf : sig + module rec Compiler : sig + module rec Version : sig + val name': unit -> string + type t = { major: int option; minor: int option; patch: int option; suffix: string option } + val make : ?major:int -> ?minor:int -> ?patch:int -> ?suffix:string -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and CodeGeneratorRequest : sig + val name': unit -> string + type t = { file_to_generate: string list; parameter: string option; proto_file: Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list; compiler_version: Version.t option } + val make : ?file_to_generate:string list -> ?parameter:string -> ?proto_file:Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list -> ?compiler_version:Version.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and CodeGeneratorResponse : sig + module rec Feature : sig + type t = FEATURE_NONE | FEATURE_PROTO3_OPTIONAL + val to_int: t -> int + val from_int: int -> t Runtime'.Result.t + val from_int_exn: int -> t + end + and File : sig + val name': unit -> string + type t = { name: string option; insertion_point: string option; content: string option; generated_code_info: Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.t option } + val make : ?name:string -> ?insertion_point:string -> ?content:string -> ?generated_code_info:Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + val name': unit -> string + type t = { error: string option; supported_features: int option; file: File.t list } + val make : ?error:string -> ?supported_features:int -> ?file:File.t list -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + end + end +end = struct + module rec Protobuf : sig + module rec Compiler : sig + module rec Version : sig + val name': unit -> string + type t = { major: int option; minor: int option; patch: int option; suffix: string option } + val make : ?major:int -> ?minor:int -> ?patch:int -> ?suffix:string -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and CodeGeneratorRequest : sig + val name': unit -> string + type t = { file_to_generate: string list; parameter: string option; proto_file: Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list; compiler_version: Version.t option } + val make : ?file_to_generate:string list -> ?parameter:string -> ?proto_file:Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list -> ?compiler_version:Version.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and CodeGeneratorResponse : sig + module rec Feature : sig + type t = FEATURE_NONE | FEATURE_PROTO3_OPTIONAL + val to_int: t -> int + val from_int: int -> t Runtime'.Result.t + val from_int_exn: int -> t + end + and File : sig + val name': unit -> string + type t = { name: string option; insertion_point: string option; content: string option; generated_code_info: Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.t option } + val make : ?name:string -> ?insertion_point:string -> ?content:string -> ?generated_code_info:Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + val name': unit -> string + type t = { error: string option; supported_features: int option; file: File.t list } + val make : ?error:string -> ?supported_features:int -> ?file:File.t list -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + end + end = struct + module rec Compiler : sig + module rec Version : sig + val name': unit -> string + type t = { major: int option; minor: int option; patch: int option; suffix: string option } + val make : ?major:int -> ?minor:int -> ?patch:int -> ?suffix:string -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and CodeGeneratorRequest : sig + val name': unit -> string + type t = { file_to_generate: string list; parameter: string option; proto_file: Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list; compiler_version: Version.t option } + val make : ?file_to_generate:string list -> ?parameter:string -> ?proto_file:Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list -> ?compiler_version:Version.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + and CodeGeneratorResponse : sig + module rec Feature : sig + type t = FEATURE_NONE | FEATURE_PROTO3_OPTIONAL + val to_int: t -> int + val from_int: int -> t Runtime'.Result.t + val from_int_exn: int -> t + end + and File : sig + val name': unit -> string + type t = { name: string option; insertion_point: string option; content: string option; generated_code_info: Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.t option } + val make : ?name:string -> ?insertion_point:string -> ?content:string -> ?generated_code_info:Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.t -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + val name': unit -> string + type t = { error: string option; supported_features: int option; file: File.t list } + val make : ?error:string -> ?supported_features:int -> ?file:File.t list -> unit -> t + val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t + val to_proto: t -> Runtime'.Writer.t + val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result + val from_proto_exn: Runtime'.Reader.t -> t + end + end = struct module rec Version : sig val name': unit -> string type t = { major: int option; minor: int option; patch: int option; suffix: string option } @@ -108,8 +243,8 @@ module Google = struct val from_proto_exn: Runtime'.Reader.t -> t end val name': unit -> string - type t = { error: string option; supported_features: int option; file: CodeGeneratorResponse.File.t list } - val make : ?error:string -> ?supported_features:int -> ?file:CodeGeneratorResponse.File.t list -> unit -> t + type t = { error: string option; supported_features: int option; file: File.t list } + val make : ?error:string -> ?supported_features:int -> ?file:File.t list -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result @@ -166,7 +301,7 @@ module Google = struct end let name' () = "plugin.google.protobuf.compiler.CodeGeneratorResponse" - type t = { error: string option; supported_features: int option; file: CodeGeneratorResponse.File.t list } + type t = { error: string option; supported_features: int option; file: File.t list } let make = fun ?error ?supported_features ?file () -> let file = match file with Some v -> v | None -> [] in @@ -174,7 +309,7 @@ module Google = struct let to_proto' = let apply = fun ~f:f' writer { error; supported_features; file } -> f' [] writer error supported_features file in - let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (2, uint64_int) ^:: repeated (15, (message (fun t -> CodeGeneratorResponse.File.to_proto' t)), not_packed) ^:: nil ) in + let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (2, uint64_int) ^:: repeated (15, (message (fun t -> File.to_proto' t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] spec in fun writer t -> apply ~f:serialize writer t @@ -182,7 +317,7 @@ module Google = struct let from_proto_exn = let constructor = fun _extensions error supported_features file -> { error; supported_features; file } in - let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (2, uint64_int) ^:: repeated (15, (message (fun t -> CodeGeneratorResponse.File.from_proto_exn t)), not_packed) ^:: nil ) in + let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (2, uint64_int) ^:: repeated (15, (message (fun t -> File.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) From df41e78603b7090c332c953b0abacd85e8a73600 Mon Sep 17 00:00:00 2001 From: Anders Fugmann Date: Tue, 9 Jan 2024 00:31:36 +0100 Subject: [PATCH 17/30] Read boxed varint using native ints --- src/ocaml_protoc_plugin/reader.ml | 53 +++++++++++++++++++++++++++++-- 1 file changed, 50 insertions(+), 3 deletions(-) diff --git a/src/ocaml_protoc_plugin/reader.ml b/src/ocaml_protoc_plugin/reader.ml index 4889232..6e30d2d 100644 --- a/src/ocaml_protoc_plugin/reader.ml +++ b/src/ocaml_protoc_plugin/reader.ml @@ -37,12 +37,35 @@ let read_byte t = t.offset <- t.offset + 1; v +[@@inline] let read_raw_varint t = + let rec inner n acc = + let v = read_byte t in + let acc = acc + (v land 0x7f) lsl n in + match v land 0x80 = 0x80 with + | true when acc < 0 -> begin + let accl = Int64.of_int acc in (* If bit63 was set, then bit63 and bit64 are now set *) + let accl = match read_byte t land 0x01 = 0x01 with + | true -> accl + | false -> Int64.logand accl 0x7fffffffffffffffL (* Apparently not a negative number after all *) + in + accl + end + | true -> inner (n + 7) acc + | false when acc < 0 -> (* Bit 63 is set, convert into a 64 bit integer, but clear bit64 *) + Int64.logand 0x7fffffffffffffffL (Int64.of_int acc) + | false -> Int64.of_int acc + + in + inner 0 0 + +[@@inline] +let read_raw_varint_reference t = let open Infix.Int64 in let rec inner n acc = - let v = Int64.of_int (read_byte t) in + let v = read_byte t |> Int64.of_int in let acc = acc + (v land 0x7fL) lsl n in - match v > 127L with + match v land 0x80L = 0x80L with | true -> (* Still More data *) inner (Int.add n 7) acc @@ -50,11 +73,12 @@ let read_raw_varint t = in inner 0 0L +[@@inline] let read_raw_varint_unboxed t = let rec inner n acc = let v = read_byte t in let acc = acc + (v land 0x7f) lsl n in - match v > 127 with + match v land 0x80 = 0x80 with | true -> (* Still More data *) inner (n + 7) acc @@ -64,7 +88,9 @@ let read_raw_varint_unboxed t = [@@inline] let read_varint t = Varint (read_raw_varint t) + let read_varint_unboxed t = Varint_unboxed (read_raw_varint_unboxed t) +[@@inline] (* Implement little endian ourselves *) let read_fixed32 t = @@ -121,3 +147,24 @@ let to_list: t -> (int * Field.t) list = in fun t -> next t |> List.of_seq + + +let%expect_test "varint boxed" = + let values = [-2L; -1L; 0x7FFFFFFFFFFFFFFFL; 0x7FFFFFFFFFFFFFFEL; 0x3FFFFFFFFFFFFFFFL; 0x3FFFFFFFFFFFFFFEL; 0L; 1L] in + List.iter ~f:(fun v -> + let buffer = Bytes.create 10 in + let _ = Writer.write_varint buffer ~offset:0 v in + Printf.printf "0x%016LxL = 0x%016LxL\n" + (read_raw_varint_reference (create (Bytes.to_string buffer))) + (read_raw_varint (create (Bytes.to_string buffer))); + () + ) values; + [%expect {| + 0xfffffffffffffffeL = 0xfffffffffffffffeL + 0xffffffffffffffffL = 0xffffffffffffffffL + 0x7fffffffffffffffL = 0x7fffffffffffffffL + 0x7ffffffffffffffeL = 0x7ffffffffffffffeL + 0x3fffffffffffffffL = 0x3fffffffffffffffL + 0x3ffffffffffffffeL = 0x3ffffffffffffffeL + 0x0000000000000000L = 0x0000000000000000L + 0x0000000000000001L = 0x0000000000000001L |}] From 941449745ea1608b063a47a8a780ac854247d393 Mon Sep 17 00:00:00 2001 From: Anders Fugmann Date: Tue, 9 Jan 2024 01:27:59 +0100 Subject: [PATCH 18/30] Fix potential bug in varint encoding --- src/ocaml_protoc_plugin/writer.ml | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/src/ocaml_protoc_plugin/writer.ml b/src/ocaml_protoc_plugin/writer.ml index b646be8..e041f01 100644 --- a/src/ocaml_protoc_plugin/writer.ml +++ b/src/ocaml_protoc_plugin/writer.ml @@ -261,12 +261,13 @@ let write_delimited_field_length_fixed_size buffer ~offset v = (* If we clear the top bit, then its not signed anymore... Maybe. *) let write_varint buffer ~offset vl = - match Infix.Int64.(vl lsr 62 > 0L) with - | false -> - (* Bits 63 or 64 are not set, so write as unboxed *) - write_varint_unboxed buffer ~offset (Int64.to_int vl) + let v = Int64.to_int vl in + (* Int64.to_int just strips the high bit *) + match (Int64.shift_right_logical vl 62) = 0L with | true -> - let v = Int64.to_int vl in + (* Bits 63 or 64 are not set, so write as unboxed *) + write_varint_unboxed buffer ~offset v + | false -> Bytes.set_uint8 buffer offset (v lor 128); let v = v lsr 7 in let offset = offset + 1 in @@ -290,16 +291,15 @@ let write_varint buffer ~offset vl = let offset = offset + 1 in Bytes.set_uint8 buffer offset (v lor 128); let offset = offset + 1 in + let v = v lsr 7 in let offset = match vl < 0L with | true -> - (* Bit 64 (signed bit) set *) - Bytes.set_uint8 buffer offset ((Int64.shift_right vl (8*7) |> Int64.to_int) lor 128); + Bytes.set_uint8 buffer offset (v lor 128); let offset = offset + 1 in - Bytes.set_uint8 buffer offset 0x01; + Bytes.set_uint8 buffer offset (0x01); offset | false -> - (* Bit 64 not set so only write 9 bytes (9*7bit = 63bit)*) - Bytes.set_uint8 buffer offset (Int64.shift_right vl (8*7) |> Int64.to_int); + Bytes.set_uint8 buffer offset v; offset in offset + 1 @@ -500,7 +500,9 @@ let%expect_test "Writefield" = let%test "varint unrolled" = let open Infix.Int64 in - let values = List.init ~len:64 ~f:(fun idx -> 1L lsl idx) in + let values = List.init ~len:64 ~f:(fun idx -> 1L lsl idx) @ + List.init ~len:64 ~f:(fun idx -> (-1L) lsl idx) + in List.fold_left ~init:true ~f:(fun acc v -> List.fold_left ~init:acc ~f:(fun acc v -> From 3fcfa02831d8d4a1dccac7d3b06fab0c731f6ad8 Mon Sep 17 00:00:00 2001 From: Anders Fugmann Date: Thu, 11 Jan 2024 22:30:05 +0100 Subject: [PATCH 19/30] Avoid too many continuations, and only use packed encoding on scalar fields --- src/ocaml_protoc_plugin/reader.ml | 11 ++- src/ocaml_protoc_plugin/serialize.ml | 53 +++------- src/ocaml_protoc_plugin/writer.ml | 140 ++++++++++++--------------- src/ocaml_protoc_plugin/writer.mli | 18 ++-- src/plugin/types.ml | 6 ++ 5 files changed, 98 insertions(+), 130 deletions(-) diff --git a/src/ocaml_protoc_plugin/reader.ml b/src/ocaml_protoc_plugin/reader.ml index 6e30d2d..23b59eb 100644 --- a/src/ocaml_protoc_plugin/reader.ml +++ b/src/ocaml_protoc_plugin/reader.ml @@ -152,11 +152,14 @@ let to_list: t -> (int * Field.t) list = let%expect_test "varint boxed" = let values = [-2L; -1L; 0x7FFFFFFFFFFFFFFFL; 0x7FFFFFFFFFFFFFFEL; 0x3FFFFFFFFFFFFFFFL; 0x3FFFFFFFFFFFFFFEL; 0L; 1L] in List.iter ~f:(fun v -> - let buffer = Bytes.create 10 in - let _ = Writer.write_varint buffer ~offset:0 v in + let buffer = + let writer = Writer.init () in + Writer.write_varint_value v writer; + Writer.contents writer + in Printf.printf "0x%016LxL = 0x%016LxL\n" - (read_raw_varint_reference (create (Bytes.to_string buffer))) - (read_raw_varint (create (Bytes.to_string buffer))); + (read_raw_varint_reference (create buffer)) + (read_raw_varint (create buffer)); () ) values; [%expect {| diff --git a/src/ocaml_protoc_plugin/serialize.ml b/src/ocaml_protoc_plugin/serialize.ml index 46a2df5..6de9606 100644 --- a/src/ocaml_protoc_plugin/serialize.ml +++ b/src/ocaml_protoc_plugin/serialize.ml @@ -13,14 +13,10 @@ let field_type: type a. a spec -> int = function | Float | Fixed32 | SFixed32 | Fixed32_int | SFixed32_int -> 5 (* Fixed 32 bit *) let write_fixed64 ~f v = - let size = 8 in - let writer = Writer.write_fixed64 in - Writer.write_value ~size ~writer (f v) + Writer.write_fixed64_value (f v) let write_fixed32 ~f v = - let size = 4 in - let writer = Writer.write_fixed32 in - Writer.write_value ~size ~writer (f v) + Writer.write_fixed32_value (f v) let zigzag_encoding v = let open Infix.Int64 in @@ -38,24 +34,14 @@ let zigzag_encoding_unboxed v = v let write_varint ~f v = - let v = f v in - let size = Writer.varint_size (Int64.to_int v) in - let writer = Writer.write_varint in - Writer.write_value ~size ~writer v + Writer.write_varint_value (f v) let write_varint_unboxed ~f v = - let v = f v in - let size = Writer.varint_size v in - let writer = Writer.write_varint_unboxed in - Writer.write_value ~size ~writer v + Writer.write_varint_unboxed_value (f v) -let write_string ~f v = +let write_length_delimited_string ~f v = let v = f v in - let write_length = write_varint_unboxed ~f:String.length v in - let write_string = Writer.write_string in - fun t -> - write_length t; - Writer.write_value ~size:(String.length v) ~writer:write_string v t + Writer.write_length_delimited_value ~data:v ~offset:0 ~len:(String.length v) let id x = x let (@@) a b = fun v -> b (a v) @@ -85,17 +71,11 @@ let write_value : type a. a spec -> a -> Writer.t -> unit = function | SInt32_int -> write_varint_unboxed ~f:zigzag_encoding_unboxed | Bool -> write_varint_unboxed ~f:(function true -> 1 | false -> 0) - | String -> write_string ~f:id - | Bytes -> write_string ~f:Bytes.unsafe_to_string + | String -> write_length_delimited_string ~f:id + | Bytes -> write_length_delimited_string ~f:Bytes.unsafe_to_string | Enum f -> write_varint_unboxed ~f | Message to_proto -> - (* - fun v writer -> - let cont = Writer.write_length_delimited_value_cont writer in - let _ = to_proto writer v in - cont () - *) - Writer.write_length_delimited_value ~write:to_proto + Writer.write_length_delimited_value' ~write:to_proto (** Optimized when the value is given in advance, and the continuation is expected to be called multiple times *) let write_value_const : type a. a spec -> a -> Writer.t -> unit = fun spec v -> @@ -103,8 +83,7 @@ let write_value_const : type a. a spec -> a -> Writer.t -> unit = fun spec v -> let writer = Writer.init () in write_value v writer; let data = Writer.contents writer in - let size = String.length data in - Writer.write_value ~size ~writer:Writer.write_string data + Writer.write_const_value data let write_field_header: 'a spec -> int -> Writer.t -> unit = fun spec index -> let field_type = field_type spec in @@ -118,14 +97,8 @@ let write_field: type a. a spec -> int -> a -> Writer.t -> unit = fun spec index write_field_header writer; write_value v writer -let is_scalar: type a. a spec -> bool = function - | String -> false - | Bytes -> false - | Message _ -> false - | _ -> true - let rec write: type a. a compound -> Writer.t -> a -> unit = function - | Repeated (index, spec, Packed) when is_scalar spec -> begin + | Repeated (index, spec, Packed) -> begin let write writer vs = List.iter ~f:(fun v -> write_value spec v writer) vs in let write_header = write_field_header String index in fun writer vs -> @@ -133,9 +106,9 @@ let rec write: type a. a compound -> Writer.t -> a -> unit = function | [] -> () | vs -> write_header writer; - Writer.write_length_delimited_value ~write vs writer + Writer.write_length_delimited_value' ~write vs writer end - | Repeated (index, spec, _) -> + | Repeated (index, spec, Not_packed) -> let write = write_field spec index in fun writer vs -> List.iter ~f:(fun v -> write v writer) vs diff --git a/src/ocaml_protoc_plugin/writer.ml b/src/ocaml_protoc_plugin/writer.ml index e041f01..bde8c70 100644 --- a/src/ocaml_protoc_plugin/writer.ml +++ b/src/ocaml_protoc_plugin/writer.ml @@ -2,11 +2,6 @@ open StdLabels open Field - -let sprintf = Printf.sprintf -let printf = Printf.printf - - let length_delimited_size_field_length = 5 type substring = { mutable offset: int; buffer: Bytes.t } @@ -35,9 +30,8 @@ let unused_space t = let varint_size_reference v = let rec inner acc = function | 0 -> acc - | v -> inner (acc + 1) (v lsr 1) [@@ocaml.unrolled 10] + | v -> inner (acc + 1) (v lsr 1) in - match v with | v when v < 0 -> 10 | 0 -> 1 @@ -55,13 +49,6 @@ let varint_size = function | v when v < 0x100000000000000 -> 8 | _ -> 9 -let rec size_of_field = function - | Varint v -> varint_size (Int64.to_int v) - | Varint_unboxed v -> varint_size v - | Fixed_32_bit _ -> 4 - | Fixed_64_bit _ -> 8 - | Length_delimited {length; _} -> size_of_field (Varint_unboxed length) + length - (* Manually unroll *) let write_varint_unboxed buffer ~offset = function | v when v < 0 -> @@ -241,7 +228,9 @@ let write_varint_unboxed buffer ~offset = function (* Write a field delimited length. A delimited field length can be no larger than 2^31. This function always write 5 bytes (7*5bits > 31bits). - This allows the field length to be statically allocated and written later + This allows the field length to be statically allocated and written later. + The spec does not forbid this encoding, but there might be implementation + that disallow '0' as the ending varint value. *) let write_delimited_field_length_fixed_size buffer ~offset v = Bytes.set_uint8 buffer offset (v lor 128); @@ -296,7 +285,7 @@ let write_varint buffer ~offset vl = | true -> Bytes.set_uint8 buffer offset (v lor 128); let offset = offset + 1 in - Bytes.set_uint8 buffer offset (0x01); + Bytes.set_uint8 buffer offset (0x01); (* Always set the 64'th bit *) offset | false -> Bytes.set_uint8 buffer offset v; @@ -314,8 +303,8 @@ let write_varint_reference buffer ~offset v = Bytes.set_uint8 buffer offset (Int64.to_int v); next_offset | rem -> - Bytes.set_uint8 buffer offset (Int.logor (Int64.to_int v |> Int.logand 0x7F) 0x80); - inner ~offset:next_offset rem [@@ocaml.unrolled 10] + Bytes.set_uint8 buffer offset (Int.logor (Int64.to_int v) 0x80); + inner ~offset:next_offset rem in inner ~offset v @@ -336,24 +325,6 @@ let write_varint_unboxed_reference buffer ~offset v = in inner ~is_negative:(v < 0) ~offset v -let write_fixed32 buffer ~offset v = - Bytes.set_int32_le buffer offset v; - offset + 4 - -let write_fixed64 buffer ~offset v = - Bytes.set_int64_le buffer offset v; - offset + 8 - -let write_string buffer ~offset v = - let len = String.length v in - Bytes.blit_string ~src:v ~src_pos:0 ~dst:buffer ~dst_pos:offset ~len; - offset + len - -let write_length_delimited buffer ~offset ~src ~src_pos ~len = - let offset = write_varint_unboxed buffer ~offset len in - Bytes.blit_string ~src:src ~src_pos ~dst:buffer ~dst_pos:offset ~len; - offset + len - let ensure_capacity ~size t = match t.data with | { offset; buffer } as elem :: _ when Bytes.length buffer - offset >= size -> elem @@ -362,46 +333,62 @@ let ensure_capacity ~size t = t.data <- elem :: tl; elem -let write_value: size:int -> writer:(Bytes.t -> offset:int -> 'a -> int) -> 'a -> t -> unit = - fun ~size ~writer v t -> - let elem = ensure_capacity ~size t in - let offset = writer elem.buffer ~offset:elem.offset v in +(** Direct functions *) +let write_const_value data t = + let len = String.length data in + let elem = ensure_capacity ~size:len t in + Bytes.blit_string ~src:data ~src_pos:0 ~dst:elem.buffer ~dst_pos:elem.offset ~len; + elem.offset <- elem.offset + len + +let write_fixed32_value: int32 -> t -> unit = fun v t -> + let elem = ensure_capacity ~size:4 t in + Bytes.set_int32_le elem.buffer elem.offset v; + elem.offset <- elem.offset + 4 + +let write_fixed64_value: int64 -> t -> unit = fun v t -> + let elem = ensure_capacity ~size:8 t in + Bytes.set_int64_le elem.buffer elem.offset v; + elem.offset <- elem.offset + 8 + +let write_varint_unboxed_value: int -> t -> unit = fun v t -> + let elem = ensure_capacity ~size:10 t in + let offset = write_varint_unboxed elem.buffer ~offset:elem.offset v in + elem.offset <- offset + +let write_varint_value: int64 -> t -> unit = fun v t -> + let elem = ensure_capacity ~size:10 t in + let offset = write_varint elem.buffer ~offset:elem.offset v in elem.offset <- offset -let write_naked_field buffer ~offset = function - | Varint_unboxed v -> write_varint_unboxed buffer ~offset v - | Varint v -> write_varint buffer ~offset v - | Fixed_32_bit v -> write_fixed32 buffer ~offset v - | Fixed_64_bit v -> write_fixed64 buffer ~offset v - | Length_delimited {offset = src_pos; length; data} -> - write_length_delimited buffer ~offset ~src:data ~src_pos ~len:length - -let add_field t field = - let size = size_of_field field in - let elem = ensure_capacity ~size t in - let offset = write_naked_field elem.buffer ~offset:elem.offset field in - elem.offset <- offset; - () - -let write_field_header : t -> int -> int -> unit = - fun t index field_type -> +let write_length_delimited_value: data:string -> offset:int -> len:int -> t -> unit = fun ~data ~offset ~len t -> + write_varint_unboxed_value len t; + let elem = ensure_capacity ~size:len t in + Bytes.blit_string ~src:data ~src_pos:offset ~dst:elem.buffer ~dst_pos:elem.offset ~len; + elem.offset <- elem.offset + len + +let write_field_header : t -> int -> int -> unit = fun t index field_type -> let header = (index lsl 3) + field_type in - add_field t (Varint_unboxed (header)) + write_varint_unboxed_value header t -let write_field : t -> int -> Field.t -> unit = - fun t index field -> - let field_type = +let write_field : t -> int -> Field.t -> unit = fun t index field -> + let field_type, writer = match field with - | Varint _ -> 0 - | Varint_unboxed _ -> 0 - | Fixed_64_bit _ -> 1 - | Length_delimited _ -> 2 - | Fixed_32_bit _ -> 5 + | Varint v -> + 0, write_varint_value v + | Varint_unboxed v -> + 0, write_varint_unboxed_value v + | Fixed_64_bit v -> + 1, write_fixed64_value v + | Length_delimited {offset; length; data} -> + 2, write_length_delimited_value ~data ~offset ~len:length + | Fixed_32_bit v -> + 5, write_fixed32_value v in write_field_header t index field_type; - add_field t field + writer t + -let write_length_delimited_value ~write v t = +let write_length_delimited_value' ~write v t = let rec size_data_added sentinel acc = function | [] -> failwith "End of list reached. This is impossible" | x :: _ when x == sentinel -> acc @@ -442,17 +429,14 @@ let write_length_delimited_value ~write v t = let _ = write t v in let size = size_data_added sentinel (sentinel.offset - (offset + length_delimited_size_field_length)) t.data in let offset' = write_varint_unboxed sentinel.buffer ~offset size in - (* Move data, to avoid holes *) + (* Move data to avoid holes *) let () = match (offset + length_delimited_size_field_length = offset') with | true -> () | false -> - (* Offset points to the first new byte. *) - (* - Printf.eprintf "\nHole size: %d. %d, %d, %d\n" n offset offset' sentinel.offset; - Printf.eprintf "Bytes.blit ~src:sentinel.buffer ~src_pos:%d ~dst:sentinel.buffer ~dst_pos:%d ~len:%d\n" (offset+5) offset' (sentinel.offset - (offset + 5)); - *) - Bytes.blit ~src:sentinel.buffer ~src_pos:(offset+5) ~dst:sentinel.buffer ~dst_pos:offset' ~len:(sentinel.offset - (offset + 5)); - sentinel.offset <- sentinel.offset - (offset+5-offset'); + Bytes.blit ~src:sentinel.buffer ~src_pos:(offset + length_delimited_size_field_length) + ~dst:sentinel.buffer ~dst_pos:offset' + ~len:(sentinel.offset - (offset + length_delimited_size_field_length)); + sentinel.offset <- sentinel.offset - (offset+length_delimited_size_field_length-offset'); in () in @@ -478,10 +462,10 @@ let contents t = let dump t = let string_contents = contents t in List.init ~len:(String.length string_contents) ~f:(fun i -> - sprintf "%02x" (Char.code (String.get string_contents i)) + Printf.sprintf "%02x" (Char.code (String.get string_contents i)) ) |> String.concat ~sep:"-" - |> printf "Buffer: %s\n" + |> Printf.printf "Buffer: %s\n" let of_list: (int * Field.t) list -> t = fun fields -> let t = init () in diff --git a/src/ocaml_protoc_plugin/writer.mli b/src/ocaml_protoc_plugin/writer.mli index f2a7bd5..3ebce87 100644 --- a/src/ocaml_protoc_plugin/writer.mli +++ b/src/ocaml_protoc_plugin/writer.mli @@ -17,14 +17,17 @@ val contents : t -> string (**/**) val varint_size : int -> int -val write_varint : bytes -> offset:int -> int64 -> int -val write_varint_unboxed : bytes -> offset:int -> int -> int -val write_fixed32 : bytes -> offset:int -> Int32.t -> int -val write_fixed64 : bytes -> offset:int -> Int64.t -> int -val write_string : bytes -> offset:int -> string -> int -val write_length_delimited : bytes -> offset:int -> src:string -> src_pos:int -> len:int -> int + +(** Direct functions *) +val write_fixed32_value: int32 -> t -> unit +val write_fixed64_value: int64 -> t -> unit +val write_varint_unboxed_value: int -> t -> unit +val write_varint_value: int64 -> t -> unit +val write_length_delimited_value: data:string -> offset:int -> len:int -> t -> unit +val write_const_value: string -> t -> unit + +val write_length_delimited_value': write:(t -> 'a -> _) -> 'a -> t -> unit val write_field : t -> int -> Field.t -> unit -val write_length_delimited_value : write:(t -> 'a -> 'b) -> 'a -> t -> unit (** Construct a writer from a field list *) val of_list: (int * Field.t) list -> t @@ -33,5 +36,4 @@ val of_list: (int * Field.t) list -> t val dump : t -> unit val unused_space : t -> int -val write_value: size:int -> writer:(Bytes.t -> offset:int -> 'a -> int) -> 'a -> t -> unit (**/**) diff --git a/src/plugin/types.ml b/src/plugin/types.ml index 4cab879..2e026cf 100644 --- a/src/plugin/types.ml +++ b/src/plugin/types.ml @@ -426,6 +426,12 @@ let c_of_field ~params ~syntax ~scope field = Repeated (number, spec, Not_packed) |> c_of_compound name + (* Repeated bytes and strings are not packed *) + | _, { label = Some Label.LABEL_REPEATED; type' = Some (TYPE_STRING | TYPE_BYTES as type'); type_name; _ } -> + let Espec spec = spec_of_type ~params ~scope type_name None type' in + Repeated (number, spec, Not_packed) + |> c_of_compound name + (* Repeated enum *) | _, { label = Some Label.LABEL_REPEATED; type' = Some Type.TYPE_ENUM; type_name; options; _} -> let spec = spec_of_enum ~scope type_name None in From c1f94949e3b5d1d41b9b158275e3feffe3e069fb Mon Sep 17 00:00:00 2001 From: Anders Fugmann Date: Thu, 18 Jan 2024 19:13:28 +0100 Subject: [PATCH 20/30] Optimize packed reading --- bench/bench.ml | 12 ++-- src/ocaml_protoc_plugin/deserialize.ml | 98 ++++++++++++++++++-------- src/ocaml_protoc_plugin/reader.ml | 34 ++++----- src/ocaml_protoc_plugin/reader.mli | 8 +-- 4 files changed, 94 insertions(+), 58 deletions(-) diff --git a/bench/bench.ml b/bench/bench.ml index b24485e..e793c54 100644 --- a/bench/bench.ml +++ b/bench/bench.ml @@ -60,17 +60,17 @@ let make_tests (type v) (module Protoc: Protoc_impl) (module Plugin: Plugin_impl let test_encode = Test.make_grouped ~name:"Encode" [ - Test.make ~name:"Plugin balanced" (Staged.stage @@ fun () -> Plugin.M.to_proto' Ocaml_protoc_plugin.Writer.(init ~mode:Balanced ()) v_plugin |> Ocaml_protoc_plugin.Writer.contents); - Test.make ~name:"Plugin speed" (Staged.stage @@ fun () -> Plugin.M.to_proto' Ocaml_protoc_plugin.Writer.(init ~mode:Speed ()) v_plugin |> Ocaml_protoc_plugin.Writer.contents); - Test.make ~name:"Plugin space" (Staged.stage @@ fun () -> Plugin.M.to_proto' Ocaml_protoc_plugin.Writer.(init ~mode:Space ()) v_plugin |> Ocaml_protoc_plugin.Writer.contents); - Test.make ~name:"Protoc" (Staged.stage @@ fun () -> let encoder = Pbrt.Encoder.create () in Protoc.encode_pb_m v_protoc encoder; (Pbrt.Encoder.to_string encoder)) + Test.make ~name:"Plugin balanced" (Staged.stage @@ fun () -> Plugin.M.to_proto' Ocaml_protoc_plugin.Writer.(init ~mode:Balanced ()) v_plugin |> Ocaml_protoc_plugin.Writer.contents |> Sys.opaque_identity); + Test.make ~name:"Plugin speed" (Staged.stage @@ fun () -> Plugin.M.to_proto' Ocaml_protoc_plugin.Writer.(init ~mode:Speed ()) v_plugin |> Ocaml_protoc_plugin.Writer.contents |> Sys.opaque_identity); + Test.make ~name:"Plugin space" (Staged.stage @@ fun () -> Plugin.M.to_proto' Ocaml_protoc_plugin.Writer.(init ~mode:Space ()) v_plugin |> Ocaml_protoc_plugin.Writer.contents |> Sys.opaque_identity); + Test.make ~name:"Protoc" (Staged.stage @@ fun () -> let encoder = Pbrt.Encoder.create () in Protoc.encode_pb_m v_protoc encoder; (Pbrt.Encoder.to_string encoder) |> Sys.opaque_identity) ] in let test_decode = Test.make_grouped ~name:"Decode" [ - Test.make ~name:"Plugin" (Staged.stage @@ fun () -> Plugin.M.from_proto_exn (Ocaml_protoc_plugin.Reader.create data)); - Test.make ~name:"Protoc" (Staged.stage @@ fun () -> Protoc.decode_pb_m (Pbrt.Decoder.of_string data)) + Test.make ~name:"Plugin" (Staged.stage @@ fun () -> Plugin.M.from_proto_exn (Ocaml_protoc_plugin.Reader.create data |> Sys.opaque_identity)); + Test.make ~name:"Protoc" (Staged.stage @@ fun () -> Protoc.decode_pb_m (Pbrt.Decoder.of_string data |> Sys.opaque_identity)) ] in Test.make_grouped ~name:(Plugin.M.name' ()) [test_encode; test_decode] diff --git a/src/ocaml_protoc_plugin/deserialize.ml b/src/ocaml_protoc_plugin/deserialize.ml index 092b92a..d8c52db 100644 --- a/src/ocaml_protoc_plugin/deserialize.ml +++ b/src/ocaml_protoc_plugin/deserialize.ml @@ -17,13 +17,23 @@ let error_wrong_field str field = Result.raise (`Wrong_field_type (str, field)) let error_illegal_value str field = Result.raise (`Illegal_value (str, field)) let error_required_field_missing () = Result.raise `Required_field_missing +let decode_zigzag v = + let open Infix.Int64 in + match v land 0x01L = 0L with + | true -> v / 2L + | false -> (v / 2L * -1L) - 1L + +let decode_zigzag_unboxed v = + match v land 0x01 = 0 with + | true -> v / 2 + | false -> (v / 2 * -1) - 1 + let read_varint ~signed ~type_name = let open! Infix.Int64 in function | Field.Varint v -> begin let v = match signed with - | true when v land 0x01L = 0L -> v / 2L - | true -> (v / 2L * -1L) - 1L + | true -> decode_zigzag v | false -> v in v @@ -33,8 +43,7 @@ let read_varint ~signed ~type_name = let rec read_varint_unboxed ~signed ~type_name = function | Field.Varint_unboxed v -> begin let v = match signed with - | true when v land 0x01 = 0 -> v / 2 - | true -> (v / 2 * -1) - 1 + | true -> decode_zigzag_unboxed v | false -> v in v @@ -45,6 +54,35 @@ let rec read_varint_unboxed ~signed ~type_name = function let read_varint32 ~signed ~type_name field = read_varint ~signed ~type_name field |> Int64.to_int32 +let get_packed_read_function: type a. a spec -> (Reader.t -> a) = function + | Double -> fun reader -> Reader.read_fixed64 reader |> Int64.float_of_bits + | Float -> fun reader -> Reader.read_fixed32 reader |> Int32.float_of_bits + | Int32 -> fun reader -> Reader.read_varint_unboxed reader |> Int32.of_int + | Int32_int -> Reader.read_varint_unboxed + | Int64 -> Reader.read_varint + | Int64_int -> Reader.read_varint_unboxed + | UInt32 -> fun reader -> Reader.read_varint_unboxed reader |> Int32.of_int + | UInt32_int -> Reader.read_varint_unboxed + | UInt64 -> Reader.read_varint + | UInt64_int -> Reader.read_varint_unboxed + | SInt32 -> fun reader -> Reader.read_varint_unboxed reader |> decode_zigzag_unboxed |> Int32.of_int + | SInt32_int -> fun reader -> Reader.read_varint_unboxed reader |> decode_zigzag_unboxed + | SInt64 -> fun reader -> Reader.read_varint reader |> decode_zigzag + | SInt64_int -> fun reader -> Reader.read_varint_unboxed reader |> decode_zigzag_unboxed + | Fixed32 -> Reader.read_fixed32 + | Fixed32_int -> fun reader -> Reader.read_fixed32 reader |> Int32.to_int + | Fixed64 -> Reader.read_fixed64 + | Fixed64_int -> fun reader -> Reader.read_fixed64 reader |> Int64.to_int + | SFixed32 -> Reader.read_fixed32 + | SFixed32_int -> fun reader -> Reader.read_fixed32 reader |> Int32.to_int + | SFixed64 -> Reader.read_fixed64 + | SFixed64_int -> fun reader -> Reader.read_fixed64 reader |> Int64.to_int + | Bool -> fun reader -> Reader.read_varint_unboxed reader != 0 + | Enum of_int -> fun reader -> Reader.read_varint_unboxed reader |> of_int + | String -> failwith "Strings cannot be packed" + | Bytes -> failwith "Bytes cannot be packed" + | Message _ -> failwith "Messages cannot be packed" + let rec type_of_spec: type a. a spec -> 'b * a decoder = let int_of_int32 spec = let (tpe, f) = type_of_spec spec in @@ -163,6 +201,12 @@ let get_boxed_type = function | `Fixed_64_bit -> Reader.Boxed | `Length_delimited -> Reader.Unboxed +let is_scalar: type a. a spec -> bool = function + | Message _ -> false + | String -> false + | Bytes -> false + | _ -> true + let sentinal: type a. a compound -> (int * (unit decoder * Reader.boxed)) list * a sentinal = function (* This is the same as required, so we should just use that! *) | Basic (index, (Message deser), _) -> @@ -194,7 +238,6 @@ let sentinal: type a. a compound -> (int * (unit decoder * Reader.boxed)) list * let field_type, read = type_of_spec spec in let boxed = get_boxed_type field_type in let default = match default with - | Some default -> default | None -> begin default_of_field_type field_type @@ -204,7 +247,7 @@ let sentinal: type a. a compound -> (int * (unit decoder * Reader.boxed)) list * let v = ref default in let get () = !v in let read field = - read field |> fun value -> v := value + read field |> fun v' -> v := v' in ([index, (read, boxed)], get) | Basic_opt (index, spec) -> @@ -216,35 +259,34 @@ let sentinal: type a. a compound -> (int * (unit decoder * Reader.boxed)) list * read field |> fun value -> v := Some value in ([index, (read, boxed)], get) - | Repeated (index, spec, _) -> - let read_field = function - | `Length_delimited -> None - | `Varint -> Some Reader.read_varint - | `Varint_unboxed -> Some Reader.read_varint_unboxed - | `Fixed_64_bit -> Some Reader.read_fixed64 - | `Fixed_32_bit -> Some Reader.read_fixed32 - in - let rec read_repeated reader decode read_f = + | Repeated (index, spec, _) when is_scalar spec -> + let v = ref [] in + let get () = List.rev !v in + let read_packed_field = get_packed_read_function spec in + let rec read_packed read_f acc reader = match Reader.has_more reader with - | false -> () - | true -> - decode reader |> fun field -> - read_f field |> fun () -> - read_repeated reader decode read_f + | true -> read_packed read_f (read_f reader :: acc) reader + | false -> acc in let (field_type, read_type) = type_of_spec spec in let boxed = get_boxed_type field_type in - let read_field_type = read_field field_type in + let read_field field = read_type field |> fun v' -> v := v' :: !v in + let read = function + | Field.Length_delimited { offset; length; data } -> + v := read_packed read_packed_field (!v) (Reader.create ~offset ~length data) + | field -> read_field field + in + ([index, (read, boxed)], get) + + | Repeated (index, spec, _) -> + (* Non-scalar types cannot be packed *) let v = ref [] in let get () = List.rev !v in - let rec read field = match field, read_field_type with - | (Field.Length_delimited _ as field), None -> - read_type field |> fun v' -> v := v' :: !v - | Field.Length_delimited { offset; length; data }, Some read_field -> - read_repeated (Reader.create ~offset ~length data) read_field read - | field, _ -> read_type field |> fun v' -> v := v' :: !v - in + let (field_type, read_type) = type_of_spec spec in + let boxed = get_boxed_type field_type in + let read field = read_type field |> fun v' -> v := v' :: !v in ([index, (read, boxed)], get) + | Oneof oneofs -> let make_reader: a ref -> a oneof -> (int * (unit decoder * Reader.boxed)) = fun v (Oneof_elem (index, spec, constr)) -> let field_type, read = type_of_spec spec in diff --git a/src/ocaml_protoc_plugin/reader.ml b/src/ocaml_protoc_plugin/reader.ml index 23b59eb..92df12e 100644 --- a/src/ocaml_protoc_plugin/reader.ml +++ b/src/ocaml_protoc_plugin/reader.ml @@ -38,7 +38,7 @@ let read_byte t = v [@@inline] -let read_raw_varint t = +let read_varint t = let rec inner n acc = let v = read_byte t in let acc = acc + (v land 0x7f) lsl n in @@ -60,7 +60,7 @@ let read_raw_varint t = inner 0 0 [@@inline] -let read_raw_varint_reference t = +let read_varint_reference t = let open Infix.Int64 in let rec inner n acc = let v = read_byte t |> Int64.of_int in @@ -74,7 +74,7 @@ let read_raw_varint_reference t = inner 0 0L [@@inline] -let read_raw_varint_unboxed t = +let read_varint_unboxed t = let rec inner n acc = let v = read_byte t in let acc = acc + (v land 0x7f) lsl n in @@ -86,50 +86,44 @@ let read_raw_varint_unboxed t = in inner 0 0 -[@@inline] -let read_varint t = Varint (read_raw_varint t) - -let read_varint_unboxed t = Varint_unboxed (read_raw_varint_unboxed t) -[@@inline] - (* Implement little endian ourselves *) let read_fixed32 t = let size = 4 in validate_capacity t size; let v = Bytes.get_int32_le (Bytes.unsafe_of_string t.data) t.offset in t.offset <- t.offset + size; - (Fixed_32_bit v) + v let read_fixed64 t = let size = 8 in validate_capacity t size; let v = Bytes.get_int64_le (Bytes.unsafe_of_string t.data) t.offset in t.offset <- t.offset + size; - (Fixed_64_bit v) + v let read_length_delimited t = - let length = read_raw_varint_unboxed t in + let length = read_varint_unboxed t in validate_capacity t length; let v = Length_delimited {offset = t.offset; length; data = t.data} in t.offset <- t.offset + length; v let read_field_header : t -> int * int = fun t -> - let v = read_raw_varint_unboxed t in + let v = read_varint_unboxed t in let tpe = v land 0x7 in let field_number = v / 8 in (tpe, field_number) let read_field_content = fun boxed -> let read_varint = match boxed with - | Boxed -> read_varint - | Unboxed -> read_varint_unboxed + | Boxed -> fun r -> Varint (read_varint r) + | Unboxed -> fun r -> Varint_unboxed (read_varint_unboxed r) in function - | 0 -> read_varint - | 1 -> read_fixed64 + | 0 -> fun r -> read_varint r + | 1 -> fun r -> Fixed_64_bit (read_fixed64 r) | 2 -> read_length_delimited - | 5 -> read_fixed32 + | 5 -> fun r -> Fixed_32_bit (read_fixed32 r) | n -> fun _ -> Result.raise (`Unknown_field_type n) @@ -158,8 +152,8 @@ let%expect_test "varint boxed" = Writer.contents writer in Printf.printf "0x%016LxL = 0x%016LxL\n" - (read_raw_varint_reference (create buffer)) - (read_raw_varint (create buffer)); + (read_varint_reference (create buffer)) + (read_varint (create buffer)); () ) values; [%expect {| diff --git a/src/ocaml_protoc_plugin/reader.mli b/src/ocaml_protoc_plugin/reader.mli index f7d8912..bddf44c 100644 --- a/src/ocaml_protoc_plugin/reader.mli +++ b/src/ocaml_protoc_plugin/reader.mli @@ -8,11 +8,11 @@ type boxed = Boxed | Unboxed (**/**) val has_more : t -> bool val to_list : t -> (int * Field.t) list -val read_varint : t -> Field.t -val read_varint_unboxed : t -> Field.t +val read_varint : t -> int64 +val read_varint_unboxed : t -> int val read_length_delimited : t -> Field.t -val read_fixed32 : t -> Field.t -val read_fixed64 : t -> Field.t +val read_fixed32 : t -> int32 +val read_fixed64 : t -> int64 val read_field_header : t -> (int * int) val read_field_content : boxed -> int -> t -> Field.t val read_field : boxed -> t -> (int * Field.t) From 8d07c3e4d13e0fc171f3fb4c0d60106468ebf315 Mon Sep 17 00:00:00 2001 From: Anders Fugmann Date: Sat, 20 Jan 2024 00:08:15 +0100 Subject: [PATCH 21/30] Optimize decoding. Benchmarks now shows faster than protoc when using flamba * Assume orderd fields when reading on fast-path and revert to a slow path if/when encountering unordered fields. * Sort fields to follow standard implementations * Change constructor to take extensions last to speedup handling of extensions * Delete locate options.ml as we require ocaml >=4.08 --- Makefile | 21 +- bench/bench.ml | 40 +- src/ocaml_protoc_plugin/deserialize.ml | 594 +++++++++--------------- src/ocaml_protoc_plugin/deserialize.mli | 5 + src/ocaml_protoc_plugin/extensions.ml | 6 +- src/ocaml_protoc_plugin/extensions.mli | 2 +- src/ocaml_protoc_plugin/field.ml | 24 +- src/ocaml_protoc_plugin/option.ml | 6 - src/ocaml_protoc_plugin/reader.ml | 51 +- src/ocaml_protoc_plugin/reader.mli | 11 +- src/ocaml_protoc_plugin/serialize.ml | 9 +- src/ocaml_protoc_plugin/writer.mli | 1 + src/plugin/scope.ml | 13 +- src/plugin/types.ml | 12 +- src/spec/descriptor.ml | 248 +++++----- src/spec/options.ml | 2 +- src/spec/plugin.ml | 36 +- test/mangle_names.proto | 1 - 18 files changed, 484 insertions(+), 598 deletions(-) create mode 100644 src/ocaml_protoc_plugin/deserialize.mli delete mode 100644 src/ocaml_protoc_plugin/option.ml diff --git a/Makefile b/Makefile index b156e84..12508e3 100644 --- a/Makefile +++ b/Makefile @@ -24,26 +24,33 @@ uninstall: build ## uninstall %: %.proto protoc --experimental_allow_proto3_optional -I $(dir $<) $< -o/dev/stdout | protoc --experimental_allow_proto3_optional --decode google.protobuf.FileDescriptorSet $(GOOGLE_INCLUDE)/descriptor.proto -src/spec/descriptor.ml: build - protoc "--plugin=protoc-gen-ocaml=_build/default/src/plugin/protoc_gen_ocaml.exe" \ +PLUGIN = _build/default/src/plugin/protoc_gen_ocaml.exe +$(PLUGIN): force + dune build src/plugin/protoc_gen_ocaml.exe + +src/spec/descriptor.ml: $(PLUGIN) + protoc "--plugin=protoc-gen-ocaml=$(PLUGIN)" \ -I /usr/include \ --ocaml_out=src/spec/. \ $(GOOGLE_INCLUDE)/descriptor.proto -src/spec/plugin.ml: build - protoc "--plugin=protoc-gen-ocaml=_build/default/src/plugin/protoc_gen_ocaml.exe" \ +src/spec/plugin.ml: $(PLUGIN) + protoc "--plugin=protoc-gen-ocaml=$(PLUGIN)" \ -I /usr/include \ --ocaml_out=src/spec/. \ $(GOOGLE_INCLUDE)/compiler/plugin.proto -src/spec/options.ml: build - protoc "--plugin=protoc-gen-ocaml=_build/default/src/plugin/protoc_gen_ocaml.exe" \ +src/spec/options.ml: $(PLUGIN) + protoc "--plugin=protoc-gen-ocaml=$(PLUGIN)" \ -I src/spec -I /usr/include \ --ocaml_out=src/spec/. \ src/spec/options.proto .PHONY: bootstrap bootstrap: src/spec/descriptor.ml src/spec/plugin.ml src/spec/options.ml ## Regenerate files used for generation +%.ml: %.proto + protoc -I $(shell pkg-config protobuf --variable=includedir) -I $(dir $<) --plugin=protoc-gen-ocaml=_build/default/src/plugin/protoc_gen_ocaml.exe \ + --ocaml_out=$(dir $@). $< .PHONY: doc @@ -66,6 +73,8 @@ gh-pages: doc ## Publish documentation bench: ## Run benchmark to compare with ocaml-protoc dune exec bench/bench.exe +.PHONY: force +force: .PHONY: help help: ## Show this help diff --git a/bench/bench.ml b/bench/bench.ml index e793c54..c646bff 100644 --- a/bench/bench.ml +++ b/bench/bench.ml @@ -1,5 +1,9 @@ +[@@@ocaml.warning "-26"] open Base open Stdio + +let meassure = Bechamel_perf.Instance.cpu_clock + [@@@ocaml.warning "-32"] module type Protoc_impl = sig type m @@ -38,14 +42,15 @@ let make_tests (type v) (module Protoc: Protoc_impl) (module Plugin: Plugin_impl let size_normal, unused_normal = verify_identity ~mode:Ocaml_protoc_plugin.Writer.Balanced v_plugin in let size_speed, unused_speed = verify_identity ~mode:Ocaml_protoc_plugin.Writer.Speed v_plugin in let size_space, unused_space = verify_identity ~mode:Ocaml_protoc_plugin.Writer.Space v_plugin in - let data = Plugin.M.to_proto' (Ocaml_protoc_plugin.Writer.init ()) v_plugin |> Ocaml_protoc_plugin.Writer.contents in - let v_plugin = Plugin.M.from_proto_exn (Ocaml_protoc_plugin.Reader.create data) in - let v_protoc = Protoc.decode_pb_m (Pbrt.Decoder.of_string data) in + let data_plugin = Plugin.M.to_proto' (Ocaml_protoc_plugin.Writer.init ()) v_plugin |> Ocaml_protoc_plugin.Writer.contents in + let v_plugin' = Plugin.M.from_proto_exn (Ocaml_protoc_plugin.Reader.create data_plugin) in + assert (Poly.equal v_plugin v_plugin'); + let v_protoc = Protoc.decode_pb_m (Pbrt.Decoder.of_string data_plugin) in let protoc_encoder = Pbrt.Encoder.create () in let () = Protoc.encode_pb_m v_protoc protoc_encoder in let data_protoc = Pbrt.Encoder.to_string protoc_encoder in - let v_plugin' = Plugin.M.from_proto_exn (Ocaml_protoc_plugin.Reader.create data_protoc) in - let () = match Plugin.M.equal v_plugin v_plugin' with + let v_plugin'' = Plugin.M.from_proto_exn (Ocaml_protoc_plugin.Reader.create data_protoc) in + let () = match Plugin.M.equal v_plugin v_plugin'' with | true -> () | false -> eprintf "Orig: %s\n" (Plugin.M.show v_plugin); @@ -69,8 +74,8 @@ let make_tests (type v) (module Protoc: Protoc_impl) (module Plugin: Plugin_impl let test_decode = Test.make_grouped ~name:"Decode" [ - Test.make ~name:"Plugin" (Staged.stage @@ fun () -> Plugin.M.from_proto_exn (Ocaml_protoc_plugin.Reader.create data |> Sys.opaque_identity)); - Test.make ~name:"Protoc" (Staged.stage @@ fun () -> Protoc.decode_pb_m (Pbrt.Decoder.of_string data |> Sys.opaque_identity)) + Test.make ~name:"Plugin" (Staged.stage @@ fun () -> Plugin.M.from_proto_exn (Ocaml_protoc_plugin.Reader.create data_plugin |> Sys.opaque_identity)); + Test.make ~name:"Protoc" (Staged.stage @@ fun () -> Protoc.decode_pb_m (Pbrt.Decoder.of_string data_protoc |> Sys.opaque_identity)) ] in Test.make_grouped ~name:(Plugin.M.name' ()) [test_encode; test_decode] @@ -128,22 +133,22 @@ let create_test_data ~depth () = let benchmark tests = let open Bechamel in - let instances = Bechamel_perf.Instance.[ cpu_clock ] in - let cfg = Benchmark.cfg ~limit:2000 ~quota:(Time.second 5.0) ~kde:(Some 1000) ~stabilize:true ~compaction:false () in + let instances = [ meassure ] in + let cfg = Benchmark.cfg ~limit:500 ~quota:(Time.second 5.0) ~kde:(Some 100) ~stabilize:true ~compaction:false () in Benchmark.all cfg instances tests let analyze results = let open Bechamel in - let ols = Analyze.ols ~bootstrap:10 ~r_square:false + let ols = Analyze.ols ~bootstrap:5 ~r_square:false ~predictors:[| Measure.run |] in - let results = Analyze.all ols Bechamel_perf.Instance.cpu_clock results in - Analyze.merge ols [ Bechamel_perf.Instance.cpu_clock ] [ results ] + let results = Analyze.all ols meassure results in + Analyze.merge ols [ meassure ] [ results ] let print_bench_results results = let open Bechamel in let () = Bechamel_notty.Unit.add - Bechamel_perf.Instance.cpu_clock - (Measure.unit Bechamel_perf.Instance.cpu_clock) + meassure + (Measure.unit meassure) in let img (window, results) = @@ -162,7 +167,8 @@ let print_bench_results results = let _ = let v_plugin = create_test_data ~depth:2 () |> Option.value_exn in - [ make_tests (module Protoc.Bench) (module Plugin.Bench) v_plugin; + [ + make_tests (module Protoc.Bench) (module Plugin.Bench) v_plugin; make_tests (module Protoc.Int64) (module Plugin.Int64) 27; make_tests (module Protoc.Float) (module Plugin.Float) 27.0001; make_tests (module Protoc.String) (module Plugin.String) "Benchmark"; @@ -171,8 +177,8 @@ let _ = List.init 1000 ~f:(fun i -> i) |> make_tests (module Protoc.Int64_list) (module Plugin.Int64_list); List.init 1000 ~f:(fun i -> Float.of_int i) |> make_tests (module Protoc.Float_list) (module Plugin.Float_list); List.init 1000 ~f:(fun _ -> random_string ()) |> make_tests (module Protoc.String_list) (module Plugin.String_list); - (* random_list ~len:100 ~f:(fun () -> Plugin.Enum_list.Enum.ED) () |> make_tests (module Protoc.Enum_list) (module Plugin.Enum_list); *) - ] + (* random_list ~len:100 ~f:(fun () -> Plugin.Enum_list.Enum.ED) () |> make_tests (module Protoc.Enum_list) (module Plugin.Enum_list); *) + ] |> List.rev |> List.iter ~f:(fun test -> test |> benchmark diff --git a/src/ocaml_protoc_plugin/deserialize.ml b/src/ocaml_protoc_plugin/deserialize.ml index d8c52db..297d713 100644 --- a/src/ocaml_protoc_plugin/deserialize.ml +++ b/src/ocaml_protoc_plugin/deserialize.ml @@ -1,20 +1,29 @@ (** Module for deserializing values *) - open StdLabels module S = Spec.Deserialize module C = S.C open S -type 'a sentinal = unit -> 'a -type 'a decoder = Field.t -> 'a +type required = Required | Optional + +type 'a reader = 'a -> Reader.t -> Field.field_type -> 'a +type 'a getter = 'a -> 'a +type 'a field_spec = (int * 'a reader) +type 'a value = ('a field_spec list * required * 'a * 'a getter) + +type (_, _) value_list = + | VNil : ('a, 'a) value_list + | VCons : ('a value) * ('b, 'c) value_list -> ('a -> 'b, 'c) value_list -type (_, _) sentinal_list = - | SNil : ('a, 'a) sentinal_list - | SCons : ('a sentinal) * ('b, 'c) sentinal_list -> ('a -> 'b, 'c) sentinal_list +type sentinel_field_spec = int * (Reader.t -> Field.field_type -> unit) +type 'a sentinel_getter = unit -> 'a + +type (_, _) sentinel_list = + | NNil : ('a, 'a) sentinel_list + | NCons : (sentinel_field_spec list * 'a sentinel_getter) * ('b, 'c) sentinel_list -> ('a -> 'b, 'c) sentinel_list let error_wrong_field str field = Result.raise (`Wrong_field_type (str, field)) -let error_illegal_value str field = Result.raise (`Illegal_value (str, field)) let error_required_field_missing () = Result.raise `Required_field_missing let decode_zigzag v = @@ -28,408 +37,243 @@ let decode_zigzag_unboxed v = | true -> v / 2 | false -> (v / 2 * -1) - 1 -let read_varint ~signed ~type_name = - let open! Infix.Int64 in - function - | Field.Varint v -> begin - let v = match signed with - | true -> decode_zigzag v - | false -> v - in - v - end - | field -> error_wrong_field type_name field - -let rec read_varint_unboxed ~signed ~type_name = function - | Field.Varint_unboxed v -> begin - let v = match signed with - | true -> decode_zigzag_unboxed v - | false -> v - in - v - end - | Field.Varint v -> read_varint_unboxed ~signed ~type_name (Field.Varint_unboxed (Int64.to_int v)) - | field -> error_wrong_field type_name field - -let read_varint32 ~signed ~type_name field = - read_varint ~signed ~type_name field |> Int64.to_int32 - -let get_packed_read_function: type a. a spec -> (Reader.t -> a) = function - | Double -> fun reader -> Reader.read_fixed64 reader |> Int64.float_of_bits - | Float -> fun reader -> Reader.read_fixed32 reader |> Int32.float_of_bits - | Int32 -> fun reader -> Reader.read_varint_unboxed reader |> Int32.of_int - | Int32_int -> Reader.read_varint_unboxed - | Int64 -> Reader.read_varint - | Int64_int -> Reader.read_varint_unboxed - | UInt32 -> fun reader -> Reader.read_varint_unboxed reader |> Int32.of_int - | UInt32_int -> Reader.read_varint_unboxed - | UInt64 -> Reader.read_varint - | UInt64_int -> Reader.read_varint_unboxed - | SInt32 -> fun reader -> Reader.read_varint_unboxed reader |> decode_zigzag_unboxed |> Int32.of_int - | SInt32_int -> fun reader -> Reader.read_varint_unboxed reader |> decode_zigzag_unboxed - | SInt64 -> fun reader -> Reader.read_varint reader |> decode_zigzag - | SInt64_int -> fun reader -> Reader.read_varint_unboxed reader |> decode_zigzag_unboxed - | Fixed32 -> Reader.read_fixed32 - | Fixed32_int -> fun reader -> Reader.read_fixed32 reader |> Int32.to_int - | Fixed64 -> Reader.read_fixed64 - | Fixed64_int -> fun reader -> Reader.read_fixed64 reader |> Int64.to_int - | SFixed32 -> Reader.read_fixed32 - | SFixed32_int -> fun reader -> Reader.read_fixed32 reader |> Int32.to_int - | SFixed64 -> Reader.read_fixed64 - | SFixed64_int -> fun reader -> Reader.read_fixed64 reader |> Int64.to_int - | Bool -> fun reader -> Reader.read_varint_unboxed reader != 0 - | Enum of_int -> fun reader -> Reader.read_varint_unboxed reader |> of_int - | String -> failwith "Strings cannot be packed" - | Bytes -> failwith "Bytes cannot be packed" - | Message _ -> failwith "Messages cannot be packed" - -let rec type_of_spec: type a. a spec -> 'b * a decoder = - let int_of_int32 spec = - let (tpe, f) = type_of_spec spec in - let f field = - f field |> Int32.to_int - in - (tpe, f) - in - - let int_of_uint32 spec = - let (tpe, f) = type_of_spec spec in - let f field = - f field |> (fun v -> - match Sys.word_size with - | 32 -> - (* If the high bit is set, we cannot represent it anyways *) - Int32.to_int v - | 64 -> - let move = 0x1_0000_0000 in - let i = Int32.to_int v in (if i < 0 then i + move else i) - | _ -> assert false - ) - in - (tpe, f) - in +let int_of_uint32 v = + let v = Int32.to_int v in + match Sys.word_size with + | 32 -> v + | 64 when v < 0 -> v + 0x1_0000_0000 + | 64 -> v + | _ -> assert false - let int_of_int64 spec = - let (tpe, f) = type_of_spec spec in - let f field = - f field |> Int64.to_int - in - (tpe, f) - in - let int_of_uint64 spec = - let (tpe, f) = type_of_spec spec in - let f field = - (* If high-bit is set, we cannot represent it *) - f field |> Int64.to_int - in - (tpe, f) - in +let read_of_spec: type a. a spec -> Field.field_type * (Reader.t -> a) = function + | Double -> Fixed64, fun reader -> Reader.read_fixed64 reader |> Int64.float_of_bits + | Float -> Fixed32, fun reader -> Reader.read_fixed32 reader |> Int32.float_of_bits + | Int32 -> Varint, fun reader -> Reader.read_varint_unboxed reader |> Int32.of_int + | Int32_int -> Varint, Reader.read_varint_unboxed + | Int64 -> Varint, Reader.read_varint + | Int64_int -> Varint, Reader.read_varint_unboxed + | UInt32 -> Varint, fun reader -> Reader.read_varint_unboxed reader |> Int32.of_int + | UInt32_int -> Varint, Reader.read_varint_unboxed + | UInt64 -> Varint, Reader.read_varint + | UInt64_int -> Varint, Reader.read_varint_unboxed + | SInt32 -> Varint, fun reader -> Reader.read_varint_unboxed reader |> decode_zigzag_unboxed |> Int32.of_int + | SInt32_int -> Varint, fun reader -> Reader.read_varint_unboxed reader |> decode_zigzag_unboxed + | SInt64 -> Varint, fun reader -> Reader.read_varint reader |> decode_zigzag + | SInt64_int -> Varint, fun reader -> Reader.read_varint_unboxed reader |> decode_zigzag_unboxed - function - | Double -> (`Fixed_64_bit, function - | Field.Fixed_64_bit v -> Int64.float_of_bits v - | field -> error_wrong_field "double" field) - | Float -> (`Fixed_32_bit, function - | Field.Fixed_32_bit v -> Int32.float_of_bits v - | field -> error_wrong_field "float" field) - | Int32 -> (`Varint, read_varint32 ~signed:false ~type_name:"int32") - | Int32_int -> (`Varint_unboxed, read_varint_unboxed ~signed:false ~type_name:"int32") - | Int64 -> (`Varint, read_varint ~signed:false ~type_name:"int64") - | Int64_int -> (`Varint_unboxed, read_varint_unboxed ~signed:false ~type_name:"int64") - | UInt32 -> (`Varint, read_varint32 ~signed:false ~type_name:"uint32") - | UInt32_int -> (`Varint_unboxed, read_varint_unboxed ~signed:false ~type_name:"uint32") - | UInt64 -> (`Varint, read_varint ~signed:false ~type_name:"uint64") - | UInt64_int -> (`Varint_unboxed, read_varint_unboxed ~signed:false ~type_name:"uint64") - | SInt32 -> (`Varint, read_varint32 ~signed:true ~type_name:"sint32") - | SInt32_int -> (`Varint_unboxed, read_varint_unboxed ~signed:true ~type_name:"sint32") - | SInt64 -> (`Varint, read_varint ~signed:true ~type_name:"sint64") - | SInt64_int -> (`Varint_unboxed, read_varint_unboxed ~signed:true ~type_name:"sint64") - | Fixed32 -> (`Fixed_32_bit, function - | Field.Fixed_32_bit v -> v - | field -> error_wrong_field "fixed32" field) - | Fixed32_int -> int_of_uint32 Fixed32 - | Fixed64 -> (`Fixed_64_bit, function - | Field.Fixed_64_bit v -> v - | field -> error_wrong_field "fixed64" field) - | Fixed64_int -> int_of_uint64 Fixed64 - | SFixed32 -> (`Fixed_32_bit, function - | Field.Fixed_32_bit v -> v - | field -> error_wrong_field "sfixed32" field) - | SFixed32_int -> int_of_int32 SFixed32 - | SFixed64 -> (`Fixed_64_bit, function - | Field.Fixed_64_bit v -> v - | field -> error_wrong_field "sfixed64" field) - | SFixed64_int -> int_of_int64 SFixed64 - | Bool -> (`Varint_unboxed, function - | Field.Varint_unboxed v -> v != 0 - | Field.Varint v -> Int64.equal v 0L |> not - | field -> error_wrong_field "bool" field) - | Enum of_int -> (`Varint_unboxed, function - | Field.Varint_unboxed v -> of_int v - | Field.Varint v -> Int64.to_int v |> of_int - | field -> error_wrong_field "enum" field) - | String -> (`Length_delimited, function - | Field.Length_delimited {offset; length; data} -> String.sub ~pos:offset ~len:length data - | field -> error_wrong_field "string" field) - | Bytes -> (`Length_delimited, function - | Field.Length_delimited {offset; length; data} -> Bytes.sub ~pos:offset ~len:length (Bytes.unsafe_of_string data) - | field -> error_wrong_field "bytes" field) - | Message from_proto -> (`Length_delimited, function - | Field.Length_delimited {offset; length; data} -> from_proto (Reader.create ~offset ~length data) - | field -> error_wrong_field "message" field) + | Fixed32 -> Fixed32, Reader.read_fixed32 + | Fixed32_int -> Fixed32, fun reader -> Reader.read_fixed32 reader |> int_of_uint32 + | SFixed32 -> Fixed32, Reader.read_fixed32 + | SFixed32_int -> Fixed32, fun reader -> Reader.read_fixed32 reader |> Int32.to_int -let default_of_field_type = function - | `Fixed_32_bit -> Field.fixed_32_bit Int32.zero - | `Fixed_64_bit -> Field.fixed_64_bit Int64.zero - | `Length_delimited -> Field.length_delimited "" - | `Varint -> Field.varint 0L - | `Varint_unboxed -> Field.varint_unboxed 0 + | Fixed64 -> Fixed64, Reader.read_fixed64 + | Fixed64_int -> Fixed64, fun reader -> Reader.read_fixed64 reader |> Int64.to_int + | SFixed64 -> Fixed64, Reader.read_fixed64 + | SFixed64_int -> Fixed64, fun reader -> Reader.read_fixed64 reader |> Int64.to_int -type expect = [ `Fixed_32_bit - | `Fixed_64_bit - | `Length_delimited - | `Varint - | `Varint_unboxed - | `Any ] + | Bool -> Varint, fun reader -> Reader.read_varint_unboxed reader != 0 + | Enum of_int -> Varint, fun reader -> Reader.read_varint_unboxed reader |> of_int + | String -> Length_delimited, fun reader -> + let Field.{ offset; length; data } = Reader.read_length_delimited reader in + String.sub ~pos:offset ~len:length data + | Bytes -> Length_delimited, fun reader -> + let Field.{ offset; length; data } = Reader.read_length_delimited reader in + let v = Bytes.create length in + Bytes.blit_string ~src:data ~src_pos:offset ~dst:v ~dst_pos:0 ~len:length; + v + | Message from_proto -> Length_delimited, fun reader -> + let Field.{ offset; length; data } = Reader.read_length_delimited reader in + from_proto (Reader.create ~offset ~length data) +let default_value: type a. a spec -> a = function + | Double -> 0.0 + | Float -> 0.0 + | Int32 -> Int32.zero + | Int64 -> Int64.zero + | UInt32 -> Int32.zero + | UInt64 -> Int64.zero + | SInt32 -> Int32.zero + | SInt64 -> Int64.zero + | Fixed32 -> Int32.zero + | Fixed64 -> Int64.zero + | SFixed32 -> Int32.zero + | SFixed64 -> Int64.zero + | Message of_proto -> of_proto (Reader.create "") + | String -> String.empty + | Bytes -> Bytes.empty + | Int32_int -> 0 + | Int64_int -> 0 + | UInt32_int -> 0 + | UInt64_int -> 0 + | SInt32_int -> 0 + | SInt64_int -> 0 + | Fixed32_int -> 0 + | Fixed64_int -> 0 + | SFixed32_int -> 0 + | SFixed64_int -> 0 + | Enum of_int -> of_int 0 + | Bool -> false -let get_boxed_type = function - | `Varint -> Reader.Boxed - | `Varint_unboxed -> Reader.Unboxed - | `Fixed_32_bit -> Reader.Boxed - | `Fixed_64_bit -> Reader.Boxed - | `Length_delimited -> Reader.Unboxed +let id x = x +let keep_last _ v = v -let is_scalar: type a. a spec -> bool = function - | Message _ -> false - | String -> false - | Bytes -> false - | _ -> true +let read_field ~read:(expect, read_f) ~map v reader field_type = + match expect = field_type with + | true -> read_f reader |> map v + | false -> + let field = Reader.read_field_content field_type reader in + error_wrong_field "Deserialize" field -let sentinal: type a. a compound -> (int * (unit decoder * Reader.boxed)) list * a sentinal = function - (* This is the same as required, so we should just use that! *) - | Basic (index, (Message deser), _) -> - let v = ref None in - let get () = match !v with - | None -> error_required_field_missing () - | Some v -> v - in - let read = function - | Field.Length_delimited {offset; length; data} -> - let reader = Reader.create ~length ~offset data in - deser reader |> fun message -> v := Some message - | field -> error_wrong_field "message" field - in - ([index, (read, Unboxed)], get) - | Basic (index, spec, None) -> - let expect, read = type_of_spec spec in - let boxed = get_boxed_type expect in - let v = ref None in - let get () = match !v with - | Some v -> v - | None -> error_required_field_missing () - in - let read field = - read field |> fun value -> v := Some value - in - ([index, (read, boxed)], get) +let value: type a. a compound -> a value = function | Basic (index, spec, default) -> - let field_type, read = type_of_spec spec in - let boxed = get_boxed_type field_type in + let read = read_field ~read:(read_of_spec spec) ~map:keep_last in + let required = match default with + | Some _ -> Optional + | None -> Required + in let default = match default with + | None -> default_value spec | Some default -> default - | None -> begin - default_of_field_type field_type - |> fun v -> try read v with Result.Error _ -> failwith "Cannot decode default field value" - end - in - let v = ref default in - let get () = !v in - let read field = - read field |> fun v' -> v := v' in - ([index, (read, boxed)], get) + ([(index, read)], required, default, id) | Basic_opt (index, spec) -> - let field_type, read = type_of_spec spec in - let boxed = get_boxed_type field_type in - let v = ref None in - let get () = !v in - let read field = - read field |> fun value -> v := Some value - in - ([index, (read, boxed)], get) - | Repeated (index, spec, _) when is_scalar spec -> - let v = ref [] in - let get () = List.rev !v in - let read_packed_field = get_packed_read_function spec in - let rec read_packed read_f acc reader = + let read = read_field ~read:(read_of_spec spec) ~map:(fun _ v -> Some v) in + ([(index, read)], Optional, None, id) + | Repeated (index, spec, Packed) -> + let field_type, read_f = read_of_spec spec in + let rec read_packed_values read_f acc reader = match Reader.has_more reader with - | true -> read_packed read_f (read_f reader :: acc) reader + | true -> read_packed_values read_f (read_f reader :: acc) reader | false -> acc in - let (field_type, read_type) = type_of_spec spec in - let boxed = get_boxed_type field_type in - let read_field field = read_type field |> fun v' -> v := v' :: !v in - let read = function - | Field.Length_delimited { offset; length; data } -> - v := read_packed read_packed_field (!v) (Reader.create ~offset ~length data) - | field -> read_field field + let read vs reader = fun (ft : Field.field_type) -> match ft with + | Field.Length_delimited -> + let Field.{ offset; length; data } = Reader.read_length_delimited reader in + let reader = Reader.create ~offset ~length data in + read_packed_values read_f vs reader + | ft when ft = field_type -> + read_f reader :: vs + | ft -> + let field = Reader.read_field_content ft reader in + error_wrong_field "Deserialize" field in - ([index, (read, boxed)], get) - - | Repeated (index, spec, _) -> - (* Non-scalar types cannot be packed *) - let v = ref [] in - let get () = List.rev !v in - let (field_type, read_type) = type_of_spec spec in - let boxed = get_boxed_type field_type in - let read field = read_type field |> fun v' -> v := v' :: !v in - ([index, (read, boxed)], get) - + ([(index, read)], Optional, [], List.rev) + | Repeated (index, spec, Not_packed) -> + let read = read_field ~read:(read_of_spec spec) ~map:(fun vs v -> v :: vs) in + ([(index, read)], Optional, [], List.rev) | Oneof oneofs -> - let make_reader: a ref -> a oneof -> (int * (unit decoder * Reader.boxed)) = fun v (Oneof_elem (index, spec, constr)) -> - let field_type, read = type_of_spec spec in - let boxed = get_boxed_type field_type in - let read field = - read field |> fun value -> v := (constr value) - in - (index, (read, boxed)) + let make_reader: a oneof -> a field_spec = fun (Oneof_elem (index, spec, constr)) -> + let read = read_field ~read:(read_of_spec spec) ~map:(fun _ -> constr) in + (index, read) in - let v = ref `not_set in - let get () = !v in - List.map ~f:(make_reader v) oneofs, get + (List.map ~f:make_reader oneofs, Optional, `not_set, id) -module Map = struct - include Map.Make (struct type t = int let compare = compare end) - let of_alist_exn l = List.fold_left ~init:empty ~f:(fun acc (k, v) -> - if mem k acc then - invalid_arg "Duplicate keys in list" - else - add k v acc - ) l -end +module IntMap = Map.Make(struct type t = int let compare = Int.compare end) let in_extension_ranges extension_ranges index = List.exists ~f:(fun (start, end') -> index >= start && index <= end') extension_ranges -(** Read fields - map based for nlogn lookup *) -(* The reader list should contain expected type to be read, so we know if it should be unboxed or not *) -let read_fields_map extension_ranges reader_list = - let extensions = ref [] in - let map = Map.of_alist_exn reader_list in - let read_field_content_boxed = Reader.read_field_content Reader.Boxed in - let rec read reader = - match Reader.has_more reader with - | false -> List.rev !extensions - | true -> - begin - let (field_type, field_number) = Reader.read_field_header reader in - match Map.find_opt field_number map with - | Some (f, boxed) -> - let field = Reader.read_field_content boxed field_type reader in - f field; - read reader - | None when in_extension_ranges extension_ranges field_number -> - (* Dont really know what to set expect to here. It really depends on the options *) - (* Maybe we should just construct the reader based on boxing or not boxing *) - (* When is this reading done??? We could just examine the spec string and derive the boxing or unboxing *) - (* We really need to have this information at the get-go. *) - let field = read_field_content_boxed field_type reader in - extensions := (field_number, field) :: !extensions; - read reader - | None -> - let _ = read_field_content_boxed field_type reader in - read reader - end +(** Full (slow) deserialization. *) +let deserialize_full: type constr a. (int * int) list -> (constr, (int * Field.t) list -> a) value_list -> constr -> Reader.t -> a = fun extension_ranges values constructor reader -> + (* Need to return the map also! *) + let rec make_sentinel_list: type a b. (a, b) value_list -> (a, b) sentinel_list = function + | VNil -> NNil + (* Consider optimizing when optional is true *) + | VCons ((fields, required, default, getter), rest) -> + let v = ref (default, required) in + let get () = match !v with + | _, Required -> error_required_field_missing (); + | v, Optional-> getter v + in + let fields = + List.map ~f:(fun (index, read) -> + let read reader field_type = let v' = fst !v in v := (read v' reader field_type, Optional) in + (index, read) + ) fields + in + NCons ((fields, get), make_sentinel_list rest) in - read -(** Read fields - array based for O(1) lookup *) -let read_fields_array extension_ranges max_index reader_list = - let extensions = ref [] in - let default_f index field = - match in_extension_ranges extension_ranges index with - | true -> extensions := (index, field) :: !extensions; - () - | false -> - () + let rec create_map: type a b. _ IntMap.t -> (a, b) sentinel_list -> _ IntMap.t = fun map -> function + | NNil -> map + | NCons ((fields, _), rest) -> + let map = + List.fold_left ~init:map ~f:(fun map (index, read)-> IntMap.add index read map) fields + in + create_map map rest in - let readers = Array.init (max_index + 1) ~f:(fun _ -> Reader.Boxed, default_f) in - List.iter ~f:(fun (idx, (f, expect)) -> readers.(idx) <- expect, fun _ -> f) reader_list; - let read_field_content_boxed = Reader.read_field_content Reader.Boxed in - let rec read reader = - match Reader.has_more reader with - | false -> List.rev !extensions - | true -> begin - let field_type, field_index = Reader.read_field_header reader in - match field_index <= max_index with - | true -> - let (boxed, f) = readers.(field_index) in - let field = Reader.read_field_content boxed field_type reader in - f field_index field; - read reader - | false -> - let field = read_field_content_boxed field_type reader in - default_f field_index field; - read reader - end + let rec apply: type constr t. constr -> (constr, t) sentinel_list -> t = fun constr -> function + | NNil -> constr + | NCons ((_, get), rest) -> + apply (constr (get ())) rest in - read -let deserialize: type constr t. (int * int) list -> (constr, t) compound_list -> ((int * Field.t) list -> constr) -> Reader.t -> t = fun extension_ranges spec constr -> - let max_index = - let rec inner: type a b. int -> (a, b) compound_list -> int = fun acc -> function - | Cons (Oneof oneofs, rest) -> - let rec max_elt: type c. int -> c oneof list -> int = fun acc -> function - | Oneof_elem (idx, _, _) :: rest -> max_elt (max idx acc) rest - | [] -> acc - in - let acc = max_elt acc oneofs in - inner acc rest - | Cons (Basic (idx, _, _), rest) -> - inner (max acc idx) rest - | Cons (Basic_opt (idx, _), rest) -> - inner (max acc idx) rest - | Cons (Repeated (idx, _, _), rest) -> - inner (max acc idx) rest - | Nil -> acc - in - inner 0 spec + let rec read: (Reader.t -> Field.field_type -> unit) IntMap.t -> (int * Field.t) list -> (int * Field.t) list = fun map extensions -> + match Reader.has_more reader with + | false -> List.rev extensions + | true -> + let (field_type, field_number) = Reader.read_field_header reader in + match IntMap.find_opt field_number map with + | Some read_f -> + read_f reader field_type; + read map extensions + | None when in_extension_ranges extension_ranges field_number -> + let field = Reader.read_field_content field_type reader in + read map ((field_number, field) :: extensions) + | None -> + let (_: Field.t) = Reader.read_field_content field_type reader in + read map extensions in - (* For even better optimization, the first pass could assume that - all fields are written (if at all) in the same order as the spec. - If we reach the end of the reader list, we revert to use read_fields_array - or read_fields_map. + let sentinels = make_sentinel_list values in + let map = create_map IntMap.empty sentinels in + let extensions = read map [] in + apply constructor sentinels extensions - Even even better, we could read opportunistically, and apply to the constructor - as soon as we find the element. - This requires that fields are collected into lists. - Also Oneof must be in the correct order, - and requires special handling (But I dont see that as a problem). - This solution avoids the need of sentinals, and has O(n), - where n is the number of fields. - If passing fails, we start over and apply standard readfields. - *) - let read_fields = match max_index < 1024 with - | true -> read_fields_array extension_ranges max_index - | false -> read_fields_map extension_ranges +let deserialize: type constr a. (int * int) list -> (constr, (int * Field.t) list -> a) compound_list -> constr -> Reader.t -> a = fun extension_ranges spec constr -> + let rec make_values: type a b. (a, b) compound_list -> (a, b) value_list = function + | Nil -> VNil + | Cons (spec, rest) -> + let value = value spec in + let values = make_values rest in + VCons (value, values) in - let rec apply: type constr t. constr -> (constr, t) sentinal_list -> t = fun constr -> function - | SCons (sentinal, rest) -> - sentinal () |> fun v -> apply (constr v) rest - | SNil -> constr + let values = make_values spec in + + let next_field reader = + match Reader.has_more reader with + | true -> Reader.read_field_header reader + | false -> Field.Varint, Int.max_int in - (* We first make a list of sentinal_getters, which we can map to the constr *) - let rec make_sentinals: type a b. (a, b) compound_list -> (a, b) sentinal_list * (int * (unit decoder * Reader.boxed)) list = function - | Cons (spec, rest) -> - let (readers, sentinal) = sentinal spec in - let (sentinals, reader_list) = make_sentinals rest in - SCons (sentinal, sentinals), List.rev_append readers reader_list - | Nil -> SNil, [] + + let rec read_values: type constr a. (int * int) list -> Field.field_type -> int -> Reader.t -> constr -> (int * Field.t) list -> (constr, (int * Field.t) list -> a) value_list -> a option = fun extension_ranges tpe idx reader constr extensions -> function + | VCons (((((index, read_f) :: _) as fields), _required, default, get), vs) when index = idx -> + let default = read_f default reader tpe in + let (tpe, idx) = next_field reader in + read_values extension_ranges tpe idx reader constr extensions (VCons ((fields, Optional, default, get), vs)) + | vs when in_extension_ranges extension_ranges idx -> + (* Extensions may be sent inline. Store all valid extensions. *) + let extensions = (idx, Reader.read_field_content tpe reader) :: extensions in + let (tpe, idx) = next_field reader in + read_values extension_ranges tpe idx reader constr extensions vs + | VCons ((_ :: fields, optional, default, get), vs) -> + read_values extension_ranges tpe idx reader constr extensions (VCons ((fields, optional, default, get), vs)) + | VCons (([], Required, _default, _get), _vs) -> + None + | VCons (([], Optional, default, get), vs) -> + read_values extension_ranges tpe idx reader (constr (get default)) extensions vs + | VNil when idx = Int.max_int -> + Some (constr (List.rev extensions)) + | VNil -> None in fun reader -> - let sentinals, reader_list = make_sentinals spec in - (* Read the fields one by one, and apply the reader - if found *) - read_fields reader_list reader |> fun extensions -> apply (constr extensions) sentinals + let offset = Reader.offset reader in + (* This start is horrible! We could simplify with has *) + let (tpe, idx) = next_field reader in + read_values extension_ranges tpe idx reader constr [] values + |> function + | Some t -> t + | None -> + Reader.reset reader offset; + deserialize_full extension_ranges values constr reader diff --git a/src/ocaml_protoc_plugin/deserialize.mli b/src/ocaml_protoc_plugin/deserialize.mli new file mode 100644 index 0000000..0e44bd1 --- /dev/null +++ b/src/ocaml_protoc_plugin/deserialize.mli @@ -0,0 +1,5 @@ +module C = Spec.Deserialize.C + +val deserialize: (int * int) list -> + ('constr, (int * Field.t) list -> 'a) Spec.Deserialize.compound_list -> + 'constr -> Reader.t -> 'a diff --git a/src/ocaml_protoc_plugin/extensions.ml b/src/ocaml_protoc_plugin/extensions.ml index 0610adc..9af55b9 100644 --- a/src/ocaml_protoc_plugin/extensions.ml +++ b/src/ocaml_protoc_plugin/extensions.ml @@ -7,15 +7,17 @@ let show : t -> string = Format.asprintf "%a" pp let equal _ _ = true let compare _ _ = 0 -let get: ('b -> 'b, 'b) Deserialize.S.compound_list -> t -> 'b = fun spec t -> +let get: type a. (a -> t -> a, t -> a) Spec.Deserialize.compound_list -> t -> a = fun spec t -> let writer = Writer.of_list t in let reader = Writer.contents writer |> Reader.create in - Deserialize.deserialize [] spec (fun _ a -> a) reader + Deserialize.deserialize [] spec (fun a _ -> a) reader let set: ('a -> Writer.t, Writer.t) Serialize.S.compound_list -> t -> 'a -> t = fun spec t v -> let writer = Writer.init () in let writer = Serialize.serialize [] spec [] writer v in let reader = Writer.contents writer |> Reader.create in + (* If we dont produce any fields, we should still clear the previous fields. *) + (* TODO: Test this code *) match Reader.to_list reader with | ((index, _) :: _) as fields -> (List.filter ~f:(fun (i, _) -> i != index) t) @ fields diff --git a/src/ocaml_protoc_plugin/extensions.mli b/src/ocaml_protoc_plugin/extensions.mli index 44b3d60..5125627 100644 --- a/src/ocaml_protoc_plugin/extensions.mli +++ b/src/ocaml_protoc_plugin/extensions.mli @@ -4,5 +4,5 @@ val pp : Format.formatter -> t -> unit val show : t -> string val equal : t -> t -> bool val compare : t -> t -> int -val get : ('b -> 'b, 'b) Deserialize.S.compound_list -> t -> 'b +val get : ('a -> t -> 'a, t -> 'a) Spec.Deserialize.compound_list -> t -> 'a val set : ('a -> Writer.t, Writer.t) Spec.Serialize.compound_list -> t -> 'a -> t diff --git a/src/ocaml_protoc_plugin/field.ml b/src/ocaml_protoc_plugin/field.ml index 1c12eb7..2f47676 100644 --- a/src/ocaml_protoc_plugin/field.ml +++ b/src/ocaml_protoc_plugin/field.ml @@ -1,12 +1,16 @@ +type length_delimited = { + offset : int; + length : int; + data : string; +} + +type field_type = Varint | Fixed64 | Fixed32 | Length_delimited + type t = | Varint of Int64.t (* int32, int64, uint32, uint64, sint32, sint64, bool, enum *) | Varint_unboxed of int | Fixed_64_bit of Int64.t (* fixed64, sfixed64, double *) - | Length_delimited of { - offset : int; - length : int; - data : string; - } (* string, bytes, embedded messages, packed repeated fields *) + | Length_delimited of length_delimited (* string, bytes, embedded messages, packed repeated fields *) | Fixed_32_bit of Int32.t (* fixed32, sfixed32, float *) let varint v = Varint v @@ -17,6 +21,11 @@ let length_delimited ?(offset=0) ?length data = let length = Option.value ~default:(String.length data - offset) length in Length_delimited {offset; length; data} +let string_of_field_type: field_type -> string = function + | Varint -> "Varint" + | Fixed64 -> "Fixed64" + | Length_delimited -> "Length_delimited" + | Fixed32 -> "Fixed32" let pp: Format.formatter -> t -> unit = fun fmt -> function @@ -46,7 +55,10 @@ let pp: Format.formatter -> t -> unit = fun fmt -> Format.fprintf fmt "@]"); Format.fprintf fmt ";@ "; Format.fprintf fmt "@[%s =@ " "data"; - (Format.fprintf fmt "%S") adata; + (match alength < 20 with + | true -> (Format.fprintf fmt "%S") (String.sub adata aoffset alength) + | false -> (Format.fprintf fmt "%S...") (String.sub adata aoffset 17) + ); Format.fprintf fmt "@]"); Format.fprintf fmt "@]}") | Fixed_32_bit a0 -> diff --git a/src/ocaml_protoc_plugin/option.ml b/src/ocaml_protoc_plugin/option.ml deleted file mode 100644 index 2e7d51d..0000000 --- a/src/ocaml_protoc_plugin/option.ml +++ /dev/null @@ -1,6 +0,0 @@ -(** Functions for manipulating Option values for compatibility with - * OCaml 4.06 *) -let value ~default = function - | None -> default - | Some x -> x -let some x = Some x diff --git a/src/ocaml_protoc_plugin/reader.ml b/src/ocaml_protoc_plugin/reader.ml index 92df12e..22b2fbd 100644 --- a/src/ocaml_protoc_plugin/reader.ml +++ b/src/ocaml_protoc_plugin/reader.ml @@ -1,9 +1,5 @@ (** Some buffer to hold data, and to read and write data *) - open StdLabels -open Field - -type boxed = Boxed | Unboxed type t = { mutable offset : int; @@ -15,11 +11,15 @@ let create ?(offset = 0) ?length data = let end_offset = match length with | None -> String.length data - | Some l -> l + offset + | Some l -> offset + l in + assert (end_offset >= offset); assert (String.length data >= end_offset); {offset; end_offset; data} +let reset t offset = t.offset <- offset +let offset { offset; _ } = offset + [@@inline] let validate_capacity t count = match t.offset + count <= t.end_offset with @@ -104,37 +104,34 @@ let read_fixed64 t = let read_length_delimited t = let length = read_varint_unboxed t in validate_capacity t length; - let v = Length_delimited {offset = t.offset; length; data = t.data} in + let v = Field.{ offset = t.offset; length = length; data = t.data } in t.offset <- t.offset + length; v -let read_field_header : t -> int * int = fun t -> +let read_field_header: t -> Field.field_type * int = fun t -> let v = read_varint_unboxed t in - let tpe = v land 0x7 in + let tpe : Field.field_type = match v land 0x7 with + | 0 -> Varint + | 1 -> Fixed64 + | 2 -> Length_delimited + | 5 -> Fixed32 + | _ -> failwith (Printf.sprintf "Illegal field header: 0x%x" v) + in let field_number = v / 8 in (tpe, field_number) -let read_field_content = fun boxed -> - let read_varint = match boxed with - | Boxed -> fun r -> Varint (read_varint r) - | Unboxed -> fun r -> Varint_unboxed (read_varint_unboxed r) - in - function - | 0 -> fun r -> read_varint r - | 1 -> fun r -> Fixed_64_bit (read_fixed64 r) - | 2 -> read_length_delimited - | 5 -> fun r -> Fixed_32_bit (read_fixed32 r) - | n -> fun _ -> Result.raise (`Unknown_field_type n) - - -let read_field : boxed -> t -> int * Field.t = fun boxed -> - let read_field_content = read_field_content boxed in - fun t -> - let (field_type, field_number) = read_field_header t in - field_number, read_field_content field_type t +let read_field_content: Field.field_type -> t -> Field.t = function + | Varint -> fun r -> Field.Varint (read_varint r) + | Fixed64 -> fun r -> Field.Fixed_64_bit (read_fixed64 r) + | Length_delimited -> fun r -> Length_delimited (read_length_delimited r) + | Fixed32 -> fun r -> Field.Fixed_32_bit (read_fixed32 r) let to_list: t -> (int * Field.t) list = - let read_field = read_field Boxed in + let read_field t = + let (tpe, index) = read_field_header t in + let field = read_field_content tpe t in + (index, field) + in let rec next t () = match has_more t with | true -> Seq.Cons (read_field t, next t) | false -> Seq.Nil diff --git a/src/ocaml_protoc_plugin/reader.mli b/src/ocaml_protoc_plugin/reader.mli index bddf44c..98a3e2d 100644 --- a/src/ocaml_protoc_plugin/reader.mli +++ b/src/ocaml_protoc_plugin/reader.mli @@ -2,18 +2,17 @@ type t (** Create a reader from a string, to be used when deserializing a protobuf type *) val create : ?offset:int -> ?length:int -> string -> t - -type boxed = Boxed | Unboxed +val offset : t -> int +val reset : t -> int -> unit (**/**) +val read_field_header: t -> Field.field_type * int +val read_field_content : Field.field_type -> t -> Field.t val has_more : t -> bool val to_list : t -> (int * Field.t) list val read_varint : t -> int64 val read_varint_unboxed : t -> int -val read_length_delimited : t -> Field.t +val read_length_delimited : t -> Field.length_delimited val read_fixed32 : t -> int32 val read_fixed64 : t -> int64 -val read_field_header : t -> (int * int) -val read_field_content : boxed -> int -> t -> Field.t -val read_field : boxed -> t -> (int * Field.t) (**/**) diff --git a/src/ocaml_protoc_plugin/serialize.ml b/src/ocaml_protoc_plugin/serialize.ml index 6de9606..60e1caf 100644 --- a/src/ocaml_protoc_plugin/serialize.ml +++ b/src/ocaml_protoc_plugin/serialize.ml @@ -99,7 +99,8 @@ let write_field: type a. a spec -> int -> a -> Writer.t -> unit = fun spec index let rec write: type a. a compound -> Writer.t -> a -> unit = function | Repeated (index, spec, Packed) -> begin - let write writer vs = List.iter ~f:(fun v -> write_value spec v writer) vs in + let write_value = write_value spec in + let write writer vs = List.iter ~f:(fun v -> write_value v writer) vs in let write_header = write_field_header String index in fun writer vs -> match vs with @@ -113,6 +114,10 @@ let rec write: type a. a compound -> Writer.t -> a -> unit = function fun writer vs -> List.iter ~f:(fun v -> write v writer) vs + (* For required fields the default is none, and the field must always be written! + Consider a Basic_req (index, spec) instead. Then default is not an option type, + and the code is simpler to read + *) | Basic (index, spec, default) -> begin let write = write_field spec index in match default with @@ -137,6 +142,8 @@ let rec write: type a. a compound -> Writer.t -> a -> unit = function match v with | `not_set -> () | v -> + (* Wonder if we could get the specs before calling v. Wonder what f is? *) + (* We could prob. return a list of all possible values + f v -> v. *) let Oneof_elem (index, spec, v) = f v in write (Basic (index, spec, None)) writer v end diff --git a/src/ocaml_protoc_plugin/writer.mli b/src/ocaml_protoc_plugin/writer.mli index 3ebce87..f002203 100644 --- a/src/ocaml_protoc_plugin/writer.mli +++ b/src/ocaml_protoc_plugin/writer.mli @@ -19,6 +19,7 @@ val contents : t -> string val varint_size : int -> int (** Direct functions *) + val write_fixed32_value: int32 -> t -> unit val write_fixed64_value: int64 -> t -> unit val write_varint_unboxed_value: int -> t -> unit diff --git a/src/plugin/scope.ml b/src/plugin/scope.ml index 5fdcea9..464b74f 100644 --- a/src/plugin/scope.ml +++ b/src/plugin/scope.ml @@ -51,12 +51,15 @@ let module_name_of_proto file = |> String.map ~f:(function '-' -> '_' | c -> c) let has_mangle_option options = - Option.map ~f:Spec.Options.Ocaml_options.get options - |> function - | Some (Ok (Some v)) -> v - | Some (Ok None) -> false + match options with | None -> false - | Some (Error _e) -> failwith "Could not parse ocaml-protoc-plugin options with id 1074" + | Some options -> + Spec.Options.Ocaml_options.get options + |> Ocaml_protoc_plugin.Result.get ~msg:"Could not parse ocaml-protoc-plugin options with id 1074" + |> function + | Some v -> v + | None -> false + module Type_tree = struct type t = { name: string; diff --git a/src/plugin/types.ml b/src/plugin/types.ml index 2e026cf..b2e7b19 100644 --- a/src/plugin/types.ml +++ b/src/plugin/types.ml @@ -533,7 +533,15 @@ let split_oneof_decl fields oneof_decls = in inner [] oneof_decls fields +let sort_fields fields = + let number = function + | FieldDescriptorProto.{ number = Some number; _ } -> number + | _ -> failwith "XAll Fields must have a number" + in + List.sort ~cmp:(fun v v' -> Int.compare (number v) (number v')) fields + let make ~params ~syntax ~is_cyclic ~is_map_entry ~has_extensions ~scope ~fields oneof_decls = + let fields = sort_fields fields in let ts = split_oneof_decl fields oneof_decls |> List.map ~f:(function @@ -607,7 +615,7 @@ let make ~params ~syntax ~is_cyclic ~is_map_entry ~has_extensions ~scope ~fields let type' = List.rev_map ~f:(fun { name; type'; _} -> ((Scope.get_name scope name), (typestr_of_type type'))) ts - |> prepend ~cond:has_extensions ("extensions'", "Runtime'.Extensions.t") + |> append ~cond:has_extensions ("extensions'", "Runtime'.Extensions.t") |> List.rev_map ~f:(function | (_, type') when t_as_tuple -> type' | (name, type') -> sprintf "%s: %s" name type' @@ -624,7 +632,7 @@ let make ~params ~syntax ~is_cyclic ~is_map_entry ~has_extensions ~scope ~fields let fields =(append ~cond:has_extensions "extensions'" field_names) in let constructor = sprintf "fun %s %s -> %s" - (if has_extensions then "extensions'" else "_extensions") args (type_destr fields) + args (if has_extensions then "extensions'" else "_extensions") (type_destr fields) in let apply = sprintf "fun ~f:f' writer %s -> f' %s writer %s" diff --git a/src/spec/descriptor.ml b/src/spec/descriptor.ml index 9b7793e..da22069 100644 --- a/src/spec/descriptor.ml +++ b/src/spec/descriptor.ml @@ -31,8 +31,8 @@ module rec Google : sig end and FileDescriptorProto : sig val name': unit -> string - type t = { name: string option; package: string option; dependency: string list; public_dependency: int list; weak_dependency: int list; message_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; service: ServiceDescriptorProto.t list; extension: FieldDescriptorProto.t list; options: FileOptions.t option; source_code_info: SourceCodeInfo.t option; syntax: string option } - val make : ?name:string -> ?package:string -> ?dependency:string list -> ?public_dependency:int list -> ?weak_dependency:int list -> ?message_type:DescriptorProto.t list -> ?enum_type:EnumDescriptorProto.t list -> ?service:ServiceDescriptorProto.t list -> ?extension:FieldDescriptorProto.t list -> ?options:FileOptions.t -> ?source_code_info:SourceCodeInfo.t -> ?syntax:string -> unit -> t + type t = { name: string option; package: string option; dependency: string list; message_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; service: ServiceDescriptorProto.t list; extension: FieldDescriptorProto.t list; options: FileOptions.t option; source_code_info: SourceCodeInfo.t option; public_dependency: int list; weak_dependency: int list; syntax: string option } + val make : ?name:string -> ?package:string -> ?dependency:string list -> ?message_type:DescriptorProto.t list -> ?enum_type:EnumDescriptorProto.t list -> ?service:ServiceDescriptorProto.t list -> ?extension:FieldDescriptorProto.t list -> ?options:FileOptions.t -> ?source_code_info:SourceCodeInfo.t -> ?public_dependency:int list -> ?weak_dependency:int list -> ?syntax:string -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result @@ -58,8 +58,8 @@ module rec Google : sig val from_proto_exn: Runtime'.Reader.t -> t end val name': unit -> string - type t = { name: string option; field: FieldDescriptorProto.t list; extension: FieldDescriptorProto.t list; nested_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; extension_range: ExtensionRange.t list; oneof_decl: OneofDescriptorProto.t list; options: MessageOptions.t option; reserved_range: ReservedRange.t list; reserved_name: string list } - val make : ?name:string -> ?field:FieldDescriptorProto.t list -> ?extension:FieldDescriptorProto.t list -> ?nested_type:DescriptorProto.t list -> ?enum_type:EnumDescriptorProto.t list -> ?extension_range:ExtensionRange.t list -> ?oneof_decl:OneofDescriptorProto.t list -> ?options:MessageOptions.t -> ?reserved_range:ReservedRange.t list -> ?reserved_name:string list -> unit -> t + type t = { name: string option; field: FieldDescriptorProto.t list; nested_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; extension_range: ExtensionRange.t list; extension: FieldDescriptorProto.t list; options: MessageOptions.t option; oneof_decl: OneofDescriptorProto.t list; reserved_range: ReservedRange.t list; reserved_name: string list } + val make : ?name:string -> ?field:FieldDescriptorProto.t list -> ?nested_type:DescriptorProto.t list -> ?enum_type:EnumDescriptorProto.t list -> ?extension_range:ExtensionRange.t list -> ?extension:FieldDescriptorProto.t list -> ?options:MessageOptions.t -> ?oneof_decl:OneofDescriptorProto.t list -> ?reserved_range:ReservedRange.t list -> ?reserved_name:string list -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result @@ -67,7 +67,7 @@ module rec Google : sig end and ExtensionRangeOptions : sig val name': unit -> string - type t = { uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { extensions': Runtime'.Extensions.t; uninterpreted_option: UninterpretedOption.t list } val make : ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t @@ -88,8 +88,8 @@ module rec Google : sig val from_int_exn: int -> t end val name': unit -> string - type t = { name: string option; number: int option; label: Label.t option; type': Type.t option; type_name: string option; extendee: string option; default_value: string option; oneof_index: int option; json_name: string option; options: FieldOptions.t option; proto3_optional: bool option } - val make : ?name:string -> ?number:int -> ?label:Label.t -> ?type':Type.t -> ?type_name:string -> ?extendee:string -> ?default_value:string -> ?oneof_index:int -> ?json_name:string -> ?options:FieldOptions.t -> ?proto3_optional:bool -> unit -> t + type t = { name: string option; extendee: string option; number: int option; label: Label.t option; type': Type.t option; type_name: string option; default_value: string option; options: FieldOptions.t option; oneof_index: int option; json_name: string option; proto3_optional: bool option } + val make : ?name:string -> ?extendee:string -> ?number:int -> ?label:Label.t -> ?type':Type.t -> ?type_name:string -> ?default_value:string -> ?options:FieldOptions.t -> ?oneof_index:int -> ?json_name:string -> ?proto3_optional:bool -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result @@ -157,8 +157,8 @@ module rec Google : sig val from_int_exn: int -> t end val name': unit -> string - type t = { java_package: string option; java_outer_classname: string option; java_multiple_files: bool; java_generate_equals_and_hash: bool option; java_string_check_utf8: bool; optimize_for: OptimizeMode.t; go_package: string option; cc_generic_services: bool; java_generic_services: bool; py_generic_services: bool; php_generic_services: bool; deprecated: bool; cc_enable_arenas: bool; objc_class_prefix: string option; csharp_namespace: string option; swift_prefix: string option; php_class_prefix: string option; php_namespace: string option; php_metadata_namespace: string option; ruby_package: string option; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } - val make : ?java_package:string -> ?java_outer_classname:string -> ?java_multiple_files:bool -> ?java_generate_equals_and_hash:bool -> ?java_string_check_utf8:bool -> ?optimize_for:OptimizeMode.t -> ?go_package:string -> ?cc_generic_services:bool -> ?java_generic_services:bool -> ?py_generic_services:bool -> ?php_generic_services:bool -> ?deprecated:bool -> ?cc_enable_arenas:bool -> ?objc_class_prefix:string -> ?csharp_namespace:string -> ?swift_prefix:string -> ?php_class_prefix:string -> ?php_namespace:string -> ?php_metadata_namespace:string -> ?ruby_package:string -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + type t = { extensions': Runtime'.Extensions.t; java_package: string option; java_outer_classname: string option; optimize_for: OptimizeMode.t; java_multiple_files: bool; go_package: string option; cc_generic_services: bool; java_generic_services: bool; py_generic_services: bool; java_generate_equals_and_hash: bool option; deprecated: bool; java_string_check_utf8: bool; cc_enable_arenas: bool; objc_class_prefix: string option; csharp_namespace: string option; swift_prefix: string option; php_class_prefix: string option; php_namespace: string option; php_generic_services: bool; php_metadata_namespace: string option; ruby_package: string option; uninterpreted_option: UninterpretedOption.t list } + val make : ?java_package:string -> ?java_outer_classname:string -> ?optimize_for:OptimizeMode.t -> ?java_multiple_files:bool -> ?go_package:string -> ?cc_generic_services:bool -> ?java_generic_services:bool -> ?py_generic_services:bool -> ?java_generate_equals_and_hash:bool -> ?deprecated:bool -> ?java_string_check_utf8:bool -> ?cc_enable_arenas:bool -> ?objc_class_prefix:string -> ?csharp_namespace:string -> ?swift_prefix:string -> ?php_class_prefix:string -> ?php_namespace:string -> ?php_generic_services:bool -> ?php_metadata_namespace:string -> ?ruby_package:string -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result @@ -166,7 +166,7 @@ module rec Google : sig end and MessageOptions : sig val name': unit -> string - type t = { message_set_wire_format: bool; no_standard_descriptor_accessor: bool; deprecated: bool; map_entry: bool option; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { extensions': Runtime'.Extensions.t; message_set_wire_format: bool; no_standard_descriptor_accessor: bool; deprecated: bool; map_entry: bool option; uninterpreted_option: UninterpretedOption.t list } val make : ?message_set_wire_format:bool -> ?no_standard_descriptor_accessor:bool -> ?deprecated:bool -> ?map_entry:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t @@ -187,8 +187,8 @@ module rec Google : sig val from_int_exn: int -> t end val name': unit -> string - type t = { ctype: CType.t; packed: bool option; jstype: JSType.t; lazy': bool; unverified_lazy: bool; deprecated: bool; weak: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } - val make : ?ctype:CType.t -> ?packed:bool -> ?jstype:JSType.t -> ?lazy':bool -> ?unverified_lazy:bool -> ?deprecated:bool -> ?weak:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + type t = { extensions': Runtime'.Extensions.t; ctype: CType.t; packed: bool option; deprecated: bool; lazy': bool; jstype: JSType.t; weak: bool; unverified_lazy: bool; uninterpreted_option: UninterpretedOption.t list } + val make : ?ctype:CType.t -> ?packed:bool -> ?deprecated:bool -> ?lazy':bool -> ?jstype:JSType.t -> ?weak:bool -> ?unverified_lazy:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result @@ -196,7 +196,7 @@ module rec Google : sig end and OneofOptions : sig val name': unit -> string - type t = { uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { extensions': Runtime'.Extensions.t; uninterpreted_option: UninterpretedOption.t list } val make : ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t @@ -205,7 +205,7 @@ module rec Google : sig end and EnumOptions : sig val name': unit -> string - type t = { allow_alias: bool option; deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { extensions': Runtime'.Extensions.t; allow_alias: bool option; deprecated: bool; uninterpreted_option: UninterpretedOption.t list } val make : ?allow_alias:bool -> ?deprecated:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t @@ -214,7 +214,7 @@ module rec Google : sig end and EnumValueOptions : sig val name': unit -> string - type t = { deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { extensions': Runtime'.Extensions.t; deprecated: bool; uninterpreted_option: UninterpretedOption.t list } val make : ?deprecated:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t @@ -223,7 +223,7 @@ module rec Google : sig end and ServiceOptions : sig val name': unit -> string - type t = { deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { extensions': Runtime'.Extensions.t; deprecated: bool; uninterpreted_option: UninterpretedOption.t list } val make : ?deprecated:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t @@ -238,7 +238,7 @@ module rec Google : sig val from_int_exn: int -> t end val name': unit -> string - type t = { deprecated: bool; idempotency_level: IdempotencyLevel.t; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { extensions': Runtime'.Extensions.t; deprecated: bool; idempotency_level: IdempotencyLevel.t; uninterpreted_option: UninterpretedOption.t list } val make : ?deprecated:bool -> ?idempotency_level:IdempotencyLevel.t -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t @@ -313,8 +313,8 @@ end = struct end and FileDescriptorProto : sig val name': unit -> string - type t = { name: string option; package: string option; dependency: string list; public_dependency: int list; weak_dependency: int list; message_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; service: ServiceDescriptorProto.t list; extension: FieldDescriptorProto.t list; options: FileOptions.t option; source_code_info: SourceCodeInfo.t option; syntax: string option } - val make : ?name:string -> ?package:string -> ?dependency:string list -> ?public_dependency:int list -> ?weak_dependency:int list -> ?message_type:DescriptorProto.t list -> ?enum_type:EnumDescriptorProto.t list -> ?service:ServiceDescriptorProto.t list -> ?extension:FieldDescriptorProto.t list -> ?options:FileOptions.t -> ?source_code_info:SourceCodeInfo.t -> ?syntax:string -> unit -> t + type t = { name: string option; package: string option; dependency: string list; message_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; service: ServiceDescriptorProto.t list; extension: FieldDescriptorProto.t list; options: FileOptions.t option; source_code_info: SourceCodeInfo.t option; public_dependency: int list; weak_dependency: int list; syntax: string option } + val make : ?name:string -> ?package:string -> ?dependency:string list -> ?message_type:DescriptorProto.t list -> ?enum_type:EnumDescriptorProto.t list -> ?service:ServiceDescriptorProto.t list -> ?extension:FieldDescriptorProto.t list -> ?options:FileOptions.t -> ?source_code_info:SourceCodeInfo.t -> ?public_dependency:int list -> ?weak_dependency:int list -> ?syntax:string -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result @@ -340,8 +340,8 @@ end = struct val from_proto_exn: Runtime'.Reader.t -> t end val name': unit -> string - type t = { name: string option; field: FieldDescriptorProto.t list; extension: FieldDescriptorProto.t list; nested_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; extension_range: ExtensionRange.t list; oneof_decl: OneofDescriptorProto.t list; options: MessageOptions.t option; reserved_range: ReservedRange.t list; reserved_name: string list } - val make : ?name:string -> ?field:FieldDescriptorProto.t list -> ?extension:FieldDescriptorProto.t list -> ?nested_type:DescriptorProto.t list -> ?enum_type:EnumDescriptorProto.t list -> ?extension_range:ExtensionRange.t list -> ?oneof_decl:OneofDescriptorProto.t list -> ?options:MessageOptions.t -> ?reserved_range:ReservedRange.t list -> ?reserved_name:string list -> unit -> t + type t = { name: string option; field: FieldDescriptorProto.t list; nested_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; extension_range: ExtensionRange.t list; extension: FieldDescriptorProto.t list; options: MessageOptions.t option; oneof_decl: OneofDescriptorProto.t list; reserved_range: ReservedRange.t list; reserved_name: string list } + val make : ?name:string -> ?field:FieldDescriptorProto.t list -> ?nested_type:DescriptorProto.t list -> ?enum_type:EnumDescriptorProto.t list -> ?extension_range:ExtensionRange.t list -> ?extension:FieldDescriptorProto.t list -> ?options:MessageOptions.t -> ?oneof_decl:OneofDescriptorProto.t list -> ?reserved_range:ReservedRange.t list -> ?reserved_name:string list -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result @@ -349,7 +349,7 @@ end = struct end and ExtensionRangeOptions : sig val name': unit -> string - type t = { uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { extensions': Runtime'.Extensions.t; uninterpreted_option: UninterpretedOption.t list } val make : ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t @@ -370,8 +370,8 @@ end = struct val from_int_exn: int -> t end val name': unit -> string - type t = { name: string option; number: int option; label: Label.t option; type': Type.t option; type_name: string option; extendee: string option; default_value: string option; oneof_index: int option; json_name: string option; options: FieldOptions.t option; proto3_optional: bool option } - val make : ?name:string -> ?number:int -> ?label:Label.t -> ?type':Type.t -> ?type_name:string -> ?extendee:string -> ?default_value:string -> ?oneof_index:int -> ?json_name:string -> ?options:FieldOptions.t -> ?proto3_optional:bool -> unit -> t + type t = { name: string option; extendee: string option; number: int option; label: Label.t option; type': Type.t option; type_name: string option; default_value: string option; options: FieldOptions.t option; oneof_index: int option; json_name: string option; proto3_optional: bool option } + val make : ?name:string -> ?extendee:string -> ?number:int -> ?label:Label.t -> ?type':Type.t -> ?type_name:string -> ?default_value:string -> ?options:FieldOptions.t -> ?oneof_index:int -> ?json_name:string -> ?proto3_optional:bool -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result @@ -439,8 +439,8 @@ end = struct val from_int_exn: int -> t end val name': unit -> string - type t = { java_package: string option; java_outer_classname: string option; java_multiple_files: bool; java_generate_equals_and_hash: bool option; java_string_check_utf8: bool; optimize_for: OptimizeMode.t; go_package: string option; cc_generic_services: bool; java_generic_services: bool; py_generic_services: bool; php_generic_services: bool; deprecated: bool; cc_enable_arenas: bool; objc_class_prefix: string option; csharp_namespace: string option; swift_prefix: string option; php_class_prefix: string option; php_namespace: string option; php_metadata_namespace: string option; ruby_package: string option; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } - val make : ?java_package:string -> ?java_outer_classname:string -> ?java_multiple_files:bool -> ?java_generate_equals_and_hash:bool -> ?java_string_check_utf8:bool -> ?optimize_for:OptimizeMode.t -> ?go_package:string -> ?cc_generic_services:bool -> ?java_generic_services:bool -> ?py_generic_services:bool -> ?php_generic_services:bool -> ?deprecated:bool -> ?cc_enable_arenas:bool -> ?objc_class_prefix:string -> ?csharp_namespace:string -> ?swift_prefix:string -> ?php_class_prefix:string -> ?php_namespace:string -> ?php_metadata_namespace:string -> ?ruby_package:string -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + type t = { extensions': Runtime'.Extensions.t; java_package: string option; java_outer_classname: string option; optimize_for: OptimizeMode.t; java_multiple_files: bool; go_package: string option; cc_generic_services: bool; java_generic_services: bool; py_generic_services: bool; java_generate_equals_and_hash: bool option; deprecated: bool; java_string_check_utf8: bool; cc_enable_arenas: bool; objc_class_prefix: string option; csharp_namespace: string option; swift_prefix: string option; php_class_prefix: string option; php_namespace: string option; php_generic_services: bool; php_metadata_namespace: string option; ruby_package: string option; uninterpreted_option: UninterpretedOption.t list } + val make : ?java_package:string -> ?java_outer_classname:string -> ?optimize_for:OptimizeMode.t -> ?java_multiple_files:bool -> ?go_package:string -> ?cc_generic_services:bool -> ?java_generic_services:bool -> ?py_generic_services:bool -> ?java_generate_equals_and_hash:bool -> ?deprecated:bool -> ?java_string_check_utf8:bool -> ?cc_enable_arenas:bool -> ?objc_class_prefix:string -> ?csharp_namespace:string -> ?swift_prefix:string -> ?php_class_prefix:string -> ?php_namespace:string -> ?php_generic_services:bool -> ?php_metadata_namespace:string -> ?ruby_package:string -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result @@ -448,7 +448,7 @@ end = struct end and MessageOptions : sig val name': unit -> string - type t = { message_set_wire_format: bool; no_standard_descriptor_accessor: bool; deprecated: bool; map_entry: bool option; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { extensions': Runtime'.Extensions.t; message_set_wire_format: bool; no_standard_descriptor_accessor: bool; deprecated: bool; map_entry: bool option; uninterpreted_option: UninterpretedOption.t list } val make : ?message_set_wire_format:bool -> ?no_standard_descriptor_accessor:bool -> ?deprecated:bool -> ?map_entry:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t @@ -469,8 +469,8 @@ end = struct val from_int_exn: int -> t end val name': unit -> string - type t = { ctype: CType.t; packed: bool option; jstype: JSType.t; lazy': bool; unverified_lazy: bool; deprecated: bool; weak: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } - val make : ?ctype:CType.t -> ?packed:bool -> ?jstype:JSType.t -> ?lazy':bool -> ?unverified_lazy:bool -> ?deprecated:bool -> ?weak:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + type t = { extensions': Runtime'.Extensions.t; ctype: CType.t; packed: bool option; deprecated: bool; lazy': bool; jstype: JSType.t; weak: bool; unverified_lazy: bool; uninterpreted_option: UninterpretedOption.t list } + val make : ?ctype:CType.t -> ?packed:bool -> ?deprecated:bool -> ?lazy':bool -> ?jstype:JSType.t -> ?weak:bool -> ?unverified_lazy:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result @@ -478,7 +478,7 @@ end = struct end and OneofOptions : sig val name': unit -> string - type t = { uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { extensions': Runtime'.Extensions.t; uninterpreted_option: UninterpretedOption.t list } val make : ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t @@ -487,7 +487,7 @@ end = struct end and EnumOptions : sig val name': unit -> string - type t = { allow_alias: bool option; deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { extensions': Runtime'.Extensions.t; allow_alias: bool option; deprecated: bool; uninterpreted_option: UninterpretedOption.t list } val make : ?allow_alias:bool -> ?deprecated:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t @@ -496,7 +496,7 @@ end = struct end and EnumValueOptions : sig val name': unit -> string - type t = { deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { extensions': Runtime'.Extensions.t; deprecated: bool; uninterpreted_option: UninterpretedOption.t list } val make : ?deprecated:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t @@ -505,7 +505,7 @@ end = struct end and ServiceOptions : sig val name': unit -> string - type t = { deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { extensions': Runtime'.Extensions.t; deprecated: bool; uninterpreted_option: UninterpretedOption.t list } val make : ?deprecated:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t @@ -520,7 +520,7 @@ end = struct val from_int_exn: int -> t end val name': unit -> string - type t = { deprecated: bool; idempotency_level: IdempotencyLevel.t; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { extensions': Runtime'.Extensions.t; deprecated: bool; idempotency_level: IdempotencyLevel.t; uninterpreted_option: UninterpretedOption.t list } val make : ?deprecated:bool -> ?idempotency_level:IdempotencyLevel.t -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t @@ -607,7 +607,7 @@ end = struct let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = - let constructor = fun _extensions file -> file in + let constructor = fun file _extensions -> file in let spec = Runtime'.Deserialize.C.( repeated (1, (message (fun t -> FileDescriptorProto.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer @@ -616,37 +616,37 @@ end = struct end and FileDescriptorProto : sig val name': unit -> string - type t = { name: string option; package: string option; dependency: string list; public_dependency: int list; weak_dependency: int list; message_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; service: ServiceDescriptorProto.t list; extension: FieldDescriptorProto.t list; options: FileOptions.t option; source_code_info: SourceCodeInfo.t option; syntax: string option } - val make : ?name:string -> ?package:string -> ?dependency:string list -> ?public_dependency:int list -> ?weak_dependency:int list -> ?message_type:DescriptorProto.t list -> ?enum_type:EnumDescriptorProto.t list -> ?service:ServiceDescriptorProto.t list -> ?extension:FieldDescriptorProto.t list -> ?options:FileOptions.t -> ?source_code_info:SourceCodeInfo.t -> ?syntax:string -> unit -> t + type t = { name: string option; package: string option; dependency: string list; message_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; service: ServiceDescriptorProto.t list; extension: FieldDescriptorProto.t list; options: FileOptions.t option; source_code_info: SourceCodeInfo.t option; public_dependency: int list; weak_dependency: int list; syntax: string option } + val make : ?name:string -> ?package:string -> ?dependency:string list -> ?message_type:DescriptorProto.t list -> ?enum_type:EnumDescriptorProto.t list -> ?service:ServiceDescriptorProto.t list -> ?extension:FieldDescriptorProto.t list -> ?options:FileOptions.t -> ?source_code_info:SourceCodeInfo.t -> ?public_dependency:int list -> ?weak_dependency:int list -> ?syntax:string -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t end = struct let name' () = "descriptor.google.protobuf.FileDescriptorProto" - type t = { name: string option; package: string option; dependency: string list; public_dependency: int list; weak_dependency: int list; message_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; service: ServiceDescriptorProto.t list; extension: FieldDescriptorProto.t list; options: FileOptions.t option; source_code_info: SourceCodeInfo.t option; syntax: string option } + type t = { name: string option; package: string option; dependency: string list; message_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; service: ServiceDescriptorProto.t list; extension: FieldDescriptorProto.t list; options: FileOptions.t option; source_code_info: SourceCodeInfo.t option; public_dependency: int list; weak_dependency: int list; syntax: string option } let make = - fun ?name ?package ?dependency ?public_dependency ?weak_dependency ?message_type ?enum_type ?service ?extension ?options ?source_code_info ?syntax () -> + fun ?name ?package ?dependency ?message_type ?enum_type ?service ?extension ?options ?source_code_info ?public_dependency ?weak_dependency ?syntax () -> let dependency = match dependency with Some v -> v | None -> [] in - let public_dependency = match public_dependency with Some v -> v | None -> [] in - let weak_dependency = match weak_dependency with Some v -> v | None -> [] in let message_type = match message_type with Some v -> v | None -> [] in let enum_type = match enum_type with Some v -> v | None -> [] in let service = match service with Some v -> v | None -> [] in let extension = match extension with Some v -> v | None -> [] in - { name; package; dependency; public_dependency; weak_dependency; message_type; enum_type; service; extension; options; source_code_info; syntax } + let public_dependency = match public_dependency with Some v -> v | None -> [] in + let weak_dependency = match weak_dependency with Some v -> v | None -> [] in + { name; package; dependency; message_type; enum_type; service; extension; options; source_code_info; public_dependency; weak_dependency; syntax } let to_proto' = - let apply = fun ~f:f' writer { name; package; dependency; public_dependency; weak_dependency; message_type; enum_type; service; extension; options; source_code_info; syntax } -> f' [] writer name package dependency public_dependency weak_dependency message_type enum_type service extension options source_code_info syntax in - let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (2, string) ^:: repeated (3, string, not_packed) ^:: repeated (10, int32_int, not_packed) ^:: repeated (11, int32_int, not_packed) ^:: repeated (4, (message (fun t -> DescriptorProto.to_proto' t)), not_packed) ^:: repeated (5, (message (fun t -> EnumDescriptorProto.to_proto' t)), not_packed) ^:: repeated (6, (message (fun t -> ServiceDescriptorProto.to_proto' t)), not_packed) ^:: repeated (7, (message (fun t -> FieldDescriptorProto.to_proto' t)), not_packed) ^:: basic_opt (8, (message (fun t -> FileOptions.to_proto' t))) ^:: basic_opt (9, (message (fun t -> SourceCodeInfo.to_proto' t))) ^:: basic_opt (12, string) ^:: nil ) in + let apply = fun ~f:f' writer { name; package; dependency; message_type; enum_type; service; extension; options; source_code_info; public_dependency; weak_dependency; syntax } -> f' [] writer name package dependency message_type enum_type service extension options source_code_info public_dependency weak_dependency syntax in + let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (2, string) ^:: repeated (3, string, not_packed) ^:: repeated (4, (message (fun t -> DescriptorProto.to_proto' t)), not_packed) ^:: repeated (5, (message (fun t -> EnumDescriptorProto.to_proto' t)), not_packed) ^:: repeated (6, (message (fun t -> ServiceDescriptorProto.to_proto' t)), not_packed) ^:: repeated (7, (message (fun t -> FieldDescriptorProto.to_proto' t)), not_packed) ^:: basic_opt (8, (message (fun t -> FileOptions.to_proto' t))) ^:: basic_opt (9, (message (fun t -> SourceCodeInfo.to_proto' t))) ^:: repeated (10, int32_int, not_packed) ^:: repeated (11, int32_int, not_packed) ^:: basic_opt (12, string) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] spec in fun writer t -> apply ~f:serialize writer t let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = - let constructor = fun _extensions name package dependency public_dependency weak_dependency message_type enum_type service extension options source_code_info syntax -> { name; package; dependency; public_dependency; weak_dependency; message_type; enum_type; service; extension; options; source_code_info; syntax } in - let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (2, string) ^:: repeated (3, string, not_packed) ^:: repeated (10, int32_int, not_packed) ^:: repeated (11, int32_int, not_packed) ^:: repeated (4, (message (fun t -> DescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (5, (message (fun t -> EnumDescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (6, (message (fun t -> ServiceDescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (7, (message (fun t -> FieldDescriptorProto.from_proto_exn t)), not_packed) ^:: basic_opt (8, (message (fun t -> FileOptions.from_proto_exn t))) ^:: basic_opt (9, (message (fun t -> SourceCodeInfo.from_proto_exn t))) ^:: basic_opt (12, string) ^:: nil ) in + let constructor = fun name package dependency message_type enum_type service extension options source_code_info public_dependency weak_dependency syntax _extensions -> { name; package; dependency; message_type; enum_type; service; extension; options; source_code_info; public_dependency; weak_dependency; syntax } in + let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (2, string) ^:: repeated (3, string, not_packed) ^:: repeated (4, (message (fun t -> DescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (5, (message (fun t -> EnumDescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (6, (message (fun t -> ServiceDescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (7, (message (fun t -> FieldDescriptorProto.from_proto_exn t)), not_packed) ^:: basic_opt (8, (message (fun t -> FileOptions.from_proto_exn t))) ^:: basic_opt (9, (message (fun t -> SourceCodeInfo.from_proto_exn t))) ^:: repeated (10, int32_int, not_packed) ^:: repeated (11, int32_int, not_packed) ^:: basic_opt (12, string) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) @@ -672,8 +672,8 @@ end = struct val from_proto_exn: Runtime'.Reader.t -> t end val name': unit -> string - type t = { name: string option; field: FieldDescriptorProto.t list; extension: FieldDescriptorProto.t list; nested_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; extension_range: ExtensionRange.t list; oneof_decl: OneofDescriptorProto.t list; options: MessageOptions.t option; reserved_range: ReservedRange.t list; reserved_name: string list } - val make : ?name:string -> ?field:FieldDescriptorProto.t list -> ?extension:FieldDescriptorProto.t list -> ?nested_type:DescriptorProto.t list -> ?enum_type:EnumDescriptorProto.t list -> ?extension_range:ExtensionRange.t list -> ?oneof_decl:OneofDescriptorProto.t list -> ?options:MessageOptions.t -> ?reserved_range:ReservedRange.t list -> ?reserved_name:string list -> unit -> t + type t = { name: string option; field: FieldDescriptorProto.t list; nested_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; extension_range: ExtensionRange.t list; extension: FieldDescriptorProto.t list; options: MessageOptions.t option; oneof_decl: OneofDescriptorProto.t list; reserved_range: ReservedRange.t list; reserved_name: string list } + val make : ?name:string -> ?field:FieldDescriptorProto.t list -> ?nested_type:DescriptorProto.t list -> ?enum_type:EnumDescriptorProto.t list -> ?extension_range:ExtensionRange.t list -> ?extension:FieldDescriptorProto.t list -> ?options:MessageOptions.t -> ?oneof_decl:OneofDescriptorProto.t list -> ?reserved_range:ReservedRange.t list -> ?reserved_name:string list -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result @@ -704,7 +704,7 @@ end = struct let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = - let constructor = fun _extensions start end' options -> { start; end'; options } in + let constructor = fun start end' options _extensions -> { start; end'; options } in let spec = Runtime'.Deserialize.C.( basic_opt (1, int32_int) ^:: basic_opt (2, int32_int) ^:: basic_opt (3, (message (fun t -> ExtensionRangeOptions.from_proto_exn t))) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer @@ -736,7 +736,7 @@ end = struct let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = - let constructor = fun _extensions start end' -> { start; end' } in + let constructor = fun start end' _extensions -> { start; end' } in let spec = Runtime'.Deserialize.C.( basic_opt (1, int32_int) ^:: basic_opt (2, int32_int) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer @@ -744,30 +744,30 @@ end = struct end let name' () = "descriptor.google.protobuf.DescriptorProto" - type t = { name: string option; field: FieldDescriptorProto.t list; extension: FieldDescriptorProto.t list; nested_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; extension_range: ExtensionRange.t list; oneof_decl: OneofDescriptorProto.t list; options: MessageOptions.t option; reserved_range: ReservedRange.t list; reserved_name: string list } + type t = { name: string option; field: FieldDescriptorProto.t list; nested_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; extension_range: ExtensionRange.t list; extension: FieldDescriptorProto.t list; options: MessageOptions.t option; oneof_decl: OneofDescriptorProto.t list; reserved_range: ReservedRange.t list; reserved_name: string list } let make = - fun ?name ?field ?extension ?nested_type ?enum_type ?extension_range ?oneof_decl ?options ?reserved_range ?reserved_name () -> + fun ?name ?field ?nested_type ?enum_type ?extension_range ?extension ?options ?oneof_decl ?reserved_range ?reserved_name () -> let field = match field with Some v -> v | None -> [] in - let extension = match extension with Some v -> v | None -> [] in let nested_type = match nested_type with Some v -> v | None -> [] in let enum_type = match enum_type with Some v -> v | None -> [] in let extension_range = match extension_range with Some v -> v | None -> [] in + let extension = match extension with Some v -> v | None -> [] in let oneof_decl = match oneof_decl with Some v -> v | None -> [] in let reserved_range = match reserved_range with Some v -> v | None -> [] in let reserved_name = match reserved_name with Some v -> v | None -> [] in - { name; field; extension; nested_type; enum_type; extension_range; oneof_decl; options; reserved_range; reserved_name } + { name; field; nested_type; enum_type; extension_range; extension; options; oneof_decl; reserved_range; reserved_name } let to_proto' = - let apply = fun ~f:f' writer { name; field; extension; nested_type; enum_type; extension_range; oneof_decl; options; reserved_range; reserved_name } -> f' [] writer name field extension nested_type enum_type extension_range oneof_decl options reserved_range reserved_name in - let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> FieldDescriptorProto.to_proto' t)), not_packed) ^:: repeated (6, (message (fun t -> FieldDescriptorProto.to_proto' t)), not_packed) ^:: repeated (3, (message (fun t -> DescriptorProto.to_proto' t)), not_packed) ^:: repeated (4, (message (fun t -> EnumDescriptorProto.to_proto' t)), not_packed) ^:: repeated (5, (message (fun t -> ExtensionRange.to_proto' t)), not_packed) ^:: repeated (8, (message (fun t -> OneofDescriptorProto.to_proto' t)), not_packed) ^:: basic_opt (7, (message (fun t -> MessageOptions.to_proto' t))) ^:: repeated (9, (message (fun t -> ReservedRange.to_proto' t)), not_packed) ^:: repeated (10, string, not_packed) ^:: nil ) in + let apply = fun ~f:f' writer { name; field; nested_type; enum_type; extension_range; extension; options; oneof_decl; reserved_range; reserved_name } -> f' [] writer name field nested_type enum_type extension_range extension options oneof_decl reserved_range reserved_name in + let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> FieldDescriptorProto.to_proto' t)), not_packed) ^:: repeated (3, (message (fun t -> DescriptorProto.to_proto' t)), not_packed) ^:: repeated (4, (message (fun t -> EnumDescriptorProto.to_proto' t)), not_packed) ^:: repeated (5, (message (fun t -> ExtensionRange.to_proto' t)), not_packed) ^:: repeated (6, (message (fun t -> FieldDescriptorProto.to_proto' t)), not_packed) ^:: basic_opt (7, (message (fun t -> MessageOptions.to_proto' t))) ^:: repeated (8, (message (fun t -> OneofDescriptorProto.to_proto' t)), not_packed) ^:: repeated (9, (message (fun t -> ReservedRange.to_proto' t)), not_packed) ^:: repeated (10, string, not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] spec in fun writer t -> apply ~f:serialize writer t let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = - let constructor = fun _extensions name field extension nested_type enum_type extension_range oneof_decl options reserved_range reserved_name -> { name; field; extension; nested_type; enum_type; extension_range; oneof_decl; options; reserved_range; reserved_name } in - let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> FieldDescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (6, (message (fun t -> FieldDescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (3, (message (fun t -> DescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (4, (message (fun t -> EnumDescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (5, (message (fun t -> ExtensionRange.from_proto_exn t)), not_packed) ^:: repeated (8, (message (fun t -> OneofDescriptorProto.from_proto_exn t)), not_packed) ^:: basic_opt (7, (message (fun t -> MessageOptions.from_proto_exn t))) ^:: repeated (9, (message (fun t -> ReservedRange.from_proto_exn t)), not_packed) ^:: repeated (10, string, not_packed) ^:: nil ) in + let constructor = fun name field nested_type enum_type extension_range extension options oneof_decl reserved_range reserved_name _extensions -> { name; field; nested_type; enum_type; extension_range; extension; options; oneof_decl; reserved_range; reserved_name } in + let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> FieldDescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (3, (message (fun t -> DescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (4, (message (fun t -> EnumDescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (5, (message (fun t -> ExtensionRange.from_proto_exn t)), not_packed) ^:: repeated (6, (message (fun t -> FieldDescriptorProto.from_proto_exn t)), not_packed) ^:: basic_opt (7, (message (fun t -> MessageOptions.from_proto_exn t))) ^:: repeated (8, (message (fun t -> OneofDescriptorProto.from_proto_exn t)), not_packed) ^:: repeated (9, (message (fun t -> ReservedRange.from_proto_exn t)), not_packed) ^:: repeated (10, string, not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) @@ -775,7 +775,7 @@ end = struct end and ExtensionRangeOptions : sig val name': unit -> string - type t = { uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { extensions': Runtime'.Extensions.t; uninterpreted_option: UninterpretedOption.t list } val make : ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t @@ -783,7 +783,7 @@ end = struct val from_proto_exn: Runtime'.Reader.t -> t end = struct let name' () = "descriptor.google.protobuf.ExtensionRangeOptions" - type t = { uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { extensions': Runtime'.Extensions.t; uninterpreted_option: UninterpretedOption.t list } let make = fun ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> let uninterpreted_option = match uninterpreted_option with Some v -> v | None -> [] in @@ -798,7 +798,7 @@ end = struct let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = - let constructor = fun extensions' uninterpreted_option -> { uninterpreted_option; extensions' } in + let constructor = fun uninterpreted_option extensions' -> { uninterpreted_option; extensions' } in let spec = Runtime'.Deserialize.C.( repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in fun writer -> deserialize writer @@ -819,8 +819,8 @@ end = struct val from_int_exn: int -> t end val name': unit -> string - type t = { name: string option; number: int option; label: Label.t option; type': Type.t option; type_name: string option; extendee: string option; default_value: string option; oneof_index: int option; json_name: string option; options: FieldOptions.t option; proto3_optional: bool option } - val make : ?name:string -> ?number:int -> ?label:Label.t -> ?type':Type.t -> ?type_name:string -> ?extendee:string -> ?default_value:string -> ?oneof_index:int -> ?json_name:string -> ?options:FieldOptions.t -> ?proto3_optional:bool -> unit -> t + type t = { name: string option; extendee: string option; number: int option; label: Label.t option; type': Type.t option; type_name: string option; default_value: string option; options: FieldOptions.t option; oneof_index: int option; json_name: string option; proto3_optional: bool option } + val make : ?name:string -> ?extendee:string -> ?number:int -> ?label:Label.t -> ?type':Type.t -> ?type_name:string -> ?default_value:string -> ?options:FieldOptions.t -> ?oneof_index:int -> ?json_name:string -> ?proto3_optional:bool -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result @@ -897,23 +897,23 @@ end = struct let from_int e = Runtime'.Result.catch (fun () -> from_int_exn e) end let name' () = "descriptor.google.protobuf.FieldDescriptorProto" - type t = { name: string option; number: int option; label: Label.t option; type': Type.t option; type_name: string option; extendee: string option; default_value: string option; oneof_index: int option; json_name: string option; options: FieldOptions.t option; proto3_optional: bool option } + type t = { name: string option; extendee: string option; number: int option; label: Label.t option; type': Type.t option; type_name: string option; default_value: string option; options: FieldOptions.t option; oneof_index: int option; json_name: string option; proto3_optional: bool option } let make = - fun ?name ?number ?label ?type' ?type_name ?extendee ?default_value ?oneof_index ?json_name ?options ?proto3_optional () -> + fun ?name ?extendee ?number ?label ?type' ?type_name ?default_value ?options ?oneof_index ?json_name ?proto3_optional () -> - { name; number; label; type'; type_name; extendee; default_value; oneof_index; json_name; options; proto3_optional } + { name; extendee; number; label; type'; type_name; default_value; options; oneof_index; json_name; proto3_optional } let to_proto' = - let apply = fun ~f:f' writer { name; number; label; type'; type_name; extendee; default_value; oneof_index; json_name; options; proto3_optional } -> f' [] writer name number label type' type_name extendee default_value oneof_index json_name options proto3_optional in - let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (3, int32_int) ^:: basic_opt (4, (enum Label.to_int)) ^:: basic_opt (5, (enum Type.to_int)) ^:: basic_opt (6, string) ^:: basic_opt (2, string) ^:: basic_opt (7, string) ^:: basic_opt (9, int32_int) ^:: basic_opt (10, string) ^:: basic_opt (8, (message (fun t -> FieldOptions.to_proto' t))) ^:: basic_opt (17, bool) ^:: nil ) in + let apply = fun ~f:f' writer { name; extendee; number; label; type'; type_name; default_value; options; oneof_index; json_name; proto3_optional } -> f' [] writer name extendee number label type' type_name default_value options oneof_index json_name proto3_optional in + let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (2, string) ^:: basic_opt (3, int32_int) ^:: basic_opt (4, (enum Label.to_int)) ^:: basic_opt (5, (enum Type.to_int)) ^:: basic_opt (6, string) ^:: basic_opt (7, string) ^:: basic_opt (8, (message (fun t -> FieldOptions.to_proto' t))) ^:: basic_opt (9, int32_int) ^:: basic_opt (10, string) ^:: basic_opt (17, bool) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] spec in fun writer t -> apply ~f:serialize writer t let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = - let constructor = fun _extensions name number label type' type_name extendee default_value oneof_index json_name options proto3_optional -> { name; number; label; type'; type_name; extendee; default_value; oneof_index; json_name; options; proto3_optional } in - let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (3, int32_int) ^:: basic_opt (4, (enum Label.from_int_exn)) ^:: basic_opt (5, (enum Type.from_int_exn)) ^:: basic_opt (6, string) ^:: basic_opt (2, string) ^:: basic_opt (7, string) ^:: basic_opt (9, int32_int) ^:: basic_opt (10, string) ^:: basic_opt (8, (message (fun t -> FieldOptions.from_proto_exn t))) ^:: basic_opt (17, bool) ^:: nil ) in + let constructor = fun name extendee number label type' type_name default_value options oneof_index json_name proto3_optional _extensions -> { name; extendee; number; label; type'; type_name; default_value; options; oneof_index; json_name; proto3_optional } in + let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (2, string) ^:: basic_opt (3, int32_int) ^:: basic_opt (4, (enum Label.from_int_exn)) ^:: basic_opt (5, (enum Type.from_int_exn)) ^:: basic_opt (6, string) ^:: basic_opt (7, string) ^:: basic_opt (8, (message (fun t -> FieldOptions.from_proto_exn t))) ^:: basic_opt (9, int32_int) ^:: basic_opt (10, string) ^:: basic_opt (17, bool) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) @@ -944,7 +944,7 @@ end = struct let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = - let constructor = fun _extensions name options -> { name; options } in + let constructor = fun name options _extensions -> { name; options } in let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (2, (message (fun t -> OneofOptions.from_proto_exn t))) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer @@ -994,7 +994,7 @@ end = struct let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = - let constructor = fun _extensions start end' -> { start; end' } in + let constructor = fun start end' _extensions -> { start; end' } in let spec = Runtime'.Deserialize.C.( basic_opt (1, int32_int) ^:: basic_opt (2, int32_int) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer @@ -1019,7 +1019,7 @@ end = struct let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = - let constructor = fun _extensions name value options reserved_range reserved_name -> { name; value; options; reserved_range; reserved_name } in + let constructor = fun name value options reserved_range reserved_name _extensions -> { name; value; options; reserved_range; reserved_name } in let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> EnumValueDescriptorProto.from_proto_exn t)), not_packed) ^:: basic_opt (3, (message (fun t -> EnumOptions.from_proto_exn t))) ^:: repeated (4, (message (fun t -> EnumReservedRange.from_proto_exn t)), not_packed) ^:: repeated (5, string, not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer @@ -1051,7 +1051,7 @@ end = struct let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = - let constructor = fun _extensions name number options -> { name; number; options } in + let constructor = fun name number options _extensions -> { name; number; options } in let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (2, int32_int) ^:: basic_opt (3, (message (fun t -> EnumValueOptions.from_proto_exn t))) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer @@ -1083,7 +1083,7 @@ end = struct let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = - let constructor = fun _extensions name method' options -> { name; method'; options } in + let constructor = fun name method' options _extensions -> { name; method'; options } in let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> MethodDescriptorProto.from_proto_exn t)), not_packed) ^:: basic_opt (3, (message (fun t -> ServiceOptions.from_proto_exn t))) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer @@ -1116,7 +1116,7 @@ end = struct let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = - let constructor = fun _extensions name input_type output_type options client_streaming server_streaming -> { name; input_type; output_type; options; client_streaming; server_streaming } in + let constructor = fun name input_type output_type options client_streaming server_streaming _extensions -> { name; input_type; output_type; options; client_streaming; server_streaming } in let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (2, string) ^:: basic_opt (3, string) ^:: basic_opt (4, (message (fun t -> MethodOptions.from_proto_exn t))) ^:: basic (5, bool, Some (false)) ^:: basic (6, bool, Some (false)) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer @@ -1131,8 +1131,8 @@ end = struct val from_int_exn: int -> t end val name': unit -> string - type t = { java_package: string option; java_outer_classname: string option; java_multiple_files: bool; java_generate_equals_and_hash: bool option; java_string_check_utf8: bool; optimize_for: OptimizeMode.t; go_package: string option; cc_generic_services: bool; java_generic_services: bool; py_generic_services: bool; php_generic_services: bool; deprecated: bool; cc_enable_arenas: bool; objc_class_prefix: string option; csharp_namespace: string option; swift_prefix: string option; php_class_prefix: string option; php_namespace: string option; php_metadata_namespace: string option; ruby_package: string option; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } - val make : ?java_package:string -> ?java_outer_classname:string -> ?java_multiple_files:bool -> ?java_generate_equals_and_hash:bool -> ?java_string_check_utf8:bool -> ?optimize_for:OptimizeMode.t -> ?go_package:string -> ?cc_generic_services:bool -> ?java_generic_services:bool -> ?py_generic_services:bool -> ?php_generic_services:bool -> ?deprecated:bool -> ?cc_enable_arenas:bool -> ?objc_class_prefix:string -> ?csharp_namespace:string -> ?swift_prefix:string -> ?php_class_prefix:string -> ?php_namespace:string -> ?php_metadata_namespace:string -> ?ruby_package:string -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + type t = { extensions': Runtime'.Extensions.t; java_package: string option; java_outer_classname: string option; optimize_for: OptimizeMode.t; java_multiple_files: bool; go_package: string option; cc_generic_services: bool; java_generic_services: bool; py_generic_services: bool; java_generate_equals_and_hash: bool option; deprecated: bool; java_string_check_utf8: bool; cc_enable_arenas: bool; objc_class_prefix: string option; csharp_namespace: string option; swift_prefix: string option; php_class_prefix: string option; php_namespace: string option; php_generic_services: bool; php_metadata_namespace: string option; ruby_package: string option; uninterpreted_option: UninterpretedOption.t list } + val make : ?java_package:string -> ?java_outer_classname:string -> ?optimize_for:OptimizeMode.t -> ?java_multiple_files:bool -> ?go_package:string -> ?cc_generic_services:bool -> ?java_generic_services:bool -> ?py_generic_services:bool -> ?java_generate_equals_and_hash:bool -> ?deprecated:bool -> ?java_string_check_utf8:bool -> ?cc_enable_arenas:bool -> ?objc_class_prefix:string -> ?csharp_namespace:string -> ?swift_prefix:string -> ?php_class_prefix:string -> ?php_namespace:string -> ?php_generic_services:bool -> ?php_metadata_namespace:string -> ?ruby_package:string -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result @@ -1159,32 +1159,32 @@ end = struct let from_int e = Runtime'.Result.catch (fun () -> from_int_exn e) end let name' () = "descriptor.google.protobuf.FileOptions" - type t = { java_package: string option; java_outer_classname: string option; java_multiple_files: bool; java_generate_equals_and_hash: bool option; java_string_check_utf8: bool; optimize_for: OptimizeMode.t; go_package: string option; cc_generic_services: bool; java_generic_services: bool; py_generic_services: bool; php_generic_services: bool; deprecated: bool; cc_enable_arenas: bool; objc_class_prefix: string option; csharp_namespace: string option; swift_prefix: string option; php_class_prefix: string option; php_namespace: string option; php_metadata_namespace: string option; ruby_package: string option; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { extensions': Runtime'.Extensions.t; java_package: string option; java_outer_classname: string option; optimize_for: OptimizeMode.t; java_multiple_files: bool; go_package: string option; cc_generic_services: bool; java_generic_services: bool; py_generic_services: bool; java_generate_equals_and_hash: bool option; deprecated: bool; java_string_check_utf8: bool; cc_enable_arenas: bool; objc_class_prefix: string option; csharp_namespace: string option; swift_prefix: string option; php_class_prefix: string option; php_namespace: string option; php_generic_services: bool; php_metadata_namespace: string option; ruby_package: string option; uninterpreted_option: UninterpretedOption.t list } let make = - fun ?java_package ?java_outer_classname ?java_multiple_files ?java_generate_equals_and_hash ?java_string_check_utf8 ?optimize_for ?go_package ?cc_generic_services ?java_generic_services ?py_generic_services ?php_generic_services ?deprecated ?cc_enable_arenas ?objc_class_prefix ?csharp_namespace ?swift_prefix ?php_class_prefix ?php_namespace ?php_metadata_namespace ?ruby_package ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> - let java_multiple_files = match java_multiple_files with Some v -> v | None -> false in - let java_string_check_utf8 = match java_string_check_utf8 with Some v -> v | None -> false in + fun ?java_package ?java_outer_classname ?optimize_for ?java_multiple_files ?go_package ?cc_generic_services ?java_generic_services ?py_generic_services ?java_generate_equals_and_hash ?deprecated ?java_string_check_utf8 ?cc_enable_arenas ?objc_class_prefix ?csharp_namespace ?swift_prefix ?php_class_prefix ?php_namespace ?php_generic_services ?php_metadata_namespace ?ruby_package ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> let optimize_for = match optimize_for with Some v -> v | None -> OptimizeMode.SPEED in + let java_multiple_files = match java_multiple_files with Some v -> v | None -> false in let cc_generic_services = match cc_generic_services with Some v -> v | None -> false in let java_generic_services = match java_generic_services with Some v -> v | None -> false in let py_generic_services = match py_generic_services with Some v -> v | None -> false in - let php_generic_services = match php_generic_services with Some v -> v | None -> false in let deprecated = match deprecated with Some v -> v | None -> false in + let java_string_check_utf8 = match java_string_check_utf8 with Some v -> v | None -> false in let cc_enable_arenas = match cc_enable_arenas with Some v -> v | None -> true in + let php_generic_services = match php_generic_services with Some v -> v | None -> false in let uninterpreted_option = match uninterpreted_option with Some v -> v | None -> [] in - { java_package; java_outer_classname; java_multiple_files; java_generate_equals_and_hash; java_string_check_utf8; optimize_for; go_package; cc_generic_services; java_generic_services; py_generic_services; php_generic_services; deprecated; cc_enable_arenas; objc_class_prefix; csharp_namespace; swift_prefix; php_class_prefix; php_namespace; php_metadata_namespace; ruby_package; uninterpreted_option; extensions' } + { java_package; java_outer_classname; optimize_for; java_multiple_files; go_package; cc_generic_services; java_generic_services; py_generic_services; java_generate_equals_and_hash; deprecated; java_string_check_utf8; cc_enable_arenas; objc_class_prefix; csharp_namespace; swift_prefix; php_class_prefix; php_namespace; php_generic_services; php_metadata_namespace; ruby_package; uninterpreted_option; extensions' } let to_proto' = - let apply = fun ~f:f' writer { java_package; java_outer_classname; java_multiple_files; java_generate_equals_and_hash; java_string_check_utf8; optimize_for; go_package; cc_generic_services; java_generic_services; py_generic_services; php_generic_services; deprecated; cc_enable_arenas; objc_class_prefix; csharp_namespace; swift_prefix; php_class_prefix; php_namespace; php_metadata_namespace; ruby_package; uninterpreted_option; extensions' } -> f' extensions' writer java_package java_outer_classname java_multiple_files java_generate_equals_and_hash java_string_check_utf8 optimize_for go_package cc_generic_services java_generic_services py_generic_services php_generic_services deprecated cc_enable_arenas objc_class_prefix csharp_namespace swift_prefix php_class_prefix php_namespace php_metadata_namespace ruby_package uninterpreted_option in - let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (8, string) ^:: basic (10, bool, Some (false)) ^:: basic_opt (20, bool) ^:: basic (27, bool, Some (false)) ^:: basic (9, (enum OptimizeMode.to_int), Some (OptimizeMode.SPEED)) ^:: basic_opt (11, string) ^:: basic (16, bool, Some (false)) ^:: basic (17, bool, Some (false)) ^:: basic (18, bool, Some (false)) ^:: basic (42, bool, Some (false)) ^:: basic (23, bool, Some (false)) ^:: basic (31, bool, Some (true)) ^:: basic_opt (36, string) ^:: basic_opt (37, string) ^:: basic_opt (39, string) ^:: basic_opt (40, string) ^:: basic_opt (41, string) ^:: basic_opt (44, string) ^:: basic_opt (45, string) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in + let apply = fun ~f:f' writer { java_package; java_outer_classname; optimize_for; java_multiple_files; go_package; cc_generic_services; java_generic_services; py_generic_services; java_generate_equals_and_hash; deprecated; java_string_check_utf8; cc_enable_arenas; objc_class_prefix; csharp_namespace; swift_prefix; php_class_prefix; php_namespace; php_generic_services; php_metadata_namespace; ruby_package; uninterpreted_option; extensions' } -> f' extensions' writer java_package java_outer_classname optimize_for java_multiple_files go_package cc_generic_services java_generic_services py_generic_services java_generate_equals_and_hash deprecated java_string_check_utf8 cc_enable_arenas objc_class_prefix csharp_namespace swift_prefix php_class_prefix php_namespace php_generic_services php_metadata_namespace ruby_package uninterpreted_option in + let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (8, string) ^:: basic (9, (enum OptimizeMode.to_int), Some (OptimizeMode.SPEED)) ^:: basic (10, bool, Some (false)) ^:: basic_opt (11, string) ^:: basic (16, bool, Some (false)) ^:: basic (17, bool, Some (false)) ^:: basic (18, bool, Some (false)) ^:: basic_opt (20, bool) ^:: basic (23, bool, Some (false)) ^:: basic (27, bool, Some (false)) ^:: basic (31, bool, Some (true)) ^:: basic_opt (36, string) ^:: basic_opt (37, string) ^:: basic_opt (39, string) ^:: basic_opt (40, string) ^:: basic_opt (41, string) ^:: basic (42, bool, Some (false)) ^:: basic_opt (44, string) ^:: basic_opt (45, string) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] spec in fun writer t -> apply ~f:serialize writer t let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = - let constructor = fun extensions' java_package java_outer_classname java_multiple_files java_generate_equals_and_hash java_string_check_utf8 optimize_for go_package cc_generic_services java_generic_services py_generic_services php_generic_services deprecated cc_enable_arenas objc_class_prefix csharp_namespace swift_prefix php_class_prefix php_namespace php_metadata_namespace ruby_package uninterpreted_option -> { java_package; java_outer_classname; java_multiple_files; java_generate_equals_and_hash; java_string_check_utf8; optimize_for; go_package; cc_generic_services; java_generic_services; py_generic_services; php_generic_services; deprecated; cc_enable_arenas; objc_class_prefix; csharp_namespace; swift_prefix; php_class_prefix; php_namespace; php_metadata_namespace; ruby_package; uninterpreted_option; extensions' } in - let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (8, string) ^:: basic (10, bool, Some (false)) ^:: basic_opt (20, bool) ^:: basic (27, bool, Some (false)) ^:: basic (9, (enum OptimizeMode.from_int_exn), Some (OptimizeMode.SPEED)) ^:: basic_opt (11, string) ^:: basic (16, bool, Some (false)) ^:: basic (17, bool, Some (false)) ^:: basic (18, bool, Some (false)) ^:: basic (42, bool, Some (false)) ^:: basic (23, bool, Some (false)) ^:: basic (31, bool, Some (true)) ^:: basic_opt (36, string) ^:: basic_opt (37, string) ^:: basic_opt (39, string) ^:: basic_opt (40, string) ^:: basic_opt (41, string) ^:: basic_opt (44, string) ^:: basic_opt (45, string) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in + let constructor = fun java_package java_outer_classname optimize_for java_multiple_files go_package cc_generic_services java_generic_services py_generic_services java_generate_equals_and_hash deprecated java_string_check_utf8 cc_enable_arenas objc_class_prefix csharp_namespace swift_prefix php_class_prefix php_namespace php_generic_services php_metadata_namespace ruby_package uninterpreted_option extensions' -> { java_package; java_outer_classname; optimize_for; java_multiple_files; go_package; cc_generic_services; java_generic_services; py_generic_services; java_generate_equals_and_hash; deprecated; java_string_check_utf8; cc_enable_arenas; objc_class_prefix; csharp_namespace; swift_prefix; php_class_prefix; php_namespace; php_generic_services; php_metadata_namespace; ruby_package; uninterpreted_option; extensions' } in + let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (8, string) ^:: basic (9, (enum OptimizeMode.from_int_exn), Some (OptimizeMode.SPEED)) ^:: basic (10, bool, Some (false)) ^:: basic_opt (11, string) ^:: basic (16, bool, Some (false)) ^:: basic (17, bool, Some (false)) ^:: basic (18, bool, Some (false)) ^:: basic_opt (20, bool) ^:: basic (23, bool, Some (false)) ^:: basic (27, bool, Some (false)) ^:: basic (31, bool, Some (true)) ^:: basic_opt (36, string) ^:: basic_opt (37, string) ^:: basic_opt (39, string) ^:: basic_opt (40, string) ^:: basic_opt (41, string) ^:: basic (42, bool, Some (false)) ^:: basic_opt (44, string) ^:: basic_opt (45, string) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) @@ -1192,7 +1192,7 @@ end = struct end and MessageOptions : sig val name': unit -> string - type t = { message_set_wire_format: bool; no_standard_descriptor_accessor: bool; deprecated: bool; map_entry: bool option; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { extensions': Runtime'.Extensions.t; message_set_wire_format: bool; no_standard_descriptor_accessor: bool; deprecated: bool; map_entry: bool option; uninterpreted_option: UninterpretedOption.t list } val make : ?message_set_wire_format:bool -> ?no_standard_descriptor_accessor:bool -> ?deprecated:bool -> ?map_entry:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t @@ -1200,7 +1200,7 @@ end = struct val from_proto_exn: Runtime'.Reader.t -> t end = struct let name' () = "descriptor.google.protobuf.MessageOptions" - type t = { message_set_wire_format: bool; no_standard_descriptor_accessor: bool; deprecated: bool; map_entry: bool option; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { extensions': Runtime'.Extensions.t; message_set_wire_format: bool; no_standard_descriptor_accessor: bool; deprecated: bool; map_entry: bool option; uninterpreted_option: UninterpretedOption.t list } let make = fun ?message_set_wire_format ?no_standard_descriptor_accessor ?deprecated ?map_entry ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> let message_set_wire_format = match message_set_wire_format with Some v -> v | None -> false in @@ -1218,7 +1218,7 @@ end = struct let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = - let constructor = fun extensions' message_set_wire_format no_standard_descriptor_accessor deprecated map_entry uninterpreted_option -> { message_set_wire_format; no_standard_descriptor_accessor; deprecated; map_entry; uninterpreted_option; extensions' } in + let constructor = fun message_set_wire_format no_standard_descriptor_accessor deprecated map_entry uninterpreted_option extensions' -> { message_set_wire_format; no_standard_descriptor_accessor; deprecated; map_entry; uninterpreted_option; extensions' } in let spec = Runtime'.Deserialize.C.( basic (1, bool, Some (false)) ^:: basic (2, bool, Some (false)) ^:: basic (3, bool, Some (false)) ^:: basic_opt (7, bool) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in fun writer -> deserialize writer @@ -1239,8 +1239,8 @@ end = struct val from_int_exn: int -> t end val name': unit -> string - type t = { ctype: CType.t; packed: bool option; jstype: JSType.t; lazy': bool; unverified_lazy: bool; deprecated: bool; weak: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } - val make : ?ctype:CType.t -> ?packed:bool -> ?jstype:JSType.t -> ?lazy':bool -> ?unverified_lazy:bool -> ?deprecated:bool -> ?weak:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t + type t = { extensions': Runtime'.Extensions.t; ctype: CType.t; packed: bool option; deprecated: bool; lazy': bool; jstype: JSType.t; weak: bool; unverified_lazy: bool; uninterpreted_option: UninterpretedOption.t list } + val make : ?ctype:CType.t -> ?packed:bool -> ?deprecated:bool -> ?lazy':bool -> ?jstype:JSType.t -> ?weak:bool -> ?unverified_lazy:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result @@ -1287,29 +1287,29 @@ end = struct let from_int e = Runtime'.Result.catch (fun () -> from_int_exn e) end let name' () = "descriptor.google.protobuf.FieldOptions" - type t = { ctype: CType.t; packed: bool option; jstype: JSType.t; lazy': bool; unverified_lazy: bool; deprecated: bool; weak: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { extensions': Runtime'.Extensions.t; ctype: CType.t; packed: bool option; deprecated: bool; lazy': bool; jstype: JSType.t; weak: bool; unverified_lazy: bool; uninterpreted_option: UninterpretedOption.t list } let make = - fun ?ctype ?packed ?jstype ?lazy' ?unverified_lazy ?deprecated ?weak ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> + fun ?ctype ?packed ?deprecated ?lazy' ?jstype ?weak ?unverified_lazy ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> let ctype = match ctype with Some v -> v | None -> CType.STRING in - let jstype = match jstype with Some v -> v | None -> JSType.JS_NORMAL in - let lazy' = match lazy' with Some v -> v | None -> false in - let unverified_lazy = match unverified_lazy with Some v -> v | None -> false in let deprecated = match deprecated with Some v -> v | None -> false in + let lazy' = match lazy' with Some v -> v | None -> false in + let jstype = match jstype with Some v -> v | None -> JSType.JS_NORMAL in let weak = match weak with Some v -> v | None -> false in + let unverified_lazy = match unverified_lazy with Some v -> v | None -> false in let uninterpreted_option = match uninterpreted_option with Some v -> v | None -> [] in - { ctype; packed; jstype; lazy'; unverified_lazy; deprecated; weak; uninterpreted_option; extensions' } + { ctype; packed; deprecated; lazy'; jstype; weak; unverified_lazy; uninterpreted_option; extensions' } let to_proto' = - let apply = fun ~f:f' writer { ctype; packed; jstype; lazy'; unverified_lazy; deprecated; weak; uninterpreted_option; extensions' } -> f' extensions' writer ctype packed jstype lazy' unverified_lazy deprecated weak uninterpreted_option in - let spec = Runtime'.Serialize.C.( basic (1, (enum CType.to_int), Some (CType.STRING)) ^:: basic_opt (2, bool) ^:: basic (6, (enum JSType.to_int), Some (JSType.JS_NORMAL)) ^:: basic (5, bool, Some (false)) ^:: basic (15, bool, Some (false)) ^:: basic (3, bool, Some (false)) ^:: basic (10, bool, Some (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in + let apply = fun ~f:f' writer { ctype; packed; deprecated; lazy'; jstype; weak; unverified_lazy; uninterpreted_option; extensions' } -> f' extensions' writer ctype packed deprecated lazy' jstype weak unverified_lazy uninterpreted_option in + let spec = Runtime'.Serialize.C.( basic (1, (enum CType.to_int), Some (CType.STRING)) ^:: basic_opt (2, bool) ^:: basic (3, bool, Some (false)) ^:: basic (5, bool, Some (false)) ^:: basic (6, (enum JSType.to_int), Some (JSType.JS_NORMAL)) ^:: basic (10, bool, Some (false)) ^:: basic (15, bool, Some (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [(1000, 536870912)] spec in fun writer t -> apply ~f:serialize writer t let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = - let constructor = fun extensions' ctype packed jstype lazy' unverified_lazy deprecated weak uninterpreted_option -> { ctype; packed; jstype; lazy'; unverified_lazy; deprecated; weak; uninterpreted_option; extensions' } in - let spec = Runtime'.Deserialize.C.( basic (1, (enum CType.from_int_exn), Some (CType.STRING)) ^:: basic_opt (2, bool) ^:: basic (6, (enum JSType.from_int_exn), Some (JSType.JS_NORMAL)) ^:: basic (5, bool, Some (false)) ^:: basic (15, bool, Some (false)) ^:: basic (3, bool, Some (false)) ^:: basic (10, bool, Some (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in + let constructor = fun ctype packed deprecated lazy' jstype weak unverified_lazy uninterpreted_option extensions' -> { ctype; packed; deprecated; lazy'; jstype; weak; unverified_lazy; uninterpreted_option; extensions' } in + let spec = Runtime'.Deserialize.C.( basic (1, (enum CType.from_int_exn), Some (CType.STRING)) ^:: basic_opt (2, bool) ^:: basic (3, bool, Some (false)) ^:: basic (5, bool, Some (false)) ^:: basic (6, (enum JSType.from_int_exn), Some (JSType.JS_NORMAL)) ^:: basic (10, bool, Some (false)) ^:: basic (15, bool, Some (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) @@ -1317,7 +1317,7 @@ end = struct end and OneofOptions : sig val name': unit -> string - type t = { uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { extensions': Runtime'.Extensions.t; uninterpreted_option: UninterpretedOption.t list } val make : ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t @@ -1325,7 +1325,7 @@ end = struct val from_proto_exn: Runtime'.Reader.t -> t end = struct let name' () = "descriptor.google.protobuf.OneofOptions" - type t = { uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { extensions': Runtime'.Extensions.t; uninterpreted_option: UninterpretedOption.t list } let make = fun ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> let uninterpreted_option = match uninterpreted_option with Some v -> v | None -> [] in @@ -1340,7 +1340,7 @@ end = struct let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = - let constructor = fun extensions' uninterpreted_option -> { uninterpreted_option; extensions' } in + let constructor = fun uninterpreted_option extensions' -> { uninterpreted_option; extensions' } in let spec = Runtime'.Deserialize.C.( repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in fun writer -> deserialize writer @@ -1349,7 +1349,7 @@ end = struct end and EnumOptions : sig val name': unit -> string - type t = { allow_alias: bool option; deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { extensions': Runtime'.Extensions.t; allow_alias: bool option; deprecated: bool; uninterpreted_option: UninterpretedOption.t list } val make : ?allow_alias:bool -> ?deprecated:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t @@ -1357,7 +1357,7 @@ end = struct val from_proto_exn: Runtime'.Reader.t -> t end = struct let name' () = "descriptor.google.protobuf.EnumOptions" - type t = { allow_alias: bool option; deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { extensions': Runtime'.Extensions.t; allow_alias: bool option; deprecated: bool; uninterpreted_option: UninterpretedOption.t list } let make = fun ?allow_alias ?deprecated ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> let deprecated = match deprecated with Some v -> v | None -> false in @@ -1373,7 +1373,7 @@ end = struct let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = - let constructor = fun extensions' allow_alias deprecated uninterpreted_option -> { allow_alias; deprecated; uninterpreted_option; extensions' } in + let constructor = fun allow_alias deprecated uninterpreted_option extensions' -> { allow_alias; deprecated; uninterpreted_option; extensions' } in let spec = Runtime'.Deserialize.C.( basic_opt (2, bool) ^:: basic (3, bool, Some (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in fun writer -> deserialize writer @@ -1382,7 +1382,7 @@ end = struct end and EnumValueOptions : sig val name': unit -> string - type t = { deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { extensions': Runtime'.Extensions.t; deprecated: bool; uninterpreted_option: UninterpretedOption.t list } val make : ?deprecated:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t @@ -1390,7 +1390,7 @@ end = struct val from_proto_exn: Runtime'.Reader.t -> t end = struct let name' () = "descriptor.google.protobuf.EnumValueOptions" - type t = { deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { extensions': Runtime'.Extensions.t; deprecated: bool; uninterpreted_option: UninterpretedOption.t list } let make = fun ?deprecated ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> let deprecated = match deprecated with Some v -> v | None -> false in @@ -1406,7 +1406,7 @@ end = struct let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = - let constructor = fun extensions' deprecated uninterpreted_option -> { deprecated; uninterpreted_option; extensions' } in + let constructor = fun deprecated uninterpreted_option extensions' -> { deprecated; uninterpreted_option; extensions' } in let spec = Runtime'.Deserialize.C.( basic (1, bool, Some (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in fun writer -> deserialize writer @@ -1415,7 +1415,7 @@ end = struct end and ServiceOptions : sig val name': unit -> string - type t = { deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { extensions': Runtime'.Extensions.t; deprecated: bool; uninterpreted_option: UninterpretedOption.t list } val make : ?deprecated:bool -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t @@ -1423,7 +1423,7 @@ end = struct val from_proto_exn: Runtime'.Reader.t -> t end = struct let name' () = "descriptor.google.protobuf.ServiceOptions" - type t = { deprecated: bool; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { extensions': Runtime'.Extensions.t; deprecated: bool; uninterpreted_option: UninterpretedOption.t list } let make = fun ?deprecated ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> let deprecated = match deprecated with Some v -> v | None -> false in @@ -1439,7 +1439,7 @@ end = struct let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = - let constructor = fun extensions' deprecated uninterpreted_option -> { deprecated; uninterpreted_option; extensions' } in + let constructor = fun deprecated uninterpreted_option extensions' -> { deprecated; uninterpreted_option; extensions' } in let spec = Runtime'.Deserialize.C.( basic (33, bool, Some (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in fun writer -> deserialize writer @@ -1454,7 +1454,7 @@ end = struct val from_int_exn: int -> t end val name': unit -> string - type t = { deprecated: bool; idempotency_level: IdempotencyLevel.t; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { extensions': Runtime'.Extensions.t; deprecated: bool; idempotency_level: IdempotencyLevel.t; uninterpreted_option: UninterpretedOption.t list } val make : ?deprecated:bool -> ?idempotency_level:IdempotencyLevel.t -> ?uninterpreted_option:UninterpretedOption.t list -> ?extensions':Runtime'.Extensions.t -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t @@ -1482,7 +1482,7 @@ end = struct let from_int e = Runtime'.Result.catch (fun () -> from_int_exn e) end let name' () = "descriptor.google.protobuf.MethodOptions" - type t = { deprecated: bool; idempotency_level: IdempotencyLevel.t; uninterpreted_option: UninterpretedOption.t list; extensions': Runtime'.Extensions.t } + type t = { extensions': Runtime'.Extensions.t; deprecated: bool; idempotency_level: IdempotencyLevel.t; uninterpreted_option: UninterpretedOption.t list } let make = fun ?deprecated ?idempotency_level ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> let deprecated = match deprecated with Some v -> v | None -> false in @@ -1499,7 +1499,7 @@ end = struct let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = - let constructor = fun extensions' deprecated idempotency_level uninterpreted_option -> { deprecated; idempotency_level; uninterpreted_option; extensions' } in + let constructor = fun deprecated idempotency_level uninterpreted_option extensions' -> { deprecated; idempotency_level; uninterpreted_option; extensions' } in let spec = Runtime'.Deserialize.C.( basic (33, bool, Some (false)) ^:: basic (34, (enum IdempotencyLevel.from_int_exn), Some (IdempotencyLevel.IDEMPOTENCY_UNKNOWN)) ^:: repeated (999, (message (fun t -> UninterpretedOption.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [(1000, 536870912)] spec constructor in fun writer -> deserialize writer @@ -1549,7 +1549,7 @@ end = struct let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = - let constructor = fun _extensions name_part is_extension -> { name_part; is_extension } in + let constructor = fun name_part is_extension _extensions -> { name_part; is_extension } in let spec = Runtime'.Deserialize.C.( basic (1, string, None) ^:: basic (2, bool, None) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer @@ -1572,7 +1572,7 @@ end = struct let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = - let constructor = fun _extensions name identifier_value positive_int_value negative_int_value double_value string_value aggregate_value -> { name; identifier_value; positive_int_value; negative_int_value; double_value; string_value; aggregate_value } in + let constructor = fun name identifier_value positive_int_value negative_int_value double_value string_value aggregate_value _extensions -> { name; identifier_value; positive_int_value; negative_int_value; double_value; string_value; aggregate_value } in let spec = Runtime'.Deserialize.C.( repeated (2, (message (fun t -> NamePart.from_proto_exn t)), not_packed) ^:: basic_opt (3, string) ^:: basic_opt (4, uint64_int) ^:: basic_opt (5, int64_int) ^:: basic_opt (6, double) ^:: basic_opt (7, bytes) ^:: basic_opt (8, string) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer @@ -1624,7 +1624,7 @@ end = struct let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = - let constructor = fun _extensions path span leading_comments trailing_comments leading_detached_comments -> { path; span; leading_comments; trailing_comments; leading_detached_comments } in + let constructor = fun path span leading_comments trailing_comments leading_detached_comments _extensions -> { path; span; leading_comments; trailing_comments; leading_detached_comments } in let spec = Runtime'.Deserialize.C.( repeated (1, int32_int, packed) ^:: repeated (2, int32_int, packed) ^:: basic_opt (3, string) ^:: basic_opt (4, string) ^:: repeated (6, string, not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer @@ -1647,7 +1647,7 @@ end = struct let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = - let constructor = fun _extensions location -> location in + let constructor = fun location _extensions -> location in let spec = Runtime'.Deserialize.C.( repeated (1, (message (fun t -> Location.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer @@ -1697,7 +1697,7 @@ end = struct let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = - let constructor = fun _extensions path source_file begin' end' -> { path; source_file; begin'; end' } in + let constructor = fun path source_file begin' end' _extensions -> { path; source_file; begin'; end' } in let spec = Runtime'.Deserialize.C.( repeated (1, int32_int, packed) ^:: basic_opt (2, string) ^:: basic_opt (3, int32_int) ^:: basic_opt (4, int32_int) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer @@ -1720,7 +1720,7 @@ end = struct let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = - let constructor = fun _extensions annotation -> annotation in + let constructor = fun annotation _extensions -> annotation in let spec = Runtime'.Deserialize.C.( repeated (1, (message (fun t -> Annotation.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer diff --git a/src/spec/options.ml b/src/spec/options.ml index 170862a..52dfd80 100644 --- a/src/spec/options.ml +++ b/src/spec/options.ml @@ -48,7 +48,7 @@ end = struct let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = - let constructor = fun _extensions mangle_names -> mangle_names in + let constructor = fun mangle_names _extensions -> mangle_names in let spec = Runtime'.Deserialize.C.( basic (1, bool, Some (false)) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer diff --git a/src/spec/plugin.ml b/src/spec/plugin.ml index 21c0e8f..c4bfea9 100644 --- a/src/spec/plugin.ml +++ b/src/spec/plugin.ml @@ -37,8 +37,8 @@ module rec Google : sig end and CodeGeneratorRequest : sig val name': unit -> string - type t = { file_to_generate: string list; parameter: string option; proto_file: Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list; compiler_version: Version.t option } - val make : ?file_to_generate:string list -> ?parameter:string -> ?proto_file:Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list -> ?compiler_version:Version.t -> unit -> t + type t = { file_to_generate: string list; parameter: string option; compiler_version: Version.t option; proto_file: Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list } + val make : ?file_to_generate:string list -> ?parameter:string -> ?compiler_version:Version.t -> ?proto_file:Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result @@ -84,8 +84,8 @@ end = struct end and CodeGeneratorRequest : sig val name': unit -> string - type t = { file_to_generate: string list; parameter: string option; proto_file: Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list; compiler_version: Version.t option } - val make : ?file_to_generate:string list -> ?parameter:string -> ?proto_file:Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list -> ?compiler_version:Version.t -> unit -> t + type t = { file_to_generate: string list; parameter: string option; compiler_version: Version.t option; proto_file: Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list } + val make : ?file_to_generate:string list -> ?parameter:string -> ?compiler_version:Version.t -> ?proto_file:Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result @@ -129,8 +129,8 @@ end = struct end and CodeGeneratorRequest : sig val name': unit -> string - type t = { file_to_generate: string list; parameter: string option; proto_file: Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list; compiler_version: Version.t option } - val make : ?file_to_generate:string list -> ?parameter:string -> ?proto_file:Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list -> ?compiler_version:Version.t -> unit -> t + type t = { file_to_generate: string list; parameter: string option; compiler_version: Version.t option; proto_file: Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list } + val make : ?file_to_generate:string list -> ?parameter:string -> ?compiler_version:Version.t -> ?proto_file:Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result @@ -186,7 +186,7 @@ end = struct let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = - let constructor = fun _extensions major minor patch suffix -> { major; minor; patch; suffix } in + let constructor = fun major minor patch suffix _extensions -> { major; minor; patch; suffix } in let spec = Runtime'.Deserialize.C.( basic_opt (1, int32_int) ^:: basic_opt (2, int32_int) ^:: basic_opt (3, int32_int) ^:: basic_opt (4, string) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer @@ -195,32 +195,32 @@ end = struct end and CodeGeneratorRequest : sig val name': unit -> string - type t = { file_to_generate: string list; parameter: string option; proto_file: Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list; compiler_version: Version.t option } - val make : ?file_to_generate:string list -> ?parameter:string -> ?proto_file:Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list -> ?compiler_version:Version.t -> unit -> t + type t = { file_to_generate: string list; parameter: string option; compiler_version: Version.t option; proto_file: Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list } + val make : ?file_to_generate:string list -> ?parameter:string -> ?compiler_version:Version.t -> ?proto_file:Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list -> unit -> t val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t val to_proto: t -> Runtime'.Writer.t val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result val from_proto_exn: Runtime'.Reader.t -> t end = struct let name' () = "plugin.google.protobuf.compiler.CodeGeneratorRequest" - type t = { file_to_generate: string list; parameter: string option; proto_file: Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list; compiler_version: Version.t option } + type t = { file_to_generate: string list; parameter: string option; compiler_version: Version.t option; proto_file: Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list } let make = - fun ?file_to_generate ?parameter ?proto_file ?compiler_version () -> + fun ?file_to_generate ?parameter ?compiler_version ?proto_file () -> let file_to_generate = match file_to_generate with Some v -> v | None -> [] in let proto_file = match proto_file with Some v -> v | None -> [] in - { file_to_generate; parameter; proto_file; compiler_version } + { file_to_generate; parameter; compiler_version; proto_file } let to_proto' = - let apply = fun ~f:f' writer { file_to_generate; parameter; proto_file; compiler_version } -> f' [] writer file_to_generate parameter proto_file compiler_version in - let spec = Runtime'.Serialize.C.( repeated (1, string, not_packed) ^:: basic_opt (2, string) ^:: repeated (15, (message (fun t -> Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.to_proto' t)), not_packed) ^:: basic_opt (3, (message (fun t -> Version.to_proto' t))) ^:: nil ) in + let apply = fun ~f:f' writer { file_to_generate; parameter; compiler_version; proto_file } -> f' [] writer file_to_generate parameter compiler_version proto_file in + let spec = Runtime'.Serialize.C.( repeated (1, string, not_packed) ^:: basic_opt (2, string) ^:: basic_opt (3, (message (fun t -> Version.to_proto' t))) ^:: repeated (15, (message (fun t -> Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.to_proto' t)), not_packed) ^:: nil ) in let serialize = Runtime'.Serialize.serialize [] spec in fun writer t -> apply ~f:serialize writer t let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = - let constructor = fun _extensions file_to_generate parameter proto_file compiler_version -> { file_to_generate; parameter; proto_file; compiler_version } in - let spec = Runtime'.Deserialize.C.( repeated (1, string, not_packed) ^:: basic_opt (2, string) ^:: repeated (15, (message (fun t -> Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.from_proto_exn t)), not_packed) ^:: basic_opt (3, (message (fun t -> Version.from_proto_exn t))) ^:: nil ) in + let constructor = fun file_to_generate parameter compiler_version proto_file _extensions -> { file_to_generate; parameter; compiler_version; proto_file } in + let spec = Runtime'.Deserialize.C.( repeated (1, string, not_packed) ^:: basic_opt (2, string) ^:: basic_opt (3, (message (fun t -> Version.from_proto_exn t))) ^:: repeated (15, (message (fun t -> Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) @@ -293,7 +293,7 @@ end = struct let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = - let constructor = fun _extensions name insertion_point content generated_code_info -> { name; insertion_point; content; generated_code_info } in + let constructor = fun name insertion_point content generated_code_info _extensions -> { name; insertion_point; content; generated_code_info } in let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (2, string) ^:: basic_opt (15, string) ^:: basic_opt (16, (message (fun t -> Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.from_proto_exn t))) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer @@ -316,7 +316,7 @@ end = struct let to_proto t = to_proto' (Runtime'.Writer.init ()) t let from_proto_exn = - let constructor = fun _extensions error supported_features file -> { error; supported_features; file } in + let constructor = fun error supported_features file _extensions -> { error; supported_features; file } in let spec = Runtime'.Deserialize.C.( basic_opt (1, string) ^:: basic_opt (2, uint64_int) ^:: repeated (15, (message (fun t -> File.from_proto_exn t)), not_packed) ^:: nil ) in let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in fun writer -> deserialize writer diff --git a/test/mangle_names.proto b/test/mangle_names.proto index a66f232..8fe697e 100644 --- a/test/mangle_names.proto +++ b/test/mangle_names.proto @@ -3,7 +3,6 @@ syntax = "proto3"; import "options.proto"; option (ocaml_options) = { mangle_names:true }; - message CamelCaseName { uint32 CamelCaseField = 1; enum CamelCaseEnum { From feb64f3037fa0642379dd312ca357eaa7708d6a5 Mon Sep 17 00:00:00 2001 From: Anders Fugmann Date: Sun, 21 Jan 2024 22:23:45 +0100 Subject: [PATCH 22/30] Fix compatibility with ocaml4.08 --- bench/bench.ml | 14 ++++++-------- src/ocaml_protoc_plugin/deserialize.ml | 2 +- 2 files changed, 7 insertions(+), 9 deletions(-) diff --git a/bench/bench.ml b/bench/bench.ml index c646bff..11e5a1d 100644 --- a/bench/bench.ml +++ b/bench/bench.ml @@ -65,17 +65,15 @@ let make_tests (type v) (module Protoc: Protoc_impl) (module Plugin: Plugin_impl let test_encode = Test.make_grouped ~name:"Encode" [ - Test.make ~name:"Plugin balanced" (Staged.stage @@ fun () -> Plugin.M.to_proto' Ocaml_protoc_plugin.Writer.(init ~mode:Balanced ()) v_plugin |> Ocaml_protoc_plugin.Writer.contents |> Sys.opaque_identity); - Test.make ~name:"Plugin speed" (Staged.stage @@ fun () -> Plugin.M.to_proto' Ocaml_protoc_plugin.Writer.(init ~mode:Speed ()) v_plugin |> Ocaml_protoc_plugin.Writer.contents |> Sys.opaque_identity); - Test.make ~name:"Plugin space" (Staged.stage @@ fun () -> Plugin.M.to_proto' Ocaml_protoc_plugin.Writer.(init ~mode:Space ()) v_plugin |> Ocaml_protoc_plugin.Writer.contents |> Sys.opaque_identity); - Test.make ~name:"Protoc" (Staged.stage @@ fun () -> let encoder = Pbrt.Encoder.create () in Protoc.encode_pb_m v_protoc encoder; (Pbrt.Encoder.to_string encoder) |> Sys.opaque_identity) + Test.make ~name:"Plugin" (Staged.stage @@ fun () -> Plugin.M.to_proto' Ocaml_protoc_plugin.Writer.(init ()) v_plugin); + Test.make ~name:"Protoc" (Staged.stage @@ fun () -> let encoder = Pbrt.Encoder.create () in Protoc.encode_pb_m v_protoc encoder; Pbrt.Encoder.to_string encoder) ] in let test_decode = Test.make_grouped ~name:"Decode" [ - Test.make ~name:"Plugin" (Staged.stage @@ fun () -> Plugin.M.from_proto_exn (Ocaml_protoc_plugin.Reader.create data_plugin |> Sys.opaque_identity)); - Test.make ~name:"Protoc" (Staged.stage @@ fun () -> Protoc.decode_pb_m (Pbrt.Decoder.of_string data_protoc |> Sys.opaque_identity)) + Test.make ~name:"Plugin" (Staged.stage @@ fun () -> Plugin.M.from_proto_exn (Ocaml_protoc_plugin.Reader.create data_plugin)); + Test.make ~name:"Protoc" (Staged.stage @@ fun () -> Protoc.decode_pb_m (Pbrt.Decoder.of_string data_protoc)) ] in Test.make_grouped ~name:(Plugin.M.name' ()) [test_encode; test_decode] @@ -134,12 +132,12 @@ let create_test_data ~depth () = let benchmark tests = let open Bechamel in let instances = [ meassure ] in - let cfg = Benchmark.cfg ~limit:500 ~quota:(Time.second 5.0) ~kde:(Some 100) ~stabilize:true ~compaction:false () in + let cfg = Benchmark.cfg ~compaction:false ~kde:(Some 1) ~quota:(Time.second 1.0) () in Benchmark.all cfg instances tests let analyze results = let open Bechamel in - let ols = Analyze.ols ~bootstrap:5 ~r_square:false + let ols = Analyze.ols ~bootstrap:5 ~r_square:true ~predictors:[| Measure.run |] in let results = Analyze.all ols meassure results in Analyze.merge ols [ meassure ] [ results ] diff --git a/src/ocaml_protoc_plugin/deserialize.ml b/src/ocaml_protoc_plugin/deserialize.ml index 297d713..fdf2e1d 100644 --- a/src/ocaml_protoc_plugin/deserialize.ml +++ b/src/ocaml_protoc_plugin/deserialize.ml @@ -100,7 +100,7 @@ let default_value: type a. a spec -> a = function | SFixed32 -> Int32.zero | SFixed64 -> Int64.zero | Message of_proto -> of_proto (Reader.create "") - | String -> String.empty + | String -> "" | Bytes -> Bytes.empty | Int32_int -> 0 | Int64_int -> 0 From 55192c32a9f266068996852067c7885a56ce2c0c Mon Sep 17 00:00:00 2001 From: Anders Fugmann Date: Mon, 22 Jan 2024 00:02:32 +0100 Subject: [PATCH 23/30] Fix Extensons bug, and change how types are emitted for extensions --- src/ocaml_protoc_plugin/extensions.ml | 30 +++++++++------ src/ocaml_protoc_plugin/extensions.mli | 5 ++- src/plugin/emit.ml | 22 +++++------ src/plugin/types.ml | 36 +++++++++++------ src/plugin/types.mli | 13 ++++++- src/spec/descriptor.ml | 2 +- src/spec/options.ml | 6 +-- src/spec/plugin.ml | 2 +- test/extensions.proto | 8 +++- test/extensions_test.ml | 53 +++++++++++++++++++++++++- 10 files changed, 133 insertions(+), 44 deletions(-) diff --git a/src/ocaml_protoc_plugin/extensions.ml b/src/ocaml_protoc_plugin/extensions.ml index 9af55b9..98a3b39 100644 --- a/src/ocaml_protoc_plugin/extensions.ml +++ b/src/ocaml_protoc_plugin/extensions.ml @@ -7,19 +7,25 @@ let show : t -> string = Format.asprintf "%a" pp let equal _ _ = true let compare _ _ = 0 -let get: type a. (a -> t -> a, t -> a) Spec.Deserialize.compound_list -> t -> a = fun spec t -> + +let index_of_spec: type a. a Spec.Serialize.compound -> int = function + | Basic (index, _, _) -> index + | Basic_opt (index, _) -> index + | Repeated (index, _, _) -> index + | Oneof _ -> failwith "Oneof fields not allowed in extensions" + +let get: type a. a Spec.Deserialize.compound -> t -> a = fun spec t -> let writer = Writer.of_list t in let reader = Writer.contents writer |> Reader.create in - Deserialize.deserialize [] spec (fun a _ -> a) reader + Deserialize.deserialize [] Spec.Deserialize.(Cons (spec, Nil)) (fun a _ -> a) reader -let set: ('a -> Writer.t, Writer.t) Serialize.S.compound_list -> t -> 'a -> t = fun spec t v -> +let set: type a. a Spec.Serialize.compound -> t -> a -> t = fun spec t v -> let writer = Writer.init () in - let writer = Serialize.serialize [] spec [] writer v in - let reader = Writer.contents writer |> Reader.create in - (* If we dont produce any fields, we should still clear the previous fields. *) - (* TODO: Test this code *) - match Reader.to_list reader with - | ((index, _) :: _) as fields -> - (List.filter ~f:(fun (i, _) -> i != index) t) @ fields - | [] -> t - | exception Result.Error _ -> failwith "Internal serialization fail" + let writer = Serialize.serialize [] Spec.Serialize.(Cons (spec, Nil)) [] writer v in + let index = index_of_spec spec in + let fields = + Writer.contents writer + |> Reader.create + |> Reader.to_list + in + List.filter ~f:(fun (i, _) -> i != index) t @ fields diff --git a/src/ocaml_protoc_plugin/extensions.mli b/src/ocaml_protoc_plugin/extensions.mli index 5125627..3ca6858 100644 --- a/src/ocaml_protoc_plugin/extensions.mli +++ b/src/ocaml_protoc_plugin/extensions.mli @@ -4,5 +4,6 @@ val pp : Format.formatter -> t -> unit val show : t -> string val equal : t -> t -> bool val compare : t -> t -> int -val get : ('a -> t -> 'a, t -> 'a) Spec.Deserialize.compound_list -> t -> 'a -val set : ('a -> Writer.t, Writer.t) Spec.Serialize.compound_list -> t -> 'a -> t + +val get: 'a Spec.Deserialize.compound -> t -> 'a +val set: 'a Spec.Serialize.compound -> t -> 'a -> t diff --git a/src/plugin/emit.ml b/src/plugin/emit.ml index 0422777..1b91fc2 100644 --- a/src/plugin/emit.ml +++ b/src/plugin/emit.ml @@ -122,26 +122,25 @@ let emit_extension ~scope ~params field = let module_name = (Scope.get_name scope name) in let extendee_type = Scope.get_scoped_name scope ~postfix:"t" extendee in let extendee_field = Scope.get_scoped_name scope ~postfix:"extensions'" extendee in - (* Create the type of the type' / type_name *) - let t = + (* Get spec and type *) + let c = let params = Parameters.{params with singleton_record = false} in - Types.make ~params ~syntax:`Proto2 ~is_cyclic:false ~scope ~is_map_entry:false ~has_extensions:false ~fields:[field] [] + Types.spec_of_field ~params ~syntax:`Proto2 ~scope field in - let signature = Code.init () in let implementation = Code.init () in Code.append implementation signature; - Code.emit signature `None "type t = %s %s" t.type' params.annot; - Code.emit signature `None "val get_exn: %s -> %s" extendee_type t.type'; - Code.emit signature `None "val get: %s -> (%s, [> Runtime'.Result.error]) result" extendee_type t.type'; - Code.emit signature `None "val set: %s -> %s -> %s" extendee_type t.type' extendee_type; + Code.emit signature `None "type t = %s %s" c.typestr params.annot; + Code.emit signature `None "val get_exn: %s -> %s" extendee_type c.typestr; + Code.emit signature `None "val get: %s -> (%s, [> Runtime'.Result.error]) result" extendee_type c.typestr; + Code.emit signature `None "val set: %s -> %s -> %s" extendee_type c.typestr extendee_type; - Code.emit implementation `None "type t = %s %s" t.type' params.annot; - Code.emit implementation `None "let get_exn extendee = Runtime'.Extensions.get %s (extendee.%s)" t.deserialize_spec extendee_field ; + Code.emit implementation `None "type t = %s %s" c.typestr params.annot; + Code.emit implementation `None "let get_exn extendee = Runtime'.Extensions.get Runtime'.Deserialize.C.(%s) (extendee.%s)" c.deserialize_spec extendee_field ; Code.emit implementation `None "let get extendee = Runtime'.Result.catch (fun () -> get_exn extendee)"; Code.emit implementation `Begin "let set extendee t ="; - Code.emit implementation `None "let extensions' = Runtime'.Extensions.set (%s) (extendee.%s) t in" t.serialize_spec extendee_field; + Code.emit implementation `None "let extensions' = Runtime'.Extensions.set Runtime'.Serialize.C.(%s) (extendee.%s) t in" c.serialize_spec extendee_field; Code.emit implementation `None "{ extendee with %s = extensions' }" extendee_field; Code.emit implementation `End ""; { module_name; signature; implementation } @@ -350,6 +349,7 @@ let parse_proto_file ~params scope in Code.append implementation implementation'; + Code.emit implementation `None ""; let base_name = Filename.remove_extension name in (base_name ^ ".ml"), implementation diff --git a/src/plugin/types.ml b/src/plugin/types.ml index b2e7b19..5f42f6e 100644 --- a/src/plugin/types.ml +++ b/src/plugin/types.ml @@ -39,6 +39,12 @@ type c = { deserialize_spec: string; } +type field_spec = { + typestr : string; + serialize_spec: string; + deserialize_spec: string; +} + type t = { type' : string; constructor: string; @@ -301,6 +307,11 @@ let string_of_packed = function | Packed -> "packed" | Not_packed -> "not_packed" +let string_of_type = function + | { name; modifier = (No_modifier _ | Required); _ } -> name + | { name; modifier = List; _ } -> sprintf "%s list" name + | { name; modifier = Optional; _ } -> sprintf "%s option" name + let c_of_compound: type a. string -> a compound -> c = fun name compound -> match compound with | Basic (index, spec, default) -> @@ -458,6 +469,15 @@ let c_of_field ~params ~syntax ~scope field = | _, { label = None; _ } -> failwith "Label not set on field struct" | _, { type' = None; _ } -> failwith "Type must be set" + +let spec_of_field ~params ~syntax ~scope field : field_spec = + let c = c_of_field ~params ~syntax ~scope field in + { + typestr = string_of_type c.type'; + serialize_spec = c.serialize_spec; + deserialize_spec = c.deserialize_spec; + } + let c_of_oneof ~params ~syntax:_ ~scope OneofDescriptorProto.{ name; _ } fields = let open FieldDescriptorProto in (* Construct the type. *) @@ -550,18 +570,12 @@ let make ~params ~syntax ~is_cyclic ~is_map_entry ~has_extensions ~scope ~fields | `Oneof (decl, fields) -> c_of_oneof ~params ~syntax ~scope decl fields ) in - let typestr_of_type = function - | { name; modifier = (No_modifier _ | Required); _ } -> name - | { name; modifier = List; _ } -> sprintf "%s list" name - | { name; modifier = Optional; _ } -> sprintf "%s option" name - in - let constructor_sig_arg = function - | {name; type' = { name = type_name; modifier = Required }; _ } -> + | { name; type' = { name = type_name; modifier = Required }; _ } -> sprintf "%s:%s" (Scope.get_name scope name) type_name - | {name; type' = { name = type_name; modifier = List }; _} -> + | { name; type' = { name = type_name; modifier = List }; _} -> sprintf "?%s:%s list" (Scope.get_name scope name) type_name - | {name; type' = { name = type_name; modifier = (Optional | No_modifier _) }; _} -> + | { name; type' = { name = type_name; modifier = (Optional | No_modifier _) }; _} -> sprintf "?%s:%s" (Scope.get_name scope name) type_name in @@ -614,7 +628,7 @@ let make ~params ~syntax ~is_cyclic ~is_map_entry ~has_extensions ~scope ~fields in let type' = - List.rev_map ~f:(fun { name; type'; _} -> ((Scope.get_name scope name), (typestr_of_type type'))) ts + List.rev_map ~f:(fun { name; type'; _} -> ((Scope.get_name scope name), (string_of_type type'))) ts |> append ~cond:has_extensions ("extensions'", "Runtime'.Extensions.t") |> List.rev_map ~f:(function | (_, type') when t_as_tuple -> type' @@ -629,7 +643,7 @@ let make ~params ~syntax ~is_cyclic ~is_map_entry ~has_extensions ~scope ~fields in let args = String.concat ~sep:" " field_names in - let fields =(append ~cond:has_extensions "extensions'" field_names) in + let fields = (append ~cond:has_extensions "extensions'" field_names) in let constructor = sprintf "fun %s %s -> %s" args (if has_extensions then "extensions'" else "_extensions") (type_destr fields) diff --git a/src/plugin/types.mli b/src/plugin/types.mli index 9891488..fc11d04 100644 --- a/src/plugin/types.mli +++ b/src/plugin/types.mli @@ -10,9 +10,20 @@ type t = { default_constructor_impl: string; } +type field_spec = { + typestr : string; + serialize_spec: string; + deserialize_spec: string; +} + +val spec_of_field: + params:Parameters.t -> + syntax:[ `Proto2 | `Proto3 ] -> + scope:Scope.t -> FieldDescriptorProto.t -> field_spec + val make: params:Parameters.t -> - syntax:[< `Proto2 | `Proto3 ] -> + syntax:[ `Proto2 | `Proto3 ] -> is_cyclic: bool -> is_map_entry: bool -> has_extensions: bool -> diff --git a/src/spec/descriptor.ml b/src/spec/descriptor.ml index da22069..bfe5642 100644 --- a/src/spec/descriptor.ml +++ b/src/spec/descriptor.ml @@ -1728,4 +1728,4 @@ end = struct end end -end \ No newline at end of file +end diff --git a/src/spec/options.ml b/src/spec/options.ml index 52dfd80..9122335 100644 --- a/src/spec/options.ml +++ b/src/spec/options.ml @@ -62,10 +62,10 @@ and Ocaml_options : sig val set: Imported'modules.Descriptor.Google.Protobuf.FileOptions.t -> Options.t option -> Imported'modules.Descriptor.Google.Protobuf.FileOptions.t end = struct type t = Options.t option - let get_exn extendee = Runtime'.Extensions.get Runtime'.Deserialize.C.( basic_opt (1074, (message (fun t -> Options.from_proto_exn t))) ^:: nil ) (extendee.Imported'modules.Descriptor.Google.Protobuf.FileOptions.extensions') + let get_exn extendee = Runtime'.Extensions.get Runtime'.Deserialize.C.(basic_opt (1074, (message (fun t -> Options.from_proto_exn t)))) (extendee.Imported'modules.Descriptor.Google.Protobuf.FileOptions.extensions') let get extendee = Runtime'.Result.catch (fun () -> get_exn extendee) let set extendee t = - let extensions' = Runtime'.Extensions.set (Runtime'.Serialize.C.( basic_opt (1074, (message (fun t -> Options.to_proto' t))) ^:: nil )) (extendee.Imported'modules.Descriptor.Google.Protobuf.FileOptions.extensions') t in + let extensions' = Runtime'.Extensions.set Runtime'.Serialize.C.(basic_opt (1074, (message (fun t -> Options.to_proto' t)))) (extendee.Imported'modules.Descriptor.Google.Protobuf.FileOptions.extensions') t in { extendee with Imported'modules.Descriptor.Google.Protobuf.FileOptions.extensions' = extensions' } -end \ No newline at end of file +end diff --git a/src/spec/plugin.ml b/src/spec/plugin.ml index c4bfea9..14e7ed3 100644 --- a/src/spec/plugin.ml +++ b/src/spec/plugin.ml @@ -325,4 +325,4 @@ end = struct end end end -end \ No newline at end of file +end diff --git a/test/extensions.proto b/test/extensions.proto index 1617647..3e51c9c 100644 --- a/test/extensions.proto +++ b/test/extensions.proto @@ -7,16 +7,22 @@ message Foo { extensions 100 to 199; extensions 500 to max; } + message Baz { optional uint32 a = 1; } extend Foo { optional uint32 baz = 128; - optional uint32 baz2 = 129; + repeated uint32 b2 = 129 [packed = true]; } extend Foo { repeated uint32 r_baz = 130; } + +extend Foo { + optional uint32 a = 131; + optional uint32 b = 132 [default = 13]; +} diff --git a/test/extensions_test.ml b/test/extensions_test.ml index 3e1378d..7f7c1b1 100644 --- a/test/extensions_test.ml +++ b/test/extensions_test.ml @@ -17,13 +17,27 @@ let%expect_test _ = let foo = Extensions.Baz'.set foo (Some 8) in let foo = Extensions.Baz'.set foo (Some 7) in let baz = Extensions.Baz'.get foo in + print_endline ([%show: Extensions.Foo.t] foo); print_endline ([%show: Extensions.Baz.t Ocaml_protoc_plugin.Result.t] baz); let () = match baz = Ok (Some 7) with | false -> print_endline "Failed. Not equal" | true -> () in (); - [%expect {| Ok (Some 7) |}] + [%expect {| + { extensions' = (128, (Field.Varint 7L)); bar = (Some 5) } + Ok (Some 7) |}] + +let%expect_test _ = + let foo = Extensions.Foo.{ bar = Some 5; extensions' = Ocaml_protoc_plugin.Extensions.default } in + let foo = Extensions.Baz'.set foo (Some 8) in + let foo = Extensions.Baz'.set foo (Some 0) in + let foo = Extensions.B2.set foo ([6;7;8]) in + let foo = Extensions.B2.set foo ([]) in + print_endline ([%show: Extensions.Foo.t] foo); + (); + [%expect {| + { extensions' = (128, (Field.Varint 0L)); bar = (Some 5) } |}] let%expect_test _ = let foo = Extensions.Foo.{ bar = Some 5; extensions' = Ocaml_protoc_plugin.Extensions.default } in @@ -63,3 +77,40 @@ let%expect_test _ = in (); [%expect {| Ok [6; 7; 8; 9] |}] + +let%expect_test _ = + let foo = Extensions.Foo.{ bar = Some 5; extensions' = Ocaml_protoc_plugin.Extensions.default } in + print_endline ([%show: Extensions.Foo.t] foo); + + let foo = Extensions.A.set foo (Some 7) in + Printf.printf "Set A = Some 7\n"; + print_endline ([%show: Extensions.Foo.t] foo); + + let foo = Extensions.A.set foo None in + Printf.printf "Set A = None\n"; + print_endline ([%show: Extensions.Foo.t] foo); + + let foo = Extensions.B.set foo 15 in + Printf.printf "Set B = 15: %d\n" (Extensions.B.get foo |> Ocaml_protoc_plugin.Result.get ~msg:"No Value"); + print_endline ([%show: Extensions.Foo.t] foo); + + let foo = Extensions.B.set foo 13 in + Printf.printf "Set B = 13: %d\n" (Extensions.B.get foo |> Ocaml_protoc_plugin.Result.get ~msg:"No Value"); + print_endline ([%show: Extensions.Foo.t] foo); + + let foo = Extensions.B.set foo 0 in + Printf.printf "Set B = 0: %d\n" (Extensions.B.get foo |> Ocaml_protoc_plugin.Result.get ~msg:"No Value"); + print_endline ([%show: Extensions.Foo.t] foo); + (); + [%expect {| + { extensions' = ; bar = (Some 5) } + Set A = Some 7 + { extensions' = (131, (Field.Varint 7L)); bar = (Some 5) } + Set A = None + { extensions' = ; bar = (Some 5) } + Set B = 15: 15 + { extensions' = (132, (Field.Varint 15L)); bar = (Some 5) } + Set B = 13: 13 + { extensions' = ; bar = (Some 5) } + Set B = 0: 0 + { extensions' = (132, (Field.Varint 0L)); bar = (Some 5) } |}] From 0e6527bef3f8c7f117dfc65029c89c0464859f0a Mon Sep 17 00:00:00 2001 From: Anders Fugmann Date: Mon, 22 Jan 2024 01:00:49 +0100 Subject: [PATCH 24/30] Improve make function to use default values on optional argument types --- src/plugin/emit.ml | 4 +--- src/plugin/types.ml | 30 ++++++++++-------------------- 2 files changed, 11 insertions(+), 23 deletions(-) diff --git a/src/plugin/emit.ml b/src/plugin/emit.ml index 1b91fc2..f5baccb 100644 --- a/src/plugin/emit.ml +++ b/src/plugin/emit.ml @@ -231,9 +231,7 @@ let rec emit_message ~params ~syntax scope Code.emit implementation `None "let name' () = \"%s\"" (Scope.get_current_scope scope); Code.emit implementation `None "type t = %s%s" type' params.annot; - Code.emit implementation `Begin "let make ="; - Code.emit implementation `None "%s" default_constructor_impl; - Code.emit implementation `End ""; + Code.emit implementation `None "let make %s" default_constructor_impl; Code.emit implementation `Begin "let to_proto' ="; Code.emit implementation `None "let apply = %s in" apply; diff --git a/src/plugin/types.ml b/src/plugin/types.ml index 5f42f6e..203c023 100644 --- a/src/plugin/types.ml +++ b/src/plugin/types.ml @@ -570,6 +570,7 @@ let make ~params ~syntax ~is_cyclic ~is_map_entry ~has_extensions ~scope ~fields | `Oneof (decl, fields) -> c_of_oneof ~params ~syntax ~scope decl fields ) in + let constructor_sig_arg = function | { name; type' = { name = type_name; modifier = Required }; _ } -> sprintf "%s:%s" (Scope.get_name scope name) type_name @@ -579,20 +580,15 @@ let make ~params ~syntax ~is_cyclic ~is_map_entry ~has_extensions ~scope ~fields sprintf "?%s:%s" (Scope.get_name scope name) type_name in - let constructor_arg = function - | {name; type' = { modifier = Required; _}; _ } -> sprintf "~%s" (Scope.get_name scope name) - | {name; _ } -> sprintf "?%s" (Scope.get_name scope name) - in - let constructor_default_value: c -> string option = fun c -> - let dv = match c with - | { type' = { modifier = (Optional | Required); _ }; _} -> None - | { name; type' = { modifier = List; _ }; _} -> Some ((Scope.get_name scope name), "[]") - | { name; type' = { modifier = No_modifier default; _}; _} -> Some ((Scope.get_name scope name), default) - in - Option.map ~f:(fun (name, default) -> - sprintf "let %s = match %s with Some v -> v | None -> %s in" name name default - ) dv + let constructor_arg c = + let name = Scope.get_name scope c.name in + match c with + | { type' = { modifier = Required; _}; _ } -> sprintf "~%s" name + | { type' = { modifier = Optional; _ }; _} -> sprintf "?%s" name + | { type' = { modifier = List; _ }; _} -> sprintf "?(%s = [])" name + | { type' = { modifier = No_modifier default; _}; _} -> sprintf "?(%s = %s)" name default in + let prepend ?(cond=true) elm l = match cond with | true -> elm :: l | false -> l @@ -667,19 +663,13 @@ let make ~params ~syntax ~is_cyclic ~is_map_entry ~has_extensions ~scope ~fields |> append ~cond:has_extensions "?(extensions' = Runtime'.Extensions.default)" |> String.concat ~sep: " " in - let mappings = - List.map ~f:constructor_default_value ts - |> List.filter ~f:(function None->false | Some _ -> true) - |> List.map ~f:(function Some v -> v | None -> failwith "Cannot be none") - |> String.concat ~sep:"\n" - in let constructor = List.map ~f:(fun {name; _} -> sprintf "%s" (Scope.get_name scope name)) ts |> append ~cond:has_extensions "extensions'" |> type_destr in - sprintf "fun %s () -> \n%s\n%s" args mappings constructor + sprintf "%s () = %s" args constructor in (* Create the deserialize spec *) let deserialize_spec = From 18d0c69c6d2823baf72cb55ae6573e4beab95e65 Mon Sep 17 00:00:00 2001 From: Anders Fugmann Date: Mon, 22 Jan 2024 01:42:16 +0100 Subject: [PATCH 25/30] Add test for large message types to test for stack overflows on recursive functions --- src/spec/descriptor.ml | 203 +++++--------------------------- src/spec/options.ml | 6 +- src/spec/plugin.ml | 25 +--- test/dune | 4 +- test/large.proto | 254 +++++++++++++++++++++++++++++++++++++++++ test/large_test.ml | 19 +++ 6 files changed, 307 insertions(+), 204 deletions(-) create mode 100644 test/large.proto create mode 100644 test/large_test.ml diff --git a/src/spec/descriptor.ml b/src/spec/descriptor.ml index bfe5642..cc0c16e 100644 --- a/src/spec/descriptor.ml +++ b/src/spec/descriptor.ml @@ -593,11 +593,7 @@ end = struct end = struct let name' () = "descriptor.google.protobuf.FileDescriptorSet" type t = FileDescriptorProto.t list - let make = - fun ?file () -> - let file = match file with Some v -> v | None -> [] in - file - + let make ?(file = []) () = file let to_proto' = let apply = fun ~f:f' writer file -> f' [] writer file in let spec = Runtime'.Serialize.C.( repeated (1, (message (fun t -> FileDescriptorProto.to_proto' t)), not_packed) ^:: nil ) in @@ -625,17 +621,7 @@ end = struct end = struct let name' () = "descriptor.google.protobuf.FileDescriptorProto" type t = { name: string option; package: string option; dependency: string list; message_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; service: ServiceDescriptorProto.t list; extension: FieldDescriptorProto.t list; options: FileOptions.t option; source_code_info: SourceCodeInfo.t option; public_dependency: int list; weak_dependency: int list; syntax: string option } - let make = - fun ?name ?package ?dependency ?message_type ?enum_type ?service ?extension ?options ?source_code_info ?public_dependency ?weak_dependency ?syntax () -> - let dependency = match dependency with Some v -> v | None -> [] in - let message_type = match message_type with Some v -> v | None -> [] in - let enum_type = match enum_type with Some v -> v | None -> [] in - let service = match service with Some v -> v | None -> [] in - let extension = match extension with Some v -> v | None -> [] in - let public_dependency = match public_dependency with Some v -> v | None -> [] in - let weak_dependency = match weak_dependency with Some v -> v | None -> [] in - { name; package; dependency; message_type; enum_type; service; extension; options; source_code_info; public_dependency; weak_dependency; syntax } - + let make ?name ?package ?(dependency = []) ?(message_type = []) ?(enum_type = []) ?(service = []) ?(extension = []) ?options ?source_code_info ?(public_dependency = []) ?(weak_dependency = []) ?syntax () = { name; package; dependency; message_type; enum_type; service; extension; options; source_code_info; public_dependency; weak_dependency; syntax } let to_proto' = let apply = fun ~f:f' writer { name; package; dependency; message_type; enum_type; service; extension; options; source_code_info; public_dependency; weak_dependency; syntax } -> f' [] writer name package dependency message_type enum_type service extension options source_code_info public_dependency weak_dependency syntax in let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (2, string) ^:: repeated (3, string, not_packed) ^:: repeated (4, (message (fun t -> DescriptorProto.to_proto' t)), not_packed) ^:: repeated (5, (message (fun t -> EnumDescriptorProto.to_proto' t)), not_packed) ^:: repeated (6, (message (fun t -> ServiceDescriptorProto.to_proto' t)), not_packed) ^:: repeated (7, (message (fun t -> FieldDescriptorProto.to_proto' t)), not_packed) ^:: basic_opt (8, (message (fun t -> FileOptions.to_proto' t))) ^:: basic_opt (9, (message (fun t -> SourceCodeInfo.to_proto' t))) ^:: repeated (10, int32_int, not_packed) ^:: repeated (11, int32_int, not_packed) ^:: basic_opt (12, string) ^:: nil ) in @@ -690,11 +676,7 @@ end = struct end = struct let name' () = "descriptor.google.protobuf.DescriptorProto.ExtensionRange" type t = { start: int option; end': int option; options: ExtensionRangeOptions.t option } - let make = - fun ?start ?end' ?options () -> - - { start; end'; options } - + let make ?start ?end' ?options () = { start; end'; options } let to_proto' = let apply = fun ~f:f' writer { start; end'; options } -> f' [] writer start end' options in let spec = Runtime'.Serialize.C.( basic_opt (1, int32_int) ^:: basic_opt (2, int32_int) ^:: basic_opt (3, (message (fun t -> ExtensionRangeOptions.to_proto' t))) ^:: nil ) in @@ -722,11 +704,7 @@ end = struct end = struct let name' () = "descriptor.google.protobuf.DescriptorProto.ReservedRange" type t = { start: int option; end': int option } - let make = - fun ?start ?end' () -> - - { start; end' } - + let make ?start ?end' () = { start; end' } let to_proto' = let apply = fun ~f:f' writer { start; end' } -> f' [] writer start end' in let spec = Runtime'.Serialize.C.( basic_opt (1, int32_int) ^:: basic_opt (2, int32_int) ^:: nil ) in @@ -745,18 +723,7 @@ end = struct end let name' () = "descriptor.google.protobuf.DescriptorProto" type t = { name: string option; field: FieldDescriptorProto.t list; nested_type: DescriptorProto.t list; enum_type: EnumDescriptorProto.t list; extension_range: ExtensionRange.t list; extension: FieldDescriptorProto.t list; options: MessageOptions.t option; oneof_decl: OneofDescriptorProto.t list; reserved_range: ReservedRange.t list; reserved_name: string list } - let make = - fun ?name ?field ?nested_type ?enum_type ?extension_range ?extension ?options ?oneof_decl ?reserved_range ?reserved_name () -> - let field = match field with Some v -> v | None -> [] in - let nested_type = match nested_type with Some v -> v | None -> [] in - let enum_type = match enum_type with Some v -> v | None -> [] in - let extension_range = match extension_range with Some v -> v | None -> [] in - let extension = match extension with Some v -> v | None -> [] in - let oneof_decl = match oneof_decl with Some v -> v | None -> [] in - let reserved_range = match reserved_range with Some v -> v | None -> [] in - let reserved_name = match reserved_name with Some v -> v | None -> [] in - { name; field; nested_type; enum_type; extension_range; extension; options; oneof_decl; reserved_range; reserved_name } - + let make ?name ?(field = []) ?(nested_type = []) ?(enum_type = []) ?(extension_range = []) ?(extension = []) ?options ?(oneof_decl = []) ?(reserved_range = []) ?(reserved_name = []) () = { name; field; nested_type; enum_type; extension_range; extension; options; oneof_decl; reserved_range; reserved_name } let to_proto' = let apply = fun ~f:f' writer { name; field; nested_type; enum_type; extension_range; extension; options; oneof_decl; reserved_range; reserved_name } -> f' [] writer name field nested_type enum_type extension_range extension options oneof_decl reserved_range reserved_name in let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> FieldDescriptorProto.to_proto' t)), not_packed) ^:: repeated (3, (message (fun t -> DescriptorProto.to_proto' t)), not_packed) ^:: repeated (4, (message (fun t -> EnumDescriptorProto.to_proto' t)), not_packed) ^:: repeated (5, (message (fun t -> ExtensionRange.to_proto' t)), not_packed) ^:: repeated (6, (message (fun t -> FieldDescriptorProto.to_proto' t)), not_packed) ^:: basic_opt (7, (message (fun t -> MessageOptions.to_proto' t))) ^:: repeated (8, (message (fun t -> OneofDescriptorProto.to_proto' t)), not_packed) ^:: repeated (9, (message (fun t -> ReservedRange.to_proto' t)), not_packed) ^:: repeated (10, string, not_packed) ^:: nil ) in @@ -784,11 +751,7 @@ end = struct end = struct let name' () = "descriptor.google.protobuf.ExtensionRangeOptions" type t = { extensions': Runtime'.Extensions.t; uninterpreted_option: UninterpretedOption.t list } - let make = - fun ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> - let uninterpreted_option = match uninterpreted_option with Some v -> v | None -> [] in - { uninterpreted_option; extensions' } - + let make ?(uninterpreted_option = []) ?(extensions' = Runtime'.Extensions.default) () = { uninterpreted_option; extensions' } let to_proto' = let apply = fun ~f:f' writer { uninterpreted_option; extensions' } -> f' extensions' writer uninterpreted_option in let spec = Runtime'.Serialize.C.( repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in @@ -898,11 +861,7 @@ end = struct end let name' () = "descriptor.google.protobuf.FieldDescriptorProto" type t = { name: string option; extendee: string option; number: int option; label: Label.t option; type': Type.t option; type_name: string option; default_value: string option; options: FieldOptions.t option; oneof_index: int option; json_name: string option; proto3_optional: bool option } - let make = - fun ?name ?extendee ?number ?label ?type' ?type_name ?default_value ?options ?oneof_index ?json_name ?proto3_optional () -> - - { name; extendee; number; label; type'; type_name; default_value; options; oneof_index; json_name; proto3_optional } - + let make ?name ?extendee ?number ?label ?type' ?type_name ?default_value ?options ?oneof_index ?json_name ?proto3_optional () = { name; extendee; number; label; type'; type_name; default_value; options; oneof_index; json_name; proto3_optional } let to_proto' = let apply = fun ~f:f' writer { name; extendee; number; label; type'; type_name; default_value; options; oneof_index; json_name; proto3_optional } -> f' [] writer name extendee number label type' type_name default_value options oneof_index json_name proto3_optional in let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (2, string) ^:: basic_opt (3, int32_int) ^:: basic_opt (4, (enum Label.to_int)) ^:: basic_opt (5, (enum Type.to_int)) ^:: basic_opt (6, string) ^:: basic_opt (7, string) ^:: basic_opt (8, (message (fun t -> FieldOptions.to_proto' t))) ^:: basic_opt (9, int32_int) ^:: basic_opt (10, string) ^:: basic_opt (17, bool) ^:: nil ) in @@ -930,11 +889,7 @@ end = struct end = struct let name' () = "descriptor.google.protobuf.OneofDescriptorProto" type t = { name: string option; options: OneofOptions.t option } - let make = - fun ?name ?options () -> - - { name; options } - + let make ?name ?options () = { name; options } let to_proto' = let apply = fun ~f:f' writer { name; options } -> f' [] writer name options in let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (2, (message (fun t -> OneofOptions.to_proto' t))) ^:: nil ) in @@ -980,11 +935,7 @@ end = struct end = struct let name' () = "descriptor.google.protobuf.EnumDescriptorProto.EnumReservedRange" type t = { start: int option; end': int option } - let make = - fun ?start ?end' () -> - - { start; end' } - + let make ?start ?end' () = { start; end' } let to_proto' = let apply = fun ~f:f' writer { start; end' } -> f' [] writer start end' in let spec = Runtime'.Serialize.C.( basic_opt (1, int32_int) ^:: basic_opt (2, int32_int) ^:: nil ) in @@ -1003,13 +954,7 @@ end = struct end let name' () = "descriptor.google.protobuf.EnumDescriptorProto" type t = { name: string option; value: EnumValueDescriptorProto.t list; options: EnumOptions.t option; reserved_range: EnumReservedRange.t list; reserved_name: string list } - let make = - fun ?name ?value ?options ?reserved_range ?reserved_name () -> - let value = match value with Some v -> v | None -> [] in - let reserved_range = match reserved_range with Some v -> v | None -> [] in - let reserved_name = match reserved_name with Some v -> v | None -> [] in - { name; value; options; reserved_range; reserved_name } - + let make ?name ?(value = []) ?options ?(reserved_range = []) ?(reserved_name = []) () = { name; value; options; reserved_range; reserved_name } let to_proto' = let apply = fun ~f:f' writer { name; value; options; reserved_range; reserved_name } -> f' [] writer name value options reserved_range reserved_name in let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> EnumValueDescriptorProto.to_proto' t)), not_packed) ^:: basic_opt (3, (message (fun t -> EnumOptions.to_proto' t))) ^:: repeated (4, (message (fun t -> EnumReservedRange.to_proto' t)), not_packed) ^:: repeated (5, string, not_packed) ^:: nil ) in @@ -1037,11 +982,7 @@ end = struct end = struct let name' () = "descriptor.google.protobuf.EnumValueDescriptorProto" type t = { name: string option; number: int option; options: EnumValueOptions.t option } - let make = - fun ?name ?number ?options () -> - - { name; number; options } - + let make ?name ?number ?options () = { name; number; options } let to_proto' = let apply = fun ~f:f' writer { name; number; options } -> f' [] writer name number options in let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (2, int32_int) ^:: basic_opt (3, (message (fun t -> EnumValueOptions.to_proto' t))) ^:: nil ) in @@ -1069,11 +1010,7 @@ end = struct end = struct let name' () = "descriptor.google.protobuf.ServiceDescriptorProto" type t = { name: string option; method': MethodDescriptorProto.t list; options: ServiceOptions.t option } - let make = - fun ?name ?method' ?options () -> - let method' = match method' with Some v -> v | None -> [] in - { name; method'; options } - + let make ?name ?(method' = []) ?options () = { name; method'; options } let to_proto' = let apply = fun ~f:f' writer { name; method'; options } -> f' [] writer name method' options in let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: repeated (2, (message (fun t -> MethodDescriptorProto.to_proto' t)), not_packed) ^:: basic_opt (3, (message (fun t -> ServiceOptions.to_proto' t))) ^:: nil ) in @@ -1101,12 +1038,7 @@ end = struct end = struct let name' () = "descriptor.google.protobuf.MethodDescriptorProto" type t = { name: string option; input_type: string option; output_type: string option; options: MethodOptions.t option; client_streaming: bool; server_streaming: bool } - let make = - fun ?name ?input_type ?output_type ?options ?client_streaming ?server_streaming () -> - let client_streaming = match client_streaming with Some v -> v | None -> false in - let server_streaming = match server_streaming with Some v -> v | None -> false in - { name; input_type; output_type; options; client_streaming; server_streaming } - + let make ?name ?input_type ?output_type ?options ?(client_streaming = false) ?(server_streaming = false) () = { name; input_type; output_type; options; client_streaming; server_streaming } let to_proto' = let apply = fun ~f:f' writer { name; input_type; output_type; options; client_streaming; server_streaming } -> f' [] writer name input_type output_type options client_streaming server_streaming in let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (2, string) ^:: basic_opt (3, string) ^:: basic_opt (4, (message (fun t -> MethodOptions.to_proto' t))) ^:: basic (5, bool, Some (false)) ^:: basic (6, bool, Some (false)) ^:: nil ) in @@ -1160,20 +1092,7 @@ end = struct end let name' () = "descriptor.google.protobuf.FileOptions" type t = { extensions': Runtime'.Extensions.t; java_package: string option; java_outer_classname: string option; optimize_for: OptimizeMode.t; java_multiple_files: bool; go_package: string option; cc_generic_services: bool; java_generic_services: bool; py_generic_services: bool; java_generate_equals_and_hash: bool option; deprecated: bool; java_string_check_utf8: bool; cc_enable_arenas: bool; objc_class_prefix: string option; csharp_namespace: string option; swift_prefix: string option; php_class_prefix: string option; php_namespace: string option; php_generic_services: bool; php_metadata_namespace: string option; ruby_package: string option; uninterpreted_option: UninterpretedOption.t list } - let make = - fun ?java_package ?java_outer_classname ?optimize_for ?java_multiple_files ?go_package ?cc_generic_services ?java_generic_services ?py_generic_services ?java_generate_equals_and_hash ?deprecated ?java_string_check_utf8 ?cc_enable_arenas ?objc_class_prefix ?csharp_namespace ?swift_prefix ?php_class_prefix ?php_namespace ?php_generic_services ?php_metadata_namespace ?ruby_package ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> - let optimize_for = match optimize_for with Some v -> v | None -> OptimizeMode.SPEED in - let java_multiple_files = match java_multiple_files with Some v -> v | None -> false in - let cc_generic_services = match cc_generic_services with Some v -> v | None -> false in - let java_generic_services = match java_generic_services with Some v -> v | None -> false in - let py_generic_services = match py_generic_services with Some v -> v | None -> false in - let deprecated = match deprecated with Some v -> v | None -> false in - let java_string_check_utf8 = match java_string_check_utf8 with Some v -> v | None -> false in - let cc_enable_arenas = match cc_enable_arenas with Some v -> v | None -> true in - let php_generic_services = match php_generic_services with Some v -> v | None -> false in - let uninterpreted_option = match uninterpreted_option with Some v -> v | None -> [] in - { java_package; java_outer_classname; optimize_for; java_multiple_files; go_package; cc_generic_services; java_generic_services; py_generic_services; java_generate_equals_and_hash; deprecated; java_string_check_utf8; cc_enable_arenas; objc_class_prefix; csharp_namespace; swift_prefix; php_class_prefix; php_namespace; php_generic_services; php_metadata_namespace; ruby_package; uninterpreted_option; extensions' } - + let make ?java_package ?java_outer_classname ?(optimize_for = OptimizeMode.SPEED) ?(java_multiple_files = false) ?go_package ?(cc_generic_services = false) ?(java_generic_services = false) ?(py_generic_services = false) ?java_generate_equals_and_hash ?(deprecated = false) ?(java_string_check_utf8 = false) ?(cc_enable_arenas = true) ?objc_class_prefix ?csharp_namespace ?swift_prefix ?php_class_prefix ?php_namespace ?(php_generic_services = false) ?php_metadata_namespace ?ruby_package ?(uninterpreted_option = []) ?(extensions' = Runtime'.Extensions.default) () = { java_package; java_outer_classname; optimize_for; java_multiple_files; go_package; cc_generic_services; java_generic_services; py_generic_services; java_generate_equals_and_hash; deprecated; java_string_check_utf8; cc_enable_arenas; objc_class_prefix; csharp_namespace; swift_prefix; php_class_prefix; php_namespace; php_generic_services; php_metadata_namespace; ruby_package; uninterpreted_option; extensions' } let to_proto' = let apply = fun ~f:f' writer { java_package; java_outer_classname; optimize_for; java_multiple_files; go_package; cc_generic_services; java_generic_services; py_generic_services; java_generate_equals_and_hash; deprecated; java_string_check_utf8; cc_enable_arenas; objc_class_prefix; csharp_namespace; swift_prefix; php_class_prefix; php_namespace; php_generic_services; php_metadata_namespace; ruby_package; uninterpreted_option; extensions' } -> f' extensions' writer java_package java_outer_classname optimize_for java_multiple_files go_package cc_generic_services java_generic_services py_generic_services java_generate_equals_and_hash deprecated java_string_check_utf8 cc_enable_arenas objc_class_prefix csharp_namespace swift_prefix php_class_prefix php_namespace php_generic_services php_metadata_namespace ruby_package uninterpreted_option in let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (8, string) ^:: basic (9, (enum OptimizeMode.to_int), Some (OptimizeMode.SPEED)) ^:: basic (10, bool, Some (false)) ^:: basic_opt (11, string) ^:: basic (16, bool, Some (false)) ^:: basic (17, bool, Some (false)) ^:: basic (18, bool, Some (false)) ^:: basic_opt (20, bool) ^:: basic (23, bool, Some (false)) ^:: basic (27, bool, Some (false)) ^:: basic (31, bool, Some (true)) ^:: basic_opt (36, string) ^:: basic_opt (37, string) ^:: basic_opt (39, string) ^:: basic_opt (40, string) ^:: basic_opt (41, string) ^:: basic (42, bool, Some (false)) ^:: basic_opt (44, string) ^:: basic_opt (45, string) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in @@ -1201,14 +1120,7 @@ end = struct end = struct let name' () = "descriptor.google.protobuf.MessageOptions" type t = { extensions': Runtime'.Extensions.t; message_set_wire_format: bool; no_standard_descriptor_accessor: bool; deprecated: bool; map_entry: bool option; uninterpreted_option: UninterpretedOption.t list } - let make = - fun ?message_set_wire_format ?no_standard_descriptor_accessor ?deprecated ?map_entry ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> - let message_set_wire_format = match message_set_wire_format with Some v -> v | None -> false in - let no_standard_descriptor_accessor = match no_standard_descriptor_accessor with Some v -> v | None -> false in - let deprecated = match deprecated with Some v -> v | None -> false in - let uninterpreted_option = match uninterpreted_option with Some v -> v | None -> [] in - { message_set_wire_format; no_standard_descriptor_accessor; deprecated; map_entry; uninterpreted_option; extensions' } - + let make ?(message_set_wire_format = false) ?(no_standard_descriptor_accessor = false) ?(deprecated = false) ?map_entry ?(uninterpreted_option = []) ?(extensions' = Runtime'.Extensions.default) () = { message_set_wire_format; no_standard_descriptor_accessor; deprecated; map_entry; uninterpreted_option; extensions' } let to_proto' = let apply = fun ~f:f' writer { message_set_wire_format; no_standard_descriptor_accessor; deprecated; map_entry; uninterpreted_option; extensions' } -> f' extensions' writer message_set_wire_format no_standard_descriptor_accessor deprecated map_entry uninterpreted_option in let spec = Runtime'.Serialize.C.( basic (1, bool, Some (false)) ^:: basic (2, bool, Some (false)) ^:: basic (3, bool, Some (false)) ^:: basic_opt (7, bool) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in @@ -1288,17 +1200,7 @@ end = struct end let name' () = "descriptor.google.protobuf.FieldOptions" type t = { extensions': Runtime'.Extensions.t; ctype: CType.t; packed: bool option; deprecated: bool; lazy': bool; jstype: JSType.t; weak: bool; unverified_lazy: bool; uninterpreted_option: UninterpretedOption.t list } - let make = - fun ?ctype ?packed ?deprecated ?lazy' ?jstype ?weak ?unverified_lazy ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> - let ctype = match ctype with Some v -> v | None -> CType.STRING in - let deprecated = match deprecated with Some v -> v | None -> false in - let lazy' = match lazy' with Some v -> v | None -> false in - let jstype = match jstype with Some v -> v | None -> JSType.JS_NORMAL in - let weak = match weak with Some v -> v | None -> false in - let unverified_lazy = match unverified_lazy with Some v -> v | None -> false in - let uninterpreted_option = match uninterpreted_option with Some v -> v | None -> [] in - { ctype; packed; deprecated; lazy'; jstype; weak; unverified_lazy; uninterpreted_option; extensions' } - + let make ?(ctype = CType.STRING) ?packed ?(deprecated = false) ?(lazy' = false) ?(jstype = JSType.JS_NORMAL) ?(weak = false) ?(unverified_lazy = false) ?(uninterpreted_option = []) ?(extensions' = Runtime'.Extensions.default) () = { ctype; packed; deprecated; lazy'; jstype; weak; unverified_lazy; uninterpreted_option; extensions' } let to_proto' = let apply = fun ~f:f' writer { ctype; packed; deprecated; lazy'; jstype; weak; unverified_lazy; uninterpreted_option; extensions' } -> f' extensions' writer ctype packed deprecated lazy' jstype weak unverified_lazy uninterpreted_option in let spec = Runtime'.Serialize.C.( basic (1, (enum CType.to_int), Some (CType.STRING)) ^:: basic_opt (2, bool) ^:: basic (3, bool, Some (false)) ^:: basic (5, bool, Some (false)) ^:: basic (6, (enum JSType.to_int), Some (JSType.JS_NORMAL)) ^:: basic (10, bool, Some (false)) ^:: basic (15, bool, Some (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in @@ -1326,11 +1228,7 @@ end = struct end = struct let name' () = "descriptor.google.protobuf.OneofOptions" type t = { extensions': Runtime'.Extensions.t; uninterpreted_option: UninterpretedOption.t list } - let make = - fun ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> - let uninterpreted_option = match uninterpreted_option with Some v -> v | None -> [] in - { uninterpreted_option; extensions' } - + let make ?(uninterpreted_option = []) ?(extensions' = Runtime'.Extensions.default) () = { uninterpreted_option; extensions' } let to_proto' = let apply = fun ~f:f' writer { uninterpreted_option; extensions' } -> f' extensions' writer uninterpreted_option in let spec = Runtime'.Serialize.C.( repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in @@ -1358,12 +1256,7 @@ end = struct end = struct let name' () = "descriptor.google.protobuf.EnumOptions" type t = { extensions': Runtime'.Extensions.t; allow_alias: bool option; deprecated: bool; uninterpreted_option: UninterpretedOption.t list } - let make = - fun ?allow_alias ?deprecated ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> - let deprecated = match deprecated with Some v -> v | None -> false in - let uninterpreted_option = match uninterpreted_option with Some v -> v | None -> [] in - { allow_alias; deprecated; uninterpreted_option; extensions' } - + let make ?allow_alias ?(deprecated = false) ?(uninterpreted_option = []) ?(extensions' = Runtime'.Extensions.default) () = { allow_alias; deprecated; uninterpreted_option; extensions' } let to_proto' = let apply = fun ~f:f' writer { allow_alias; deprecated; uninterpreted_option; extensions' } -> f' extensions' writer allow_alias deprecated uninterpreted_option in let spec = Runtime'.Serialize.C.( basic_opt (2, bool) ^:: basic (3, bool, Some (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in @@ -1391,12 +1284,7 @@ end = struct end = struct let name' () = "descriptor.google.protobuf.EnumValueOptions" type t = { extensions': Runtime'.Extensions.t; deprecated: bool; uninterpreted_option: UninterpretedOption.t list } - let make = - fun ?deprecated ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> - let deprecated = match deprecated with Some v -> v | None -> false in - let uninterpreted_option = match uninterpreted_option with Some v -> v | None -> [] in - { deprecated; uninterpreted_option; extensions' } - + let make ?(deprecated = false) ?(uninterpreted_option = []) ?(extensions' = Runtime'.Extensions.default) () = { deprecated; uninterpreted_option; extensions' } let to_proto' = let apply = fun ~f:f' writer { deprecated; uninterpreted_option; extensions' } -> f' extensions' writer deprecated uninterpreted_option in let spec = Runtime'.Serialize.C.( basic (1, bool, Some (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in @@ -1424,12 +1312,7 @@ end = struct end = struct let name' () = "descriptor.google.protobuf.ServiceOptions" type t = { extensions': Runtime'.Extensions.t; deprecated: bool; uninterpreted_option: UninterpretedOption.t list } - let make = - fun ?deprecated ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> - let deprecated = match deprecated with Some v -> v | None -> false in - let uninterpreted_option = match uninterpreted_option with Some v -> v | None -> [] in - { deprecated; uninterpreted_option; extensions' } - + let make ?(deprecated = false) ?(uninterpreted_option = []) ?(extensions' = Runtime'.Extensions.default) () = { deprecated; uninterpreted_option; extensions' } let to_proto' = let apply = fun ~f:f' writer { deprecated; uninterpreted_option; extensions' } -> f' extensions' writer deprecated uninterpreted_option in let spec = Runtime'.Serialize.C.( basic (33, bool, Some (false)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in @@ -1483,13 +1366,7 @@ end = struct end let name' () = "descriptor.google.protobuf.MethodOptions" type t = { extensions': Runtime'.Extensions.t; deprecated: bool; idempotency_level: IdempotencyLevel.t; uninterpreted_option: UninterpretedOption.t list } - let make = - fun ?deprecated ?idempotency_level ?uninterpreted_option ?(extensions' = Runtime'.Extensions.default) () -> - let deprecated = match deprecated with Some v -> v | None -> false in - let idempotency_level = match idempotency_level with Some v -> v | None -> IdempotencyLevel.IDEMPOTENCY_UNKNOWN in - let uninterpreted_option = match uninterpreted_option with Some v -> v | None -> [] in - { deprecated; idempotency_level; uninterpreted_option; extensions' } - + let make ?(deprecated = false) ?(idempotency_level = IdempotencyLevel.IDEMPOTENCY_UNKNOWN) ?(uninterpreted_option = []) ?(extensions' = Runtime'.Extensions.default) () = { deprecated; idempotency_level; uninterpreted_option; extensions' } let to_proto' = let apply = fun ~f:f' writer { deprecated; idempotency_level; uninterpreted_option; extensions' } -> f' extensions' writer deprecated idempotency_level uninterpreted_option in let spec = Runtime'.Serialize.C.( basic (33, bool, Some (false)) ^:: basic (34, (enum IdempotencyLevel.to_int), Some (IdempotencyLevel.IDEMPOTENCY_UNKNOWN)) ^:: repeated (999, (message (fun t -> UninterpretedOption.to_proto' t)), not_packed) ^:: nil ) in @@ -1535,11 +1412,7 @@ end = struct end = struct let name' () = "descriptor.google.protobuf.UninterpretedOption.NamePart" type t = { name_part: string; is_extension: bool } - let make = - fun ~name_part ~is_extension () -> - - { name_part; is_extension } - + let make ~name_part ~is_extension () = { name_part; is_extension } let to_proto' = let apply = fun ~f:f' writer { name_part; is_extension } -> f' [] writer name_part is_extension in let spec = Runtime'.Serialize.C.( basic (1, string, None) ^:: basic (2, bool, None) ^:: nil ) in @@ -1558,11 +1431,7 @@ end = struct end let name' () = "descriptor.google.protobuf.UninterpretedOption" type t = { name: NamePart.t list; identifier_value: string option; positive_int_value: int option; negative_int_value: int option; double_value: float option; string_value: bytes option; aggregate_value: string option } - let make = - fun ?name ?identifier_value ?positive_int_value ?negative_int_value ?double_value ?string_value ?aggregate_value () -> - let name = match name with Some v -> v | None -> [] in - { name; identifier_value; positive_int_value; negative_int_value; double_value; string_value; aggregate_value } - + let make ?(name = []) ?identifier_value ?positive_int_value ?negative_int_value ?double_value ?string_value ?aggregate_value () = { name; identifier_value; positive_int_value; negative_int_value; double_value; string_value; aggregate_value } let to_proto' = let apply = fun ~f:f' writer { name; identifier_value; positive_int_value; negative_int_value; double_value; string_value; aggregate_value } -> f' [] writer name identifier_value positive_int_value negative_int_value double_value string_value aggregate_value in let spec = Runtime'.Serialize.C.( repeated (2, (message (fun t -> NamePart.to_proto' t)), not_packed) ^:: basic_opt (3, string) ^:: basic_opt (4, uint64_int) ^:: basic_opt (5, int64_int) ^:: basic_opt (6, double) ^:: basic_opt (7, bytes) ^:: basic_opt (8, string) ^:: nil ) in @@ -1608,13 +1477,7 @@ end = struct end = struct let name' () = "descriptor.google.protobuf.SourceCodeInfo.Location" type t = { path: int list; span: int list; leading_comments: string option; trailing_comments: string option; leading_detached_comments: string list } - let make = - fun ?path ?span ?leading_comments ?trailing_comments ?leading_detached_comments () -> - let path = match path with Some v -> v | None -> [] in - let span = match span with Some v -> v | None -> [] in - let leading_detached_comments = match leading_detached_comments with Some v -> v | None -> [] in - { path; span; leading_comments; trailing_comments; leading_detached_comments } - + let make ?(path = []) ?(span = []) ?leading_comments ?trailing_comments ?(leading_detached_comments = []) () = { path; span; leading_comments; trailing_comments; leading_detached_comments } let to_proto' = let apply = fun ~f:f' writer { path; span; leading_comments; trailing_comments; leading_detached_comments } -> f' [] writer path span leading_comments trailing_comments leading_detached_comments in let spec = Runtime'.Serialize.C.( repeated (1, int32_int, packed) ^:: repeated (2, int32_int, packed) ^:: basic_opt (3, string) ^:: basic_opt (4, string) ^:: repeated (6, string, not_packed) ^:: nil ) in @@ -1633,11 +1496,7 @@ end = struct end let name' () = "descriptor.google.protobuf.SourceCodeInfo" type t = Location.t list - let make = - fun ?location () -> - let location = match location with Some v -> v | None -> [] in - location - + let make ?(location = []) () = location let to_proto' = let apply = fun ~f:f' writer location -> f' [] writer location in let spec = Runtime'.Serialize.C.( repeated (1, (message (fun t -> Location.to_proto' t)), not_packed) ^:: nil ) in @@ -1683,11 +1542,7 @@ end = struct end = struct let name' () = "descriptor.google.protobuf.GeneratedCodeInfo.Annotation" type t = { path: int list; source_file: string option; begin': int option; end': int option } - let make = - fun ?path ?source_file ?begin' ?end' () -> - let path = match path with Some v -> v | None -> [] in - { path; source_file; begin'; end' } - + let make ?(path = []) ?source_file ?begin' ?end' () = { path; source_file; begin'; end' } let to_proto' = let apply = fun ~f:f' writer { path; source_file; begin'; end' } -> f' [] writer path source_file begin' end' in let spec = Runtime'.Serialize.C.( repeated (1, int32_int, packed) ^:: basic_opt (2, string) ^:: basic_opt (3, int32_int) ^:: basic_opt (4, int32_int) ^:: nil ) in @@ -1706,11 +1561,7 @@ end = struct end let name' () = "descriptor.google.protobuf.GeneratedCodeInfo" type t = Annotation.t list - let make = - fun ?annotation () -> - let annotation = match annotation with Some v -> v | None -> [] in - annotation - + let make ?(annotation = []) () = annotation let to_proto' = let apply = fun ~f:f' writer annotation -> f' [] writer annotation in let spec = Runtime'.Serialize.C.( repeated (1, (message (fun t -> Annotation.to_proto' t)), not_packed) ^:: nil ) in diff --git a/src/spec/options.ml b/src/spec/options.ml index 9122335..f596ca4 100644 --- a/src/spec/options.ml +++ b/src/spec/options.ml @@ -34,11 +34,7 @@ module rec Options : sig end = struct let name' () = "options.Options" type t = bool - let make = - fun ?mangle_names () -> - let mangle_names = match mangle_names with Some v -> v | None -> false in - mangle_names - + let make ?(mangle_names = false) () = mangle_names let to_proto' = let apply = fun ~f:f' writer mangle_names -> f' [] writer mangle_names in let spec = Runtime'.Serialize.C.( basic (1, bool, Some (false)) ^:: nil ) in diff --git a/src/spec/plugin.ml b/src/spec/plugin.ml index 14e7ed3..7743c40 100644 --- a/src/spec/plugin.ml +++ b/src/spec/plugin.ml @@ -172,11 +172,7 @@ end = struct end = struct let name' () = "plugin.google.protobuf.compiler.Version" type t = { major: int option; minor: int option; patch: int option; suffix: string option } - let make = - fun ?major ?minor ?patch ?suffix () -> - - { major; minor; patch; suffix } - + let make ?major ?minor ?patch ?suffix () = { major; minor; patch; suffix } let to_proto' = let apply = fun ~f:f' writer { major; minor; patch; suffix } -> f' [] writer major minor patch suffix in let spec = Runtime'.Serialize.C.( basic_opt (1, int32_int) ^:: basic_opt (2, int32_int) ^:: basic_opt (3, int32_int) ^:: basic_opt (4, string) ^:: nil ) in @@ -204,12 +200,7 @@ end = struct end = struct let name' () = "plugin.google.protobuf.compiler.CodeGeneratorRequest" type t = { file_to_generate: string list; parameter: string option; compiler_version: Version.t option; proto_file: Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.t list } - let make = - fun ?file_to_generate ?parameter ?compiler_version ?proto_file () -> - let file_to_generate = match file_to_generate with Some v -> v | None -> [] in - let proto_file = match proto_file with Some v -> v | None -> [] in - { file_to_generate; parameter; compiler_version; proto_file } - + let make ?(file_to_generate = []) ?parameter ?compiler_version ?(proto_file = []) () = { file_to_generate; parameter; compiler_version; proto_file } let to_proto' = let apply = fun ~f:f' writer { file_to_generate; parameter; compiler_version; proto_file } -> f' [] writer file_to_generate parameter compiler_version proto_file in let spec = Runtime'.Serialize.C.( repeated (1, string, not_packed) ^:: basic_opt (2, string) ^:: basic_opt (3, (message (fun t -> Version.to_proto' t))) ^:: repeated (15, (message (fun t -> Imported'modules.Descriptor.Google.Protobuf.FileDescriptorProto.to_proto' t)), not_packed) ^:: nil ) in @@ -279,11 +270,7 @@ end = struct end = struct let name' () = "plugin.google.protobuf.compiler.CodeGeneratorResponse.File" type t = { name: string option; insertion_point: string option; content: string option; generated_code_info: Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.t option } - let make = - fun ?name ?insertion_point ?content ?generated_code_info () -> - - { name; insertion_point; content; generated_code_info } - + let make ?name ?insertion_point ?content ?generated_code_info () = { name; insertion_point; content; generated_code_info } let to_proto' = let apply = fun ~f:f' writer { name; insertion_point; content; generated_code_info } -> f' [] writer name insertion_point content generated_code_info in let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (2, string) ^:: basic_opt (15, string) ^:: basic_opt (16, (message (fun t -> Imported'modules.Descriptor.Google.Protobuf.GeneratedCodeInfo.to_proto' t))) ^:: nil ) in @@ -302,11 +289,7 @@ end = struct end let name' () = "plugin.google.protobuf.compiler.CodeGeneratorResponse" type t = { error: string option; supported_features: int option; file: File.t list } - let make = - fun ?error ?supported_features ?file () -> - let file = match file with Some v -> v | None -> [] in - { error; supported_features; file } - + let make ?error ?supported_features ?(file = []) () = { error; supported_features; file } let to_proto' = let apply = fun ~f:f' writer { error; supported_features; file } -> f' [] writer error supported_features file in let spec = Runtime'.Serialize.C.( basic_opt (1, string) ^:: basic_opt (2, uint64_int) ^:: repeated (15, (message (fun t -> File.to_proto' t)), not_packed) ^:: nil ) in diff --git a/test/dune b/test/dune index 47fe3d0..3edf71f 100644 --- a/test/dune +++ b/test/dune @@ -36,7 +36,7 @@ (rule (targets basic.ml primitive_types.ml int_types.ml repeated.ml enum.ml - message.ml oneof.ml map.ml package.ml include.ml included.ml + message.ml oneof.ml map.ml package.ml include.ml included.ml large.ml included2.ml included3_dash.ml service.ml recursive.ml protocol.ml name_clash.ml name_clash_mangle.ml proto2.ml packed.ml mangle_names.ml extensions.ml options.ml name_clash2.ml empty.ml service_rpc_clash.ml service_empty_package.ml) @@ -44,7 +44,7 @@ (:plugin ../src/plugin/protoc_gen_ocaml.exe) (:proto basic.proto primitive_types.proto int_types.proto repeated.proto - enum.proto message.proto oneof.proto map.proto package.proto + enum.proto message.proto oneof.proto map.proto package.proto large.proto include.proto included.proto included2.proto included3-dash.proto service.proto recursive.proto protocol.proto name_clash.proto name_clash_mangle.proto proto2.proto packed.proto mangle_names.proto extensions.proto options.proto diff --git a/test/large.proto b/test/large.proto new file mode 100644 index 0000000..c2f51d1 --- /dev/null +++ b/test/large.proto @@ -0,0 +1,254 @@ +syntax = "proto3"; + +message large { + uint32 x1 = 1; + uint32 x2 = 2; + uint32 x3 = 3; + uint32 x4 = 4; + uint32 x5 = 5; + uint32 x6 = 6; + uint32 x7 = 7; + uint32 x8 = 8; + uint32 x9 = 9; + uint32 x10 = 10; + uint32 x11 = 11; + uint32 x12 = 12; + uint32 x13 = 13; + uint32 x14 = 14; + uint32 x15 = 15; + uint32 x16 = 16; + uint32 x17 = 17; + uint32 x18 = 18; + uint32 x19 = 19; + uint32 x20 = 20; + uint32 x21 = 21; + uint32 x22 = 22; + uint32 x23 = 23; + uint32 x24 = 24; + uint32 x25 = 25; + uint32 x26 = 26; + uint32 x27 = 27; + uint32 x28 = 28; + uint32 x29 = 29; + uint32 x30 = 30; + uint32 x31 = 31; + uint32 x32 = 32; + uint32 x33 = 33; + uint32 x34 = 34; + uint32 x35 = 35; + uint32 x36 = 36; + uint32 x37 = 37; + uint32 x38 = 38; + uint32 x39 = 39; + uint32 x40 = 40; + uint32 x41 = 41; + uint32 x42 = 42; + uint32 x43 = 43; + uint32 x44 = 44; + uint32 x45 = 45; + uint32 x46 = 46; + uint32 x47 = 47; + uint32 x48 = 48; + uint32 x49 = 49; + uint32 x50 = 50; + uint32 x51 = 51; + uint32 x52 = 52; + uint32 x53 = 53; + uint32 x54 = 54; + uint32 x55 = 55; + uint32 x56 = 56; + uint32 x57 = 57; + uint32 x58 = 58; + uint32 x59 = 59; + uint32 x60 = 60; + uint32 x61 = 61; + uint32 x62 = 62; + uint32 x63 = 63; + uint32 x64 = 64; + uint32 x65 = 65; + uint32 x66 = 66; + uint32 x67 = 67; + uint32 x68 = 68; + uint32 x69 = 69; + uint32 x70 = 70; + uint32 x71 = 71; + uint32 x72 = 72; + uint32 x73 = 73; + uint32 x74 = 74; + uint32 x75 = 75; + uint32 x76 = 76; + uint32 x77 = 77; + uint32 x78 = 78; + uint32 x79 = 79; + uint32 x80 = 80; + uint32 x81 = 81; + uint32 x82 = 82; + uint32 x83 = 83; + uint32 x84 = 84; + uint32 x85 = 85; + uint32 x86 = 86; + uint32 x87 = 87; + uint32 x88 = 88; + uint32 x89 = 89; + uint32 x90 = 90; + uint32 x91 = 91; + uint32 x92 = 92; + uint32 x93 = 93; + uint32 x94 = 94; + uint32 x95 = 95; + uint32 x96 = 96; + uint32 x97 = 97; + uint32 x98 = 98; + uint32 x99 = 99; + uint32 x100 = 100; + uint32 x101 = 101; + uint32 x102 = 102; + uint32 x103 = 103; + uint32 x104 = 104; + uint32 x105 = 105; + uint32 x106 = 106; + uint32 x107 = 107; + uint32 x108 = 108; + uint32 x109 = 109; + uint32 x110 = 110; + uint32 x111 = 111; + uint32 x112 = 112; + uint32 x113 = 113; + uint32 x114 = 114; + uint32 x115 = 115; + uint32 x116 = 116; + uint32 x117 = 117; + uint32 x118 = 118; + uint32 x119 = 119; + uint32 x120 = 120; + uint32 x121 = 121; + uint32 x122 = 122; + uint32 x123 = 123; + uint32 x124 = 124; + uint32 x125 = 125; + uint32 x126 = 126; + uint32 x127 = 127; + uint32 x128 = 128; + uint32 x129 = 129; + uint32 x130 = 130; + uint32 x131 = 131; + uint32 x132 = 132; + uint32 x133 = 133; + uint32 x134 = 134; + uint32 x135 = 135; + uint32 x136 = 136; + uint32 x137 = 137; + uint32 x138 = 138; + uint32 x139 = 139; + uint32 x140 = 140; + uint32 x141 = 141; + uint32 x142 = 142; + uint32 x143 = 143; + uint32 x144 = 144; + uint32 x145 = 145; + uint32 x146 = 146; + uint32 x147 = 147; + uint32 x148 = 148; + uint32 x149 = 149; + uint32 x150 = 150; + uint32 x151 = 151; + uint32 x152 = 152; + uint32 x153 = 153; + uint32 x154 = 154; + uint32 x155 = 155; + uint32 x156 = 156; + uint32 x157 = 157; + uint32 x158 = 158; + uint32 x159 = 159; + uint32 x160 = 160; + uint32 x161 = 161; + uint32 x162 = 162; + uint32 x163 = 163; + uint32 x164 = 164; + uint32 x165 = 165; + uint32 x166 = 166; + uint32 x167 = 167; + uint32 x168 = 168; + uint32 x169 = 169; + uint32 x170 = 170; + uint32 x171 = 171; + uint32 x172 = 172; + uint32 x173 = 173; + uint32 x174 = 174; + uint32 x175 = 175; + uint32 x176 = 176; + uint32 x177 = 177; + uint32 x178 = 178; + uint32 x179 = 179; + uint32 x180 = 180; + uint32 x181 = 181; + uint32 x182 = 182; + uint32 x183 = 183; + uint32 x184 = 184; + uint32 x185 = 185; + uint32 x186 = 186; + uint32 x187 = 187; + uint32 x188 = 188; + uint32 x189 = 189; + uint32 x190 = 190; + uint32 x191 = 191; + uint32 x192 = 192; + uint32 x193 = 193; + uint32 x194 = 194; + uint32 x195 = 195; + uint32 x196 = 196; + uint32 x197 = 197; + uint32 x198 = 198; + uint32 x199 = 199; + uint32 x200 = 200; + uint32 x201 = 201; + uint32 x202 = 202; + uint32 x203 = 203; + uint32 x204 = 204; + uint32 x205 = 205; + uint32 x206 = 206; + uint32 x207 = 207; + uint32 x208 = 208; + uint32 x209 = 209; + uint32 x210 = 210; + uint32 x211 = 211; + uint32 x212 = 212; + uint32 x213 = 213; + uint32 x214 = 214; + uint32 x215 = 215; + uint32 x216 = 216; + uint32 x217 = 217; + uint32 x218 = 218; + uint32 x219 = 219; + uint32 x220 = 220; + uint32 x221 = 221; + uint32 x222 = 222; + uint32 x223 = 223; + uint32 x224 = 224; + uint32 x225 = 225; + uint32 x226 = 226; + uint32 x227 = 227; + uint32 x228 = 228; + uint32 x229 = 229; + uint32 x230 = 230; + uint32 x231 = 231; + uint32 x232 = 232; + uint32 x233 = 233; + uint32 x234 = 234; + uint32 x235 = 235; + uint32 x236 = 236; + uint32 x237 = 237; + uint32 x238 = 238; + uint32 x239 = 239; + uint32 x240 = 240; + uint32 x241 = 241; + uint32 x242 = 242; + uint32 x243 = 243; + uint32 x244 = 244; + uint32 x245 = 245; + uint32 x246 = 246; + uint32 x247 = 247; + uint32 x248 = 248; + uint32 x249 = 249; + uint32 x250 = 250; +} diff --git a/test/large_test.ml b/test/large_test.ml new file mode 100644 index 0000000..d9b8243 --- /dev/null +++ b/test/large_test.ml @@ -0,0 +1,19 @@ +open Large +open Ocaml_protoc_plugin + +let%expect_test "Test very large message type" = + let large = Large.make ~x7:7 () in + let writer = Large.to_proto large in + let contents = Writer.contents writer in + Printf.printf "Size of large message: %d\n" (String.length contents); + let reader = Reader.create contents in + let large' = Large.from_proto_exn reader in + Printf.printf "Serialization works: %b\n" (large = large'); + Printf.printf "x7: %d = %d\n" large.x7 large'.x7; + Printf.printf "x5: %d = %d\n" large.x5 large'.x5; + (); + [%expect {| + Size of large message: 2 + Serialization works: true + x7: 7 = 7 + x5: 0 = 0 |}] From ae705bfeb1c448c1c848f6febc5633354db90b34 Mon Sep 17 00:00:00 2001 From: Anders Fugmann Date: Mon, 22 Jan 2024 19:46:11 +0100 Subject: [PATCH 26/30] Update tests for repeated types --- test/packed_test.ml | 49 ++++++++++++++++++++++++++++++++++++--------- 1 file changed, 39 insertions(+), 10 deletions(-) diff --git a/test/packed_test.ml b/test/packed_test.ml index 3942e51..ff13a55 100644 --- a/test/packed_test.ml +++ b/test/packed_test.ml @@ -1,15 +1,18 @@ open Packed -let%expect_test "Packed as string" = +let%expect_test "Packed" = let module T = Packed.Packed in let module T' = Packed.String in - let t = [5; 6; 7; 8; 9] in + let t = [5; 6; 0; 7; 8; 9] in Test_lib.test_encode (module T) t; - T.to_proto t - |> Ocaml_protoc_plugin.Writer.contents + let contents = + T.to_proto t + |> Ocaml_protoc_plugin.Writer.contents + in + contents |> Ocaml_protoc_plugin.Reader.create |> T'.from_proto |> (function - | Ok t -> print_endline (T'.show t) + | Ok t -> Printf.printf "Data: %s. Size: %d\n" (T'.show t) (String.length contents) | Error e -> Printf.printf "Failed to decode: %s\n" (Ocaml_protoc_plugin.Result.show_error e) ); [%expect {| @@ -20,17 +23,21 @@ let%expect_test "Packed as string" = i: 9 "\005\006\007\b\t" |}] -let%expect_test "Packed as int" = +let%expect_test "Not packed" = let module T = Packed.Not_packed in let module T' = Packed.UInt in - let t = [5; 6; 7; 8; 9] in + let t = [5; 6; 0; 7; 8; 9] in Test_lib.test_encode (module T) t; - T.to_proto t - |> Ocaml_protoc_plugin.Writer.contents + let contents = + T.to_proto t + |> Ocaml_protoc_plugin.Writer.contents + in + contents |> Ocaml_protoc_plugin.Reader.create |> T'.from_proto |> (function - | Ok t -> print_endline (T'.show t) + | Ok t -> Printf.printf "Last element: %s. Size: %d\n" (T'.show t) (String.length contents) + | Error e -> Printf.printf "Failed to decode: %s\n" (Ocaml_protoc_plugin.Result.show_error e) ); [%expect {| @@ -40,3 +47,25 @@ let%expect_test "Packed as int" = i: 8 i: 9 9 |}] + +(* Verify that empty lists are not serialized at all *) +let%expect_test "Empty lists are not transmitted" = + Test_lib.test_encode (module Packed.Packed) []; + Packed.Packed.to_proto [] + |> Ocaml_protoc_plugin.Writer.contents + |> String.length + |> Printf.eprintf "Size packed %d\n"; + + Test_lib.test_encode (module Packed.Not_packed) []; + Packed.Not_packed.to_proto [] + |> Ocaml_protoc_plugin.Writer.contents + |> String.length + |> Printf.eprintf "Size packed %d\n"; + (); + [%expect {| + i: 5 + i: 6 + i: 7 + i: 8 + i: 9 + "\005\006\007\b\t" |}] From effa2e481476a1687dcf024a07c1c4865713eb17 Mon Sep 17 00:00:00 2001 From: Anders Fugmann Date: Mon, 22 Jan 2024 21:33:55 +0100 Subject: [PATCH 27/30] Optimize deserialization for the fast pass, and update benchmark to be more fair to protoc --- bench/bench.ml | 34 ++++++++++----------- src/ocaml_protoc_plugin/deserialize.ml | 41 +++++++++++++++++++++----- test/packed_test.ml | 14 ++++----- 3 files changed, 57 insertions(+), 32 deletions(-) diff --git a/bench/bench.ml b/bench/bench.ml index 11e5a1d..151bc9c 100644 --- a/bench/bench.ml +++ b/bench/bench.ml @@ -86,11 +86,11 @@ let _ = Gc.set { control with minor_heap_size=4000_1000; space_overhead=500 } -let random_list ?(len=100) ~f () = - List.init (Random.int len) ~f:(fun _ -> f ()) +let random_list ~len ~f () = + List.init len ~f:(fun _ -> f ()) -let random_string () = - String.init (Random.int 20) ~f:(fun _ -> Random.char ()) +let random_string ~len () = + String.init len ~f:(fun _ -> Random.char ()) let create_test_data ~depth () = let module M = Plugin.Bench.M in @@ -106,24 +106,24 @@ let create_test_data ~depth () = let random_enum () = Array.random_element_exn [| Enum.EA; Enum.EB; Enum.EC; Enum.ED; Enum.EE; |] in - let s1 = optional ~f:random_string () in - let n1 = optional ~f:(random_list ~f:(fun () -> Random.int 1_000)) () in - let n2 = optional ~f:(random_list ~f:(fun () -> Random.int 1_000)) () in - let d1 = optional ~f:(random_list ~f:(fun () -> Random.float 1_000.)) () in - let n3 = optional ~f:(fun () -> Random.int 1_000) () in - let b1 = optional ~f:Random.bool () in - let _e = optional ~f:(random_list ~f:random_enum) () in - - Data.make ?s1 ?n1 ?n2 ?d1 ?n3 ?b1 (* ?e *) () + let s1 = random_string ~len:20 () in + let n1 = random_list ~len:100 ~f:(fun () -> Random.int 1_000) () in + let n2 = random_list ~len:100 ~f:(fun () -> Random.int 1_000) () in + let d1 = random_list ~len:100 ~f:(fun () -> Random.float 1_000.) () in + let n3 = Random.int 10 in + let b1 = Random.bool () in + let e = random_list ~len:100 ~f:random_enum () in + + Data.make ~s1 ~n1 ~n2 ~d1 ~n3 ~b1 (* ~e *) () in let rec create_btree n () = match n with | 0 -> None | n -> - let data = random_list ~f:create_data () in + let data = random_list ~len:2 ~f:create_data () in let children = - random_list ~len:8 ~f:(create_btree (n - 1)) () |> List.filter_opt + random_list ~len:2 ~f:(create_btree (n - 1)) () |> List.filter_opt in M.make ~children ~data () |> Option.some in @@ -164,7 +164,7 @@ let print_bench_results results = let _ = - let v_plugin = create_test_data ~depth:2 () |> Option.value_exn in + let v_plugin = create_test_data ~depth:4 () |> Option.value_exn in [ make_tests (module Protoc.Bench) (module Plugin.Bench) v_plugin; make_tests (module Protoc.Int64) (module Plugin.Int64) 27; @@ -174,7 +174,7 @@ let _ = List.init 1000 ~f:(fun i -> i) |> make_tests (module Protoc.Int64_list) (module Plugin.Int64_list); List.init 1000 ~f:(fun i -> Float.of_int i) |> make_tests (module Protoc.Float_list) (module Plugin.Float_list); - List.init 1000 ~f:(fun _ -> random_string ()) |> make_tests (module Protoc.String_list) (module Plugin.String_list); + List.init 1000 ~f:(fun _ -> random_string ~len:20 ()) |> make_tests (module Protoc.String_list) (module Plugin.String_list); (* random_list ~len:100 ~f:(fun () -> Plugin.Enum_list.Enum.ED) () |> make_tests (module Protoc.Enum_list) (module Plugin.Enum_list); *) ] |> List.rev |> List.iter ~f:(fun test -> diff --git a/src/ocaml_protoc_plugin/deserialize.ml b/src/ocaml_protoc_plugin/deserialize.ml index fdf2e1d..304ac29 100644 --- a/src/ocaml_protoc_plugin/deserialize.ml +++ b/src/ocaml_protoc_plugin/deserialize.ml @@ -247,29 +247,56 @@ let deserialize: type constr a. (int * int) list -> (constr, (int * Field.t) lis | false -> Field.Varint, Int.max_int in - let rec read_values: type constr a. (int * int) list -> Field.field_type -> int -> Reader.t -> constr -> (int * Field.t) list -> (constr, (int * Field.t) list -> a) value_list -> a option = fun extension_ranges tpe idx reader constr extensions -> function - | VCons (((((index, read_f) :: _) as fields), _required, default, get), vs) when index = idx -> + let rec read_values: type constr a. (int * int) list -> Field.field_type -> int -> Reader.t -> constr -> (int * Field.t) list -> (constr, (int * Field.t) list -> a) value_list -> a option = fun extension_ranges tpe idx reader constr extensions -> + let rec read_repeated tpe index read_f default get reader = let default = read_f default reader tpe in let (tpe, idx) = next_field reader in + match idx = index with + | true -> read_repeated tpe index read_f default get reader + | false -> default, tpe, idx + in + function + | VCons (([index, read_f], _required, default, get), vs) when index = idx -> + (* Read all values, and apply constructor once all fields have been read. + This pattern is the most likely to be matched for all values, and is added + as an optimization to avoid reconstructing the value list for each recursion. + *) + let default, tpe, idx = read_repeated tpe index read_f default get reader in + let constr = (constr (get default)) in + read_values extension_ranges tpe idx reader constr extensions vs + | VCons (((index, read_f) :: fields, _required, default, get), vs) when index = idx -> + (* Read all values for the given field *) + let default, tpe, idx = read_repeated tpe index read_f default get reader in read_values extension_ranges tpe idx reader constr extensions (VCons ((fields, Optional, default, get), vs)) | vs when in_extension_ranges extension_ranges idx -> - (* Extensions may be sent inline. Store all valid extensions. *) + (* Extensions may be sent inline. Store all valid extensions, before starting to apply constructors *) let extensions = (idx, Reader.read_field_content tpe reader) :: extensions in let (tpe, idx) = next_field reader in read_values extension_ranges tpe idx reader constr extensions vs + | VCons (([], Required, _default, _get), _vs) -> + (* If there are no more fields to be read we will never find the value. + If all values are read, then raise, else revert to full deserialization *) + begin match (idx = Int.max_int) with + | true -> error_required_field_missing () + | false -> None + end | VCons ((_ :: fields, optional, default, get), vs) -> + (* Drop the field, as we dont expect to find it. *) read_values extension_ranges tpe idx reader constr extensions (VCons ((fields, optional, default, get), vs)) - | VCons (([], Required, _default, _get), _vs) -> - None | VCons (([], Optional, default, get), vs) -> + (* Apply destructor. This case is only relevant for oneof fields *) read_values extension_ranges tpe idx reader (constr (get default)) extensions vs | VNil when idx = Int.max_int -> + (* All fields read successfully. Apply extensions and return result. *) Some (constr (List.rev extensions)) - | VNil -> None + | VNil -> + (* This implies that there are still fields to be read. + Revert to full deserialization. + *) + None in fun reader -> let offset = Reader.offset reader in - (* This start is horrible! We could simplify with has *) let (tpe, idx) = next_field reader in read_values extension_ranges tpe idx reader constr [] values |> function diff --git a/test/packed_test.ml b/test/packed_test.ml index ff13a55..1cf06d7 100644 --- a/test/packed_test.ml +++ b/test/packed_test.ml @@ -18,10 +18,11 @@ let%expect_test "Packed" = [%expect {| i: 5 i: 6 + i: 0 i: 7 i: 8 i: 9 - "\005\006\007\b\t" |}] + Data: "\005\006\000\007\b\t". Size: 8 |}] let%expect_test "Not packed" = let module T = Packed.Not_packed in @@ -43,10 +44,11 @@ let%expect_test "Not packed" = [%expect {| i: 5 i: 6 + i: 0 i: 7 i: 8 i: 9 - 9 |}] + Last element: 9. Size: 12 |}] (* Verify that empty lists are not serialized at all *) let%expect_test "Empty lists are not transmitted" = @@ -63,9 +65,5 @@ let%expect_test "Empty lists are not transmitted" = |> Printf.eprintf "Size packed %d\n"; (); [%expect {| - i: 5 - i: 6 - i: 7 - i: 8 - i: 9 - "\005\006\007\b\t" |}] + Size packed 0 + Size packed 0 |}] From 94fe3255a58a20ee780518f69f682c7950e39299 Mon Sep 17 00:00:00 2001 From: Anders Fugmann Date: Mon, 22 Jan 2024 23:56:37 +0100 Subject: [PATCH 28/30] Do away with loop unrolled versions of read_varint, as they are not meassurable faster than the simpler ones --- src/ocaml_protoc_plugin/reader.ml | 27 +-- src/ocaml_protoc_plugin/writer.ml | 365 ++++++----------------------- src/ocaml_protoc_plugin/writer.mli | 1 - 3 files changed, 81 insertions(+), 312 deletions(-) diff --git a/src/ocaml_protoc_plugin/reader.ml b/src/ocaml_protoc_plugin/reader.ml index 22b2fbd..8bdab2d 100644 --- a/src/ocaml_protoc_plugin/reader.ml +++ b/src/ocaml_protoc_plugin/reader.ml @@ -37,6 +37,19 @@ let read_byte t = t.offset <- t.offset + 1; v +let read_varint_reference t = + let open Infix.Int64 in + let rec inner n acc = + let v = read_byte t |> Int64.of_int in + let acc = acc + (v land 0x7fL) lsl n in + match v land 0x80L = 0x80L with + | true -> + (* Still More data *) + inner (Int.add n 7) acc + | false -> acc + in + inner 0 0L + [@@inline] let read_varint t = let rec inner n acc = @@ -59,20 +72,6 @@ let read_varint t = in inner 0 0 -[@@inline] -let read_varint_reference t = - let open Infix.Int64 in - let rec inner n acc = - let v = read_byte t |> Int64.of_int in - let acc = acc + (v land 0x7fL) lsl n in - match v land 0x80L = 0x80L with - | true -> - (* Still More data *) - inner (Int.add n 7) acc - | false -> acc - in - inner 0 0L - [@@inline] let read_varint_unboxed t = let rec inner n acc = diff --git a/src/ocaml_protoc_plugin/writer.ml b/src/ocaml_protoc_plugin/writer.ml index bde8c70..f029bdd 100644 --- a/src/ocaml_protoc_plugin/writer.ml +++ b/src/ocaml_protoc_plugin/writer.ml @@ -26,274 +26,6 @@ let unused_space t = in inner t.data -(** Get index of most significant bit. *) -let varint_size_reference v = - let rec inner acc = function - | 0 -> acc - | v -> inner (acc + 1) (v lsr 1) - in - match v with - | v when v < 0 -> 10 - | 0 -> 1 - | v -> (6 + inner 0 v) / 7 - -let varint_size = function - | v when v < 0 -> 10 - | v when v < 0x80 -> 1 - | v when v < 0x4000 -> 2 - | v when v < 0x200000 -> 3 - | v when v < 0x10000000 -> 4 - | v when v < 0x800000000 -> 5 - | v when v < 0x40000000000 -> 6 - | v when v < 0x2000000000000 -> 7 - | v when v < 0x100000000000000 -> 8 - | _ -> 9 - -(* Manually unroll *) -let write_varint_unboxed buffer ~offset = function - | v when v < 0 -> - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let offset = offset + 1 in - Bytes.set_uint8 buffer offset 0x01; - offset + 1 - - | v when v < 1 lsl (7*1) -> - Bytes.set_uint8 buffer offset v; - offset + 1 - - | v when v < 1 lsl (7*2) -> - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset v; - offset + 1 - - | v when v < 1 lsl (7*3) -> - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset v; - offset + 1 - - | v when v < 1 lsl (7*4) -> - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset v; - offset + 1 - - | v when v < 1 lsl (7*5) -> - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset v; - offset + 1 - - | v when v < 1 lsl (7*6) -> - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset v; - offset + 1 - - | v when v < 1 lsl (7*7) -> - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset v; - offset + 1 - - | v when v < 1 lsl (8*7) -> - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset v; - offset + 1 - - | v (* when v < 1 lsl (8*8) *) -> - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset v; - offset + 1 - -(* Write a field delimited length. - A delimited field length can be no larger than 2^31. - This function always write 5 bytes (7*5bits > 31bits). - This allows the field length to be statically allocated and written later. - The spec does not forbid this encoding, but there might be implementation - that disallow '0' as the ending varint value. -*) -let write_delimited_field_length_fixed_size buffer ~offset v = - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset v; - offset + 1 - -(* If we clear the top bit, then its not signed anymore... Maybe. *) -let write_varint buffer ~offset vl = - let v = Int64.to_int vl in - (* Int64.to_int just strips the high bit *) - match (Int64.shift_right_logical vl 62) = 0L with - | true -> - (* Bits 63 or 64 are not set, so write as unboxed *) - write_varint_unboxed buffer ~offset v - | false -> - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let v = v lsr 7 in - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (v lor 128); - let offset = offset + 1 in - let v = v lsr 7 in - let offset = match vl < 0L with - | true -> - Bytes.set_uint8 buffer offset (v lor 128); - let offset = offset + 1 in - Bytes.set_uint8 buffer offset (0x01); (* Always set the 64'th bit *) - offset - | false -> - Bytes.set_uint8 buffer offset v; - offset - in - offset + 1 - -(** Reference implementation. Uses a loop which is slower than the manually unrolled version *) let write_varint_reference buffer ~offset v = let rec inner ~offset v = let next_offset = offset + 1 in @@ -303,28 +35,63 @@ let write_varint_reference buffer ~offset v = Bytes.set_uint8 buffer offset (Int64.to_int v); next_offset | rem -> - Bytes.set_uint8 buffer offset (Int.logor (Int64.to_int v) 0x80); + Bytes.set_uint8 buffer offset (Int.logor (Int64.to_int v) 0b1000_0000); inner ~offset:next_offset rem in inner ~offset v (** Reference implementation. Uses a loop which is slower than the manually unrolled version *) -let write_varint_unboxed_reference buffer ~offset v = +let write_varint_unboxed buffer ~offset v = let rec inner ~is_negative ~offset v = match v lsr 7 with | 0 when is_negative -> - (* If the value was signed, set bit 63 and 64 *) - inner ~is_negative:false ~offset (v lor 0xC0) + (* If the value was signed, set bit 64 also *) + inner ~is_negative:false ~offset (v lor 0b1000_0000) | 0 -> Bytes.set_uint8 buffer offset v; offset + 1 | rem -> - let v' = v land 0x7F lor 0x80 in - Bytes.set_uint8 buffer offset v'; + Bytes.set_uint8 buffer offset (v lor 0b1000_0000); inner ~is_negative ~offset:(offset + 1) rem in inner ~is_negative:(v < 0) ~offset v +let write_varint buffer ~offset v = + match Int64.shift_right_logical v 62 with + | 0b01L -> + (* Bit 63 set (and not bit 64). + Write as signed int, drop the last byte and clear the msb + *) + let v = Int64.to_int v in + let offset = write_varint_unboxed buffer ~offset v in + let byte = Bytes.get_uint8 buffer (offset - 2) land 0b0111_1111 in + Bytes.set_uint8 buffer (offset - 2) byte; + Bytes.set_uint8 buffer (offset - 1) 0; + offset - 1 + | 0b10L -> + (* Only bit 64 is set. Set bit 63, and then clear it again in the output *) + let v = Int64.to_int v lor 0x4000_0000_0000_0000 in + let offset = write_varint_unboxed buffer ~offset v in + let byte = Bytes.get_uint8 buffer (offset - 2) land 0b1011_1111 in + Bytes.set_uint8 buffer (offset - 2) byte; + offset + | _ -> write_varint_unboxed buffer ~offset (Int64.to_int v) + +(* Write a field delimited length. + A delimited field length can be no larger than 2^31. + This function always write 5 bytes (7*5bits = 35bits > 31bits). + This allows the field length to be statically allocated and written later. + The spec does not forbid this encoding, but there might be implementation + that disallow '0' as the ending varint value. +*) +let write_delimited_field_length_fixed_size buffer ~offset v = + (* Set the 34'th bit to make sure all bytes are written. Then clear it again *) + let offset = write_varint_unboxed buffer ~offset (v lor 0x400000000) in + let v = Bytes.get_uint8 buffer (offset - 1) in + Bytes.set_uint8 buffer (offset-1) (v land 0b0011_1111); + offset + + let ensure_capacity ~size t = match t.data with | { offset; buffer } as elem :: _ when Bytes.length buffer - offset >= size -> elem @@ -467,6 +234,9 @@ let dump t = |> String.concat ~sep:"-" |> Printf.printf "Buffer: %s\n" +let string_of_bytes b = + Bytes.to_seq b |> Seq.map Char.code |> Seq.map (Printf.sprintf "%02x") |> List.of_seq |> String.concat ~sep:" " + let of_list: (int * Field.t) list -> t = fun fields -> let t = init () in List.iter ~f:(fun (index, field) -> write_field t index field) fields; @@ -478,12 +248,29 @@ let%expect_test "Writefield" = write_field buffer 2 (Varint 5L); write_field buffer 3 (Varint 7L); write_field buffer 4 (Varint 11L); - dump buffer; [%expect {| Buffer: 08-03-10-05-18-07-20-0b |}] +let%expect_test "fixed_size" = + List.iter ~f:(fun v -> + let buffer = Bytes.make 10 '\255' in + let _ = write_delimited_field_length_fixed_size buffer ~offset:0 v in + Printf.printf "Fixed field: 0x%08x: %s\n" v (string_of_bytes buffer); + ) [0;1;2;0x7fffffff; 0x3fffffff]; + (); + [%expect {| + Fixed field: 0x00000000: 80 80 80 80 00 ff ff ff ff ff + Fixed field: 0x00000001: 81 80 80 80 00 ff ff ff ff ff + Fixed field: 0x00000002: 82 80 80 80 00 ff ff ff ff ff + Fixed field: 0x7fffffff: ff ff ff ff 07 ff ff ff ff ff + Fixed field: 0x3fffffff: ff ff ff ff 03 ff ff ff ff ff |}] + + let%test "varint unrolled" = let open Infix.Int64 in + let string_of_bytes b = + Bytes.to_seq b |> Seq.map Char.code |> Seq.map (Printf.sprintf "%02x") |> List.of_seq |> String.concat ~sep:" " + in let values = List.init ~len:64 ~f:(fun idx -> 1L lsl idx) @ List.init ~len:64 ~f:(fun idx -> (-1L) lsl idx) in @@ -493,13 +280,13 @@ let%test "varint unrolled" = let acc = let b1 = Bytes.make 10 '\000' in let b2 = Bytes.make 10 '\000' in - write_varint_unboxed_reference b1 ~offset:0 (Int64.to_int v) |> ignore; - write_varint_unboxed b2 ~offset:0 (Int64.to_int v) |> ignore; - match Bytes.equal b1 b2 with + write_varint_unboxed b1 ~offset:0 (Int64.to_int v) |> ignore; + write_varint b2 ~offset:0 (v) |> ignore; + match Bytes.equal b1 b2 || Int64.shift_right_logical v 63 != 0L with | true -> acc | false -> - Printf.printf "Unboxed: %16Lx (%20d): %S = %S\n" v (Int64.to_int v) (Bytes.to_string b1) (Bytes.to_string b2); - false + Printf.printf "Unboxed: %16Lx (%20d): %S = %S\n" v (Int64.to_int v) (string_of_bytes b1) (string_of_bytes b2); + false in let acc = let b1 = Bytes.make 10 '\000' in @@ -509,26 +296,10 @@ let%test "varint unrolled" = match Bytes.equal b1 b2 with | true -> acc | false -> - Printf.printf "Boxed: %16Lx: %S = %S\n" v (Bytes.to_string b1) (Bytes.to_string b2); + Printf.printf "Boxed: %16Lx: %S = %S\n" v (string_of_bytes b1) (string_of_bytes b2); false in acc ) [v-2L; v-1L; v; v+1L; v+2L] ) values - - -let%test "varint size unrolled" = - let open Infix.Int64 in - let values = List.init ~len:64 ~f:(fun idx -> 1L lsl idx) in - List.fold_left ~init:true ~f:(fun acc v -> - List.fold_left ~init:acc ~f:(fun acc v -> - let size_reference = varint_size_reference (Int64.to_int v) in - let size = varint_size (Int64.to_int v) in - match size = size_reference with - | true -> acc - | false -> - Printf.printf "varint_size(0x%Lx/%Ld/%d): %d = %d\n" v v (Int64.to_int v) size size_reference; - false - ) [v-2L; v-1L; v; v+1L; v+2L] - ) values diff --git a/src/ocaml_protoc_plugin/writer.mli b/src/ocaml_protoc_plugin/writer.mli index f002203..5bc9426 100644 --- a/src/ocaml_protoc_plugin/writer.mli +++ b/src/ocaml_protoc_plugin/writer.mli @@ -16,7 +16,6 @@ val init: ?mode:mode -> ?block_size:int -> unit -> t val contents : t -> string (**/**) -val varint_size : int -> int (** Direct functions *) From cd50f0ddbeb6d74f7cda419625ef1544112061f9 Mon Sep 17 00:00:00 2001 From: Anders Fugmann Date: Wed, 24 Jan 2024 00:56:24 +0100 Subject: [PATCH 29/30] Use unsafe_read and conversions when size has already been verified, and simplify read and write of varints. Using flambda, this has proven to be the fastest implementation. --- src/ocaml_protoc_plugin/infix.ml | 13 +++++ src/ocaml_protoc_plugin/reader.ml | 65 ++++++------------------ src/ocaml_protoc_plugin/reader.mli | 5 +- src/ocaml_protoc_plugin/writer.ml | 79 ++++++------------------------ src/ocaml_protoc_plugin/writer.mli | 5 +- 5 files changed, 49 insertions(+), 118 deletions(-) diff --git a/src/ocaml_protoc_plugin/infix.ml b/src/ocaml_protoc_plugin/infix.ml index e471d19..a78c58f 100644 --- a/src/ocaml_protoc_plugin/infix.ml +++ b/src/ocaml_protoc_plugin/infix.ml @@ -10,3 +10,16 @@ module Int64 = struct let ( * ) = mul let (-) = sub end + +module Int = struct + open Int + let (land) = logand + let (lsl) = shift_left + let (lsr) = shift_right_logical + let (lor) = logor + let (lxor) = logxor + let (+) = add + let (/) = div + let ( * ) = mul + let (-) = sub +end diff --git a/src/ocaml_protoc_plugin/reader.ml b/src/ocaml_protoc_plugin/reader.ml index 8bdab2d..87dc368 100644 --- a/src/ocaml_protoc_plugin/reader.ml +++ b/src/ocaml_protoc_plugin/reader.ml @@ -20,72 +20,39 @@ let create ?(offset = 0) ?length data = let reset t offset = t.offset <- offset let offset { offset; _ } = offset -[@@inline] let validate_capacity t count = match t.offset + count <= t.end_offset with | true -> () | false -> Result.raise `Premature_end_of_input - [@@inline] -let has_more t = t.offset < t.end_offset +let has_more t = t.offset < t.end_offset [@@inline] + let read_byte t = - validate_capacity t 1; - let v = Bytes.get_uint8 (Bytes.unsafe_of_string t.data) t.offset in - t.offset <- t.offset + 1; - v + match t.offset < t.end_offset with + | true -> + let v = String.unsafe_get t.data t.offset |> Char.code in + t.offset <- t.offset + 1; + v + | false -> Result.raise `Premature_end_of_input +[@@inline] -let read_varint_reference t = +let read_varint t = let open Infix.Int64 in - let rec inner n acc = + let rec inner acc bit = let v = read_byte t |> Int64.of_int in - let acc = acc + (v land 0x7fL) lsl n in + let acc = acc lor ((v land 0x7fL) lsl bit) in match v land 0x80L = 0x80L with | true -> - (* Still More data *) - inner (Int.add n 7) acc + inner acc (Int.add bit 7) | false -> acc in - inner 0 0L + inner 0L 0[@@unrolled 10] -[@@inline] -let read_varint t = - let rec inner n acc = - let v = read_byte t in - let acc = acc + (v land 0x7f) lsl n in - match v land 0x80 = 0x80 with - | true when acc < 0 -> begin - let accl = Int64.of_int acc in (* If bit63 was set, then bit63 and bit64 are now set *) - let accl = match read_byte t land 0x01 = 0x01 with - | true -> accl - | false -> Int64.logand accl 0x7fffffffffffffffL (* Apparently not a negative number after all *) - in - accl - end - | true -> inner (n + 7) acc - | false when acc < 0 -> (* Bit 63 is set, convert into a 64 bit integer, but clear bit64 *) - Int64.logand 0x7fffffffffffffffL (Int64.of_int acc) - | false -> Int64.of_int acc - - in - inner 0 0 - -[@@inline] -let read_varint_unboxed t = - let rec inner n acc = - let v = read_byte t in - let acc = acc + (v land 0x7f) lsl n in - match v land 0x80 = 0x80 with - | true -> - (* Still More data *) - inner (n + 7) acc - | false -> acc - in - inner 0 0 +let read_varint_unboxed t = read_varint t |> Int64.to_int -(* Implement little endian ourselves *) let read_fixed32 t = let size = 4 in validate_capacity t size; @@ -148,7 +115,7 @@ let%expect_test "varint boxed" = Writer.contents writer in Printf.printf "0x%016LxL = 0x%016LxL\n" - (read_varint_reference (create buffer)) + v (read_varint (create buffer)); () ) values; diff --git a/src/ocaml_protoc_plugin/reader.mli b/src/ocaml_protoc_plugin/reader.mli index 98a3e2d..98a345e 100644 --- a/src/ocaml_protoc_plugin/reader.mli +++ b/src/ocaml_protoc_plugin/reader.mli @@ -10,9 +10,10 @@ val read_field_header: t -> Field.field_type * int val read_field_content : Field.field_type -> t -> Field.t val has_more : t -> bool val to_list : t -> (int * Field.t) list -val read_varint : t -> int64 -val read_varint_unboxed : t -> int val read_length_delimited : t -> Field.length_delimited val read_fixed32 : t -> int32 val read_fixed64 : t -> int64 + +val read_varint : t -> int64 +val read_varint_unboxed : t -> int (**/**) diff --git a/src/ocaml_protoc_plugin/writer.ml b/src/ocaml_protoc_plugin/writer.ml index f029bdd..b39d8b7 100644 --- a/src/ocaml_protoc_plugin/writer.ml +++ b/src/ocaml_protoc_plugin/writer.ml @@ -26,56 +26,21 @@ let unused_space t = in inner t.data -let write_varint_reference buffer ~offset v = +let write_varint buffer ~offset v = let rec inner ~offset v = let next_offset = offset + 1 in let open Infix.Int64 in match v lsr 7 with | 0L -> - Bytes.set_uint8 buffer offset (Int64.to_int v); + Bytes.unsafe_set buffer offset (Int64.to_int v |> Char.unsafe_chr); next_offset | rem -> - Bytes.set_uint8 buffer offset (Int.logor (Int64.to_int v) 0b1000_0000); + Bytes.unsafe_set buffer offset ((v land 0x7fL) lor 0b1000_0000L |> Int64.to_int |> Char.unsafe_chr); inner ~offset:next_offset rem in - inner ~offset v + inner ~offset v[@@unrolled 10] -(** Reference implementation. Uses a loop which is slower than the manually unrolled version *) -let write_varint_unboxed buffer ~offset v = - let rec inner ~is_negative ~offset v = - match v lsr 7 with - | 0 when is_negative -> - (* If the value was signed, set bit 64 also *) - inner ~is_negative:false ~offset (v lor 0b1000_0000) - | 0 -> - Bytes.set_uint8 buffer offset v; - offset + 1 - | rem -> - Bytes.set_uint8 buffer offset (v lor 0b1000_0000); - inner ~is_negative ~offset:(offset + 1) rem - in - inner ~is_negative:(v < 0) ~offset v - -let write_varint buffer ~offset v = - match Int64.shift_right_logical v 62 with - | 0b01L -> - (* Bit 63 set (and not bit 64). - Write as signed int, drop the last byte and clear the msb - *) - let v = Int64.to_int v in - let offset = write_varint_unboxed buffer ~offset v in - let byte = Bytes.get_uint8 buffer (offset - 2) land 0b0111_1111 in - Bytes.set_uint8 buffer (offset - 2) byte; - Bytes.set_uint8 buffer (offset - 1) 0; - offset - 1 - | 0b10L -> - (* Only bit 64 is set. Set bit 63, and then clear it again in the output *) - let v = Int64.to_int v lor 0x4000_0000_0000_0000 in - let offset = write_varint_unboxed buffer ~offset v in - let byte = Bytes.get_uint8 buffer (offset - 2) land 0b1011_1111 in - Bytes.set_uint8 buffer (offset - 2) byte; - offset - | _ -> write_varint_unboxed buffer ~offset (Int64.to_int v) +let write_varint_unboxed buffer ~offset v = write_varint buffer ~offset (Int64.of_int v) (* Write a field delimited length. A delimited field length can be no larger than 2^31. @@ -266,7 +231,7 @@ let%expect_test "fixed_size" = Fixed field: 0x3fffffff: ff ff ff ff 03 ff ff ff ff ff |}] -let%test "varint unrolled" = +let%test "varint" = let open Infix.Int64 in let string_of_bytes b = Bytes.to_seq b |> Seq.map Char.code |> Seq.map (Printf.sprintf "%02x") |> List.of_seq |> String.concat ~sep:" " @@ -276,30 +241,14 @@ let%test "varint unrolled" = in List.fold_left ~init:true ~f:(fun acc v -> List.fold_left ~init:acc ~f:(fun acc v -> - - let acc = - let b1 = Bytes.make 10 '\000' in - let b2 = Bytes.make 10 '\000' in - write_varint_unboxed b1 ~offset:0 (Int64.to_int v) |> ignore; - write_varint b2 ~offset:0 (v) |> ignore; - match Bytes.equal b1 b2 || Int64.shift_right_logical v 63 != 0L with - | true -> acc - | false -> - Printf.printf "Unboxed: %16Lx (%20d): %S = %S\n" v (Int64.to_int v) (string_of_bytes b1) (string_of_bytes b2); - false - in - let acc = - let b1 = Bytes.make 10 '\000' in - let b2 = Bytes.make 10 '\000' in - write_varint_reference b1 ~offset:0 v |> ignore; - write_varint b2 ~offset:0 v |> ignore; - match Bytes.equal b1 b2 with - | true -> acc - | false -> - Printf.printf "Boxed: %16Lx: %S = %S\n" v (string_of_bytes b1) (string_of_bytes b2); + let b1 = Bytes.make 10 '\000' in + let b2 = Bytes.make 10 '\000' in + write_varint_unboxed b1 ~offset:0 (Int64.to_int v) |> ignore; + write_varint b2 ~offset:0 (v) |> ignore; + match Bytes.equal b1 b2 || Int64.shift_right_logical v 63 != 0L with + | true -> acc + | false -> + Printf.printf "Unboxed: %16Lx (%20d): %S = %S\n" v (Int64.to_int v) (string_of_bytes b1) (string_of_bytes b2); false - in - acc - ) [v-2L; v-1L; v; v+1L; v+2L] ) values diff --git a/src/ocaml_protoc_plugin/writer.mli b/src/ocaml_protoc_plugin/writer.mli index 5bc9426..8452b7e 100644 --- a/src/ocaml_protoc_plugin/writer.mli +++ b/src/ocaml_protoc_plugin/writer.mli @@ -17,8 +17,7 @@ val contents : t -> string (**/**) -(** Direct functions *) - +(* Direct functions *) val write_fixed32_value: int32 -> t -> unit val write_fixed64_value: int64 -> t -> unit val write_varint_unboxed_value: int -> t -> unit @@ -36,4 +35,6 @@ val of_list: (int * Field.t) list -> t val dump : t -> unit val unused_space : t -> int +val write_varint: Bytes.t -> offset:int -> Int64.t -> int +val write_varint_unboxed: Bytes.t -> offset:int -> int -> int (**/**) From 3b15f82fa4eaefde16b741d5178e4fe90de7047e Mon Sep 17 00:00:00 2001 From: Anders Fugmann Date: Sat, 27 Jan 2024 00:10:46 +0100 Subject: [PATCH 30/30] Fix bug with unordered oneof fields --- src/plugin/types.ml | 49 +++++++++++++++++++-------------------------- test/oneof.proto | 10 +++++++++ 2 files changed, 31 insertions(+), 28 deletions(-) diff --git a/src/plugin/types.ml b/src/plugin/types.ml index 203c023..3d2729e 100644 --- a/src/plugin/types.ml +++ b/src/plugin/types.ml @@ -528,35 +528,27 @@ let c_of_oneof ~params ~syntax:_ ~scope OneofDescriptorProto.{ name; _ } fields (** Return a list of plain fields + a list of fields per oneof_decl *) let split_oneof_decl fields oneof_decls = let open FieldDescriptorProto in - let rec inner oneofs oneof_decls = function - | { oneof_index = Some i; _ } as o1 :: fs -> begin - match oneofs with - | [] -> inner [o1] oneof_decls fs - | { oneof_index = Some j; _ } :: _ when i = j -> - inner (o1 :: oneofs) oneof_decls fs - | oneofs -> - `Oneof (List.hd oneof_decls, List.rev oneofs) :: inner [o1] (List.tl oneof_decls) fs - end - | f :: fs -> begin - match oneofs with - | [] -> `Field f :: inner [] oneof_decls fs - | oneofs -> - `Oneof (List.hd oneof_decls, List.rev oneofs) :: `Field f :: inner [] (List.tl oneof_decls) fs - end - | [] -> begin - match oneofs, oneof_decls with - | [], [] -> [] - | oneofs, [oneof_decl] -> - [ `Oneof (oneof_decl, List.rev oneofs) ] - | _ -> failwith "No field or no oneof" - end + let rec filter_oneofs acc rest index = function + | { oneof_index = Some i; _ } as f :: fs when i = index -> + filter_oneofs (f :: acc) rest index fs + | f :: fs -> filter_oneofs acc (f :: rest) index fs + | [] -> List.rev acc, List.rev rest in - inner [] oneof_decls fields + let rec inner = function + | { oneof_index = Some i; _ } as f :: fs -> + let oneofs, fs = filter_oneofs [f] [] i fs in + let decl = List.nth oneof_decls i in + `Oneof (decl, oneofs) :: inner fs + | f :: fs -> + `Field f :: inner fs + | [] -> [] + in + inner fields let sort_fields fields = let number = function | FieldDescriptorProto.{ number = Some number; _ } -> number - | _ -> failwith "XAll Fields must have a number" + | _ -> failwith "All Fields must have a number" in List.sort ~cmp:(fun v v' -> Int.compare (number v) (number v')) fields @@ -565,10 +557,11 @@ let make ~params ~syntax ~is_cyclic ~is_map_entry ~has_extensions ~scope ~fields let ts = split_oneof_decl fields oneof_decls |> List.map ~f:(function - | `Oneof (_, [ FieldDescriptorProto.{ proto3_optional = Some true; _ } as field] ) - | `Field field -> c_of_field ~params ~syntax ~scope field - | `Oneof (decl, fields) -> c_of_oneof ~params ~syntax ~scope decl fields - ) + (* proto3 Oneof fields with only one field is mapped as regular field *) + | `Oneof (_, [ FieldDescriptorProto.{ proto3_optional = Some true; _ } as field] ) + | `Field field -> c_of_field ~params ~syntax ~scope field + | `Oneof (decl, fields) -> c_of_oneof ~params ~syntax ~scope decl fields + ) in let constructor_sig_arg = function diff --git a/test/oneof.proto b/test/oneof.proto index c70df6e..022fe58 100644 --- a/test/oneof.proto +++ b/test/oneof.proto @@ -50,3 +50,13 @@ message Test5 { message Empty { }; oneof a { Empty e = 1; }; } + +message Test6 { + int64 i = 1; + oneof a { + int64 a1 = 10; + int64 a2 = 21; + }; + int64 j = 20; + oneof b { int64 f = 30; }; +}