Data_encoding: use inline record for case field

This commit is contained in:
Grégoire Henry 2018-05-29 15:03:30 +02:00
parent 47f8bbbe68
commit 09a039bfea
7 changed files with 55 additions and 35 deletions

View File

@ -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)

View File

@ -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

View File

@ -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)

View File

@ -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 ;

View File

@ -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 ;

View File

@ -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 ;

View File

@ -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