Alpha: minor cleanup of Apply for better readability

src/proto_alpha/lib_protocol/src/alpha_context.ml

@@ -73,6 +73,7 @@ module Gas = struct
   let set_unlimited = Raw_context.set_gas_unlimited
   let consume = Raw_context.consume_gas
   let level = Raw_context.gas_level
+  let consumed = Raw_context.gas_consumed
   let block_level = Raw_context.block_gas_level
 end
 module Level = struct

src/proto_alpha/lib_protocol/src/alpha_context.mli

@@ -140,6 +140,7 @@ module Gas : sig
   val set_unlimited: context -> context
   val consume: context -> cost -> context tzresult
   val level: context -> t
+  val consumed: since: context -> until: context -> Z.t
   val block_level: context -> Z.t
 end
 
@@ -526,7 +527,7 @@ module Contract : sig
   val init_origination_nonce: context -> Operation_hash.t -> context
   val unset_origination_nonce: context -> context
   val fresh_contract_from_current_nonce : context -> (context * t) tzresult Lwt.t
-  val originated_from_current_nonce: context -> contract list tzresult Lwt.t
+  val originated_from_current_nonce: since: context -> until:context -> contract list tzresult Lwt.t
 
   type big_map_diff = (string * Script.expr option) list
 

src/proto_alpha/lib_protocol/src/apply.ml

@@ -328,22 +328,6 @@ let () =
 
 open Apply_operation_result
 
-let gas_difference ctxt_before ctxt_after =
-  match Gas.level ctxt_before, Gas.level ctxt_after with
-  | Limited { remaining = before }, Limited { remaining = after } -> Z.sub before after
-  | _ -> Z.zero
-
-let new_contracts ctxt_before ctxt_after =
-  Contract.originated_from_current_nonce ctxt_before >>=? fun before ->
-  Contract.originated_from_current_nonce ctxt_after >>=? fun after ->
-  return (List.filter (fun c -> not (List.exists (Contract.equal c) before)) after)
-
-let cleanup_balance_updates balance_updates =
-  List.filter
-    (fun (_, (Credited update | Debited update)) ->
-       not (Tez.equal update Tez.zero))
-    balance_updates
-
 let apply_manager_operation_content :
   type kind.
   ( Alpha_context.t -> Script_ir_translator.unparsing_mode -> payer:Contract.t -> source:Contract.t ->
@@ -383,7 +367,7 @@ let apply_manager_operation_content :
                       [ Contract source, Debited amount ;
                         Contract destination, Credited amount ] ;
                   originated_contracts = [] ;
-                  consumed_gas = gas_difference before_operation ctxt ;
+                  consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt ;
                   storage_size_diff = 0L } in
             return (ctxt, result, [])
         | Some script ->
@@ -410,7 +394,9 @@ let apply_manager_operation_content :
               ctxt destination storage big_map_diff >>=? fun ctxt ->
             Fees.update_script_storage
               ctxt ~payer destination >>=? fun (ctxt, new_size, fees) ->
-            new_contracts before_operation ctxt >>=? fun originated_contracts ->
+            Contract.originated_from_current_nonce
+              ~since: before_operation
+              ~until: ctxt >>=? fun originated_contracts ->
             let result =
               Transaction_result
                 { storage = Some storage ;
@@ -420,7 +406,7 @@ let apply_manager_operation_content :
                         Contract source, Debited amount ;
                         Contract destination, Credited amount ] ;
                   originated_contracts ;
-                  consumed_gas = gas_difference before_operation ctxt ;
+                  consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt ;
                   storage_size_diff = Int64.sub new_size old_size } in
             return (ctxt, result, operations)
       end
@@ -451,7 +437,7 @@ let apply_manager_operation_content :
                     Contract source, Debited credit ;
                     Contract contract, Credited credit ] ;
               originated_contracts = [ contract ] ;
-              consumed_gas = gas_difference before_operation ctxt ;
+              consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt ;
               storage_size_diff = size } in
         return (ctxt, result, [])
     | Delegation delegate ->
@@ -855,46 +841,3 @@ let finalize_application ctxt protocol_data delegate =
   may_start_new_cycle ctxt >>=? fun ctxt ->
   Amendment.may_start_new_voting_cycle ctxt >>=? fun ctxt ->
   return ctxt
-
-let compare_operations op1 op2 =
-  let Operation_data op1 = op1.protocol_data in
-  let Operation_data op2 = op2.protocol_data in
-  match op1.contents, op2.contents with
-  | Single (Endorsements _), Single (Endorsements _) -> 0
-  | _, Single (Endorsements _) -> 1
-  | Single (Endorsements _), _ -> -1
-
-  | Single (Seed_nonce_revelation _), Single (Seed_nonce_revelation _) -> 0
-  | _, Single (Seed_nonce_revelation _) -> 1
-  | Single (Seed_nonce_revelation _), _ -> -1
-
-  | Single (Double_endorsement_evidence _), Single (Double_endorsement_evidence _) -> 0
-  | _, Single (Double_endorsement_evidence _) -> 1
-  | Single (Double_endorsement_evidence _), _ -> -1
-
-  | Single (Double_baking_evidence _), Single (Double_baking_evidence _) -> 0
-  | _, Single (Double_baking_evidence _) -> 1
-  | Single (Double_baking_evidence _), _ -> -1
-
-  | Single (Activate_account _), Single (Activate_account _) -> 0
-  | _, Single (Activate_account _) -> 1
-  | Single (Activate_account _), _ -> -1
-
-  | Single (Proposals _), Single (Proposals _) -> 0
-  | _, Single (Proposals _) -> 1
-  | Single (Proposals _), _ -> -1
-
-  | Single (Ballot _), Single (Ballot _) -> 0
-  | _, Single (Ballot _) -> 1
-  | Single (Ballot _), _ -> -1
-
-  (* Manager operations with smaller counter are pre-validated first. *)
-  | Single (Manager_operation op1), Single (Manager_operation op2) ->
-      Int32.compare op1.counter op2.counter
-  | Cons (Manager_operation op1, _), Single (Manager_operation op2) ->
-      Int32.compare op1.counter op2.counter
-  | Single (Manager_operation op1), Cons (Manager_operation op2, _) ->
-      Int32.compare op1.counter op2.counter
-  | Cons (Manager_operation op1, _), Cons (Manager_operation op2, _) ->
-      Int32.compare op1.counter op2.counter
-

src/proto_alpha/lib_protocol/src/apply_operation_result.ml

@@ -95,6 +95,12 @@ let balance_update_encoding =
 
 type balance_updates = (balance * balance_update) list
 
+let cleanup_balance_updates balance_updates =
+  List.filter
+    (fun (_, (Credited update | Debited update)) ->
+       not (Tez.equal update Tez.zero))
+    balance_updates
+
 let balance_updates_encoding =
   def "operation_metadata.alpha.balance_updates" @@
   list (merge_objs balance_encoding balance_update_encoding)

src/proto_alpha/lib_protocol/src/apply_operation_result.mli

@@ -29,6 +29,9 @@ type balance_update =
 (** A list of balance updates. Duplicates may happen. *)
 type balance_updates = (balance * balance_update) list
 
+(** Remove zero-valued balances from a list of updates. *)
+val cleanup_balance_updates : balance_updates -> balance_updates
+
 (** Result of applying a {!Operation.t}. Follows the same structure. *)
 type 'kind operation_metadata = {
   contents: 'kind contents_result_list ;

src/proto_alpha/lib_protocol/src/contract_repr.ml

@@ -120,16 +120,19 @@ let originated_contract nonce =
     Data_encoding.Binary.to_bytes_exn origination_nonce_encoding nonce in
   Originated (Contract_hash.hash_bytes [data])
 
-let originated_contracts ({ origination_index } as origination_nonce) =
+let originated_contracts
+    ~since: { origination_index = first ; operation_hash = first_hash }
+    ~until: ({ origination_index = last ; operation_hash = last_hash } as origination_nonce) =
+  assert (Operation_hash.equal first_hash last_hash) ;
   let rec contracts acc origination_index =
-    if Compare.Int32.(origination_index < 0l) then
+    if Compare.Int32.(origination_index < first) then
       acc
     else
       let origination_nonce =
         { origination_nonce with origination_index } in
       let acc = originated_contract origination_nonce :: acc in
       contracts acc (Int32.pred origination_index) in
-  contracts [] (Int32.pred origination_index)
+  contracts [] (Int32.pred last)
 
 let initial_origination_nonce operation_hash =
   { operation_hash ; origination_index = 0l }

src/proto_alpha/lib_protocol/src/contract_repr.mli

@@ -31,7 +31,7 @@ type origination_nonce
 
 val originated_contract : origination_nonce -> contract
 
-val originated_contracts : origination_nonce -> contract list
+val originated_contracts : since: origination_nonce -> until: origination_nonce -> contract list
 
 val initial_origination_nonce : Operation_hash.t -> origination_nonce
 

src/proto_alpha/lib_protocol/src/contract_storage.ml

@@ -277,13 +277,14 @@ let fresh_contract_from_current_nonce c =
   Lwt.return (Raw_context.increment_origination_nonce c) >>=? fun (c, nonce) ->
   return (c, Contract_repr.originated_contract nonce)
 
-let originated_from_current_nonce ctxt =
+let originated_from_current_nonce ~since: ctxt_since ~until: ctxt_until =
-  Lwt.return (Raw_context.origination_nonce ctxt) >>=? fun nonce ->
+  Lwt.return (Raw_context.origination_nonce ctxt_since) >>=? fun since ->
+  Lwt.return (Raw_context.origination_nonce ctxt_until) >>=? fun until ->
   filter_map_s
-    (fun contract -> exists ctxt contract >>=? function
+    (fun contract -> exists ctxt_until contract >>=? function
        | true -> return (Some contract)
        | false -> return None)
-    (Contract_repr.originated_contracts nonce)
+    (Contract_repr.originated_contracts ~since ~until)
 
 let check_counter_increment c contract counter =
   Storage.Contract.Counter.get c contract >>=? fun contract_counter ->

src/proto_alpha/lib_protocol/src/contract_storage.mli

@@ -95,7 +95,9 @@ val originate:
 val fresh_contract_from_current_nonce :
   Raw_context.t -> (Raw_context.t * Contract_repr.t) tzresult Lwt.t
 val originated_from_current_nonce :
-  Raw_context.t -> Contract_repr.t list tzresult Lwt.t
+  since: Raw_context.t ->
+  until: Raw_context.t ->
+  Contract_repr.t list tzresult Lwt.t
 
 val init:
   Raw_context.t -> Raw_context.t tzresult Lwt.t

src/proto_alpha/lib_protocol/src/main.ml

@@ -174,7 +174,48 @@ let finalize_block { mode ; ctxt ; op_count } =
       let ctxt = Alpha_context.finalize ~commit_message ctxt in
       return (ctxt, { Alpha_context.Block_header.baker ; level ; voting_period_kind })
 
-let compare_operations = Apply.compare_operations
+let compare_operations op1 op2 =
+  let open Alpha_context in
+  let Operation_data op1 = op1.protocol_data in
+  let Operation_data op2 = op2.protocol_data in
+  match op1.contents, op2.contents with
+  | Single (Endorsements _), Single (Endorsements _) -> 0
+  | _, Single (Endorsements _) -> 1
+  | Single (Endorsements _), _ -> -1
+
+  | Single (Seed_nonce_revelation _), Single (Seed_nonce_revelation _) -> 0
+  | _, Single (Seed_nonce_revelation _) -> 1
+  | Single (Seed_nonce_revelation _), _ -> -1
+
+  | Single (Double_endorsement_evidence _), Single (Double_endorsement_evidence _) -> 0
+  | _, Single (Double_endorsement_evidence _) -> 1
+  | Single (Double_endorsement_evidence _), _ -> -1
+
+  | Single (Double_baking_evidence _), Single (Double_baking_evidence _) -> 0
+  | _, Single (Double_baking_evidence _) -> 1
+  | Single (Double_baking_evidence _), _ -> -1
+
+  | Single (Activate_account _), Single (Activate_account _) -> 0
+  | _, Single (Activate_account _) -> 1
+  | Single (Activate_account _), _ -> -1
+
+  | Single (Proposals _), Single (Proposals _) -> 0
+  | _, Single (Proposals _) -> 1
+  | Single (Proposals _), _ -> -1
+
+  | Single (Ballot _), Single (Ballot _) -> 0
+  | _, Single (Ballot _) -> 1
+  | Single (Ballot _), _ -> -1
+
+  (* Manager operations with smaller counter are pre-validated first. *)
+  | Single (Manager_operation op1), Single (Manager_operation op2) ->
+      Int32.compare op1.counter op2.counter
+  | Cons (Manager_operation op1, _), Single (Manager_operation op2) ->
+      Int32.compare op1.counter op2.counter
+  | Single (Manager_operation op1), Cons (Manager_operation op2, _) ->
+      Int32.compare op1.counter op2.counter
+  | Cons (Manager_operation op1, _), Cons (Manager_operation op2, _) ->
+      Int32.compare op1.counter op2.counter
 
 let init ctxt block_header =
   let level = block_header.Block_header.level in

src/proto_alpha/lib_protocol/src/raw_context.ml

@@ -154,6 +154,10 @@ let consume_gas ctxt cost =
   ok { ctxt with block_gas ; operation_gas }
 let gas_level ctxt = ctxt.operation_gas
 let block_gas_level ctxt = ctxt.block_gas
+let gas_consumed ~since ~until =
+  match gas_level since, gas_level until with
+  | Limited { remaining = before }, Limited { remaining = after } -> Z.sub before after
+  | _, _ -> Z.zero
 
 type error += Storage_limit_too_high (* `Permanent *)
 

src/proto_alpha/lib_protocol/src/raw_context.mli

@@ -83,6 +83,7 @@ type error += Gas_limit_too_high (* `Permanent *)
 val set_gas_limit: t -> Z.t -> t tzresult
 val set_gas_unlimited: t -> t
 val gas_level: t -> Gas_limit_repr.t
+val gas_consumed: since: t -> until: t -> Z.t
 val block_gas_level: t -> Z.t
 
 type error += Storage_limit_too_high (* `Permanent *)