From 09a039bfea1086b2a07b847cadea6653dfef99fe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Tue, 29 May 2018 15:03:30 +0200 Subject: [PATCH] Data_encoding: use inline record for case field --- src/lib_data_encoding/binary_length.ml | 8 ++-- src/lib_data_encoding/binary_reader.ml | 8 ++-- src/lib_data_encoding/binary_stream_reader.ml | 8 ++-- src/lib_data_encoding/binary_writer.ml | 8 ++-- src/lib_data_encoding/encoding.ml | 38 ++++++++++++------- src/lib_data_encoding/encoding.mli | 14 +++++-- src/lib_data_encoding/json.ml | 6 +-- 7 files changed, 55 insertions(+), 35 deletions(-) diff --git a/src/lib_data_encoding/binary_length.ml b/src/lib_data_encoding/binary_length.ml index 335a7e5f1..6e564793e 100644 --- a/src/lib_data_encoding/binary_length.ml +++ b/src/lib_data_encoding/binary_length.ml @@ -64,7 +64,7 @@ let rec length : type x. x Encoding.t -> x -> int = length_case cases | Mu (`Dynamic, _name, self) -> length (self e) value - | Obj (Opt (`Dynamic, _, e)) -> begin + | Obj (Opt { kind = `Dynamic ; encoding = e }) -> begin match value with | None -> 1 | Some value -> 1 + length e value @@ -87,7 +87,7 @@ let rec length : type x. x Encoding.t -> x -> int = | Tups (`Variable, e1, e2) -> let (v1, v2) = value in length e1 v1 + length e2 v2 - | Obj (Opt (`Variable, _, e)) -> begin + | Obj (Opt { kind = `Variable ; encoding = e }) -> begin match value with | None -> 0 | Some value -> length e value @@ -106,8 +106,8 @@ let rec length : type x. x Encoding.t -> x -> int = | Mu (`Variable, _name, self) -> length (self e) value (* Recursive*) - | Obj (Req (_, e)) -> length e value - | Obj (Dft (_, e, _)) -> length e value + | Obj (Req { encoding = e }) -> length e value + | Obj (Dft { encoding = e }) -> length e value | Tup e -> length e value | Conv { encoding = e ; proj } -> length e (proj value) diff --git a/src/lib_data_encoding/binary_reader.ml b/src/lib_data_encoding/binary_reader.ml index 512439b24..36625f406 100644 --- a/src/lib_data_encoding/binary_reader.ml +++ b/src/lib_data_encoding/binary_reader.ml @@ -190,15 +190,15 @@ let rec read_rec : type ret. ret Encoding.t -> state -> ret let l = read_list e state in Array.of_list l | List e -> read_list e state - | (Obj (Req (_, e))) -> read_rec e state - | (Obj (Dft (_, e, _))) -> read_rec e state - | (Obj (Opt (`Dynamic, _, e))) -> + | (Obj (Req { encoding = e })) -> read_rec e state + | (Obj (Dft { encoding = e })) -> read_rec e state + | (Obj (Opt { kind = `Dynamic ; encoding = e })) -> let present = Atom.bool state in if not present then None else Some (read_rec e state) - | (Obj (Opt (`Variable, _, e))) -> + | (Obj (Opt { kind = `Variable ; encoding = e })) -> if state.remaining_bytes = 0 then None else diff --git a/src/lib_data_encoding/binary_stream_reader.ml b/src/lib_data_encoding/binary_stream_reader.ml index 0f4a604a5..3dacdfe35 100644 --- a/src/lib_data_encoding/binary_stream_reader.ml +++ b/src/lib_data_encoding/binary_stream_reader.ml @@ -252,16 +252,16 @@ let rec read_rec read_list e state @@ fun (l, state) -> k (Array.of_list l, state) | List e -> read_list e state k - | (Obj (Req (_, e))) -> read_rec e state k - | (Obj (Dft (_, e, _))) -> read_rec e state k - | (Obj (Opt (`Dynamic, _, e))) -> + | (Obj (Req { encoding = e })) -> read_rec e state k + | (Obj (Dft { encoding = e })) -> read_rec e state k + | (Obj (Opt { kind = `Dynamic ; encoding = e })) -> Atom.bool resume state @@ fun (present, state) -> if not present then k (None, state) else read_rec e state @@ fun (v, state) -> k (Some v, state) - | (Obj (Opt (`Variable, _, e))) -> + | (Obj (Opt { kind = `Variable ; encoding = e })) -> let size = remaining_bytes state in if size = 0 then k (None, state) diff --git a/src/lib_data_encoding/binary_writer.ml b/src/lib_data_encoding/binary_writer.ml index 446cf79bb..189dc546a 100644 --- a/src/lib_data_encoding/binary_writer.ml +++ b/src/lib_data_encoding/binary_writer.ml @@ -226,18 +226,18 @@ let rec write_rec : type a. a Encoding.t -> state -> a -> unit = Array.iter (write_rec e state) value | List e -> List.iter (write_rec e state) value - | Obj (Req (_, e)) -> write_rec e state value - | Obj (Opt (`Dynamic, _, e)) -> begin + | Obj (Req { encoding = e }) -> write_rec e state value + | Obj (Opt { kind = `Dynamic ; encoding = e }) -> begin match value with | None -> Atom.bool state false | Some value -> Atom.bool state true ; write_rec e state value end - | Obj (Opt (`Variable, _, e)) -> begin + | Obj (Opt { kind = `Variable ; encoding = e }) -> begin match value with | None -> () | Some value -> write_rec e state value end - | Obj (Dft (_, e, _)) -> write_rec e state value + | Obj (Dft { encoding = e }) -> write_rec e state value | Objs (_, e1, e2) -> let (v1, v2) = value in write_rec e1 state v1 ; diff --git a/src/lib_data_encoding/encoding.ml b/src/lib_data_encoding/encoding.ml index f7cd8a1d8..23146e1a1 100644 --- a/src/lib_data_encoding/encoding.ml +++ b/src/lib_data_encoding/encoding.ml @@ -114,9 +114,17 @@ type 'a desc = | Delayed : (unit -> 'a t) -> 'a desc and _ field = - | Req : string * 'a t -> 'a field - | Opt : Kind.enum * string * 'a t -> 'a option field - | Dft : string * 'a t * 'a -> 'a field + | Req : { name: string ; + encoding: 'a t ; + } -> 'a field + | Opt : { name: string ; + kind: Kind.enum ; + encoding: 'a t ; + } -> 'a option field + | Dft : { name: string ; + encoding: 'a t ; + default: 'a ; + } -> 'a field and 'a case = | Case : { name : string option ; @@ -157,7 +165,7 @@ let rec classify : type a. a t -> Kind.t = fun e -> | String kind -> (kind :> Kind.t) | String_enum (_, cases) -> `Fixed Binary_size.(integer_to_size @@ enum_size cases) - | Obj (Opt (kind, _, _)) -> (kind :> Kind.t) + | Obj (Opt { kind }) -> (kind :> Kind.t) | Objs (kind, _, _) -> kind | Tups (kind, _, _) -> kind | Union (kind, _, _) -> (kind :> Kind.t) @@ -167,8 +175,8 @@ let rec classify : type a. a t -> Kind.t = fun e -> | Array _ -> `Variable | List _ -> `Variable (* Recursive *) - | Obj (Req (_, encoding)) -> classify encoding - | Obj (Dft (_, encoding, _)) -> classify encoding + | Obj (Req { encoding }) -> classify encoding + | Obj (Dft { encoding }) -> classify encoding | Tup encoding -> classify encoding | Conv { encoding } -> classify encoding | Describe { encoding } -> classify encoding @@ -224,9 +232,9 @@ let rec is_zeroable: type t. t encoding -> bool = fun e -> | Array _ -> true (* 0-element array *) | List _ -> true (* 0-element list *) (* represented as whatever is inside: truth mostly propagates *) - | Obj (Req (_, e)) -> is_zeroable e (* represented as-is *) - | Obj (Opt (`Variable, _, _)) -> true (* optional field ommited *) - | Obj (Dft (_, e, _)) -> is_zeroable e (* represented as-is *) + | Obj (Req { encoding = e }) -> is_zeroable e (* represented as-is *) + | Obj (Opt { kind = `Variable }) -> true (* optional field ommited *) + | Obj (Dft { encoding = e }) -> is_zeroable e (* represented as-is *) | Obj _ -> false | Objs (_, e1, e2) -> is_zeroable e1 && is_zeroable e2 | Tup e -> is_zeroable e @@ -331,17 +339,21 @@ let describe ?title ?description encoding = let def name encoding = make @@ Def { name ; encoding } let req ?title ?description n t = - Req (n, describe ?title ?description t) + Req { name = n ; encoding = describe ?title ?description t } let opt ?title ?description n encoding = let kind = match classify encoding with | `Variable -> `Variable | `Fixed _ | `Dynamic -> `Dynamic in - Opt (kind, n, make @@ Describe { title ; description ; encoding }) + Opt { name = n ; kind ; + encoding = make @@ Describe { title ; description ; encoding } } let varopt ?title ?description n encoding = - Opt (`Variable, n, make @@ Describe { title ; description ; encoding }) + Opt { name = n ; kind = `Variable ; + encoding = make @@ Describe { title ; description ; encoding } } let dft ?title ?description n t d = - Dft (n, describe ?title ?description t, d) + Dft { name = n ; + encoding = describe ?title ?description t ; + default = d } let raw_splitted ~json ~binary = make @@ Splitted { encoding = binary ; diff --git a/src/lib_data_encoding/encoding.mli b/src/lib_data_encoding/encoding.mli index 517f83723..7c21ccf66 100644 --- a/src/lib_data_encoding/encoding.mli +++ b/src/lib_data_encoding/encoding.mli @@ -72,9 +72,17 @@ type 'a desc = | Delayed : (unit -> 'a t) -> 'a desc and _ field = - | Req : string * 'a t -> 'a field - | Opt : Kind.enum * string * 'a t -> 'a option field - | Dft : string * 'a t * 'a -> 'a field + | Req : { name: string ; + encoding: 'a t ; + } -> 'a field + | Opt : { name: string ; + kind: Kind.enum ; + encoding: 'a t ; + } -> 'a option field + | Dft : { name: string ; + encoding: 'a t ; + default: 'a ; + } -> 'a field and 'a case = | Case : { name : string option ; diff --git a/src/lib_data_encoding/json.ml b/src/lib_data_encoding/json.ml index 63753df75..2b03fe5f0 100644 --- a/src/lib_data_encoding/json.ml +++ b/src/lib_data_encoding/json.ml @@ -225,9 +225,9 @@ and field_json : type a. a Encoding.field -> a Json_encoding.field = let open Json_encoding in function - | Encoding.Req (name, e) -> req name (get_json e) - | Encoding.Opt (_, name, e) -> opt name (get_json e) - | Encoding.Dft (name, e, d) -> dft name (get_json e) d + | Encoding.Req { name ; encoding = e } -> req name (get_json e) + | Encoding.Opt { name ; encoding = e } -> opt name (get_json e) + | Encoding.Dft { name ; encoding = e ; default = d} -> dft name (get_json e) d and case_json : type a. a Encoding.case -> a Json_encoding.case = let open Json_encoding in