Data_encoding: cosmetic fixes
This commit is contained in:
parent
6f4a98f6fd
commit
2d8ca36f12
@ -58,7 +58,7 @@ let fixup_references uf =
|
||||
let rec fixup_layout = function
|
||||
| Ref s -> Ref (UF.find uf s).title
|
||||
| Enum (i, name) -> Enum (i, (UF.find uf name).title)
|
||||
| Seq layout -> Seq (fixup_layout layout)
|
||||
| Seq (layout, len) -> Seq (fixup_layout layout, len)
|
||||
| (Zero_width
|
||||
| Int _
|
||||
| Bool
|
||||
@ -295,15 +295,15 @@ let describe (type x) (encoding : x Encoding.t) =
|
||||
fields ref_name recursives references encoding.encoding
|
||||
| Delayed func ->
|
||||
fields ref_name recursives references (func ()).encoding
|
||||
| List (_, { encoding }) ->
|
||||
| List (len, { encoding }) ->
|
||||
let (layout, references) =
|
||||
layout None recursives references encoding in
|
||||
([ Anonymous_field (`Variable, Seq layout) ],
|
||||
([ Anonymous_field (`Variable, Seq (layout, len)) ],
|
||||
references)
|
||||
| Array (_, { encoding }) ->
|
||||
| Array (len, { encoding }) ->
|
||||
let (layout, references) =
|
||||
layout None recursives references encoding in
|
||||
([ Anonymous_field (`Variable, Seq layout) ],
|
||||
([ Anonymous_field (`Variable, Seq (layout, len)) ],
|
||||
references)
|
||||
| Bytes kind ->
|
||||
([ Anonymous_field ((kind :> Kind.t), Bytes) ], references)
|
||||
@ -436,14 +436,14 @@ let describe (type x) (encoding : x Encoding.t) =
|
||||
let size, cases = enum tbl encoding_array in
|
||||
let references = add_reference name (Int_enum { size ; cases }) references in
|
||||
(Enum (size, name), references)
|
||||
| Array (_, data) ->
|
||||
| Array (len, data) ->
|
||||
let (descr, references) =
|
||||
layout None recursives references data.encoding in
|
||||
(Seq descr, references)
|
||||
| List (_, data) ->
|
||||
(Seq (descr, len), references)
|
||||
| List (len, data) ->
|
||||
let layout, references =
|
||||
layout None recursives references data.encoding in
|
||||
(Seq layout, references)
|
||||
(Seq (layout, len), references)
|
||||
| Obj (Req { encoding = { encoding } })
|
||||
| Obj (Dft { encoding = { encoding } }) ->
|
||||
layout ref_name recursives references encoding
|
||||
|
@ -17,7 +17,8 @@ type read_error =
|
||||
| Invalid_float of { min : float ; v : float ; max : float }
|
||||
| Trailing_zero
|
||||
| Size_limit_exceeded
|
||||
| Oversized_list
|
||||
| List_too_long
|
||||
| Array_too_long
|
||||
|
||||
let pp_read_error ppf = function
|
||||
| Not_enough_data ->
|
||||
@ -38,8 +39,10 @@ let pp_read_error ppf = function
|
||||
Format.fprintf ppf "Trailing zero in Z"
|
||||
| Size_limit_exceeded ->
|
||||
Format.fprintf ppf "Size limit exceeded"
|
||||
| Oversized_list ->
|
||||
Format.fprintf ppf "Size limit exceeded"
|
||||
| List_too_long ->
|
||||
Format.fprintf ppf "List length limit exceeded"
|
||||
| Array_too_long ->
|
||||
Format.fprintf ppf "Array length limit exceeded"
|
||||
|
||||
exception Read_error of read_error
|
||||
|
||||
@ -51,7 +54,8 @@ type write_error =
|
||||
| Invalid_bytes_length of { expected : int ; found : int }
|
||||
| Invalid_string_length of { expected : int ; found : int }
|
||||
| Invalid_natural
|
||||
| Oversized_list
|
||||
| List_too_long
|
||||
| Array_too_long
|
||||
|
||||
let pp_write_error ppf = function
|
||||
| Size_limit_exceeded ->
|
||||
@ -72,7 +76,9 @@ let pp_write_error ppf = function
|
||||
expected found
|
||||
| Invalid_natural ->
|
||||
Format.fprintf ppf "Negative natural"
|
||||
| Oversized_list ->
|
||||
Format.fprintf ppf "Size limit exceeded"
|
||||
| List_too_long ->
|
||||
Format.fprintf ppf "List length limit exceeded"
|
||||
| Array_too_long ->
|
||||
Format.fprintf ppf "Array length limit exceeded"
|
||||
|
||||
exception Write_error of write_error
|
||||
|
@ -20,7 +20,8 @@ type read_error =
|
||||
| Invalid_float of { min : float ; v : float ; max : float }
|
||||
| Trailing_zero
|
||||
| Size_limit_exceeded
|
||||
| Oversized_list
|
||||
| List_too_long
|
||||
| Array_too_long
|
||||
exception Read_error of read_error
|
||||
val pp_read_error: Format.formatter -> read_error -> unit
|
||||
|
||||
@ -32,7 +33,8 @@ type write_error =
|
||||
| Invalid_bytes_length of { expected : int ; found : int }
|
||||
| Invalid_string_length of { expected : int ; found : int }
|
||||
| Invalid_natural
|
||||
| Oversized_list
|
||||
| List_too_long
|
||||
| Array_too_long
|
||||
|
||||
val pp_write_error : Format.formatter -> write_error -> unit
|
||||
|
||||
|
@ -72,13 +72,13 @@ let rec length : type x. x Encoding.t -> x -> int =
|
||||
| Bytes `Variable -> MBytes.length value
|
||||
| String `Variable -> String.length value
|
||||
| Array (Some max_length, _e) when Array.length value > max_length ->
|
||||
raise (Write_error Oversized_list)
|
||||
raise (Write_error Array_too_long)
|
||||
| Array (_, e) ->
|
||||
Array.fold_left
|
||||
(fun acc v -> length e v + acc)
|
||||
0 value
|
||||
| List (Some max_length, _e) when List.length value > max_length ->
|
||||
raise (Write_error Oversized_list)
|
||||
raise (Write_error List_too_long)
|
||||
| List (_, e) ->
|
||||
List.fold_left
|
||||
(fun acc v -> length e v + acc)
|
||||
|
@ -192,11 +192,11 @@ let rec read_rec : type ret. ret Encoding.t -> state -> ret
|
||||
Atom.string_enum arr state
|
||||
| Array (max_length, e) ->
|
||||
let max_length = Option.unopt ~default:max_int max_length in
|
||||
let l = read_list max_length e state in
|
||||
let l = read_list List_too_long max_length e state in
|
||||
Array.of_list l
|
||||
| List (max_length, e) ->
|
||||
let max_length = Option.unopt ~default:max_int max_length in
|
||||
read_list max_length e state
|
||||
read_list Array_too_long max_length e state
|
||||
| (Obj (Req { encoding = e })) -> read_rec e state
|
||||
| (Obj (Dft { encoding = e })) -> read_rec e state
|
||||
| (Obj (Opt { kind = `Dynamic ; encoding = e })) ->
|
||||
@ -303,13 +303,13 @@ and read_variable_pair
|
||||
(left, right)
|
||||
| _ -> assert false (* Should be rejected by [Encoding.Kind.combine] *)
|
||||
|
||||
and read_list : type a. int -> a Encoding.t -> state -> a list
|
||||
= fun max_length e state ->
|
||||
and read_list : type a. read_error -> int -> a Encoding.t -> state -> a list
|
||||
= fun error max_length e state ->
|
||||
let rec loop max_length acc =
|
||||
if state.remaining_bytes = 0 then
|
||||
List.rev acc
|
||||
else if max_length = 0 then
|
||||
raise Oversized_list
|
||||
raise error
|
||||
else
|
||||
let v = read_rec e state in
|
||||
loop (max_length - 1) (v :: acc) in
|
||||
|
@ -27,7 +27,7 @@ and layout =
|
||||
| Bytes
|
||||
| String
|
||||
| Enum of Binary_size.integer * string
|
||||
| Seq of layout (* For arrays and lists *)
|
||||
| Seq of layout * int option (* For arrays and lists *)
|
||||
| Ref of string
|
||||
| Padding
|
||||
|
||||
@ -115,8 +115,16 @@ module Printer_ast = struct
|
||||
Format.fprintf ppf "%a encoding an enumeration (see %s)"
|
||||
pp_int (size :> integer_extended)
|
||||
reference
|
||||
| Seq (Ref reference) -> Format.fprintf ppf "sequence of $%s" reference
|
||||
| Seq data -> Format.fprintf ppf "sequence of %a" pp_layout data
|
||||
| Seq (data, len) ->
|
||||
Format.fprintf ppf "sequence of " ;
|
||||
begin match len with
|
||||
| None -> ()
|
||||
| Some len -> Format.fprintf ppf "at most %d " len
|
||||
end ;
|
||||
begin match data with
|
||||
| Ref reference -> Format.fprintf ppf "$%s" reference
|
||||
| _ -> pp_layout ppf data
|
||||
end
|
||||
|
||||
|
||||
let pp_tag_size ppf tag =
|
||||
@ -387,13 +395,14 @@ module Encoding = struct
|
||||
(fun (size, cases, _) -> Enum (size, cases)) ;
|
||||
case ~title:"Seq"
|
||||
(Tag 9)
|
||||
(obj2
|
||||
(obj3
|
||||
(req "layout" layout)
|
||||
(req "kind" (constant "Seq")))
|
||||
(req "kind" (constant "Seq"))
|
||||
(opt "max_length" int31))
|
||||
(function
|
||||
| Seq layout -> Some (layout, ())
|
||||
| Seq (layout, len) -> Some (layout, (), len)
|
||||
| _ -> None)
|
||||
(fun (layout, ()) -> Seq layout) ;
|
||||
(fun (layout, (), len) -> Seq (layout, len)) ;
|
||||
case ~title:"Ref"
|
||||
(Tag 10)
|
||||
(obj2
|
||||
|
@ -27,7 +27,7 @@ and layout =
|
||||
| Bytes
|
||||
| String
|
||||
| Enum of Binary_size.integer * string
|
||||
| Seq of layout (* For arrays and lists *)
|
||||
| Seq of layout * int option (* For arrays and lists *)
|
||||
| Ref of string
|
||||
| Padding
|
||||
|
||||
|
@ -261,11 +261,11 @@ let rec read_rec
|
||||
Atom.string_enum arr resume state k
|
||||
| Array (max_length, e) ->
|
||||
let max_length = Option.unopt ~default:max_int max_length in
|
||||
read_list max_length e state @@ fun (l, state) ->
|
||||
read_list Array_too_long max_length e state @@ fun (l, state) ->
|
||||
k (Array.of_list l, state)
|
||||
| List (max_length, e) ->
|
||||
let max_length = Option.unopt ~default:max_int max_length in
|
||||
read_list max_length e state k
|
||||
read_list List_too_long max_length e state k
|
||||
| (Obj (Req { encoding = e })) -> read_rec whole e state k
|
||||
| (Obj (Dft { encoding = e })) -> read_rec whole e state k
|
||||
| (Obj (Opt { kind = `Dynamic ; encoding = e })) ->
|
||||
@ -398,14 +398,14 @@ and read_variable_pair
|
||||
|
||||
and read_list
|
||||
: type a ret.
|
||||
int -> a Encoding.t -> state -> ((a list * state) -> ret status) -> ret status
|
||||
= fun max_length e state k ->
|
||||
read_error -> int -> a Encoding.t -> state -> ((a list * state) -> ret status) -> ret status
|
||||
= fun error max_length e state k ->
|
||||
let rec loop state acc max_length =
|
||||
let size = remaining_bytes state in
|
||||
if size = 0 then
|
||||
k (List.rev acc, state)
|
||||
else if max_length = 0 then
|
||||
raise Oversized_list
|
||||
raise error
|
||||
else
|
||||
read_rec false e state @@ fun (v, state) ->
|
||||
loop state (v :: acc) (max_length - 1) in
|
||||
|
@ -226,11 +226,11 @@ let rec write_rec : type a. a Encoding.t -> state -> a -> unit =
|
||||
| String_enum (tbl, arr) ->
|
||||
Atom.string_enum tbl arr state value
|
||||
| Array (Some max_length, _e) when Array.length value > max_length ->
|
||||
raise Oversized_list
|
||||
raise Array_too_long
|
||||
| Array (_, e) ->
|
||||
Array.iter (write_rec e state) value
|
||||
| List (Some max_length, _e) when List.length value > max_length ->
|
||||
raise Oversized_list
|
||||
raise List_too_long
|
||||
| List (_, e) ->
|
||||
List.iter (write_rec e state) value
|
||||
| Obj (Req { encoding = e }) -> write_rec e state value
|
||||
|
@ -169,6 +169,9 @@ module Encoding: sig
|
||||
- encoded as the concatenation of all the element in binary
|
||||
prefixed its length in bytes
|
||||
|
||||
If [max_length] is passed and the encoding of elements has fixed
|
||||
size, a {!check_size} is automatically added for earlier rejection.
|
||||
|
||||
@raise [Invalid_argument] if the inner encoding is variable. *)
|
||||
val array : ?max_length:int -> 'a encoding -> 'a array encoding
|
||||
|
||||
@ -177,6 +180,9 @@ module Encoding: sig
|
||||
- encoded as the concatenation of all the element in binary
|
||||
prefixed its length in bytes
|
||||
|
||||
If [max_length] is passed and the encoding of elements has fixed
|
||||
size, a {!check_size} is automatically added for earlier rejection.
|
||||
|
||||
@raise [Invalid_argument] if the inner encoding is also variable. *)
|
||||
val list : ?max_length:int -> 'a encoding -> 'a list encoding
|
||||
|
||||
@ -633,7 +639,8 @@ module Binary: sig
|
||||
| Invalid_float of { min : float ; v : float ; max : float }
|
||||
| Trailing_zero
|
||||
| Size_limit_exceeded
|
||||
| Oversized_list
|
||||
| List_too_long
|
||||
| Array_too_long
|
||||
exception Read_error of read_error
|
||||
val pp_read_error: Format.formatter -> read_error -> unit
|
||||
|
||||
@ -646,7 +653,8 @@ module Binary: sig
|
||||
| Invalid_bytes_length of { expected : int ; found : int }
|
||||
| Invalid_string_length of { expected : int ; found : int }
|
||||
| Invalid_natural
|
||||
| Oversized_list
|
||||
| List_too_long
|
||||
| Array_too_long
|
||||
val pp_write_error : Format.formatter -> write_error -> unit
|
||||
exception Write_error of write_error
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user