balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Alpha: minor cleanup of Apply for better readability

Browse Source
This commit is contained in:
Benjamin Canou 2018-06-06 12:05:57 +02:00
parent 91479c1079
commit 7c8e0403e3
12 changed files with 80 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
src/proto_alpha/lib_protocol/src/alpha_context.ml
View File

@ -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

3
src/proto_alpha/lib_protocol/src/alpha_context.mli
View File

@ -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

69
src/proto_alpha/lib_protocol/src/apply.ml
View File

@ -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

6
src/proto_alpha/lib_protocol/src/apply_operation_result.ml
View File

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

3
src/proto_alpha/lib_protocol/src/apply_operation_result.mli
View File

@ -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 ;

9
src/proto_alpha/lib_protocol/src/contract_repr.ml
View File

@ -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 }

2
src/proto_alpha/lib_protocol/src/contract_repr.mli
View File

@ -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

9
src/proto_alpha/lib_protocol/src/contract_storage.ml
View File

@ -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 =
Lwt.return (Raw_context.origination_nonce ctxt) >>=? fun nonce ->
let originated_from_current_nonce ~since: ctxt_since ~until: ctxt_until =
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 ->

4
src/proto_alpha/lib_protocol/src/contract_storage.mli
View File

@ -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

43
src/proto_alpha/lib_protocol/src/main.ml
View File

@ -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

4
src/proto_alpha/lib_protocol/src/raw_context.ml
View File

@ -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 *)

1
src/proto_alpha/lib_protocol/src/raw_context.mli
View File

@ -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 *)