Alpha, Michelson: thread the gas directly in the context

src/bin_client/test/test_contracts.sh

@@ -208,7 +208,7 @@ assert_output $contract_dir/exec_concat.tz Unit '""' '"_abc"'
 assert_output $contract_dir/exec_concat.tz Unit '"test"' '"test_abc"'
 
 # Get current steps to quota
-assert_output $contract_dir/steps_to_quota.tz Unit Unit 39973
+assert_output $contract_dir/steps_to_quota.tz Unit Unit 39968
 
 # Get the current balance of the contract
 assert_output $contract_dir/balance.tz Unit Unit '"4,000,000"'

src/proto_alpha/lib_client/client_proto_programs.ml

@@ -134,7 +134,7 @@ let typecheck_program ?gas (program : Michelson_v1_parser.parsed) block cctxt =
   Alpha_services.Helpers.typecheck_code cctxt block (program.expanded, gas)
 
 let print_typecheck_result
-    ~emacs ~show_types ~print_source_on_error ~original_gas
+    ~emacs ~show_types ~print_source_on_error
     program res (cctxt : #Client_context.printer) =
   if emacs then
     let type_map, errs, _gas = match res with
@@ -154,8 +154,7 @@ let print_typecheck_result
     match res with
     | Ok (type_map, gas) ->
         let program = Michelson_v1_printer.inject_types type_map program in
-        cctxt#message "@[<v 0>Well typed@,Gas used: %a@,Gas remaining: %a@]"
+        cctxt#message "@[<v 0>Well typed@,Gas remaining: %a@]"
-          Gas.pp (Gas.used ~original:original_gas ~current:gas)
           Gas.pp gas >>= fun () ->
         if show_types then
           cctxt#message "%a" Micheline_printer.print_expr program >>= fun () ->

src/proto_alpha/lib_client/client_proto_programs.mli

@@ -51,7 +51,7 @@ val print_trace_result :
     tzresult -> unit tzresult Lwt.t
 
 val hash_and_sign :
-  ?gas:Gas.t ->
+  ?gas:int ->
   Michelson_v1_parser.parsed ->
   Michelson_v1_parser.parsed ->
   Client_keys.sk_uri ->
@@ -60,7 +60,7 @@ val hash_and_sign :
   (string * string * Gas.t) tzresult Lwt.t
 
 val typecheck_data :
-  ?gas:Proto_alpha.Gas.t ->
+  ?gas:int ->
   data:Michelson_v1_parser.parsed ->
   ty:Michelson_v1_parser.parsed ->
   'a ->
@@ -68,7 +68,7 @@ val typecheck_data :
   Gas.t tzresult Lwt.t
 
 val typecheck_program :
-  ?gas:Gas.t ->
+  ?gas:int ->
   Michelson_v1_parser.parsed ->
   Block_services.block ->
   #Proto_alpha.rpc_context ->
@@ -78,7 +78,6 @@ val print_typecheck_result :
   emacs:bool ->
   show_types:bool ->
   print_source_on_error:bool ->
-  original_gas:Gas.t ->
   Michelson_v1_parser.parsed ->
   (Script_tc_errors.type_map * Gas.t) tzresult ->
   #Client_context.printer ->

src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml

@@ -50,12 +50,12 @@ let commands () =
       (parameter
          (fun _ctx str ->
             try
-              return @@ Proto_alpha.Gas.of_int @@ int_of_string str
+              return (int_of_string str)
             with _ ->
               failwith "Invalid gas literal: '%s'" str)) in
   let resolve_max_gas ctxt block = function
     | None -> Alpha_services.Constants.max_gas ctxt block >>=? fun gas ->
-        return @@ Proto_alpha.Gas.of_int gas
+        return gas
     | Some gas -> return gas in
   let data_parameter =
     Clic.parameter (fun _ data ->
@@ -129,7 +129,6 @@ let commands () =
              resolve_max_gas cctxt cctxt#block original_gas >>=? fun original_gas ->
              typecheck_program ~gas:original_gas program cctxt#block cctxt >>= fun res ->
              print_typecheck_result
-               ~original_gas
                ~emacs:emacs_mode
                ~show_types
                ~print_source_on_error:(not no_print_source)
@@ -164,9 +163,8 @@ let commands () =
          resolve_max_gas cctxt cctxt#block custom_gas >>=? fun original_gas ->
          Client_proto_programs.typecheck_data ~gas:original_gas ~data ~ty cctxt#block cctxt >>= function
          | Ok gas ->
-             cctxt#message "@[<v 0>Well typed@,Gas used: %a@,Gas remaining: %a@]"
+             cctxt#message "@[<v 0>Well typed@,Gas remaining: %a@]"
-               Proto_alpha.Gas.pp (Proto_alpha.Gas.used ~original:original_gas ~current:gas)
+               Proto_alpha.Alpha_context.Gas.pp gas >>= fun () ->
-               Proto_alpha.Gas.pp gas >>= fun () ->
              return ()
          | Error errs ->
              cctxt#warning "%a"
@@ -193,8 +191,8 @@ let commands () =
          Alpha_services.Helpers.hash_data cctxt
            cctxt#block (data.expanded, typ.expanded, Some original_gas) >>= function
          | Ok (hash, remaining_gas) ->
-             cctxt#message "%S@,Gas used: %a" hash
+             cctxt#message "%S@,Gas remaining: %a" hash
-               Proto_alpha.Gas.pp (Proto_alpha.Gas.used ~original:original_gas ~current:remaining_gas) >>= fun () ->
+               Proto_alpha.Alpha_context.Gas.pp remaining_gas >>= fun () ->
              return ()
          | Error errs ->
              cctxt#warning "%a"
@@ -225,10 +223,9 @@ let commands () =
          resolve_max_gas cctxt cctxt#block gas >>=? fun gas ->
          Client_proto_programs.hash_and_sign ~gas data typ sk cctxt#block cctxt >>= begin function
            | Ok (hash, signature, current_gas) ->
-               cctxt#message "@[<v 0>Hash: %S@,Signature: %S@,Gas used: %a@,Remaining gas: %a@]"
+               cctxt#message "@[<v 0>Hash: %S@,Signature: %S@,Remaining gas: %a@]"
                  hash signature
-                 Proto_alpha.Gas.pp (Proto_alpha.Gas.used ~original:gas ~current:current_gas)
+                 Proto_alpha.Alpha_context.Gas.pp current_gas
-                 Proto_alpha.Gas.pp current_gas
            | Error errs ->
                cctxt#warning "%a"
                  (Michelson_v1_error_reporter.report_errors

src/proto_alpha/lib_protocol/src/TEZOS_PROTOCOL

@@ -20,6 +20,7 @@
         "Cycle_repr",
         "Level_repr",
         "Seed_repr",
+        "Gas_repr",
         "Script_int_repr",
         "Script_timestamp_repr",
         "Michelson_v1_primitives",
@@ -55,7 +56,6 @@
 
         "Script_typed_ir",
         "Fees",
-        "Gas",
         "Script_tc_errors",
         "Michelson_v1_gas",
         "Script_ir_translator",

src/proto_alpha/lib_protocol/src/alpha_context.ml

@@ -61,6 +61,13 @@ end
 
 module Voting_period = Voting_period_repr
 
+module Gas = struct
+  include Gas_repr
+  let set_limit = Raw_context.set_gas_limit
+  let set_unlimited = Raw_context.set_gas_unlimited
+  let consume = Raw_context.consume_gas
+  let level = Raw_context.gas_level
+end
 module Level = struct
   include Level_repr
   include Level_storage

src/proto_alpha/lib_protocol/src/alpha_context.mli

@@ -106,6 +106,36 @@ module Cycle : sig
 
 end
 
+module Gas : sig
+  type t = private
+    | Unaccounted
+    | Limited of { remaining : int }
+
+  val encoding : t Data_encoding.encoding
+  val pp : Format.formatter -> t -> unit
+
+  type cost
+
+  val cost_encoding : cost Data_encoding.encoding
+  val pp_cost : Format.formatter -> cost -> unit
+
+  type error += Quota_exceeded
+
+  val free : cost
+  val step_cost : int -> cost
+  val alloc_cost : int -> cost
+  val alloc_bytes_cost : int -> cost
+  val alloc_bits_cost : int -> cost
+
+  val ( *@ ) : int -> cost -> cost
+  val ( +@ ) : cost -> cost -> cost
+
+  val set_limit: context -> int -> context
+  val set_unlimited: context -> context
+  val consume: context -> cost -> context tzresult
+  val level: context -> t
+end
+
 module Script_int : module type of Script_int_repr
 
 module Script_timestamp : sig

src/proto_alpha/lib_protocol/src/apply.ml

@@ -371,7 +371,9 @@ let apply_amendment_operation_content ctxt delegate = function
 let apply_manager_operation_content
     ctxt origination_nonce source = function
   | Reveal _ -> return (ctxt, origination_nonce, None)
-  | Transaction { amount ; parameters ; destination } -> begin
+  | Transaction { amount ; parameters ; destination } ->
+      let ctxt = Gas.set_limit ctxt (Constants.max_gas ctxt) in
+      begin
         Contract.spend ctxt source amount >>=? fun ctxt ->
         Contract.credit ctxt destination amount >>=? fun ctxt ->
         Contract.get_script ctxt destination >>=? function
@@ -386,19 +388,17 @@ let apply_manager_operation_content
                 | _ -> fail (Bad_contract_parameter (destination, None, parameters))
           end
         | Some script ->
-          let gas = Gas.of_int (Constants.max_gas ctxt) in
+            let call_contract ctxt argument =
-          let call_contract argument gas =
               Script_interpreter.execute
                 origination_nonce
                 source destination ctxt script amount argument
-              gas
               >>= function
-            | Ok (storage_res, _res, gas, ctxt, origination_nonce, maybe_big_map_diff) ->
+              | Ok (storage_res, _res, ctxt, origination_nonce, maybe_big_map_diff) ->
                   begin match maybe_big_map_diff with
-                  | None -> return (None, gas)
+                    | None -> return (None, ctxt)
                     | Some map ->
-                      Script_ir_translator.to_serializable_big_map gas map >>=? fun (diff, gas) ->
+                        Script_ir_translator.to_serializable_big_map ctxt map >>=? fun (diff, ctxt) ->
-                      return (Some diff, gas) end >>=? fun (diff, _gas) ->
+                        return (Some diff, ctxt) end >>=? fun (diff, ctxt) ->
                   Contract.update_script_storage
                     ctxt destination
                     storage_res diff >>=? fun ctxt ->
@@ -407,14 +407,14 @@ let apply_manager_operation_content
                   return (ctxt, origination_nonce, None)
               | Error err ->
                   return (ctxt, origination_nonce, Some err) in
-          Lwt.return @@ Script_ir_translator.parse_toplevel gas script.code >>=? fun ((arg_type, _, _, _), gas) ->
+            Lwt.return @@ Script_ir_translator.parse_toplevel ctxt script.code >>=? fun ((arg_type, _, _, _), ctxt) ->
             let arg_type = Micheline.strip_locations arg_type in
             match parameters, Micheline.root arg_type with
             | None, Prim (_, T_unit, _, _) ->
-              call_contract (Micheline.strip_locations (Prim (0, Script.D_Unit, [], None))) gas
+                call_contract ctxt (Micheline.strip_locations (Prim (0, Script.D_Unit, [], None)))
             | Some parameters, _ -> begin
-              Script_ir_translator.typecheck_data ctxt gas (parameters, arg_type) >>= function
+                Script_ir_translator.typecheck_data ctxt (parameters, arg_type) >>= function
-              | Ok gas -> call_contract parameters gas
+                | Ok ctxt -> call_contract ctxt parameters
                 | Error errs ->
                     let err = Bad_contract_parameter (destination, Some arg_type, Some parameters) in
                     return (ctxt, origination_nonce, Some ((err :: errs)))
@@ -423,15 +423,15 @@ let apply_manager_operation_content
       end
   | Origination { manager ; delegate ; script ;
                   spendable ; delegatable ; credit } ->
-      let gas = Gas.of_int (Constants.max_gas ctxt) in
+      let ctxt = Gas.set_limit ctxt (Constants.max_gas ctxt) in
       begin match script with
-        | None -> return (None, None, gas)
+        | None -> return (None, None, ctxt)
         | Some script ->
-            Script_ir_translator.parse_script ctxt gas script >>=? fun (_, gas) ->
+            Script_ir_translator.parse_script ctxt script >>=? fun (_, ctxt) ->
-            Script_ir_translator.erase_big_map_initialization ctxt gas script >>=? fun (script, big_map_diff, gas) ->
+            Script_ir_translator.erase_big_map_initialization ctxt script >>=? fun (script, big_map_diff, ctxt) ->
             return (Some (script, (Script_interpreter.dummy_code_fee, Script_interpreter.dummy_storage_fee)),
-                    big_map_diff, gas)
+                    big_map_diff, ctxt)
-      end >>=? fun (script, big_map, _gas) ->
+      end >>=? fun (script, big_map, ctxt) ->
       Contract.spend ctxt source credit >>=? fun ctxt ->
       Contract.originate ctxt
         origination_nonce
@@ -488,6 +488,7 @@ let apply_sourced_operation
                 ctxt origination_nonce source content)
         (ctxt, origination_nonce, None) contents
       >>=? fun (ctxt, origination_nonce, err) ->
+      let ctxt = Gas.set_unlimited ctxt in
       return (ctxt, origination_nonce, err)
   | Consensus_operation content ->
       apply_consensus_operation_content ctxt
@@ -615,6 +616,7 @@ let apply_anonymous_operation ctxt _delegate origination_nonce kind =
 
 let apply_operation
     ctxt delegate pred_block block_prio hash operation =
+  let ctxt = Gas.set_unlimited ctxt in
   match operation.contents with
   | Anonymous_operations ops ->
       let origination_nonce = Contract.initial_origination_nonce hash in

src/proto_alpha/lib_protocol/src/gas.ml

@@ -1,153 +0,0 @@
-(**************************************************************************)
-(*                                                                        *)
-(*    Copyright (c) 2014 - 2016.                                          *)
-(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
-(*                                                                        *)
-(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
-(*                                                                        *)
-(**************************************************************************)
-
-type t = { remaining : int } [@@unboxed]
-
-type cost =
-  { allocations : int ;
-    steps : int }
-
-let encoding =
-  let open Data_encoding in
-  conv
-    (fun { remaining } ->
-       (remaining))
-    (fun (remaining) ->
-       { remaining })
-    int31
-
-let pp ppf { remaining } =
-  Format.pp_print_int ppf remaining
-
-let of_int remaining = { remaining }
-
-let remaining { remaining } = remaining
-
-(* Maximum gas representable on a 64 bit system *)
-let max_gas = of_int 4611686018427387903
-
-let encoding_cost =
-  let open Data_encoding in
-  conv
-    (fun { allocations ; steps } ->
-       (allocations, steps))
-    (fun (allocations, steps) ->
-       { allocations ; steps })
-    (obj2
-       (req "allocations" int31)
-       (req "steps" int31))
-
-let pp_cost ppf { allocations ; steps } =
-  Format.fprintf ppf
-    "(steps: %d, allocs: %d)"
-    steps allocations
-
-type error += Quota_exceeded
-
-let check_error gas =
-  if Compare.Int.(gas.remaining <= 0)
-  then error Quota_exceeded
-  else ok ()
-
-let check gas =
-  Lwt.return @@ check_error gas
-
-let used ~original ~current =
-  { remaining = original.remaining - current.remaining }
-
-let consume t cost =
-  { remaining =
-      t.remaining
-      - 2 * cost.allocations
-      - 1 * cost.steps }
-
-let consume_check gas cost =
-  let gas = consume gas cost in
-  check gas >>|? fun () ->
-  gas
-
-let consume_check_error gas cost =
-  let gas = consume gas cost in
-  check_error gas >|? fun () ->
-  gas
-
-(* Cost for heap allocating n words of data. *)
-let alloc_cost n =
-  { allocations = n + 1 ;
-    steps = 0 }
-
-let alloc_bytes_cost n =
-  alloc_cost (n / 8)
-
-let alloc_bits_cost n =
-  alloc_cost (n / 64)
-
-(* Cost for one computation step. *)
-let step_cost n =
-  { allocations = 0 ;
-    steps = n }
-
-let free =
-  { allocations = 0 ;
-    steps = 0 }
-
-let ( +@ ) x y =
-  { allocations = x.allocations + y.allocations ;
-    steps = x.steps + y.steps }
-
-let ( *@ ) x y =
-  { allocations = x * y.allocations ;
-    steps = x * y.steps }
-
-(* f should fail if it does not receive sufficient gas *)
-let rec fold_left ~cycle_cost gas f acc l =
-  consume_check gas cycle_cost >>=? fun gas ->
-  match l with
-  | [] -> return (acc, gas)
-  | hd :: tl -> f gas hd acc >>=? fun (acc, gas) ->
-      fold_left ~cycle_cost gas f acc tl
-
-(* f should fail if it does not receive sufficient gas *)
-let rec fold_right ~cycle_cost gas f base l =
-  consume_check gas cycle_cost >>=? fun gas ->
-  match l with
-  | [] -> return (base, gas)
-  | hd :: tl ->
-      fold_right ~cycle_cost gas f base tl >>=? fun (acc, gas) ->
-      f gas hd acc
-
-(* f should fail if it does not receive sufficient gas *)
-let rec fold_right_error ~cycle_cost gas f base l =
-  consume_check_error gas cycle_cost >>? fun gas ->
-  match l with
-  | [] -> ok (base, gas)
-  | hd :: tl ->
-      fold_right_error ~cycle_cost gas f base tl >>? fun (acc, gas) ->
-      f gas hd acc
-
-(* f should fail if it does not receive sufficient gas *)
-let rec fold_left_error ~cycle_cost gas f acc l =
-  consume_check_error gas cycle_cost >>? fun gas ->
-  match l with
-  | [] -> ok (acc, gas)
-  | hd :: tl -> f gas hd acc >>? fun (acc, gas) ->
-      fold_left_error ~cycle_cost gas f acc tl
-
-let () =
-  let open Data_encoding in
-  register_error_kind
-    `Permanent
-    ~id:"quotaExceededRuntimeError"
-    ~title: "Quota exceeded (runtime script error)"
-    ~description:
-      "A script or one of its callee took too much \
-       time or storage space"
-    empty
-    (function Quota_exceeded -> Some () | _ -> None)
-    (fun () -> Quota_exceeded) ;

src/proto_alpha/lib_protocol/src/gas_repr.ml

@@ -0,0 +1,100 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+type t =
+  | Unaccounted
+  | Limited of { remaining : int }
+
+type cost =
+  { allocations : int ;
+    steps : int }
+
+let encoding =
+  let open Data_encoding in
+  union
+    [ case (Tag 0) int31
+        (function Limited { remaining } -> Some remaining | _ -> None)
+        (fun remaining -> Limited { remaining }) ;
+      case (Tag 1) (constant "unaccounted")
+        (function Unaccounted -> Some () | _ -> None)
+        (fun () -> Unaccounted) ]
+
+let pp ppf = function
+  | Unaccounted ->
+      Format.fprintf ppf "unaccounted"
+  | Limited { remaining } ->
+      Format.fprintf ppf "%d units remaining" remaining
+
+let cost_encoding =
+  let open Data_encoding in
+  conv
+    (fun { allocations ; steps } ->
+       (allocations, steps))
+    (fun (allocations, steps) ->
+       { allocations ; steps })
+    (obj2
+       (req "allocations" int31)
+       (req "steps" int31))
+
+let pp_cost ppf { allocations ; steps } =
+  Format.fprintf ppf
+    "(steps: %d, allocs: %d)"
+    steps allocations
+
+type error += Quota_exceeded
+
+let consume t cost = match t with
+  | Unaccounted -> ok Unaccounted
+  | Limited { remaining } ->
+      let remaining =
+        remaining
+        - 2 * cost.allocations
+        - 1 * cost.steps in
+      if Compare.Int.(remaining <= 0)
+      then error Quota_exceeded
+      else ok (Limited { remaining })
+
+let alloc_cost n =
+  { allocations = n + 1 ;
+    steps = 0 }
+
+let alloc_bytes_cost n =
+  alloc_cost (n / 8)
+
+let alloc_bits_cost n =
+  alloc_cost (n / 64)
+
+let step_cost n =
+  { allocations = 0 ;
+    steps = n }
+
+let free =
+  { allocations = 0 ;
+    steps = 0 }
+
+let ( +@ ) x y =
+  { allocations = x.allocations + y.allocations ;
+    steps = x.steps + y.steps }
+
+let ( *@ ) x y =
+  { allocations = x * y.allocations ;
+    steps = x * y.steps }
+
+let () =
+  let open Data_encoding in
+  register_error_kind
+    `Permanent
+    ~id:"quotaExceededRuntimeError"
+    ~title: "Quota exceeded (runtime script error)"
+    ~description:
+      "A script or one of its callee took too much \
+       time or storage space"
+    empty
+    (function Quota_exceeded -> Some () | _ -> None)
+    (fun () -> Quota_exceeded) ;

src/proto_alpha/lib_protocol/src/gas_repr.mli

@@ -7,30 +7,21 @@
 (*                                                                        *)
 (**************************************************************************)
 
-type t
+type t =
-type cost
+  | Unaccounted
-
+  | Limited of { remaining : int }
-val consume : t -> cost -> t
 
 val encoding : t Data_encoding.encoding
 val pp : Format.formatter -> t -> unit
 
-val encoding_cost : cost Data_encoding.encoding
+type cost
+
+val cost_encoding : cost Data_encoding.encoding
 val pp_cost : Format.formatter -> cost -> unit
 
-val check : t -> unit tzresult Lwt.t
-val consume_check : t -> cost -> t tzresult Lwt.t
-val check_error : t -> unit tzresult
-val consume_check_error : t -> cost -> t tzresult
 type error += Quota_exceeded
 
-val of_int : int -> t
+val consume : t -> cost -> t tzresult
-val remaining : t -> int
-
-val ( *@ ) : int -> cost -> cost
-val ( +@ ) : cost -> cost -> cost
-
-val used : original:t -> current:t -> t
 
 val free : cost
 val step_cost : int -> cost
@@ -38,24 +29,5 @@ val alloc_cost : int -> cost
 val alloc_bytes_cost : int -> cost
 val alloc_bits_cost : int -> cost
 
-val max_gas : t
+val ( *@ ) : int -> cost -> cost
-
+val ( +@ ) : cost -> cost -> cost
-val fold_left : cycle_cost:cost ->
-  t ->
-  (t -> 'a -> 'b -> ('b * t) tzresult Lwt.t) ->
-  'b -> 'a list -> ('b * t) tzresult Lwt.t
-
-val fold_right : cycle_cost:cost ->
-  t ->
-  (t -> 'a -> 'b -> ('b * t) tzresult Lwt.t) ->
-  'b -> 'a list -> ('b * t) tzresult Lwt.t
-
-val fold_right_error : cycle_cost:cost ->
-  t ->
-  (t -> 'a -> 'b -> ('b * t) tzresult) ->
-  'b -> 'a list -> ('b * t) tzresult
-
-val fold_left_error : cycle_cost:cost ->
-  t ->
-  (t -> 'a -> 'b -> ('b * t) tzresult) ->
-  'b -> 'a list -> ('b * t) tzresult

src/proto_alpha/lib_protocol/src/helpers_services.ml

@@ -79,7 +79,7 @@ module S = struct
       ~query: RPC_query.empty
       ~input: (obj2
                  (req "program" Script.expr_encoding)
-                 (opt "gas" Gas.encoding))
+                 (opt "gas" int31))
       ~output: (obj2
                   (req "type_map" Script_tc_errors_registration.type_map_enc)
                   (req "gas" Gas.encoding))
@@ -93,7 +93,7 @@ module S = struct
       ~input: (obj3
                  (req "data" Script.expr_encoding)
                  (req "type" Script.expr_encoding)
-                 (opt "gas" Gas.encoding))
+                 (opt "gas" int31))
       ~output: (obj1 (req "gas" Gas.encoding))
       RPC_path.(custom_root / "typecheck_data")
 
@@ -105,7 +105,7 @@ module S = struct
       ~input: (obj3
                  (req "data" Script.expr_encoding)
                  (req "type" Script.expr_encoding)
-                 (opt "gas" Gas.encoding))
+                 (opt "gas" int31))
       ~output: (obj2
                   (req "hash" string)
                   (req "gas" Gas.encoding))
@@ -178,53 +178,53 @@ let () =
   register0 S.run_code begin fun ctxt () parameters ->
     let (code, storage, input, amount, contract, gas, origination_nonce) =
       I.run_parameters ctxt parameters in
+    let ctxt = if Compare.Int.(gas > 0) then Gas.set_limit ctxt gas else Gas.set_unlimited ctxt in
     Script_interpreter.execute
       origination_nonce
       contract (* transaction initiator *)
       contract (* script owner *)
-      ctxt { storage ; code } amount input
+      ctxt { storage ; code } amount input >>=? fun (sto, ret, _ctxt, _, maybe_big_map_diff) ->
-      (Gas.of_int gas) >>=? fun (sto, ret, _gas, _ctxt, _, maybe_big_map_diff) ->
     return (sto, ret,
             Option.map maybe_big_map_diff
-              ~f:Script_ir_translator.to_printable_big_map)
+              ~f:(Script_ir_translator.to_printable_big_map ctxt))
   end ;
   register0 S.trace_code begin fun ctxt () parameters ->
     let (code, storage, input, amount, contract, gas, origination_nonce) =
       I.run_parameters ctxt parameters in
+    let ctxt = if Compare.Int.(gas > 0) then Gas.set_limit ctxt gas else Gas.set_unlimited ctxt in
     Script_interpreter.trace
       origination_nonce
       contract (* transaction initiator *)
       contract (* script owner *)
       ctxt { storage ; code } amount input
-      (Gas.of_int gas) >>=? fun ((sto, ret, _gas, _ctxt, _, maybe_big_map_diff), trace) ->
+    >>=? fun ((sto, ret, _ctxt, _, maybe_big_map_diff), trace) ->
     return (sto, ret, trace,
             Option.map maybe_big_map_diff
-              ~f:Script_ir_translator.to_printable_big_map)
+              ~f:(Script_ir_translator.to_printable_big_map ctxt))
   end ;
   register0 S.typecheck_code begin fun ctxt () (expr, maybe_gas) ->
-    Script_ir_translator.typecheck_code ctxt
+    let ctxt = match maybe_gas with
-      (match maybe_gas with
+      | None -> Gas.set_unlimited ctxt
-       | None -> Gas.of_int (Constants.max_gas ctxt)
+      | Some gas -> Gas.set_limit ctxt gas in
-       | Some gas -> gas)
+    Script_ir_translator.typecheck_code ctxt expr >>=? fun (res, ctxt) ->
-      expr
+    return (res, Gas.level ctxt)
   end ;
   register0 S.typecheck_data begin fun ctxt () (data, ty, maybe_gas) ->
-    Script_ir_translator.typecheck_data ctxt
+    let ctxt = match maybe_gas with
-      (match maybe_gas with
+      | None -> Gas.set_unlimited ctxt
-       | None -> Gas.of_int (Constants.max_gas ctxt)
+      | Some gas -> Gas.set_limit ctxt gas in
-       | Some gas -> gas)
+    Script_ir_translator.typecheck_data ctxt (data, ty) >>=? fun ctxt ->
-      (data, ty)
+    return (Gas.level ctxt)
   end ;
   register0 S.hash_data begin fun ctxt () (expr, typ, maybe_gas) ->
     let open Script_ir_translator in
-    Lwt.return @@
+    let ctxt = match maybe_gas with
-    parse_ty
+      | None -> Gas.set_unlimited ctxt
-      (match maybe_gas with
+      | Some gas -> Gas.set_limit ctxt gas in
-       | None -> Gas.of_int (Constants.max_gas ctxt)
+    Lwt.return (parse_ty ctxt false (Micheline.root typ)) >>=? fun ((Ex_ty typ, _), ctxt) ->
-       | Some gas -> gas)
+    parse_data ctxt typ (Micheline.root expr) >>=? fun (data, ctxt) ->
-      false (Micheline.root typ) >>=? fun ((Ex_ty typ, _), gas) ->
+    Lwt.return (Script_ir_translator.hash_data ctxt typ data) >>=? fun (hash, ctxt) ->
-    parse_data ctxt gas typ (Micheline.root expr) >>=? fun (data, gas) ->
+    return (hash, Gas.level ctxt)
-    Lwt.return @@ Script_ir_translator.hash_data gas typ data
   end ;
   register1 S.level begin fun ctxt raw () offset ->
     return (Level.from_raw ctxt ?offset raw)

src/proto_alpha/lib_protocol/src/helpers_services.mli

@@ -37,16 +37,16 @@ val trace_code:
 
 val typecheck_code:
   'a #RPC_context.simple ->
-  'a -> (Script.expr * Gas.t option) ->
+  'a -> (Script.expr * int option) ->
   (Script_tc_errors.type_map * Gas.t) shell_tzresult Lwt.t
 
 val typecheck_data:
   'a #RPC_context.simple ->
-  'a -> Script.expr * Script.expr * (Gas.t option) -> Gas.t shell_tzresult Lwt.t
+  'a -> Script.expr * Script.expr * int option -> Gas.t shell_tzresult Lwt.t
 
 val hash_data:
   'a #RPC_context.simple ->
-  'a -> Script.expr * Script.expr * (Gas.t option) -> (string * Gas.t) shell_tzresult Lwt.t
+  'a -> Script.expr * Script.expr * int option -> (string * Gas.t) shell_tzresult Lwt.t
 
 val level:
   'a #RPC_context.simple ->

src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml

@@ -181,7 +181,6 @@ module Cost_of = struct
   (* TODO: This needs to be a function of the data being hashed *)
   let hash _data = step_cost 3
   let steps_to_quota = step_cost 1
-  let get_steps_to_quota gas = Script_int.abs (Script_int.of_int (remaining gas))
   let source = step_cost 3
   let self = step_cost 3
   let amount = step_cost 1

src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli

@@ -74,7 +74,6 @@ module Cost_of : sig
   val check_signature : Gas.cost
   val hash_key : Gas.cost
   val hash : 'a -> Gas.cost
-  val get_steps_to_quota : Gas.t -> Script_int.n Script_int.num
   val steps_to_quota : Gas.cost
   val source : Gas.cost
   val self : Gas.cost

src/proto_alpha/lib_protocol/src/raw_context.ml

@@ -19,6 +19,7 @@ type t = {
   endorsements_received: Int_set.t;
   fees: Tez_repr.t ;
   rewards: Tez_repr.t ;
+  gas: Gas_repr.t;
 }
 
 type context = t
@@ -47,6 +48,14 @@ let add_rewards ctxt rewards =
 let get_rewards ctxt = ctxt.rewards
 let get_fees ctxt = ctxt.fees
 
+let set_gas_limit ctxt remaining = { ctxt with gas = Limited { remaining } }
+let set_gas_unlimited ctxt = { ctxt with gas = Unaccounted }
+let consume_gas ctxt cost =
+  Gas_repr.consume ctxt.gas cost >>? fun gas ->
+  ok { ctxt with gas }
+let gas_level ctxt = ctxt.gas
+
+
 type storage_error =
   | Incompatible_protocol_version of string
   | Missing_key of string list * [`Get | `Set | `Del | `Copy]
@@ -263,6 +272,7 @@ let prepare ~level ~timestamp ~fitness ctxt =
     endorsements_received = Int_set.empty ;
     fees = Tez_repr.zero ;
     rewards = Tez_repr.zero ;
+    gas = Unaccounted ;
   }
 
 let check_first_block ctxt =
@@ -307,6 +317,7 @@ let register_resolvers enc resolve =
       endorsements_received = Int_set.empty ;
       fees = Tez_repr.zero ;
       rewards = Tez_repr.zero ;
+      gas = Unaccounted ;
     } in
     resolve faked_context str in
   Context.register_resolver enc  resolve

src/proto_alpha/lib_protocol/src/raw_context.mli

@@ -73,6 +73,11 @@ val add_rewards: context -> Tez_repr.t -> context tzresult Lwt.t
 val get_fees: context -> Tez_repr.t
 val get_rewards: context -> Tez_repr.t
 
+val set_gas_limit: t -> int -> t
+val set_gas_unlimited: t -> t
+val consume_gas: t -> Gas_repr.cost -> t tzresult
+val gas_level: t -> Gas_repr.t
+
 (** {1 Generic accessors} *************************************************)
 
 type key = string list

src/proto_alpha/lib_protocol/src/script_interpreter.mli

@@ -20,14 +20,14 @@ val execute:
   Contract.origination_nonce ->
   Contract.t -> Contract.t -> Alpha_context.t ->
   Script.t -> Tez.t ->
-  Script.expr -> Gas.t ->
+  Script.expr ->
-  (Script.expr * Script.expr * Gas.t * context * Contract.origination_nonce *
+  (Script.expr * Script.expr * context * Contract.origination_nonce *
    Script_typed_ir.ex_big_map option) tzresult Lwt.t
 
 val trace:
   Contract.origination_nonce ->
   Contract.t -> Contract.t -> Alpha_context.t ->
   Script.t -> Tez.t ->
-  Script.expr -> Gas.t ->
+  Script.expr ->
-  ((Script.expr * Script.expr * Gas.t * context * Contract.origination_nonce * Script_typed_ir.ex_big_map option) *
+  ((Script.expr * Script.expr * context * Contract.origination_nonce * Script_typed_ir.ex_big_map option) *
    (Script.location * Gas.t * Script.expr list) list) tzresult Lwt.t

src/proto_alpha/lib_protocol/src/script_ir_translator.mli

@@ -39,14 +39,14 @@ val map_key_ty : ('a, 'b) Script_typed_ir.map -> 'a Script_typed_ir.comparable_t
 val map_size : ('a, 'b) Script_typed_ir.map -> Script_int.n Script_int.num
 
 val big_map_mem :
-  context -> Gas.t -> Contract.t -> 'key ->
+  context -> Contract.t -> 'key ->
   ('key, 'value) Script_typed_ir.big_map ->
-  (bool * Gas.t) tzresult Lwt.t
+  (bool * context) tzresult Lwt.t
 val big_map_get :
-  context -> Gas.t ->
+  context ->
   Contract.t -> 'key ->
   ('key, 'value) Script_typed_ir.big_map ->
-  ('value option * Gas.t) tzresult Lwt.t
+  ('value option * context) tzresult Lwt.t
 val big_map_update :
   'key -> 'value option -> ('key, 'value) Script_typed_ir.big_map ->
   ('key, 'value) Script_typed_ir.big_map
@@ -57,42 +57,42 @@ val ty_eq :
 
 val parse_data :
   ?type_logger: (int -> Script.expr list -> Script.expr list -> unit) ->
-  context -> Gas.t -> 'a Script_typed_ir.ty -> Script.node -> ('a * Gas.t) tzresult Lwt.t
+  context -> 'a Script_typed_ir.ty -> Script.node -> ('a * context) tzresult Lwt.t
 val unparse_data :
-  Gas.t -> 'a Script_typed_ir.ty -> 'a -> (Script.node * Gas.t) tzresult
+  context -> 'a Script_typed_ir.ty -> 'a -> (Script.node * context) tzresult
 
 val parse_ty :
-  Gas.t -> bool -> Script.node ->
+  context -> bool -> Script.node ->
-  ((ex_ty * Script_typed_ir.annot) * Gas.t) tzresult
+  ((ex_ty * Script_typed_ir.annot) * context) tzresult
 val unparse_ty :
   string option -> 'a Script_typed_ir.ty -> Script.node
 
 val parse_toplevel
-  : Gas.t -> Script.expr -> ((Script.node * Script.node * Script.node * Script.node) * Gas.t) tzresult
+  : context -> Script.expr -> ((Script.node * Script.node * Script.node * Script.node) * context) tzresult
 
 val typecheck_code :
-  context -> Gas.t -> Script.expr -> (type_map * Gas.t) tzresult Lwt.t
+  context -> Script.expr -> (type_map * context) tzresult Lwt.t
 
 val typecheck_data :
   ?type_logger: (int -> Script.expr list -> Script.expr list -> unit) ->
-  context -> Gas.t -> Script.expr * Script.expr -> Gas.t tzresult Lwt.t
+  context -> Script.expr * Script.expr -> context tzresult Lwt.t
 
 val parse_script :
   ?type_logger: (int -> Script.expr list -> Script.expr list -> unit) ->
-  context -> Gas.t -> Script.t -> (ex_script * Gas.t) tzresult Lwt.t
+  context -> Script.t -> (ex_script * context) tzresult Lwt.t
 
-val hash_data : Gas.t -> 'a Script_typed_ir.ty -> 'a -> (string * Gas.t) tzresult
+val hash_data : context -> 'a Script_typed_ir.ty -> 'a -> (string * context) tzresult
 
 val extract_big_map : 'a Script_typed_ir.ty -> 'a -> Script_typed_ir.ex_big_map option
 
 val to_serializable_big_map :
-  Gas.t -> Script_typed_ir.ex_big_map ->
+  context -> Script_typed_ir.ex_big_map ->
-  (Contract_storage.big_map_diff * Gas.t) tzresult Lwt.t
+  (Contract_storage.big_map_diff * context) tzresult Lwt.t
 
 val to_printable_big_map :
-  Script_typed_ir.ex_big_map ->
+  context -> Script_typed_ir.ex_big_map ->
   (Script.expr * Script.expr option) list
 
 val erase_big_map_initialization :
-  context -> Gas.t -> Script.t ->
+  context -> Script.t ->
-  (Script.t * Contract_storage.big_map_diff option * Gas.t) tzresult Lwt.t
+  (Script.t * Contract_storage.big_map_diff option * context) tzresult Lwt.t

src/proto_alpha/lib_protocol/src/script_tc_errors_registration.ml

@@ -29,10 +29,12 @@ let type_map_enc =
 let ex_ty_enc =
   Data_encoding.conv
     (fun (Ex_ty ty) -> strip_locations (unparse_ty None ty))
-    (fun expr ->
+    (fun _expr ->
+       (* (* code temporarily deactivated *)
           match parse_ty (Gas.of_int 10000000000) true (root expr) with
           | Ok ((Ex_ty ty, _), _) -> Ex_ty ty
-       | _ -> Ex_ty Unit_t (* FIXME: ? *))
+          | _ -> *)
+       Ex_ty Unit_t (* FIXME: ? *))
     Script.expr_encoding
 
 (* main registration *)

src/proto_alpha/lib_protocol/test/helpers/helpers_script.ml

@@ -29,10 +29,11 @@ let execute_code_pred
   let hash = Operation.hash apply_op in
   let dummy_nonce = Contract.initial_origination_nonce hash in
   let amount = Tez.zero in
-  let gaz = Gas.of_int (Alpha_context.Constants.max_gas tc) in
+  let gas = Proto_alpha.Alpha_context.Constants.max_gas tc in
+  let tc = Proto_alpha.Alpha_context.Gas.set_limit tc gas in
   let return = Script_interpreter.execute
       dummy_nonce op.contract dst
-      tc script amount argument gaz in
+      tc script amount argument in
   return
 
 

src/proto_alpha/lib_protocol/test/helpers/helpers_script.mli

@@ -13,6 +13,6 @@ open Alpha_context
 val init_amount : int
 val execute_code_pred :
   ?tc:Alpha_context.t -> Helpers_block.result -> Script.t -> Script.expr ->
-  (Script.expr * Script.expr * Gas.t * context * Contract.origination_nonce * Script_typed_ir.ex_big_map option)
+  (Script.expr * Script.expr * context * Contract.origination_nonce * Script_typed_ir.ex_big_map option)
     proto_tzresult Lwt.t
 

src/proto_alpha/lib_protocol/test/test_big_maps.ml

@@ -42,11 +42,11 @@ let code = {|
 
 let storage = {| Pair { Elt "A" 1 ; Elt "B" 2 } Unit |}
 
-let expect_big_map tc contract print_key ?(gas=Proto_alpha.Gas.max_gas) key_type print_data data_type contents =
+let expect_big_map tc contract print_key key_type print_data data_type contents =
   let open Proto_alpha.Error_monad in
   iter_p
     (fun (n, exp) ->
-       Lwt.return @@ Proto_alpha.Script_ir_translator.hash_data gas key_type n >>=? fun (key, gas) ->
+       Lwt.return @@ Proto_alpha.Script_ir_translator.hash_data tc key_type n >>=? fun (key, _tc) ->
        Proto_alpha.Alpha_context.Contract.Big_map.get_opt tc contract key >>=? fun data ->
        match data, exp with
        | None, None ->
@@ -56,11 +56,11 @@ let expect_big_map tc contract print_key ?(gas=Proto_alpha.Gas.max_gas) key_type
            debug " - big_map[%a] is not defined (error)" print_key n ;
            Helpers_assert.fail_msg "Wrong big map contents"
        | Some data, None ->
-           Proto_alpha.Script_ir_translator.parse_data tc gas data_type (Micheline.root data) >>=? fun (data, _gas) ->
+           Proto_alpha.Script_ir_translator.parse_data tc data_type (Micheline.root data) >>=? fun (data, _tc) ->
            debug " - big_map[%a] = %a (error)" print_key n print_data data ;
            Helpers_assert.fail_msg "Wrong big map contents"
        | Some data, Some exp ->
-           Proto_alpha.Script_ir_translator.parse_data tc gas data_type (Micheline.root data) >>=? fun (data, _gas) ->
+           Proto_alpha.Script_ir_translator.parse_data tc data_type (Micheline.root data) >>=? fun (data, _tc) ->
            debug " - big_map[%a] = %a (expected %a)" print_key n print_data data print_data exp ;
            Helpers_assert.equal data exp ;
            return ())

src/proto_alpha/lib_protocol/test/test_michelson.ml

@@ -48,7 +48,7 @@ let quote s = "\"" ^ s ^ "\""
 let parse_execute sb ?tc code_str param_str storage_str =
   let param = parse_param param_str in
   let script = parse_script code_str storage_str in
-  Script.execute_code_pred ?tc sb script param >>=?? fun (ret, st, _, tc, nonce, bgm) ->
+  Script.execute_code_pred ?tc sb script param >>=?? fun (ret, st, tc, nonce, bgm) ->
   let contracts = Contract.originated_contracts nonce in
   return (ret, st, tc, contracts, bgm)
 
@@ -85,8 +85,8 @@ let test_print ctxt fn s i =
   return ()
 
 
-let test_output ctxt ?location (file_name: string) (storage: string) (input: string) (expected_output: string) =
+let test_output ctxt ?tc ?location (file_name: string) (storage: string) (input: string) (expected_output: string) =
-  test ctxt file_name storage input >>=? fun (_storage_prim, output_prim, _tc, _contracts, _bgm) ->
+  test ?tc ctxt file_name storage input >>=? fun (_storage_prim, output_prim, _tc, _contracts, _bgm) ->
   let output = string_of_canon output_prim in
   let msg = Option.unopt ~default:"strings aren't equal" location in
   Assert.equal_string ~msg expected_output output ;
@@ -287,7 +287,7 @@ let test_example () =
   test_output ~location: __LOC__ "exec_concat" "Unit" "\"test\"" "\"test_abc\"" >>=? fun _ ->
 
   (*  Get current steps to quota *)
-  test_output ~location: __LOC__ "steps_to_quota" "Unit" "Unit" "39973" >>=? fun _ ->
+  test_output ~location: __LOC__ "steps_to_quota" "Unit" "Unit" "39968" >>=? fun _ ->
 
   let bootstrap_0 = List.nth Account.bootstrap_accounts 0 in
   get_balance_res bootstrap_0 sb >>=?? fun _balance ->
@@ -436,7 +436,7 @@ let test_example () =
   let contract = List.hd cs in
   Proto_alpha.Alpha_context.Contract.get_script tc contract >>=?? fun res ->
   let script = Option.unopt_exn (Failure "get_script") res in
-  Script.execute_code_pred ~tc sb script (parse_param "\"abc\"") >>=?? fun (_, ret, _, _, _, _) ->
+  Script.execute_code_pred ~tc sb script (parse_param "\"abc\"") >>=?? fun (_, ret, _, _, _) ->
   Assert.equal_string ~msg: __LOC__ "\"abc\"" @@ string_of_canon ret ;
 
   (* Test DEFAULT_ACCOUNT *)