Data_encoding: separate Size into its own module

This commit is contained in:
Raphaël Proust 2018-05-03 15:11:46 +08:00
parent 2418554f78
commit 1ade54a7d7
5 changed files with 119 additions and 104 deletions

View File

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

View File

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

View File

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

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

View 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 ]