balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Data_encoding: split out Binary_length

Browse Source
This commit is contained in:
Grégoire Henry 2018-05-12 17:48:06 +02:00 committed by Benjamin Canou
parent aee6718148
commit 1da0d0c8d7
5 changed files with 140 additions and 118 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

116
src/lib_data_encoding/binary.ml
View File

@ -20,116 +20,6 @@ type 'l writer = {
write: 'a. 'a Encoding.t -> 'a -> MBytes.t -> int -> int ;
}
let rec length : type x. x Encoding.t -> x -> int = fun e ->
let open Encoding in
match e.encoding with
(* Fixed *)
| Null -> fun _ -> 0
| Empty -> fun _ -> 0
| Constant _ -> fun _ -> 0
| Bool -> fun _ -> Binary_size.bool
| Int8 -> fun _ -> Binary_size.int8
| Uint8 -> fun _ -> Binary_size.uint8
| Int16 -> fun _ -> Binary_size.int16
| Uint16 -> fun _ -> Binary_size.uint16
| Int31 -> fun _ -> Binary_size.int31
| Int32 -> fun _ -> Binary_size.int32
| Int64 -> fun _ -> Binary_size.int64
| Z -> fun z -> (Z.numbits z + 1 + 6) / 7
| RangedInt { minimum ; maximum } ->
fun _ -> Binary_size.(integer_to_size @@ range_to_size ~minimum ~maximum)
| Float -> fun _ -> Binary_size.float
| RangedFloat _ -> fun _ -> Binary_size.float
| Bytes `Fixed n -> fun _ -> n
| String `Fixed n -> fun _ -> n
| String_enum (_, arr) ->
fun _ -> Binary_size.(integer_to_size @@ enum_size arr)
| Objs (`Fixed n, _, _) -> fun _ -> n
| Tups (`Fixed n, _, _) -> fun _ -> n
| Union (`Fixed n, _, _) -> fun _ -> n
(* Dynamic *)
| Objs (`Dynamic, e1, e2) ->
let length1 = length e1 in
let length2 = length e2 in
fun (v1, v2) -> length1 v1 + length2 v2
| Tups (`Dynamic, e1, e2) ->
let length1 = length e1 in
let length2 = length e2 in
fun (v1, v2) -> length1 v1 + length2 v2
| Union (`Dynamic, sz, cases) ->
let tag_size = Binary_size.tag_size sz in
let case_length (Case { encoding = e ; proj }) =
let length v = tag_size + length e v in
fun v -> Option.map ~f:length (proj v) in
apply_and_get_first_some (List.map case_length cases)
| Mu (`Dynamic, _name, self) ->
fun v -> length (self e) v
| Obj (Opt (`Dynamic, _, e)) ->
let length = length e in
(function None -> 1 | Some x -> 1 + length x)
(* Variable *)
| Ignore -> fun _ -> 0
| Bytes `Variable -> MBytes.length
| String `Variable -> String.length
| Array e ->
let length = length e in
fun v ->
Array.fold_left
(fun acc v -> length v + acc)
0 v
| List e ->
let length = length e in
fun v ->
List.fold_left
(fun acc v -> length v + acc)
0 v
| Objs (`Variable, e1, e2) ->
let length1 = length e1 in
let length2 = length e2 in
fun (v1, v2) -> length1 v1 + length2 v2
| Tups (`Variable, e1, e2) ->
let length1 = length e1
and length2 = length e2 in
fun (v1, v2) -> length1 v1 + length2 v2
| Obj (Opt (`Variable, _, e)) ->
let length = length e in
(function None -> 0 | Some x -> length x)
| Union (`Variable, sz, cases) ->
let rec case_lengths json_only_cases acc = function
| [] -> (List.rev acc, json_only_cases)
| Case { tag = Json_only } :: tl -> case_lengths true acc tl
| Case { encoding = e ; proj ; tag = Tag _ } :: tl ->
let length v = Binary_size.tag_size sz + length e v in
case_lengths
json_only_cases
((fun v ->
match proj v with
| None -> None
| Some v -> Some (length v)) :: acc)
tl in
let cases, json_only = case_lengths false [] cases in
apply_and_get_first_some
~error:(if json_only
then Failure "No case matched, but JSON only cases were present in union"
else No_case_matched)
cases
| Mu (`Variable, _name, self) ->
fun v -> length (self e) v
(* Recursive*)
| Obj (Req (_, e)) -> length e
| Obj (Dft (_, e, _)) -> length e
| Tup e -> length e
| Conv { encoding = e ; proj } ->
let length = length e in
fun v -> length (proj v)
| Describe { encoding = e } -> length e
| Def { encoding = e } -> length e
| Splitted { encoding = e } -> length e
| Dynamic_size e ->
let length = length e in
fun v -> Binary_size.int32 + length v
| Delayed f -> length (f ())
(** Writer *)
module Writer = struct
@ -428,7 +318,7 @@ let rec write_rec
| Union (_, sz, cases) -> union { write = write_rec } sz cases
| Mu (_, _, self) -> fun v buf ofs -> write_rec (self e) v buf ofs
| Dynamic_size e ->
let length = length e
let length = Binary_length.length e
and write = write_rec e in
fun v buf ofs ->
int32 (Int32.of_int @@ length v) buf ofs |> write v buf
@ -542,10 +432,6 @@ let to_bytes t v =
write_rec_buffer t v bytes ;
MBytes_buffer.to_mbytes bytes
let to_bytes = to_bytes
let length = length
let fixed_length e =
match Encoding.classify e with
| `Fixed n -> Some n

3
src/lib_data_encoding/binary.mli
View File

@ -10,8 +10,5 @@
(** This is for use *within* the data encoding library only. Instead, you should
use the corresponding module intended for use: {Data_encoding.Binary}. *)
val length : 'a Encoding.t -> 'a -> int
val write : 'a Encoding.t -> 'a -> MBytes.t -> int -> int option
val to_bytes : 'a Encoding.t -> 'a -> MBytes.t
val fixed_length : 'a Encoding.t -> int option
val fixed_length_exn : 'a Encoding.t -> int

123
src/lib_data_encoding/binary_length.ml Normal file
View File

@ -0,0 +1,123 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Binary_error
let rec length : type x. x Encoding.t -> x -> int =
fun e value ->
let open Encoding in
match e.encoding with
(* Fixed *)
| Null -> 0
| Empty -> 0
| Constant _ -> 0
| Bool -> Binary_size.bool
| Int8 -> Binary_size.int8
| Uint8 -> Binary_size.uint8
| Int16 -> Binary_size.int16
| Uint16 -> Binary_size.uint16
| Int31 -> Binary_size.int31
| Int32 -> Binary_size.int32
| Int64 -> Binary_size.int64
| Z -> (Z.numbits value + 1 + 6) / 7
| RangedInt { minimum ; maximum } ->
Binary_size.integer_to_size @@
Binary_size.range_to_size ~minimum ~maximum
| Float -> Binary_size.float
| RangedFloat _ -> Binary_size.float
| Bytes `Fixed n -> n
| String `Fixed n -> n
| String_enum (_, arr) ->
Binary_size.integer_to_size @@ Binary_size.enum_size arr
| Objs (`Fixed n, _, _) -> n
| Tups (`Fixed n, _, _) -> n
| Union (`Fixed n, _, _) -> n
(* Dynamic *)
| Objs (`Dynamic, e1, e2) ->
let (v1, v2) = value in
length e1 v1 + length e2 v2
| Tups (`Dynamic, e1, e2) ->
let (v1, v2) = value in
length e1 v1 + length e2 v2
| Union (`Dynamic, sz, cases) ->
let rec length_case = function
| [] -> raise (Read_error No_case_matched)
| Case { tag = Json_only } :: tl -> length_case tl
| Case { encoding = e ; proj ; _ } :: tl ->
match proj value with
| None -> length_case tl
| Some value ->
let tag_size = Binary_size.tag_size sz in
tag_size + length e value in
length_case cases
| Mu (`Dynamic, _name, self) ->
length (self e) value
| Obj (Opt (`Dynamic, _, e)) -> begin
match value with
| None -> 1
| Some value -> 1 + length e value
end
(* Variable *)
| Ignore -> 0
| Bytes `Variable -> MBytes.length value
| String `Variable -> String.length value
| Array e ->
Array.fold_left
(fun acc v -> length e v + acc)
0 value
| List e ->
List.fold_left
(fun acc v -> length e v + acc)
0 value
| Objs (`Variable, e1, e2) ->
let (v1, v2) = value in
length e1 v1 + length e2 v2
| Tups (`Variable, e1, e2) ->
let (v1, v2) = value in
length e1 v1 + length e2 v2
| Obj (Opt (`Variable, _, e)) -> begin
match value with
| None -> 0
| Some value -> length e value
end
| Union (`Variable, sz, cases) ->
let rec length_case = function
| [] -> raise (Read_error No_case_matched)
| Case { tag = Json_only } :: tl -> length_case tl
| Case { encoding = e ; proj ; _ } :: tl ->
match proj value with
| None -> length_case tl
| Some value ->
let tag_size = Binary_size.tag_size sz in
tag_size + length e value in
length_case cases
| Mu (`Variable, _name, self) ->
length (self e) value
(* Recursive*)
| Obj (Req (_, e)) -> length e value
| Obj (Dft (_, e, _)) -> length e value
| Tup e -> length e value
| Conv { encoding = e ; proj } ->
length e (proj value)
| Describe { encoding = e } -> length e value
| Def { encoding = e } -> length e value
| Splitted { encoding = e } -> length e value
| Dynamic_size e ->
Binary_size.int32 + length e value
| Delayed f -> length (f ()) value
let fixed_length e =
match Encoding.classify e with
| `Fixed n -> Some n
| `Dynamic | `Variable -> None
let fixed_length_exn e =
match fixed_length e with
| Some n -> n
| None -> invalid_arg "Data_encoding.Binary.fixed_length_exn"

15
src/lib_data_encoding/binary_length.mli Normal file
View File

@ -0,0 +1,15 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
(** This is for use *within* the data encoding library only. Instead, you should
use the corresponding module intended for use: {Data_encoding.Binary}. *)
val length : 'a Encoding.t -> 'a -> int
val fixed_length : 'a Encoding.t -> int option
val fixed_length_exn : 'a Encoding.t -> int

1
src/lib_data_encoding/data_encoding.ml
View File

@ -24,6 +24,7 @@ module Bson = Bson
module Binary = struct
include Binary
include Binary_error
include Binary_length
include Binary_reader
include Binary_stream_reader
end