Data_encoding: proper handling of kind in Dynamic_size

This commit is contained in:
Grégoire Henry 2018-05-31 13:12:33 +02:00 committed by Benjamin Canou
parent 6922a793fe
commit 499377bcc4
3 changed files with 58 additions and 38 deletions

View File

@ -72,9 +72,7 @@ let fixup_references uf =
Named_field (name, kind, fixup_layout layout)
| Anonymous_field (kind, layout) ->
Anonymous_field (kind, fixup_layout layout)
| Dynamic_field i ->
Dynamic_field i
| (Option_indicator_field _) as field -> field in
| (Dynamic_size_field _ | Optional_field _) as field -> field in
function
| Obj { fields } -> Obj { fields = List.map field fields }
| Cases ({ cases } as x) ->
@ -141,31 +139,33 @@ let describe (type x) ?toplevel_name (encoding : x Encoding.t) =
uf_add_name name ;
name in
let rec extract_dynamic :
type x. string option -> x Encoding.desc -> bool * string option * pdesc =
type x. string option -> x Encoding.desc -> Binary_size.unsigned_integer option * string option * pdesc =
fun ref_name -> function
| Conv { encoding } -> extract_dynamic ref_name encoding.encoding
| Describe { id = ref_name ; encoding } -> extract_dynamic (Some ref_name) encoding.encoding
| Splitted { encoding } -> extract_dynamic ref_name encoding.encoding
| Delayed f -> extract_dynamic ref_name (f ()).encoding
| Dynamic_size { encoding } -> (true, ref_name, P encoding.encoding)
| enc -> (false, ref_name, P enc) in
| Dynamic_size { kind ; encoding } -> (Some kind, ref_name, P encoding.encoding)
| enc -> (None, ref_name, P enc) in
let rec field_descr :
type a. recursives -> references ->
a Encoding.field -> Binary_schema.field_descr list * references =
fun recursives references -> function
| Req { name ; encoding = { encoding } }
| Dft { name ; encoding = { encoding } } ->
| Dft { name ; encoding = { encoding } } -> begin
let (dynamics, ref_name, P field) = extract_dynamic None encoding in
let (layout, references) = layout ref_name recursives references field in
if layout = Zero_width && dynamics then
([], references) (* FIXME what if (dynamic_size empty) ?? *)
if layout = Zero_width then
([], references)
else
let field_descr =
Binary_schema.Named_field (name, classify_desc field, layout) in
if dynamics then
([ Dynamic_field 1 ; field_descr ], references)
else
([ field_descr], references)
match dynamics with
| Some kind ->
([ Dynamic_size_field (ref_name, 1, kind) ; field_descr ], references)
| None ->
([ field_descr], references)
end
| Opt { kind = `Variable ; name ; encoding = { encoding } } ->
let (layout, references) =
layout None recursives references encoding in
@ -173,7 +173,7 @@ let describe (type x) ?toplevel_name (encoding : x Encoding.t) =
| Opt { kind = `Dynamic ; name ; encoding = { encoding } } ->
let (layout, references) =
layout None recursives references encoding in
([Binary_schema.Option_indicator_field name ; Named_field (name, classify_desc encoding, layout) ], references)
([Binary_schema.Optional_field name ; Named_field (name, classify_desc encoding, layout) ], references)
and obj fields =
Binary_schema.Obj { fields }
and union :
@ -241,10 +241,10 @@ let describe (type x) ?toplevel_name (encoding : x Encoding.t) =
| Empty -> ([ Anonymous_field (`Fixed 0, Zero_width) ], references)
| Ignore -> ([ Anonymous_field (`Fixed 0, Zero_width) ], references)
| Constant _ -> ([ Anonymous_field (`Fixed 0, Zero_width) ], references)
| Dynamic_size { encoding } ->
| Dynamic_size { kind ; encoding } ->
let (fields, refs) =
fields None recursives references encoding.encoding in
(Dynamic_field (List.length fields) :: fields, refs)
(Dynamic_size_field (None, List.length fields, kind) :: fields, refs)
| Check_size { encoding } ->
fields ref_name recursives references encoding.encoding
| Conv { encoding } ->

View File

@ -14,8 +14,8 @@ type integer_extended = [ Binary_size.integer | `Int32 | `Int64 ]
type field_descr =
| Named_field of string * Kind.t * layout
| Anonymous_field of Kind.t * layout
| Dynamic_field of int
| Option_indicator_field of string
| Dynamic_size_field of string option * int * Binary_size.unsigned_integer
| Optional_field of string
and layout =
| Zero_width
@ -83,22 +83,22 @@ module Printer = struct
| Int integer ->
Format.fprintf ppf "%a" pp_int integer
| Bool ->
Format.fprintf ppf "8 bit Signed Integer, with 0 for false and 255 for true"
Format.fprintf ppf "8 bit unsigned integer: 0 for false and 255 for true"
| RangedInt (minimum, maximum) ->
Format.fprintf ppf "%a in the range %d to %d"
pp_int ((Binary_size.range_to_size ~minimum ~maximum) :> integer_extended) minimum maximum
| RangedFloat (minimum, maximum) ->
Format.fprintf ppf
"Double precision (8 byte) floating point number in the range %f to %f"
"Double precision (8 bytes) floating point number in the range %f to %f"
minimum maximum
| Float ->
Format.fprintf ppf "Double precision (8 byte) floating point number"
Format.fprintf ppf "Double precision (8 bytes) floating point number"
| Bytes ->
Format.fprintf ppf "Bytes"
| String ->
Format.fprintf ppf "String"
| Ref reference ->
Format.fprintf ppf "%s" reference
Format.fprintf ppf "$%s" reference
| Enum (size, reference) ->
Format.fprintf ppf "%a encoding an enumeration (see %s)"
pp_int (size :> integer_extended)
@ -107,7 +107,7 @@ module Printer = struct
| Seq data -> Format.fprintf ppf "Sequence of %a" pp_layout data
let binary_table_headers = [ "Name" ; "Kind" ; "Data" ]
let binary_table_headers = [ "Name" ; "Size" ; "Contents" ]
let enum_headers = [ "Case number" ; "Encoded string" ]
let pp_tag_size ppf tag =
@ -126,17 +126,29 @@ module Printer = struct
function
| Named_field (name, kind, desc) ->
[ name ; Format.asprintf "%a" pp_kind kind ; string_of_layout desc ]
| Dynamic_field i ->
[ Format.asprintf "Size of next %d fields" i ;
Format.asprintf "%a" pp_kind (`Fixed 4) ; string_of_layout (Int `Int32) ]
| Dynamic_size_field (Some name, 1, size) ->
[ Format.asprintf "# bytes in field \"%s\"" name ;
Format.asprintf "%a"
pp_kind (`Fixed (Binary_size.integer_to_size size)) ;
string_of_layout (Int (size :> integer_extended)) ]
| Dynamic_size_field (None, 1, size) ->
[ Format.asprintf "# bytes in next field" ;
Format.asprintf "%a"
pp_kind (`Fixed (Binary_size.integer_to_size size)) ;
string_of_layout (Int (size :> integer_extended)) ]
| Dynamic_size_field (_, i, size) ->
[ Format.asprintf "# bytes in next %d fields" i ;
Format.asprintf "%a"
pp_kind (`Fixed (Binary_size.integer_to_size size)) ;
string_of_layout (Int (size :> integer_extended)) ]
| Anonymous_field (kind, desc) ->
[ "Unnamed field " ^ anon_num () ;
Format.asprintf "%a" pp_kind kind ;
string_of_layout desc ]
| Option_indicator_field name ->
[ "Presence of " ^ name ;
| Optional_field name ->
[ Format.asprintf "? presence of field \"%s\"" name ;
Format.asprintf "%a" pp_kind (`Fixed 1) ;
"0 if not present and 1 if present" ]
string_of_layout Bool ]
let toplevel ({ name ; description }, encoding) =
match encoding with
@ -382,6 +394,12 @@ module Encoding = struct
| _ -> None)
(fun (n, _) -> `Fixed n)) :: (kind_enum_cases ()))
let unsigned_integer_encoding =
string_enum
[("Uint30", `Uint30) ;
("Uint16", `Uint16) ;
("Uint8", `Uint8) ]
let field_descr_encoding =
let dynamic_layout_encoding = dynamic_size layout_encoding in
def "schema.field" @@
@ -407,20 +425,22 @@ module Encoding = struct
(fun (kind, _, layout) -> Anonymous_field (layout, kind)) ;
case ~name:"Dynamic_field"
(Tag 2)
(obj2
(obj4
(req "kind" (constant "dyn"))
(req "num_fields" int31))
(function Dynamic_field i -> Some ((), i)
(opt "name" string)
(req "num_fields" int31)
(req "size" unsigned_integer_encoding))
(function Dynamic_size_field (name, i, size) -> Some ((), name, i, size)
| _ -> None)
(fun ((), i) -> Dynamic_field i) ;
case ~name:"Option_indicator_field"
(fun ((), name, i, size) -> Dynamic_size_field (name, i, size)) ;
case ~name:"Optional_field"
(Tag 3)
(obj2
(req "kind" (constant "option_indicator"))
(req "name" string))
(function Option_indicator_field s -> Some ((), s)
(function Optional_field s -> Some ((), s)
| _ -> None)
(fun ((), s) -> Option_indicator_field s)
(fun ((), s) -> Optional_field s)
]
let tag_size_encoding =

View File

@ -14,8 +14,8 @@ type integer_extended = [ Binary_size.integer | `Int32 | `Int64 ]
type field_descr =
| Named_field of string * Encoding.Kind.t * layout
| Anonymous_field of Encoding.Kind.t * layout
| Dynamic_field of int
| Option_indicator_field of string
| Dynamic_size_field of string option * int * Binary_size.unsigned_integer
| Optional_field of string
and layout =
| Zero_width