balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Data_encoding: don't open Encoding

Browse Source
This commit is contained in:
Raphaël Proust 2018-05-03 15:13:39 +08:00
parent 1ade54a7d7
commit 34d4e9ec5d
2 changed files with 41 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
src/lib_data_encoding/binary.ml
View File

@ -7,17 +7,16 @@
(* *)
(**************************************************************************)
open Encoding (* TODO: unoppen *)
type 'l writer = {
write: 'a. 'a t -> 'a -> MBytes.t -> int -> int ;
write: 'a. 'a Encoding.t -> 'a -> MBytes.t -> int -> int ;
}
type 'l reader = {
read: 'a. 'a t -> MBytes.t -> int -> int -> (int * 'a) ;
read: 'a. 'a Encoding.t -> MBytes.t -> int -> int -> (int * 'a) ;
}
let rec length : type x. x t -> x -> int = fun e ->
let rec length : type x. x Encoding.t -> x -> int = fun e ->
let open Encoding in
match e.encoding with
(* Fixed *)
| Null -> fun _ -> 0
@ -222,6 +221,7 @@ module Writer = struct
| `Uint16 -> uint16
let union w sz cases =
let open Encoding in
let writes_case = function
| Case { tag = Json_only } -> None
| Case { encoding = e ; proj ; tag = Tag tag } ->
@ -305,7 +305,7 @@ module BufferedWriter = struct
end
let rec assoc_snd target = function
| [] -> raise No_case_matched
| [] -> raise Encoding.No_case_matched
| (value, hd) :: tl ->
if hd = target
then value
@ -315,10 +315,11 @@ let get_string_enum_case tbl v =
try
snd (Hashtbl.find tbl v)
with _ ->
raise No_case_matched
raise Encoding.No_case_matched
let rec write_rec
: type a. a t -> a -> MBytes.t -> int -> int = fun e ->
: type a. a Encoding.t -> a -> MBytes.t -> int -> int = fun e ->
let open Encoding in
let open Writer in
match e.encoding with
| Null -> (fun () _buf ofs -> ofs)
@ -395,8 +396,9 @@ let rec write_rec
| Delayed f -> write_rec (f ())
let rec write_rec_buffer
: type a. a encoding -> a -> MBytes_buffer.t -> unit =
: type a. a Encoding.t -> a -> MBytes_buffer.t -> unit =
fun encoding value buffer ->
let open Encoding in
let open BufferedWriter in
match encoding.encoding with
| Null -> ()
@ -588,8 +590,8 @@ module Reader = struct
ofs'', (v1, v2)
let varseq r e1 e2 buf ofs len =
let k1 = classify e1
and k2 = classify e2 in
let k1 = Encoding.classify e1
and k2 = Encoding.classify e2 in
match k1, k2 with
| (`Dynamic | `Fixed _), `Variable ->
let ofs', v1 = r.read e1 buf ofs len in
@ -626,6 +628,7 @@ module Reader = struct
| `Uint16 -> uint16
let union r sz cases =
let open Encoding in
let read_cases =
TzList.filter_map
(function
@ -643,7 +646,8 @@ module Reader = struct
end
let rec read_rec : type a. a t-> MBytes.t -> int -> int -> int * a = fun e ->
let rec read_rec : type a. a Encoding.t-> MBytes.t -> int -> int -> int * a = fun e ->
let open Encoding in
let open Reader in
match e.encoding with
| Null -> (fun _buf ofs _len -> ofs, ())
@ -755,7 +759,7 @@ let to_bytes = to_bytes
let length = length
let fixed_length e =
match classify e with
match Encoding.classify e with
| `Fixed n -> Some n
| `Dynamic | `Variable -> None
let fixed_length_exn e =
@ -781,10 +785,10 @@ module Stream_reader = struct
number of elements that have been read so far. *)
type path =
| P_top : path
| P_await : { path : path ; encoding : 'a t ; data_len : int } -> path
| P_seq : { path : path ; encoding : 'a t ;
| P_await : { path : path ; encoding : 'a Encoding.t ; data_len : int } -> path
| P_seq : { path : path ; encoding : 'a Encoding.t ;
fun_data_len : int -> int } -> path
| P_list : { path:path ; encoding:'a t ; data_len : int ;
| P_list : { path:path ; encoding:'a Encoding.t ; data_len : int ;
base_ofs : int ; nb_elts_read : int } -> path
(* used to accumulate given mbytes when reading a list of blocks,
@ -854,6 +858,7 @@ module Stream_reader = struct
buf, reader b ofs delta_ofs
end
open Encoding (* open here, shadow below, use shadowed definitions later *)
(* functions that try to read data from a given mbytes_stream,
or raise Need_more_data *)
@ -913,7 +918,7 @@ module Stream_reader = struct
(* auxiliary function: computing size of data in branches
Objs(`Variable) and Tups(`Variable) *)
let varseq_lengths e1 e2 ofs len = match classify e1, classify e2 with
let varseq_lengths e1 e2 ofs len = match Encoding.classify e1, Encoding.classify e2 with
| (`Dynamic | `Fixed _), `Variable -> len, (fun ofs' -> len - ofs' + ofs)
| `Variable, `Fixed n -> (len - n), (fun _ -> n)
| _ -> assert false (* Should be rejected by Kind.combine *)
@ -924,11 +929,11 @@ module Stream_reader = struct
incrementality), and 'mbytes_stream' *)
let rec data_checker
: type a.
path -> a encoding -> mbytes_stream -> int ->
path -> a Encoding.t -> mbytes_stream -> int ->
path * mbytes_stream =
fun path e buf len ->
(*length of data with `Variable kind should be given by the caller*)
assert (classify e != `Variable || len >= 0) ;
assert (Encoding.classify e != `Variable || len >= 0) ;
try match e.encoding with
| Null -> next_path path buf
| Empty -> next_path path buf
@ -1050,14 +1055,14 @@ module Stream_reader = struct
)None cases
in
begin match opt with
| None -> raise (Unexpected_tag ctag)
| None -> raise (Encoding.Unexpected_tag ctag)
| Some func -> func (len - (Size.tag_size sz))
end
| Dynamic_size e ->
let buf, sz = int32 buf in
let sz = Int32.to_int sz in
if sz < 0 then raise (Invalid_size sz) ;
if sz < 0 then raise (Encoding.Invalid_size sz) ;
data_checker path e buf sz
| Delayed f -> data_checker path (f ()) buf len

29
src/lib_data_encoding/json.ml
View File

@ -7,8 +7,6 @@
(* *)
(**************************************************************************)
open Encoding (* TODO: unopen *)
type json =
[ `O of (string * json) list
@ -21,7 +19,7 @@ type json =
type schema = Json_schema.schema
type pair_builder = {
build: 'a 'b. Kind.t -> 'a t -> 'b t -> ('a * 'b) t
build: 'a 'b. Encoding.Kind.t -> 'a Encoding.t -> 'b Encoding.t -> ('a * 'b) Encoding.t
}
exception Parse_error of string
@ -70,7 +68,8 @@ let bytes_jsont =
(fun h -> `Hex h)
string)
let rec lift_union : type a. a t -> a t = fun e ->
let rec lift_union : type a. a Encoding.t -> a Encoding.t = fun e ->
let open Encoding in
match e.encoding with
| Conv { proj ; inj ; encoding = e ; schema } -> begin
match lift_union e with
@ -98,8 +97,9 @@ let rec lift_union : type a. a t -> a t = fun e ->
| _ -> e
and lift_union_in_pair
: type a b. pair_builder -> Kind.t -> a t -> b t -> (a * b) t
: type a b. pair_builder -> Encoding.Kind.t -> a Encoding.t -> b Encoding.t -> (a * b) Encoding.t
= fun b p e1 e2 ->
let open Encoding in
match lift_union e1, lift_union e2 with
| e1, { encoding = Union (_kind, tag, cases) } ->
make @@
@ -131,7 +131,8 @@ and lift_union_in_pair
cases)
| e1, e2 -> b.build p e1 e2
let rec json : type a. a desc -> a Json_encoding.encoding =
let rec json : type a. a Encoding.desc -> a Json_encoding.encoding =
let open Encoding in
let open Json_encoding in
function
| Null -> null
@ -172,19 +173,19 @@ let rec json : type a. a desc -> a Json_encoding.encoding =
| Delayed f -> get_json (f ())
and field_json
: type a. a field -> a Json_encoding.field =
: type a. a Encoding.field -> a Json_encoding.field =
let open Json_encoding in
function
| Req (name, e) -> req name (get_json e)
| Opt (_, name, e) -> opt name (get_json e)
| Dft (name, e, d) -> dft name (get_json e) d
| Encoding.Req (name, e) -> req name (get_json e)
| Encoding.Opt (_, name, e) -> opt name (get_json e)
| Encoding.Dft (name, e, d) -> dft name (get_json e) d
and case_json : type a. a case -> a Json_encoding.case =
and case_json : type a. a Encoding.case -> a Json_encoding.case =
let open Json_encoding in
function
| Case { encoding = e ; proj ; inj ; _ } -> case (get_json e) proj inj
| Encoding.Case { encoding = e ; proj ; inj ; _ } -> case (get_json e) proj inj
and get_json : type a. a t -> a Json_encoding.encoding = fun e ->
and get_json : type a. a Encoding.t -> a Json_encoding.encoding = fun e ->
match e.json_encoding with
| None ->
let json_encoding = json (lift_union e).encoding in
@ -267,7 +268,7 @@ let encoding =
Encoding.string in
let json =
Json_encoding.any_ezjson_value in
raw_splitted ~binary ~json
Encoding.raw_splitted ~binary ~json
let schema_encoding =
Encoding.conv