Data_encoding: do not use wildcard pattern matching

This commit is contained in:
Grégoire Henry 2018-05-31 11:36:59 +02:00 committed by Benjamin Canou
parent a17e5d177c
commit 705d6fb282
3 changed files with 51 additions and 10 deletions

View File

@ -143,11 +143,11 @@ let describe (type x) ?toplevel_name (encoding : x Encoding.t) =
type a. recursives -> references ->
a Encoding.field -> Binary_schema.field_descr list * references =
fun recursives references -> function
| Req { name ; encoding = ({ encoding } as enc) }
| Dft { name ; encoding = ({ encoding } as enc) } ->
| Req { name ; encoding = { encoding } }
| Dft { name ; encoding = { encoding } } ->
let (dynamics, field) = extract_dynamic encoding in
let (layout, references) = layout recursives references field in
(dynamics @ [ Named_field (name, classify enc, layout) ], references)
(dynamics @ [ Named_field (name, classify_desc encoding, layout) ], references)
| Opt { kind = `Variable ; name ; encoding = { encoding } } ->
let (layout, references) = layout recursives references encoding in
([ Named_field (name, `Variable, layout) ], references)
@ -199,7 +199,7 @@ let describe (type x) ?toplevel_name (encoding : x Encoding.t) =
UF.add uf new_cannonical ;
(name,
add_reference name
(obj [ Anonymous_field (classify { encoding ; json_encoding = None }, layout) ])
(obj [ Anonymous_field (classify_desc encoding, layout) ])
references)
end
and enum : type a. (a, _) Hashtbl.t -> a array -> _ = fun tbl encoding_array ->
@ -225,6 +225,8 @@ let describe (type x) ?toplevel_name (encoding : x Encoding.t) =
| Dynamic_size { encoding } ->
let (fields, refs) = fields recursives references encoding.encoding in
(Dynamic_field (List.length fields) :: fields, refs)
| Check_size { encoding } ->
fields recursives references encoding.encoding
| Conv { encoding } ->
fields recursives references encoding.encoding
| Describe { id = name ; description ; encoding } ->
@ -249,11 +251,11 @@ let describe (type x) ?toplevel_name (encoding : x Encoding.t) =
| (String_enum (tbl, encoding_array) as encoding) ->
let size, cases = enum tbl encoding_array in
let name = new_reference () in
([ Anonymous_field (classify { encoding ; json_encoding = None }, Ref name) ],
([ Anonymous_field (classify_desc encoding, Ref name) ],
add_reference name (Int_enum { size ; cases }) references)
| Tup ({ encoding } as enc) ->
| Tup { encoding } ->
let (layout, references) = layout recursives references encoding in
([ Anonymous_field (classify enc, layout) ], references)
([ Anonymous_field (classify_desc encoding, layout) ], references)
| Tups { left ; right } ->
let (fields1, references) = fields recursives references left.encoding in
let (fields2, references) = fields recursives references right.encoding in
@ -269,9 +271,45 @@ let describe (type x) ?toplevel_name (encoding : x Encoding.t) =
let { encoding } = fix { encoding ; json_encoding = None } in
let (name, references) = describe ~name ?description (name :: recursives) references encoding in
([ Anonymous_field (kind, Ref name) ], references)
| encoding ->
| Bool as encoding ->
let layout, references = layout recursives references encoding in
([ Anonymous_field (classify (make encoding), layout) ], references)
([ Anonymous_field (classify_desc encoding, layout) ], references)
| Int8 as encoding ->
let layout, references = layout recursives references encoding in
([ Anonymous_field (classify_desc encoding, layout) ], references)
| Uint8 as encoding ->
let layout, references = layout recursives references encoding in
([ Anonymous_field (classify_desc encoding, layout) ], references)
| Int16 as encoding ->
let layout, references = layout recursives references encoding in
([ Anonymous_field (classify_desc encoding, layout) ], references)
| Uint16 as encoding ->
let layout, references = layout recursives references encoding in
([ Anonymous_field (classify_desc encoding, layout) ], references)
| Int31 as encoding ->
let layout, references = layout recursives references encoding in
([ Anonymous_field (classify_desc encoding, layout) ], references)
| Int32 as encoding ->
let layout, references = layout recursives references encoding in
([ Anonymous_field (classify_desc encoding, layout) ], references)
| Int64 as encoding ->
let layout, references = layout recursives references encoding in
([ Anonymous_field (classify_desc encoding, layout) ], references)
| N as encoding ->
let layout, references = layout recursives references encoding in
([ Anonymous_field (classify_desc encoding, layout) ], references)
| Z as encoding ->
let layout, references = layout recursives references encoding in
([ Anonymous_field (classify_desc encoding, layout) ], references)
| RangedInt _ as encoding ->
let layout, references = layout recursives references encoding in
([ Anonymous_field (classify_desc encoding, layout) ], references)
| RangedFloat _ as encoding ->
let layout, references = layout recursives references encoding in
([ Anonymous_field (classify_desc encoding, layout) ], references)
| Float as encoding ->
let layout, references = layout recursives references encoding in
([ Anonymous_field (classify_desc encoding, layout) ], references)
and layout :
type c. recursives -> references ->
c Encoding.desc -> Binary_schema.layout * references =

View File

@ -162,7 +162,9 @@ and 'a t = {
type 'a encoding = 'a t
let rec classify : type a. a t -> Kind.t = fun e ->
match e.encoding with
classify_desc e.encoding
and classify_desc : type a. a desc -> Kind.t = fun e ->
match e with
(* Fixed *)
| Null -> `Fixed 0
| Empty -> `Fixed 0

View File

@ -271,4 +271,5 @@ val mu :
('a encoding -> 'a encoding) -> 'a encoding
val classify : 'a encoding -> [ `Fixed of int | `Dynamic | `Variable ]
val classify_desc : 'a desc -> [ `Fixed of int | `Dynamic | `Variable ]
val raw_splitted : json:'a Json_encoding.encoding -> binary:'a encoding -> 'a encoding