Michelson: gas costs tweaks and fixes

src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml

@@ -57,7 +57,7 @@ module Cost_of = struct
   let map_to_list : type key value. (key, value) Script_typed_ir.map -> cost
     = fun (module Box) ->
       let size = snd Box.boxed in
-      2 *@ (alloc_cost (size * 2))
+      3 *@ alloc_cost size
 
   let map_mem _key map = step_cost (map_access map)
 
@@ -85,10 +85,13 @@ module Cost_of = struct
   let wrap = alloc_cost 1
 
   let mul n1 n2 =
-    let bits =
+    let steps =
       (Z.numbits (Script_int.to_zint n1))
       * (Z.numbits (Script_int.to_zint n2)) in
-    step_cost bits +@ alloc_bits_cost bits
+    let bits =
+      (Z.numbits (Script_int.to_zint n1))
+      + (Z.numbits (Script_int.to_zint n2)) in
+    step_cost steps +@ alloc_bits_cost bits
 
   let div n1 n2 =
     mul n1 n2 +@ alloc_cost 2
@@ -171,24 +174,21 @@ module Cost_of = struct
   let unpack bytes = 10 *@ step_cost (MBytes.length bytes)
   let pack bytes = alloc_bytes_cost (MBytes.length bytes)
 
-  (* TODO: protocol operations *)
-  let address = step_cost 3
-  let contract = Gas.read_bytes_cost Z.zero +@ step_cost 3
-  let manager = step_cost 3
-  let transfer = step_cost 50
-  let create_account = step_cost 20
-  let create_contract = step_cost 70
+  let address = step_cost 1
+  let contract = Gas.read_bytes_cost Z.zero +@ step_cost 100
+  let transfer = step_cost 10
+  let create_account = step_cost 10
+  let create_contract = step_cost 10
   let implicit_account = step_cost 10
-  let set_delegate = step_cost 10
-  let balance = step_cost 5
-  let now = step_cost 3
-  let check_signature = step_cost 3
-  let hash_key = step_cost 3
-  (* TODO: This needs to be a function of the data being hashed *)
-  let hash data len = step_cost (MBytes.length data) +@ alloc_bytes_cost len
+  let set_delegate = step_cost 10 +@ write_bytes_cost (Z.of_int 32)
+  let balance = step_cost 1 +@ read_bytes_cost (Z.of_int 8)
+  let now = step_cost 5
+  let check_signature = step_cost 100
+  let hash_key = step_cost 3 +@ bytes 20
+  let hash data len = 10 *@ step_cost (MBytes.length data) +@ bytes len
   let steps_to_quota = step_cost 1
-  let source = step_cost 3
-  let self = step_cost 3
+  let source = step_cost 1
+  let self = step_cost 1
   let amount = step_cost 1
   let compare_bool _ _ = step_cost 1
   let compare_string s1 s2 =
@@ -225,8 +225,8 @@ module Cost_of = struct
     let some = alloc_cost 1
     let none = alloc_cost 0
     let list_element = alloc_cost 2 +@ step_cost 1
-    let set_element = alloc_cost 3 +@ step_cost 2
-    let map_element = alloc_cost 4 +@ step_cost 2
+    let set_element size = log2 size *@ (alloc_cost 3 +@ step_cost 2)
+    let map_element size = log2 size *@ (alloc_cost 4 +@ step_cost 2)
     let primitive_type = alloc_cost 1
     let one_arg_type = alloc_cost 2
     let two_arg_type = alloc_cost 3
@@ -379,8 +379,8 @@ module Cost_of = struct
     let some = prim_cost 1 []
     let none = prim_cost 0 []
     let list_element = alloc_cost 2
-    let set_element = alloc_cost 2 (* FIXME: log(size) *)
-    let map_element = alloc_cost 2 (* FIXME: log(size) *)
+    let set_element = alloc_cost 2
+    let map_element = alloc_cost 2
     let one_arg_type = prim_cost 1
     let two_arg_type = prim_cost 2
 

src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli

@@ -68,7 +68,6 @@ module Cost_of : sig
   val unpack : MBytes.t -> Gas.cost
   val address : Gas.cost
   val contract : Gas.cost
-  val manager : Gas.cost
   val transfer : Gas.cost
   val create_account : Gas.cost
   val create_contract : Gas.cost
@@ -125,8 +124,8 @@ module Cost_of : sig
     val none : Gas.cost
 
     val list_element : Gas.cost
-    val set_element : Gas.cost
-    val map_element : Gas.cost
+    val set_element : int -> Gas.cost
+    val map_element : int -> Gas.cost
 
     val primitive_type : Gas.cost
     val one_arg_type : Gas.cost

src/proto_alpha/lib_protocol/src/script_ir_translator.ml

@@ -1243,9 +1243,10 @@ let rec parse_data
     let traced body =
       trace error body in
     let parse_items ?type_logger loc ctxt expr key_type value_type items item_wrapper =
+      let length = List.length items in
       fold_left_s
         (fun (last_value, map, ctxt) item ->
-           Lwt.return (Gas.consume ctxt Typecheck_costs.cycle) >>=? fun ctxt ->
+           Lwt.return (Gas.consume ctxt (Typecheck_costs.map_element length)) >>=? fun ctxt ->
            match item with
            | Prim (_, D_Elt, [ k; v ], _) ->
                parse_comparable_data ?type_logger ctxt key_type k >>=? fun (k, ctxt) ->
@@ -1498,10 +1499,11 @@ let rec parse_data
         traced (fail (Invalid_kind (location expr, [ Seq_kind ], kind expr)))
     (* Sets *)
     | Set_t (t, _ty_name), (Seq (loc, vs) as expr) ->
+        let length = List.length vs in
         traced @@
         fold_left_s
           (fun (last_value, set, ctxt) v ->
-             Lwt.return (Gas.consume ctxt Typecheck_costs.set_element) >>=? fun ctxt ->
+             Lwt.return (Gas.consume ctxt (Typecheck_costs.set_element length)) >>=? fun ctxt ->
              parse_comparable_data ?type_logger ctxt t v >>=? fun (v, ctxt) ->
              begin match last_value with
                | Some value ->