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 = { 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 = { 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 match e.encoding with
(* Fixed *) (* Fixed *)
| Null -> fun _ -> 0 | Null -> fun _ -> 0
@ -222,6 +221,7 @@ module Writer = struct
| `Uint16 -> uint16 | `Uint16 -> uint16
let union w sz cases = let union w sz cases =
let open Encoding in
let writes_case = function let writes_case = function
| Case { tag = Json_only } -> None | Case { tag = Json_only } -> None
| Case { encoding = e ; proj ; tag = Tag tag } -> | Case { encoding = e ; proj ; tag = Tag tag } ->
@ -305,7 +305,7 @@ module BufferedWriter = struct
end end
let rec assoc_snd target = function let rec assoc_snd target = function
| [] -> raise No_case_matched | [] -> raise Encoding.No_case_matched
| (value, hd) :: tl -> | (value, hd) :: tl ->
if hd = target if hd = target
then value then value
@ -315,10 +315,11 @@ let get_string_enum_case tbl v =
try try
snd (Hashtbl.find tbl v) snd (Hashtbl.find tbl v)
with _ -> with _ ->
raise No_case_matched raise Encoding.No_case_matched
let rec write_rec 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 let open Writer in
match e.encoding with match e.encoding with
| Null -> (fun () _buf ofs -> ofs) | Null -> (fun () _buf ofs -> ofs)
@ -395,8 +396,9 @@ let rec write_rec
| Delayed f -> write_rec (f ()) | Delayed f -> write_rec (f ())
let rec write_rec_buffer 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 -> fun encoding value buffer ->
let open Encoding in
let open BufferedWriter in let open BufferedWriter in
match encoding.encoding with match encoding.encoding with
| Null -> () | Null -> ()
@ -588,8 +590,8 @@ module Reader = struct
ofs'', (v1, v2) ofs'', (v1, v2)
let varseq r e1 e2 buf ofs len = let varseq r e1 e2 buf ofs len =
let k1 = classify e1 let k1 = Encoding.classify e1
and k2 = classify e2 in and k2 = Encoding.classify e2 in
match k1, k2 with match k1, k2 with
| (`Dynamic | `Fixed _), `Variable -> | (`Dynamic | `Fixed _), `Variable ->
let ofs', v1 = r.read e1 buf ofs len in let ofs', v1 = r.read e1 buf ofs len in
@ -626,6 +628,7 @@ module Reader = struct
| `Uint16 -> uint16 | `Uint16 -> uint16
let union r sz cases = let union r sz cases =
let open Encoding in
let read_cases = let read_cases =
TzList.filter_map TzList.filter_map
(function (function
@ -643,7 +646,8 @@ module Reader = struct
end 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 let open Reader in
match e.encoding with match e.encoding with
| Null -> (fun _buf ofs _len -> ofs, ()) | Null -> (fun _buf ofs _len -> ofs, ())
@ -755,7 +759,7 @@ let to_bytes = to_bytes
let length = length let length = length
let fixed_length e = let fixed_length e =
match classify e with match Encoding.classify e with
| `Fixed n -> Some n | `Fixed n -> Some n
| `Dynamic | `Variable -> None | `Dynamic | `Variable -> None
let fixed_length_exn e = let fixed_length_exn e =
@ -781,10 +785,10 @@ module Stream_reader = struct
number of elements that have been read so far. *) number of elements that have been read so far. *)
type path = type path =
| P_top : path | P_top : path
| P_await : { path : path ; encoding : 'a t ; data_len : int } -> path | P_await : { path : path ; encoding : 'a Encoding.t ; data_len : int } -> path
| P_seq : { path : path ; encoding : 'a t ; | P_seq : { path : path ; encoding : 'a Encoding.t ;
fun_data_len : int -> int } -> path 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 base_ofs : int ; nb_elts_read : int } -> path
(* used to accumulate given mbytes when reading a list of blocks, (* 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 buf, reader b ofs delta_ofs
end end
open Encoding (* open here, shadow below, use shadowed definitions later *)
(* functions that try to read data from a given mbytes_stream, (* functions that try to read data from a given mbytes_stream,
or raise Need_more_data *) or raise Need_more_data *)
@ -913,7 +918,7 @@ module Stream_reader = struct
(* auxiliary function: computing size of data in branches (* auxiliary function: computing size of data in branches
Objs(`Variable) and Tups(`Variable) *) 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) | (`Dynamic | `Fixed _), `Variable -> len, (fun ofs' -> len - ofs' + ofs)
| `Variable, `Fixed n -> (len - n), (fun _ -> n) | `Variable, `Fixed n -> (len - n), (fun _ -> n)
| _ -> assert false (* Should be rejected by Kind.combine *) | _ -> assert false (* Should be rejected by Kind.combine *)
@ -924,11 +929,11 @@ module Stream_reader = struct
incrementality), and 'mbytes_stream' *) incrementality), and 'mbytes_stream' *)
let rec data_checker let rec data_checker
: type a. : type a.
path -> a encoding -> mbytes_stream -> int -> path -> a Encoding.t -> mbytes_stream -> int ->
path * mbytes_stream = path * mbytes_stream =
fun path e buf len -> fun path e buf len ->
(*length of data with `Variable kind should be given by the caller*) (*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 try match e.encoding with
| Null -> next_path path buf | Null -> next_path path buf
| Empty -> next_path path buf | Empty -> next_path path buf
@ -1050,14 +1055,14 @@ module Stream_reader = struct
)None cases )None cases
in in
begin match opt with begin match opt with
| None -> raise (Unexpected_tag ctag) | None -> raise (Encoding.Unexpected_tag ctag)
| Some func -> func (len - (Size.tag_size sz)) | Some func -> func (len - (Size.tag_size sz))
end end
| Dynamic_size e -> | Dynamic_size e ->
let buf, sz = int32 buf in let buf, sz = int32 buf in
let sz = Int32.to_int sz 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 data_checker path e buf sz
| Delayed f -> data_checker path (f ()) buf len | 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 = type json =
[ `O of (string * json) list [ `O of (string * json) list
@ -21,7 +19,7 @@ type json =
type schema = Json_schema.schema type schema = Json_schema.schema
type pair_builder = { 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 exception Parse_error of string
@ -70,7 +68,8 @@ let bytes_jsont =
(fun h -> `Hex h) (fun h -> `Hex h)
string) 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 match e.encoding with
| Conv { proj ; inj ; encoding = e ; schema } -> begin | Conv { proj ; inj ; encoding = e ; schema } -> begin
match lift_union e with match lift_union e with
@ -98,8 +97,9 @@ let rec lift_union : type a. a t -> a t = fun e ->
| _ -> e | _ -> e
and lift_union_in_pair 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 -> = fun b p e1 e2 ->
let open Encoding in
match lift_union e1, lift_union e2 with match lift_union e1, lift_union e2 with
| e1, { encoding = Union (_kind, tag, cases) } -> | e1, { encoding = Union (_kind, tag, cases) } ->
make @@ make @@
@ -131,7 +131,8 @@ and lift_union_in_pair
cases) cases)
| e1, e2 -> b.build p e1 e2 | 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 let open Json_encoding in
function function
| Null -> null | Null -> null
@ -172,19 +173,19 @@ let rec json : type a. a desc -> a Json_encoding.encoding =
| Delayed f -> get_json (f ()) | Delayed f -> get_json (f ())
and field_json 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 let open Json_encoding in
function function
| Req (name, e) -> req name (get_json e) | Encoding.Req (name, e) -> req name (get_json e)
| Opt (_, name, e) -> opt name (get_json e) | Encoding.Opt (_, name, e) -> opt name (get_json e)
| Dft (name, e, d) -> dft name (get_json e) d | 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 let open Json_encoding in
function 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 match e.json_encoding with
| None -> | None ->
let json_encoding = json (lift_union e).encoding in let json_encoding = json (lift_union e).encoding in
@ -267,7 +268,7 @@ let encoding =
Encoding.string in Encoding.string in
let json = let json =
Json_encoding.any_ezjson_value in Json_encoding.any_ezjson_value in
raw_splitted ~binary ~json Encoding.raw_splitted ~binary ~json
let schema_encoding = let schema_encoding =
Encoding.conv Encoding.conv