Micheline: use zarith instead of strings for integers

src/lib_micheline/jbuild

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

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 =

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

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 _) :: _,

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
+        | None -> Format.fprintf ppf "%s" (Z.to_string value)
-        | Some comment -> Format.fprintf ppf "%s@ %a" value print_comment comment
+        | Some comment -> Format.fprintf ppf "%s@ %a" (Z.to_string value) print_comment comment
       end
   | String ((_, _, { comment }), value) ->
       begin match comment with

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

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

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

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((), Z.of_int 1);
-                                  Int ((), "2");
+                                  Int ((), Z.of_int 2);
-                                  Int ((), "3")],
+                                  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) ;

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)"

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

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 ->
+        return (Script_int.of_zint v, ctxt)
-        begin match Script_int.of_string v with
-          | None -> fail (error ())
-          | Some v -> return (v, ctxt)
-        end
     | Nat_t, Int (_, v) ->
-        Lwt.return (Gas.consume ctxt (Typecheck_costs.int_of_string v)) >>=? fun ctxt ->
+        let v = Script_int.of_zint v in
-        begin match Script_int.of_string v with
+        if Compare.Int.(Script_int.compare v Script_int.zero >= 0) then
-          | None -> fail (error ())
+          return (Script_int.abs v, ctxt)
-          | Some v ->
+        else fail (error ())
-              if Compare.Int.(Script_int.compare v Script_int.zero >= 0) then
-                return (Script_int.abs v, ctxt)
-              else fail (error ())
-        end
     | 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 ->
+        return (Script_timestamp.of_zint v, ctxt)
-        begin
-          match Script_timestamp.of_string v with
-          | Some v -> return (v, ctxt)
-          | None -> fail (error ())
-        end
     | Timestamp_t, String (_, s) ->
         Lwt.return (Gas.consume ctxt Typecheck_costs.string_timestamp) >>=? fun ctxt ->
         begin try

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

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