diff --git a/src/lib_micheline/jbuild b/src/lib_micheline/jbuild index 19f5389b7..154f8bb34 100644 --- a/src/lib_micheline/jbuild +++ b/src/lib_micheline/jbuild @@ -7,6 +7,7 @@ ( ;; External uutf + zarith ;; Internal tezos-error-monad tezos-data-encoding diff --git a/src/lib_micheline/micheline.ml b/src/lib_micheline/micheline.ml index 2396e9cd2..6d36c1562 100644 --- a/src/lib_micheline/micheline.ml +++ b/src/lib_micheline/micheline.ml @@ -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 = diff --git a/src/lib_micheline/micheline.mli b/src/lib_micheline/micheline.mli index 93e7862e6..385f45093 100644 --- a/src/lib_micheline/micheline.mli +++ b/src/lib_micheline/micheline.mli @@ -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 diff --git a/src/lib_micheline/micheline_parser.ml b/src/lib_micheline/micheline_parser.ml index 31f8bb158..b8c01a401 100644 --- a/src/lib_micheline/micheline_parser.ml +++ b/src/lib_micheline/micheline_parser.ml @@ -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 _) :: _, diff --git a/src/lib_micheline/micheline_printer.ml b/src/lib_micheline/micheline_printer.ml index bae1bc73c..7513e4350 100644 --- a/src/lib_micheline/micheline_printer.ml +++ b/src/lib_micheline/micheline_printer.ml @@ -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 diff --git a/src/lib_protocol_environment/sigs/v1/micheline.mli b/src/lib_protocol_environment/sigs/v1/micheline.mli index d95f7865e..e5d789cda 100644 --- a/src/lib_protocol_environment/sigs/v1/micheline.mli +++ b/src/lib_protocol_environment/sigs/v1/micheline.mli @@ -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 diff --git a/src/lib_protocol_environment/tezos_protocol_environment.ml b/src/lib_protocol_environment/tezos_protocol_environment.ml index c21f63806..05de4ec4c 100644 --- a/src/lib_protocol_environment/tezos_protocol_environment.ml +++ b/src/lib_protocol_environment/tezos_protocol_environment.ml @@ -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 diff --git a/src/lib_protocol_environment/tezos_protocol_environment.mli b/src/lib_protocol_environment/tezos_protocol_environment.mli index 1fa917655..d99173cf8 100644 --- a/src/lib_protocol_environment/tezos_protocol_environment.mli +++ b/src/lib_protocol_environment/tezos_protocol_environment.mli @@ -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 diff --git a/src/proto_alpha/lib_baking/test/test_michelson_parser.ml b/src/proto_alpha/lib_baking/test/test_michelson_parser.ml index 952650610..502409d3d 100644 --- a/src/proto_alpha/lib_baking/test/test_michelson_parser.ml +++ b/src/proto_alpha/lib_baking/test/test_michelson_parser.ml @@ -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) ; diff --git a/src/proto_alpha/lib_client/michelson_v1_emacs.ml b/src/proto_alpha/lib_client/michelson_v1_emacs.ml index 57e81d9fd..30cccb229 100644 --- a/src/proto_alpha/lib_client/michelson_v1_emacs.ml +++ b/src/proto_alpha/lib_client/michelson_v1_emacs.ml @@ -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)" diff --git a/src/proto_alpha/lib_protocol/src/alpha_context.mli b/src/proto_alpha/lib_protocol/src/alpha_context.mli index 258c91712..18576a06e 100644 --- a/src/proto_alpha/lib_protocol/src/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/src/alpha_context.mli @@ -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 diff --git a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml index c772e3cba..220006859 100644 --- a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml @@ -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 diff --git a/src/proto_alpha/lib_protocol/src/script_timestamp_repr.ml b/src/proto_alpha/lib_protocol/src/script_timestamp_repr.ml index 418006cae..2b95e43dc 100644 --- a/src/proto_alpha/lib_protocol/src/script_timestamp_repr.ml +++ b/src/proto_alpha/lib_protocol/src/script_timestamp_repr.ml @@ -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 diff --git a/src/proto_alpha/lib_protocol/src/script_timestamp_repr.mli b/src/proto_alpha/lib_protocol/src/script_timestamp_repr.mli index 5b5191850..a82496a78 100644 --- a/src/proto_alpha/lib_protocol/src/script_timestamp_repr.mli +++ b/src/proto_alpha/lib_protocol/src/script_timestamp_repr.mli @@ -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