Data_encoding: proper handling of kind in Dynamic_size
This commit is contained in:
parent
6922a793fe
commit
499377bcc4
@ -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 } ->
|
||||
|
@ -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 =
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user