Data_encoding: separate Size into its own module
This commit is contained in:
parent
2418554f78
commit
1ade54a7d7
@ -32,13 +32,13 @@ let rec length : type x. x t -> x -> int = fun e ->
|
||||
| Int32 -> fun _ -> Size.int32
|
||||
| Int64 -> fun _ -> Size.int64
|
||||
| RangedInt { minimum ; maximum } ->
|
||||
fun _ -> integer_to_size @@ range_to_size ~minimum ~maximum
|
||||
fun _ -> Size.(integer_to_size @@ range_to_size ~minimum ~maximum)
|
||||
| Float -> fun _ -> Size.float
|
||||
| RangedFloat _ -> fun _ -> Size.float
|
||||
| Bytes `Fixed n -> fun _ -> n
|
||||
| String `Fixed n -> fun _ -> n
|
||||
| String_enum (_, arr) ->
|
||||
fun _ -> integer_to_size @@ enum_size arr
|
||||
fun _ -> Size.(integer_to_size @@ enum_size arr)
|
||||
| Objs (`Fixed n, _, _) -> fun _ -> n
|
||||
| Tups (`Fixed n, _, _) -> fun _ -> n
|
||||
| Union (`Fixed n, _, _) -> fun _ -> n
|
||||
@ -52,7 +52,7 @@ let rec length : type x. x t -> x -> int = fun e ->
|
||||
let length2 = length e2 in
|
||||
fun (v1, v2) -> length1 v1 + length2 v2
|
||||
| Union (`Dynamic, sz, cases) ->
|
||||
let tag_size = tag_size sz in
|
||||
let tag_size = 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
|
||||
@ -94,7 +94,7 @@ let rec length : type x. x t -> x -> int = fun e ->
|
||||
| [] -> (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 = tag_size sz + length e v in
|
||||
let length v = Size.tag_size sz + length e v in
|
||||
case_lengths
|
||||
json_only_cases
|
||||
((fun v ->
|
||||
@ -339,7 +339,7 @@ let rec write_rec
|
||||
if v < minimum || v > maximum
|
||||
then invalid_arg (Printf.sprintf "Integer %d not in range [%d, %d]." v minimum maximum) ;
|
||||
let v = if minimum >= 0 then v - minimum else v in
|
||||
match range_to_size ~minimum ~maximum with
|
||||
match Size.range_to_size ~minimum ~maximum with
|
||||
| `Uint8 -> uint8 v
|
||||
| `Uint16 -> uint16 v
|
||||
| `Uint30 -> uint30 v
|
||||
@ -362,7 +362,7 @@ let rec write_rec
|
||||
| String_enum (tbl, arr) ->
|
||||
(fun v ->
|
||||
let value = get_string_enum_case tbl v in
|
||||
match enum_size arr with
|
||||
match Size.enum_size arr with
|
||||
| `Uint30 -> uint30 value
|
||||
| `Uint16 -> uint16 value
|
||||
| `Uint8 -> uint8 value)
|
||||
@ -424,7 +424,7 @@ let rec write_rec_buffer
|
||||
value minimum maximum) ;
|
||||
let value = if minimum >= 0 then value - minimum else value in
|
||||
begin
|
||||
match range_to_size ~minimum ~maximum with
|
||||
match Size.range_to_size ~minimum ~maximum with
|
||||
| `Uint30 -> uint30 value buffer
|
||||
| `Uint16 -> uint16 value buffer
|
||||
| `Uint8 -> uint8 value buffer
|
||||
@ -438,7 +438,7 @@ let rec write_rec_buffer
|
||||
value minimum maximum) ;
|
||||
float value buffer
|
||||
| String_enum (tbl, arr) ->
|
||||
(match enum_size arr with
|
||||
(match Size.enum_size arr with
|
||||
| `Uint30 -> BufferedWriter.uint30
|
||||
| `Uint16 -> BufferedWriter.uint16
|
||||
| `Uint8 -> BufferedWriter.uint8)
|
||||
@ -638,7 +638,7 @@ module Reader = struct
|
||||
cases in
|
||||
fun buf ofs len ->
|
||||
let ofs, tag = read_tag sz buf ofs len in
|
||||
try List.assoc tag read_cases buf ofs (len - tag_size sz)
|
||||
try List.assoc tag read_cases buf ofs (len - Size.tag_size sz)
|
||||
with Not_found -> raise (Unexpected_tag tag)
|
||||
|
||||
end
|
||||
@ -661,7 +661,7 @@ let rec read_rec : type a. a t-> MBytes.t -> int -> int -> int * a = fun e ->
|
||||
| RangedInt { minimum ; maximum } ->
|
||||
(fun buf ofs alpha ->
|
||||
let ofs, value =
|
||||
match range_to_size ~minimum ~maximum with
|
||||
match Size.range_to_size ~minimum ~maximum with
|
||||
| `Int8 -> int8 buf ofs alpha
|
||||
| `Int16 -> int16 buf ofs alpha
|
||||
| `Int31 -> int31 buf ofs alpha
|
||||
@ -686,7 +686,7 @@ let rec read_rec : type a. a t-> MBytes.t -> int -> int -> int * a = fun e ->
|
||||
| String_enum (_, arr) -> begin
|
||||
fun buf ofs a ->
|
||||
let ofs, ind =
|
||||
match enum_size arr with
|
||||
match Size.enum_size arr with
|
||||
| `Uint8 -> uint8 buf ofs a
|
||||
| `Uint16 -> uint16 buf ofs a
|
||||
| `Uint30 -> uint30 buf ofs a in
|
||||
@ -944,7 +944,7 @@ module Stream_reader = struct
|
||||
| Int64 -> next_path path (fst (int64 buf))
|
||||
| RangedInt { minimum ; maximum } ->
|
||||
let (stream, ranged) =
|
||||
match range_to_size ~minimum ~maximum with
|
||||
match Size.range_to_size ~minimum ~maximum with
|
||||
| `Int8 -> int8 buf
|
||||
| `Int16 -> int16 buf
|
||||
| `Int31 -> int31 buf
|
||||
@ -973,7 +973,7 @@ module Stream_reader = struct
|
||||
|
||||
| String_enum (_, arr) ->
|
||||
next_path path
|
||||
(match enum_size arr with
|
||||
(match Size.enum_size arr with
|
||||
| `Uint8 -> fst @@ uint8 buf
|
||||
| `Uint16 -> fst @@ uint16 buf
|
||||
| `Uint30 -> fst @@ uint30 buf)
|
||||
@ -1051,7 +1051,7 @@ module Stream_reader = struct
|
||||
in
|
||||
begin match opt with
|
||||
| None -> raise (Unexpected_tag ctag)
|
||||
| Some func -> func (len - (tag_size sz))
|
||||
| Some func -> func (len - (Size.tag_size sz))
|
||||
end
|
||||
|
||||
| Dynamic_size e ->
|
||||
|
@ -28,28 +28,6 @@ let apply ?(error=No_case_matched) fs v =
|
||||
loop fs
|
||||
|
||||
|
||||
module Size = struct
|
||||
let bool = 1
|
||||
let int8 = 1
|
||||
let uint8 = 1
|
||||
let char = 1
|
||||
let int16 = 2
|
||||
let uint16 = 2
|
||||
let uint30 = 4
|
||||
let uint32 = 4
|
||||
let uint64 = 8
|
||||
let int31 = 4
|
||||
let int32 = 4
|
||||
let int64 = 8
|
||||
let float = 8
|
||||
end
|
||||
|
||||
type tag_size = [ `Uint8 | `Uint16 ]
|
||||
|
||||
let tag_size = function
|
||||
| `Uint8 -> Size.uint8
|
||||
| `Uint16 -> Size.uint16
|
||||
|
||||
module Kind = struct
|
||||
|
||||
type t =
|
||||
@ -99,7 +77,7 @@ module Kind = struct
|
||||
| [] -> assert false (* should be rejected by Data_encoding.union *)
|
||||
| k :: ks ->
|
||||
match List.fold_left merge k ks with
|
||||
| `Fixed n -> `Fixed (n + tag_size sz)
|
||||
| `Fixed n -> `Fixed (n + Size.tag_size sz)
|
||||
| k -> k
|
||||
|
||||
end
|
||||
@ -131,7 +109,7 @@ type 'a desc =
|
||||
| Objs : Kind.t * 'a t * 'b t -> ('a * 'b) desc
|
||||
| Tup : 'a t -> 'a desc
|
||||
| Tups : Kind.t * 'a t * 'b t -> ('a * 'b) desc
|
||||
| Union : Kind.t * tag_size * 'a case list -> 'a desc
|
||||
| Union : Kind.t * Size.tag_size * 'a case list -> 'a desc
|
||||
| Mu : Kind.enum * string * ('a t -> 'a t) -> 'a desc
|
||||
| Conv :
|
||||
{ proj : ('a -> 'b) ;
|
||||
@ -168,41 +146,6 @@ and 'a t = {
|
||||
mutable json_encoding: 'a Json_encoding.encoding option ;
|
||||
}
|
||||
|
||||
type signed_integer = [ `Int31 | `Int16 | `Int8 ]
|
||||
type unsigned_integer = [ `Uint30 | `Uint16 | `Uint8 ]
|
||||
type integer = [ signed_integer | unsigned_integer ]
|
||||
|
||||
let signed_range_to_size min max : [> signed_integer ] =
|
||||
if min >= ~-128 && max <= 127
|
||||
then `Int8
|
||||
else if min >= ~-32_768 && max <= 32_767
|
||||
then `Int16
|
||||
else `Int31
|
||||
|
||||
(* max should be centered at zero *)
|
||||
let unsigned_range_to_size max : [> unsigned_integer ] =
|
||||
if max <= 255
|
||||
then `Uint8
|
||||
else if max <= 65535
|
||||
then `Uint16
|
||||
else `Uint30
|
||||
|
||||
let integer_to_size = function
|
||||
| `Int31 -> Size.int31
|
||||
| `Int16 -> Size.int16
|
||||
| `Int8 -> Size.int8
|
||||
| `Uint30 -> Size.uint30
|
||||
| `Uint16 -> Size.uint16
|
||||
| `Uint8 -> Size.uint8
|
||||
|
||||
let range_to_size ~minimum ~maximum : integer =
|
||||
if minimum < 0
|
||||
then signed_range_to_size minimum maximum
|
||||
else unsigned_range_to_size (maximum - minimum)
|
||||
|
||||
let enum_size arr =
|
||||
unsigned_range_to_size (Array.length arr)
|
||||
|
||||
type 'a encoding = 'a t
|
||||
|
||||
let rec classify : type a. a t -> Kind.t = fun e ->
|
||||
@ -220,14 +163,14 @@ let rec classify : type a. a t -> Kind.t = fun e ->
|
||||
| Int32 -> `Fixed Size.int32
|
||||
| Int64 -> `Fixed Size.int64
|
||||
| RangedInt { minimum ; maximum } ->
|
||||
`Fixed (integer_to_size @@ range_to_size ~minimum ~maximum)
|
||||
`Fixed Size.(integer_to_size @@ range_to_size ~minimum ~maximum)
|
||||
| Float -> `Fixed Size.float
|
||||
| RangedFloat _ -> `Fixed Size.float
|
||||
(* Tagged *)
|
||||
| Bytes kind -> (kind :> Kind.t)
|
||||
| String kind -> (kind :> Kind.t)
|
||||
| String_enum (_, cases) ->
|
||||
`Fixed (integer_to_size (enum_size cases))
|
||||
`Fixed Size.(integer_to_size @@ enum_size cases)
|
||||
| Obj (Opt (kind, _, _)) -> (kind :> Kind.t)
|
||||
| Objs (kind, _, _) -> kind
|
||||
| Tups (kind, _, _) -> kind
|
||||
|
@ -50,26 +50,6 @@
|
||||
* predicates, etc.) *)
|
||||
(* TODO: move the doc into the packing module *)
|
||||
|
||||
module Size: sig
|
||||
val bool: int
|
||||
val int8: int
|
||||
val uint8: int
|
||||
val char: int
|
||||
val int16: int
|
||||
val uint16: int
|
||||
val uint30: int
|
||||
val uint32: int
|
||||
val uint64: int
|
||||
val int31: int
|
||||
val int32: int
|
||||
val int64: int
|
||||
val float: int
|
||||
end
|
||||
|
||||
type tag_size = [ `Uint8 | `Uint16 ]
|
||||
|
||||
val tag_size: tag_size -> int
|
||||
|
||||
val apply: ?error:exn -> ('a -> 'b option) list -> 'a -> 'b
|
||||
|
||||
module Kind: sig
|
||||
@ -84,7 +64,7 @@ module Kind: sig
|
||||
|
||||
val merge : t -> t -> t
|
||||
|
||||
val merge_list: tag_size -> t list -> t
|
||||
val merge_list: Size.tag_size -> t list -> t
|
||||
|
||||
end
|
||||
|
||||
@ -115,7 +95,7 @@ type 'a desc =
|
||||
| Objs : Kind.t * 'a t * 'b t -> ('a * 'b) desc
|
||||
| Tup : 'a t -> 'a desc
|
||||
| Tups : Kind.t * 'a t * 'b t -> ('a * 'b) desc
|
||||
| Union : Kind.t * tag_size * 'a case list -> 'a desc
|
||||
| Union : Kind.t * Size.tag_size * 'a case list -> 'a desc
|
||||
| Mu : Kind.enum * string * ('a t -> 'a t) -> 'a desc
|
||||
| Conv :
|
||||
{ proj : ('a -> 'b) ;
|
||||
@ -155,13 +135,6 @@ type 'a encoding = 'a t
|
||||
|
||||
val make: ?json_encoding: 'a Json_encoding.encoding -> 'a desc -> 'a t
|
||||
|
||||
type signed_integer = [ `Int31 | `Int16 | `Int8 ]
|
||||
type unsigned_integer = [ `Uint30 | `Uint16 | `Uint8 ]
|
||||
type integer = [ signed_integer | unsigned_integer ]
|
||||
val integer_to_size: integer -> int
|
||||
val range_to_size: minimum:int -> maximum:int -> integer
|
||||
val enum_size: 'a array -> [> unsigned_integer ]
|
||||
|
||||
|
||||
exception No_case_matched
|
||||
exception Unexpected_tag of int
|
||||
|
65
src/lib_data_encoding/size.ml
Normal file
65
src/lib_data_encoding/size.ml
Normal file
@ -0,0 +1,65 @@
|
||||
(**************************************************************************)
|
||||
(* *)
|
||||
(* Copyright (c) 2014 - 2018. *)
|
||||
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
|
||||
(* *)
|
||||
(* All rights reserved. No warranty, explicit or implicit, provided. *)
|
||||
(* *)
|
||||
(**************************************************************************)
|
||||
|
||||
let bool = 1
|
||||
let int8 = 1
|
||||
let uint8 = 1
|
||||
let char = 1
|
||||
let int16 = 2
|
||||
let uint16 = 2
|
||||
let uint30 = 4
|
||||
let uint32 = 4
|
||||
let uint64 = 8
|
||||
let int31 = 4
|
||||
let int32 = 4
|
||||
let int64 = 8
|
||||
let float = 8
|
||||
|
||||
type tag_size = [ `Uint8 | `Uint16 ]
|
||||
|
||||
let tag_size = function
|
||||
| `Uint8 -> uint8
|
||||
| `Uint16 -> uint16
|
||||
|
||||
|
||||
type signed_integer = [ `Int31 | `Int16 | `Int8 ]
|
||||
type unsigned_integer = [ `Uint30 | `Uint16 | `Uint8 ]
|
||||
type integer = [ signed_integer | unsigned_integer ]
|
||||
|
||||
let signed_range_to_size min max : [> signed_integer ] =
|
||||
if min >= ~-128 && max <= 127
|
||||
then `Int8
|
||||
else if min >= ~-32_768 && max <= 32_767
|
||||
then `Int16
|
||||
else `Int31
|
||||
|
||||
(* max should be centered at zero *)
|
||||
let unsigned_range_to_size max : [> unsigned_integer ] =
|
||||
if max <= 255
|
||||
then `Uint8
|
||||
else if max <= 65535
|
||||
then `Uint16
|
||||
else `Uint30
|
||||
|
||||
let integer_to_size = function
|
||||
| `Int31 -> int31
|
||||
| `Int16 -> int16
|
||||
| `Int8 -> int8
|
||||
| `Uint30 -> uint30
|
||||
| `Uint16 -> uint16
|
||||
| `Uint8 -> uint8
|
||||
|
||||
let range_to_size ~minimum ~maximum : integer =
|
||||
if minimum < 0
|
||||
then signed_range_to_size minimum maximum
|
||||
else unsigned_range_to_size (maximum - minimum)
|
||||
|
||||
let enum_size arr =
|
||||
unsigned_range_to_size (Array.length arr)
|
||||
|
34
src/lib_data_encoding/size.mli
Normal file
34
src/lib_data_encoding/size.mli
Normal file
@ -0,0 +1,34 @@
|
||||
(**************************************************************************)
|
||||
(* *)
|
||||
(* Copyright (c) 2014 - 2018. *)
|
||||
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
|
||||
(* *)
|
||||
(* All rights reserved. No warranty, explicit or implicit, provided. *)
|
||||
(* *)
|
||||
(**************************************************************************)
|
||||
|
||||
val bool: int
|
||||
val int8: int
|
||||
val uint8: int
|
||||
val char: int
|
||||
val int16: int
|
||||
val uint16: int
|
||||
val uint30: int
|
||||
val uint32: int
|
||||
val uint64: int
|
||||
val int31: int
|
||||
val int32: int
|
||||
val int64: int
|
||||
val float: int
|
||||
|
||||
type tag_size = [ `Uint8 | `Uint16 ]
|
||||
|
||||
val tag_size: tag_size -> int
|
||||
|
||||
type signed_integer = [ `Int31 | `Int16 | `Int8 ]
|
||||
type unsigned_integer = [ `Uint30 | `Uint16 | `Uint8 ]
|
||||
type integer = [ signed_integer | unsigned_integer ]
|
||||
val integer_to_size: integer -> int
|
||||
val range_to_size: minimum:int -> maximum:int -> integer
|
||||
val enum_size: 'a array -> [> unsigned_integer ]
|
||||
|
Loading…
Reference in New Issue
Block a user