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

Micheline: use zarith instead of strings for integers

Browse Source
This commit is contained in:
Benjamin Canou 2018-03-28 20:42:10 +02:00 committed by Grégoire Henry
parent c3cf4dfbfb
commit 27486e500a
14 changed files with 30 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
src/lib_micheline/jbuild
View File

@ -7,6 +7,7 @@
(
;; External
uutf
zarith
;; Internal
tezos-error-monad
tezos-data-encoding

4
src/lib_micheline/micheline.ml
View File

@ -8,7 +8,7 @@
(**************************************************************************)
type ('l, 'p) node =
| Int of 'l * string
| Int of 'l * Z.t
| String of 'l * string
| Prim of 'l * 'p * ('l, 'p) node list * string option
| Seq of 'l * ('l, 'p) node list * string option
@ -116,7 +116,7 @@ let rec map_node fl fp = function
let canonical_encoding ~variant prim_encoding =
let open Data_encoding in
let int_encoding =
obj1 (req "int" string) in
obj1 (req "int" z) in
let string_encoding =
obj1 (req "string" string) in
let int_encoding tag =

2
src/lib_micheline/micheline.mli
View File

@ -11,7 +11,7 @@
parameter is used to conatin locations, but can also embed custom
data. The second parameter is the type of primitive names. *)
type ('l, 'p) node =
| Int of 'l * string
| Int of 'l * Z.t
| String of 'l * string
| Prim of 'l * 'p * ('l, 'p) node list * string option
| Seq of 'l * ('l, 'p) node list * string option

2
src/lib_micheline/micheline_parser.ml
View File

@ -526,7 +526,7 @@ let rec parse ?(check = true) errors tokens stack =
{ token = Int value ; loc } :: rest
| (Expression None | Sequence _ | Toplevel _) :: _,
{ token = Int value ; loc } :: ([] | { token = Semi | Close_brace} :: _ as rest) ->
let expr : node = Int (loc, value) in
let expr : node = Int (loc, Z.of_string value) in
let errors = if check then do_check ~toplevel: false errors expr else errors in
parse ~check errors rest (fill_mode expr stack)
| (Unwrapped _ | Wrapped _) :: _,

6
src/lib_micheline/micheline_printer.ml
View File

@ -47,7 +47,7 @@ let preformat root =
let rec preformat_expr = function
| Int (loc, value) ->
let cml, csz = preformat_loc loc in
Int ((cml, String.length value + csz, loc), value)
Int ((cml, String.length (Z.to_string value) + csz, loc), value)
| String (loc, value) ->
let cml, csz = preformat_loc loc in
String ((cml, String.length value + csz, loc), value)
@ -105,8 +105,8 @@ let rec print_expr_unwrapped ppf = function
end
| Int ((_, _, { comment }), value) ->
begin match comment with
| None -> Format.fprintf ppf "%s" value
| Some comment -> Format.fprintf ppf "%s@ %a" value print_comment comment
| None -> Format.fprintf ppf "%s" (Z.to_string value)
| Some comment -> Format.fprintf ppf "%s@ %a" (Z.to_string value) print_comment comment
end
| String ((_, _, { comment }), value) ->
begin match comment with

2
src/lib_protocol_environment/sigs/v1/micheline.mli
View File

@ -8,7 +8,7 @@
(**************************************************************************)
type ('l, 'p) node =
| Int of 'l * string
| Int of 'l * Z.t
| String of 'l * string
| Prim of 'l * 'p * ('l, 'p) node list * string option
| Seq of 'l * ('l, 'p) node list * string option

1
src/lib_protocol_environment/tezos_protocol_environment.ml
View File

@ -137,6 +137,7 @@ module Make (Context : CONTEXT) = struct
and type Signature.watermark = Signature.watermark
and type 'a Micheline.canonical = 'a Micheline.canonical
and type ('a, 'b) RPC_path.t = ('a, 'b) RPC_path.t
and type Z.t = Z.t
and type ('a, 'b) Micheline.node = ('a, 'b) Micheline.node
and type Data_encoding.json_schema = Data_encoding.json_schema
and type RPC_service.meth = RPC_service.meth

1
src/lib_protocol_environment/tezos_protocol_environment.mli
View File

@ -129,6 +129,7 @@ module Make (Context : CONTEXT) : sig
and type Signature.t = Signature.t
and type Signature.watermark = Signature.watermark
and type 'a Micheline.canonical = 'a Micheline.canonical
and type Z.t = Z.t
and type ('a, 'b) Micheline.node = ('a, 'b) Micheline.node
and type Data_encoding.json_schema = Data_encoding.json_schema
and type ('a, 'b) RPC_path.t = ('a, 'b) RPC_path.t

12
src/proto_alpha/lib_baking/test/test_michelson_parser.ml
View File

@ -330,7 +330,7 @@ let test_parsing () =
assert_parses "PUSH int 100"
[ (Prim ((), "PUSH", [ Prim ((), "int", [], None) ;
Int ((), "100") ], None)) ] >>? fun () ->
Int ((), Z.of_int 100) ], None)) ] >>? fun () ->
assert_parses "DROP" [ (Prim ((), "DROP", [], None)) ] >>? fun () ->
assert_parses "DIP{DROP}"
@ -360,9 +360,9 @@ let test_parsing () =
[ Prim ((), "PUSH", [ Prim ((), "list",
[ Prim ((), "nat", [], None) ], None) ;
Prim ((), "List",
[ Int((), "1");
Int ((), "2");
Int ((), "3")],
[ Int((), Z.of_int 1);
Int ((), Z.of_int 2);
Int ((), Z.of_int 3)],
None) ], None) ] >>? fun () ->
assert_parses "PUSH (lambda nat nat) {}"
[ Prim ((), "PUSH", [ Prim ((), "lambda",
@ -380,7 +380,7 @@ let test_parsing () =
Prim((), "bool", [], None)], None) ;
Prim ((), "Map",
[Prim ((), "Item",
[Int ((), "100");
[Int ((), Z.of_int 100);
Prim ((), "False", [], None)], None)], None) ],
None) ] >>? fun () ->
assert_parses
@ -402,7 +402,7 @@ let test_parsing () =
Prim ((), "return", [ Prim((), "int", [], None) ], None);
Prim ((), "code", [ Seq((), [ Prim ((), "CAR", [], None) ;
Prim ((), "PUSH", [ Prim((), "int", [], None) ;
Int ((), "1")], None) ;
Int ((), Z.of_int 1)], None) ;
Prim ((), "ADD", [], None) ;
Prim ((), "UNIT", [], None) ;
Prim ((), "SWAP", [], None) ;

2
src/proto_alpha/lib_client/michelson_v1_emacs.ml
View File

@ -16,7 +16,7 @@ let print_expr ppf expr =
| None -> ()
| Some annot -> Format.fprintf ppf " %s" annot in
let rec print_expr ppf = function
| Int (_, value) -> Format.fprintf ppf "%s" value
| Int (_, value) -> Format.fprintf ppf "%s" (Z.to_string value)
| String (_, value) -> Micheline_printer.print_string ppf value
| Seq (_, items, annot) ->
Format.fprintf ppf "(seq%a %a)"

1
src/proto_alpha/lib_protocol/src/alpha_context.mli
View File

@ -153,6 +153,7 @@ module Script_timestamp : sig
val sub_delta: t -> z num -> t
val now: context -> t
val to_zint: t -> Z.t
val of_zint: Z.t -> t
end
module Script : sig

31
src/proto_alpha/lib_protocol/src/script_ir_translator.ml
View File

@ -562,10 +562,10 @@ let rec unparse_data
(Prim (-1, D_Unit, [], None), gas)
| Int_t, v ->
Gas.consume ctxt (Unparse_costs.int v) >|? fun gas ->
(Int (-1, Script_int.to_string v), gas)
(Int (-1, Script_int.to_zint v), gas)
| Nat_t, v ->
Gas.consume ctxt (Unparse_costs.int v) >|? fun gas ->
(Int (-1, Script_int.to_string v), gas)
(Int (-1, Script_int.to_zint v), gas)
| String_t, s ->
Gas.consume ctxt (Unparse_costs.string s) >|? fun gas ->
(String (-1, s), gas)
@ -579,7 +579,7 @@ let rec unparse_data
Gas.consume ctxt (Unparse_costs.timestamp t) >>? fun gas ->
begin
match Script_timestamp.to_notation t with
| None -> ok @@ (Int (-1, Script_timestamp.to_num_str t), gas)
| None -> ok @@ (Int (-1, Script_timestamp.to_zint t), gas)
| Some s -> ok @@ (String (-1, s), gas)
end
| Contract_t _, (_, _, c) ->
@ -1083,20 +1083,12 @@ let rec parse_data
traced (fail (Invalid_kind (location expr, [ String_kind ], kind expr)))
(* Integers *)
| Int_t, Int (_, v) ->
Lwt.return (Gas.consume ctxt (Typecheck_costs.int_of_string v)) >>=? fun ctxt ->
begin match Script_int.of_string v with
| None -> fail (error ())
| Some v -> return (v, ctxt)
end
return (Script_int.of_zint v, ctxt)
| Nat_t, Int (_, v) ->
Lwt.return (Gas.consume ctxt (Typecheck_costs.int_of_string v)) >>=? fun ctxt ->
begin match Script_int.of_string v with
| None -> fail (error ())
| Some v ->
if Compare.Int.(Script_int.compare v Script_int.zero >= 0) then
return (Script_int.abs v, ctxt)
else fail (error ())
end
let v = Script_int.of_zint v in
if Compare.Int.(Script_int.compare v Script_int.zero >= 0) then
return (Script_int.abs v, ctxt)
else fail (error ())
| Int_t, expr ->
traced (fail (Invalid_kind (location expr, [ Int_kind ], kind expr)))
| Nat_t, expr ->
@ -1115,12 +1107,7 @@ let rec parse_data
traced (fail (Invalid_kind (location expr, [ String_kind ], kind expr)))
(* Timestamps *)
| Timestamp_t, (Int (_, v)) ->
Lwt.return (Gas.consume ctxt (Typecheck_costs.int_of_string v)) >>=? fun ctxt ->
begin
match Script_timestamp.of_string v with
| Some v -> return (v, ctxt)
| None -> fail (error ())
end
return (Script_timestamp.of_zint v, ctxt)
| Timestamp_t, String (_, s) ->
Lwt.return (Gas.consume ctxt Typecheck_costs.string_timestamp) >>=? fun ctxt ->
begin try

1
src/proto_alpha/lib_protocol/src/script_timestamp_repr.ml
View File

@ -45,3 +45,4 @@ let add_delta t delta =
Z.add t (Script_int_repr.to_zint delta)
let to_zint x = x
let of_zint x = x

1
src/proto_alpha/lib_protocol/src/script_timestamp_repr.mli
View File

@ -30,3 +30,4 @@ val add_delta : t -> z num -> t
val sub_delta : t -> z num -> t
val to_zint : t -> Z.t
val of_zint : Z.t -> t