From 595685cf42e5951ec5387385d1c700f887a85486 Mon Sep 17 00:00:00 2001 From: Benjamin Canou Date: Thu, 5 Apr 2018 17:17:27 +0200 Subject: [PATCH] Michelson: replace direct transfers with an internal operation queue --- src/bin_client/test/contracts/accounts.tz | 9 +- src/bin_client/test/contracts/add1.tz | 7 +- src/bin_client/test/contracts/add1_list.tz | 12 +- .../test/contracts/add_delta_timestamp.tz | 5 +- .../test/contracts/add_timestamp_delta.tz | 5 +- .../test/contracts/after_strategy.tz | 5 +- src/bin_client/test/contracts/always.tz | 6 +- src/bin_client/test/contracts/and.tz | 5 +- src/bin_client/test/contracts/append.tz | 6 +- src/bin_client/test/contracts/assert.tz | 3 +- src/bin_client/test/contracts/assert_cmpeq.tz | 3 +- src/bin_client/test/contracts/assert_cmpge.tz | 3 +- src/bin_client/test/contracts/assert_cmpgt.tz | 3 +- src/bin_client/test/contracts/assert_cmple.tz | 3 +- src/bin_client/test/contracts/assert_cmplt.tz | 3 +- .../test/contracts/assert_cmpneq.tz | 3 +- src/bin_client/test/contracts/assert_eq.tz | 3 +- src/bin_client/test/contracts/assert_ge.tz | 3 +- src/bin_client/test/contracts/assert_gt.tz | 3 +- src/bin_client/test/contracts/assert_le.tz | 3 +- src/bin_client/test/contracts/assert_lt.tz | 3 +- src/bin_client/test/contracts/assert_neq.tz | 3 +- src/bin_client/test/contracts/at_least.tz | 5 +- src/bin_client/test/contracts/auction.tz | 3 +- src/bin_client/test/contracts/bad_lockup.tz | 8 +- src/bin_client/test/contracts/balance.tz | 5 +- .../test/contracts/big_map_get_add.tz | 3 +- src/bin_client/test/contracts/big_map_mem.tz | 3 +- .../test/contracts/big_map_union.tz | 3 +- src/bin_client/test/contracts/build_list.tz | 5 +- .../test/contracts/cadr_annotation.tz | 3 +- .../test/contracts/check_signature.tz | 5 +- src/bin_client/test/contracts/compare.tz | 5 +- src/bin_client/test/contracts/concat.tz | 7 +- src/bin_client/test/contracts/concat_hello.tz | 5 +- src/bin_client/test/contracts/concat_list.tz | 5 +- src/bin_client/test/contracts/conditionals.tz | 6 +- src/bin_client/test/contracts/cons_twice.tz | 5 +- src/bin_client/test/contracts/contains_all.tz | 5 +- src/bin_client/test/contracts/cps_fact.tz | 16 + .../test/contracts/create_account.tz | 5 +- .../test/contracts/create_add1_lists.tz | 16 +- .../test/contracts/create_contract.tz | 11 +- .../test/contracts/create_contract_literal.tz | 12 +- .../test/contracts/data_publisher.tz | 19 +- .../test/contracts/default_account.tz | 4 +- .../test/contracts/diff_timestamps.tz | 5 +- src/bin_client/test/contracts/dispatch.tz | 8 +- src/bin_client/test/contracts/empty.tz | 4 +- src/bin_client/test/contracts/empty_map.tz | 5 +- src/bin_client/test/contracts/exec_concat.tz | 5 +- src/bin_client/test/contracts/fail.tz | 3 +- src/bin_client/test/contracts/fail_amount.tz | 5 +- src/bin_client/test/contracts/first.tz | 5 +- .../test/contracts/get_map_value.tz | 5 +- src/bin_client/test/contracts/hardlimit.tz | 10 +- .../contracts/hash_consistency_checker.tz | 5 +- src/bin_client/test/contracts/hash_key.tz | 5 +- src/bin_client/test/contracts/hash_string.tz | 5 +- src/bin_client/test/contracts/id.tz | 6 +- src/bin_client/test/contracts/if.tz | 5 +- src/bin_client/test/contracts/if_some.tz | 5 +- .../test/contracts/infinite_loop.tz | 3 +- .../test/contracts/insertion_sort.tz | 8 +- .../test/contracts/int_publisher.tz | 8 +- src/bin_client/test/contracts/king_of_tez.tz | 9 +- src/bin_client/test/contracts/list_id.tz | 5 +- src/bin_client/test/contracts/list_id_map.tz | 5 +- src/bin_client/test/contracts/list_iter.tz | 5 +- src/bin_client/test/contracts/list_iter2.tz | 5 +- .../test/contracts/list_map_block.tz | 5 +- .../test/contracts/list_of_transactions.tz | 13 +- src/bin_client/test/contracts/lockup.tz | 6 +- src/bin_client/test/contracts/loop_left.tz | 5 +- .../test/contracts/macro_annotations.tz | 8 +- src/bin_client/test/contracts/map_caddaadr.tz | 4 +- src/bin_client/test/contracts/map_car.tz | 3 +- src/bin_client/test/contracts/map_id.tz | 5 +- src/bin_client/test/contracts/map_iter.tz | 5 +- src/bin_client/test/contracts/map_size.tz | 5 +- src/bin_client/test/contracts/max_in_list.tz | 5 +- src/bin_client/test/contracts/min.tz | 6 +- src/bin_client/test/contracts/noop.tz | 3 +- src/bin_client/test/contracts/not.tz | 5 +- src/bin_client/test/contracts/or.tz | 6 +- src/bin_client/test/contracts/originator.tz | 7 +- src/bin_client/test/contracts/pair_id.tz | 5 +- src/bin_client/test/contracts/pair_macro.tz | 4 +- .../contracts/parameterizable_payments.tz | 26 -- .../test/contracts/parameterized_multisig.tz | 8 +- .../test/contracts/publisher_payouts.tz | 17 - src/bin_client/test/contracts/queue.tz | 10 +- src/bin_client/test/contracts/reduce_map.tz | 5 +- src/bin_client/test/contracts/reentrancy.tz | 9 +- src/bin_client/test/contracts/ret_int.tz | 5 +- src/bin_client/test/contracts/reverse.tz | 5 +- src/bin_client/test/contracts/reverse_loop.tz | 5 +- src/bin_client/test/contracts/self.tz | 5 +- src/bin_client/test/contracts/set_caddaadr.tz | 3 +- src/bin_client/test/contracts/set_car.tz | 3 +- src/bin_client/test/contracts/set_cdr.tz | 3 +- src/bin_client/test/contracts/set_id.tz | 5 +- src/bin_client/test/contracts/set_iter.tz | 5 +- src/bin_client/test/contracts/set_member.tz | 5 +- src/bin_client/test/contracts/set_size.tz | 5 +- .../test/contracts/spawn_identities.tz | 17 +- .../test/contracts/steps_to_quota.tz | 5 +- src/bin_client/test/contracts/store_input.tz | 3 +- src/bin_client/test/contracts/store_now.tz | 3 +- src/bin_client/test/contracts/str_id.tz | 5 +- .../test/contracts/strategy_proxy.tz | 9 - .../test/contracts/sub_timestamp_delta.tz | 5 +- src/bin_client/test/contracts/subset.tz | 5 +- .../test/contracts/swap_left_right.tz | 5 +- .../test/contracts/swap_storage_input.tz | 9 - .../test/contracts/swap_storage_input_dip.tz | 8 - .../test/contracts/take_my_money.tz | 2 +- src/bin_client/test/contracts/tez_add_sub.tz | 5 +- .../test/contracts/transfer_amount.tz | 3 +- src/bin_client/test/contracts/transfer_to.tz | 7 +- .../test/contracts/two_vulnerabilities.tz | 7 - src/bin_client/test/contracts/unpair_macro.tz | 3 +- .../test/contracts/weather_insurance.tz | 10 +- src/bin_client/test/contracts/xor.tz | 5 +- src/bin_client/test/test_contracts.sh | 380 +++++++++-------- src/bin_client/test/test_lib.inc.sh | 29 +- .../lib_client/client_proto_context.ml | 92 +++- .../lib_client/client_proto_context.mli | 3 + .../lib_client/client_proto_programs.ml | 12 +- .../lib_client/client_proto_programs.mli | 13 +- .../lib_client/michelson_v1_emacs.ml | 2 - .../lib_client/michelson_v1_error_reporter.ml | 10 - .../lib_protocol/src/alpha_context.mli | 13 +- src/proto_alpha/lib_protocol/src/apply.ml | 121 ++++-- .../lib_protocol/src/constants_repr.ml | 2 +- src/proto_alpha/lib_protocol/src/fees.ml | 10 +- src/proto_alpha/lib_protocol/src/fees.mli | 4 +- .../lib_protocol/src/helpers_services.ml | 46 +- .../lib_protocol/src/helpers_services.mli | 10 +- .../lib_protocol/src/michelson_v1_gas.ml | 5 + .../lib_protocol/src/michelson_v1_gas.mli | 3 + .../src/michelson_v1_primitives.ml | 10 +- .../src/michelson_v1_primitives.mli | 2 +- .../lib_protocol/src/operation_repr.ml | 58 ++- .../lib_protocol/src/operation_repr.mli | 12 +- .../lib_protocol/src/script_interpreter.ml | 187 +++------ .../lib_protocol/src/script_interpreter.mli | 6 +- .../lib_protocol/src/script_ir_translator.ml | 396 +++++++++--------- .../lib_protocol/src/script_ir_translator.mli | 13 +- .../lib_protocol/src/script_tc_errors.ml | 2 - .../src/script_tc_errors_registration.ml | 26 -- .../lib_protocol/src/script_typed_ir.ml | 41 +- .../lib_protocol/test/contracts/accounts.tz | 9 +- .../lib_protocol/test/contracts/add1.tz | 7 +- .../lib_protocol/test/contracts/add1_list.tz | 12 +- .../test/contracts/add_delta_timestamp.tz | 5 +- .../test/contracts/add_timestamp_delta.tz | 5 +- .../test/contracts/after_strategy.tz | 5 +- .../lib_protocol/test/contracts/always.tz | 6 +- .../lib_protocol/test/contracts/and.tz | 5 +- .../lib_protocol/test/contracts/append.tz | 6 +- .../lib_protocol/test/contracts/assert.tz | 3 +- .../test/contracts/assert_cmpeq.tz | 3 +- .../test/contracts/assert_cmpge.tz | 3 +- .../test/contracts/assert_cmpgt.tz | 3 +- .../test/contracts/assert_cmple.tz | 3 +- .../test/contracts/assert_cmplt.tz | 3 +- .../test/contracts/assert_cmpneq.tz | 3 +- .../lib_protocol/test/contracts/assert_eq.tz | 3 +- .../lib_protocol/test/contracts/assert_ge.tz | 3 +- .../lib_protocol/test/contracts/assert_gt.tz | 3 +- .../lib_protocol/test/contracts/assert_le.tz | 3 +- .../lib_protocol/test/contracts/assert_lt.tz | 3 +- .../lib_protocol/test/contracts/assert_neq.tz | 3 +- .../lib_protocol/test/contracts/at_least.tz | 5 +- .../lib_protocol/test/contracts/auction.tz | 3 +- .../lib_protocol/test/contracts/bad_lockup.tz | 8 +- .../lib_protocol/test/contracts/balance.tz | 5 +- .../lib_protocol/test/contracts/build_list.tz | 5 +- .../test/contracts/cadr_annotation.tz | 3 +- .../test/contracts/check_signature.tz | 5 +- .../lib_protocol/test/contracts/compare.tz | 5 +- .../lib_protocol/test/contracts/concat.tz | 7 +- .../test/contracts/concat_hello.tz | 5 +- .../test/contracts/concat_list.tz | 5 +- .../test/contracts/conditionals.tz | 6 +- .../lib_protocol/test/contracts/cons_twice.tz | 5 +- .../test/contracts/contains_all.tz | 5 +- .../test/contracts/create_account.tz | 5 +- .../test/contracts/create_add1_lists.tz | 16 +- .../test/contracts/create_contract.tz | 11 +- .../test/contracts/create_contract_literal.tz | 12 +- .../test/contracts/data_publisher.tz | 19 +- .../test/contracts/default_account.tz | 4 +- .../test/contracts/diff_timestamps.tz | 5 +- .../lib_protocol/test/contracts/dispatch.tz | 8 +- .../lib_protocol/test/contracts/empty.tz | 4 +- .../lib_protocol/test/contracts/empty_map.tz | 5 +- .../test/contracts/exec_concat.tz | 5 +- .../lib_protocol/test/contracts/fail.tz | 3 +- .../test/contracts/fail_amount.tz | 5 +- .../lib_protocol/test/contracts/first.tz | 5 +- .../test/contracts/get_map_value.tz | 5 +- .../lib_protocol/test/contracts/hardlimit.tz | 10 +- .../contracts/hash_consistency_checker.tz | 5 +- .../lib_protocol/test/contracts/hash_key.tz | 5 +- .../test/contracts/hash_string.tz | 5 +- .../lib_protocol/test/contracts/id.tz | 6 +- .../lib_protocol/test/contracts/if.tz | 5 +- .../lib_protocol/test/contracts/if_some.tz | 5 +- .../test/contracts/infinite_loop.tz | 3 +- .../test/contracts/insertion_sort.tz | 8 +- .../test/contracts/int_publisher.tz | 8 +- .../test/contracts/king_of_tez.tz | 9 +- .../lib_protocol/test/contracts/list_id.tz | 5 +- .../test/contracts/list_id_map.tz | 5 +- .../lib_protocol/test/contracts/list_iter.tz | 5 +- .../lib_protocol/test/contracts/list_iter2.tz | 5 +- .../test/contracts/list_map_block.tz | 5 +- .../test/contracts/list_of_transactions.tz | 13 +- .../lib_protocol/test/contracts/lockup.tz | 6 +- .../lib_protocol/test/contracts/loop_left.tz | 5 +- .../test/contracts/macro_annotations.tz | 8 +- .../test/contracts/map_caddaadr.tz | 4 +- .../lib_protocol/test/contracts/map_car.tz | 3 +- .../lib_protocol/test/contracts/map_id.tz | 5 +- .../lib_protocol/test/contracts/map_iter.tz | 5 +- .../lib_protocol/test/contracts/map_size.tz | 5 +- .../test/contracts/max_in_list.tz | 5 +- .../lib_protocol/test/contracts/min.tz | 6 +- .../lib_protocol/test/contracts/noop.tz | 3 +- .../lib_protocol/test/contracts/not.tz | 5 +- .../lib_protocol/test/contracts/or.tz | 6 +- .../lib_protocol/test/contracts/originator.tz | 7 +- .../lib_protocol/test/contracts/pair_id.tz | 5 +- .../lib_protocol/test/contracts/pair_macro.tz | 4 +- .../contracts/parameterizable_payments.tz | 26 -- .../test/contracts/parameterized_multisig.tz | 8 +- .../test/contracts/publisher_payouts.tz | 17 - .../lib_protocol/test/contracts/queue.tz | 10 +- .../lib_protocol/test/contracts/reduce_map.tz | 5 +- .../lib_protocol/test/contracts/reentrancy.tz | 9 +- .../lib_protocol/test/contracts/ret_int.tz | 5 +- .../lib_protocol/test/contracts/reverse.tz | 5 +- .../test/contracts/reverse_loop.tz | 5 +- .../lib_protocol/test/contracts/self.tz | 5 +- .../test/contracts/set_caddaadr.tz | 3 +- .../lib_protocol/test/contracts/set_car.tz | 3 +- .../lib_protocol/test/contracts/set_cdr.tz | 3 +- .../lib_protocol/test/contracts/set_id.tz | 5 +- .../lib_protocol/test/contracts/set_iter.tz | 5 +- .../lib_protocol/test/contracts/set_member.tz | 5 +- .../lib_protocol/test/contracts/set_size.tz | 5 +- .../test/contracts/spawn_identities.tz | 17 +- .../test/contracts/steps_to_quota.tz | 5 +- .../test/contracts/store_input.tz | 3 +- .../lib_protocol/test/contracts/store_now.tz | 3 +- .../lib_protocol/test/contracts/str_id.tz | 5 +- .../test/contracts/strategy_proxy.tz | 9 - .../test/contracts/sub_timestamp_delta.tz | 5 +- .../lib_protocol/test/contracts/subset.tz | 5 +- .../test/contracts/swap_left_right.tz | 5 +- .../test/contracts/swap_storage_input.tz | 9 - .../test/contracts/swap_storage_input_dip.tz | 8 - .../test/contracts/take_my_money.tz | 2 +- .../test/contracts/tez_add_sub.tz | 5 +- .../test/contracts/transfer_amount.tz | 3 +- .../test/contracts/transfer_to.tz | 7 +- .../test/contracts/two_vulnerabilities.tz | 7 - .../test/contracts/unpair_macro.tz | 3 +- .../test/contracts/weather_insurance.tz | 10 +- .../lib_protocol/test/contracts/xor.tz | 5 +- .../test/helpers/helpers_operation.ml | 23 +- .../test/helpers/helpers_operation.mli | 8 +- .../test/helpers/helpers_script.ml | 15 +- .../test/helpers/helpers_script.mli | 2 +- src/proto_alpha/lib_protocol/test/main.ml | 5 +- .../lib_protocol/test/test_big_maps.ml | 9 +- .../lib_protocol/test/test_michelson.ml | 329 ++++++++------- 279 files changed, 1521 insertions(+), 1827 deletions(-) create mode 100644 src/bin_client/test/contracts/cps_fact.tz delete mode 100644 src/bin_client/test/contracts/parameterizable_payments.tz delete mode 100644 src/bin_client/test/contracts/publisher_payouts.tz delete mode 100644 src/bin_client/test/contracts/strategy_proxy.tz delete mode 100644 src/bin_client/test/contracts/swap_storage_input.tz delete mode 100644 src/bin_client/test/contracts/swap_storage_input_dip.tz delete mode 100644 src/bin_client/test/contracts/two_vulnerabilities.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/parameterizable_payments.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/publisher_payouts.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/strategy_proxy.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/swap_storage_input.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/swap_storage_input_dip.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/two_vulnerabilities.tz diff --git a/src/bin_client/test/contracts/accounts.tz b/src/bin_client/test/contracts/accounts.tz index 93f16946c..31944fe1f 100644 --- a/src/bin_client/test/contracts/accounts.tz +++ b/src/bin_client/test/contracts/accounts.tz @@ -6,15 +6,14 @@ parameter (or key_hash (pair key (pair tez signature))); # Maps the key to the balance they have stored storage (map key_hash tez); -return unit; code { DUP; CAR; # Deposit into account IF_LEFT { DUP; DIIP{ CDR; DUP }; DIP{ SWAP }; GET; # Create the account - IF_NONE { DIP{ AMOUNT; SOME }; UPDATE; UNIT; PAIR } + IF_NONE { DIP{ AMOUNT; SOME }; UPDATE; NIL operation; PAIR } # Add to an existing account - { AMOUNT; ADD; SOME; SWAP; UPDATE; UNIT; PAIR }} + { AMOUNT; ADD; SOME; SWAP; UPDATE; NIL operation; PAIR }} # Withdrawl { DUP; DUP; DUP; DUP; # Check signature on data @@ -38,5 +37,7 @@ code { DUP; CAR; SWAP; CAR; HASH_KEY; UPDATE; SWAP; DUP; CDAR; # Execute the transfer - DIP{ CAR; HASH_KEY; IMPLICIT_ACCOUNT }; UNIT; TRANSFER_TOKENS; + DIP{ CAR; HASH_KEY; IMPLICIT_ACCOUNT }; UNIT; + TRANSFER_TOKENS; + NIL operation; SWAP; CONS; PAIR }}}} diff --git a/src/bin_client/test/contracts/add1.tz b/src/bin_client/test/contracts/add1.tz index 858f70263..78d4f9d1c 100644 --- a/src/bin_client/test/contracts/add1.tz +++ b/src/bin_client/test/contracts/add1.tz @@ -1,10 +1,7 @@ - parameter int; -storage unit; -return int; +storage int; code {CAR; # Get the parameter PUSH int 1; # We're adding 1, so we need to put 1 on the stack ADD; # Add the two numbers - UNIT; # We need to put the storage value on the stack - SWAP; # The values must be rearranged to match the return calling convention + NIL operation; # We put an empty list of operations on the stack PAIR} # Create the end value diff --git a/src/bin_client/test/contracts/add1_list.tz b/src/bin_client/test/contracts/add1_list.tz index 811ba38b1..7fb50d977 100644 --- a/src/bin_client/test/contracts/add1_list.tz +++ b/src/bin_client/test/contracts/add1_list.tz @@ -1,9 +1,7 @@ parameter (list int); -storage unit; -return (list int); -code { CAR; # Get the parameter +storage (list int); +code { CAR; # Get the parameter LAMBDA int int { PUSH int 1; ADD }; # Create a lambda that adds 1 - MAP; # Map over the list - UNIT; # Push Unit - SWAP; # Reorder the stack for the PAIR - PAIR } # Match the calling convetion + MAP; # Map over the list + NIL operation; # No internal op + PAIR } # Match the calling convetion diff --git a/src/bin_client/test/contracts/add_delta_timestamp.tz b/src/bin_client/test/contracts/add_delta_timestamp.tz index b0a235731..b9ed86901 100644 --- a/src/bin_client/test/contracts/add_delta_timestamp.tz +++ b/src/bin_client/test/contracts/add_delta_timestamp.tz @@ -1,4 +1,3 @@ parameter (pair int timestamp); -storage unit; -return timestamp; -code { CAR; DUP; CAR; DIP{CDR}; ADD; UNIT; SWAP; PAIR} +storage (option timestamp); +code { CAR; DUP; CAR; DIP{CDR}; ADD; SOME; NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/add_timestamp_delta.tz b/src/bin_client/test/contracts/add_timestamp_delta.tz index 405cea517..766bf9f91 100644 --- a/src/bin_client/test/contracts/add_timestamp_delta.tz +++ b/src/bin_client/test/contracts/add_timestamp_delta.tz @@ -1,4 +1,3 @@ parameter (pair timestamp int); -storage unit; -return timestamp; -code { CAR; DUP; CAR; DIP{CDR}; ADD; UNIT; SWAP; PAIR} +storage (option timestamp); +code { CAR; DUP; CAR; DIP{CDR}; ADD; SOME; NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/after_strategy.tz b/src/bin_client/test/contracts/after_strategy.tz index 51e199707..70812e52b 100644 --- a/src/bin_client/test/contracts/after_strategy.tz +++ b/src/bin_client/test/contracts/after_strategy.tz @@ -1,4 +1,3 @@ parameter nat; -storage timestamp; -return (pair nat bool); -code {DUP; CAR; DIP{CDR; DUP; NOW; CMPGT}; PAIR; PAIR}; +storage (pair (pair nat bool) timestamp); +code {DUP; CAR; DIP{CDDR; DUP; NOW; CMPGT}; PAIR; PAIR ; NIL operation ; PAIR}; diff --git a/src/bin_client/test/contracts/always.tz b/src/bin_client/test/contracts/always.tz index a578996b2..a7802fec9 100644 --- a/src/bin_client/test/contracts/always.tz +++ b/src/bin_client/test/contracts/always.tz @@ -1,6 +1,4 @@ - parameter nat; -return (pair nat bool); -storage unit; +storage (pair nat bool); code { CAR; PUSH bool True; SWAP; - PAIR; UNIT; SWAP; PAIR} + PAIR; NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/and.tz b/src/bin_client/test/contracts/and.tz index dcd4ed46a..d723e72eb 100644 --- a/src/bin_client/test/contracts/and.tz +++ b/src/bin_client/test/contracts/and.tz @@ -1,4 +1,3 @@ parameter (pair (bool @first) (bool @second)); -return bool; -storage unit; -code { CAR @param; DUP; CAR @first; DIP{CDR @second}; AND; UNIT; SWAP; PAIR }; +storage (option bool); +code { CAR @param; DUP; CAR @first; DIP{CDR @second}; AND; SOME; NIL operation; PAIR }; diff --git a/src/bin_client/test/contracts/append.tz b/src/bin_client/test/contracts/append.tz index e3dcbc1b9..46a9d8217 100644 --- a/src/bin_client/test/contracts/append.tz +++ b/src/bin_client/test/contracts/append.tz @@ -1,7 +1,5 @@ - parameter (pair (list int) (list int)); -return (list int); -storage unit; +storage (list int); code { CAR; DUP; DIP{CDR}; CAR; # Unpack lists NIL int; SWAP; # Setup reverse accumulator LAMBDA (pair int (list int)) @@ -12,4 +10,4 @@ code { CAR; DUP; DIP{CDR}; CAR; # Unpack lists (list int) {DUP; CAR; DIP{CDR}; CONS}; REDUCE; # Append reversed list - UNIT; SWAP; PAIR} # Calling convention + NIL operation; PAIR} # Calling convention diff --git a/src/bin_client/test/contracts/assert.tz b/src/bin_client/test/contracts/assert.tz index 087b12907..6c5ce503b 100644 --- a/src/bin_client/test/contracts/assert.tz +++ b/src/bin_client/test/contracts/assert.tz @@ -1,4 +1,3 @@ parameter bool; storage unit; -return unit; -code {CAR; ASSERT; UNIT; UNIT; PAIR} +code {CAR; ASSERT; UNIT; NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/assert_cmpeq.tz b/src/bin_client/test/contracts/assert_cmpeq.tz index f5dd7d0f4..55621bac8 100644 --- a/src/bin_client/test/contracts/assert_cmpeq.tz +++ b/src/bin_client/test/contracts/assert_cmpeq.tz @@ -1,4 +1,3 @@ parameter (pair int int); storage unit; -return unit; -code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPEQ; UNIT; DUP; PAIR} +code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPEQ; UNIT; NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/assert_cmpge.tz b/src/bin_client/test/contracts/assert_cmpge.tz index 3db916747..e98b17044 100644 --- a/src/bin_client/test/contracts/assert_cmpge.tz +++ b/src/bin_client/test/contracts/assert_cmpge.tz @@ -1,4 +1,3 @@ parameter (pair int int); storage unit; -return unit; -code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPGE; UNIT; DUP; PAIR} +code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPGE; UNIT; NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/assert_cmpgt.tz b/src/bin_client/test/contracts/assert_cmpgt.tz index a2d172017..7a44174b7 100644 --- a/src/bin_client/test/contracts/assert_cmpgt.tz +++ b/src/bin_client/test/contracts/assert_cmpgt.tz @@ -1,4 +1,3 @@ parameter (pair int int); storage unit; -return unit; -code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPGT; UNIT; DUP; PAIR} +code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPGT; UNIT; NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/assert_cmple.tz b/src/bin_client/test/contracts/assert_cmple.tz index c728c2183..e4b61cfc4 100644 --- a/src/bin_client/test/contracts/assert_cmple.tz +++ b/src/bin_client/test/contracts/assert_cmple.tz @@ -1,4 +1,3 @@ parameter (pair int int); storage unit; -return unit; -code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPLE; UNIT; DUP; PAIR} +code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPLE; UNIT; NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/assert_cmplt.tz b/src/bin_client/test/contracts/assert_cmplt.tz index 200165564..290b49537 100644 --- a/src/bin_client/test/contracts/assert_cmplt.tz +++ b/src/bin_client/test/contracts/assert_cmplt.tz @@ -1,4 +1,3 @@ parameter (pair int int); storage unit; -return unit; -code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPLT; UNIT; DUP; PAIR} +code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPLT; UNIT; NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/assert_cmpneq.tz b/src/bin_client/test/contracts/assert_cmpneq.tz index 8c8e13b93..86b601393 100644 --- a/src/bin_client/test/contracts/assert_cmpneq.tz +++ b/src/bin_client/test/contracts/assert_cmpneq.tz @@ -1,4 +1,3 @@ parameter (pair int int); storage unit; -return unit; -code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPNEQ; UNIT; DUP; PAIR} +code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPNEQ; UNIT; NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/assert_eq.tz b/src/bin_client/test/contracts/assert_eq.tz index 45f6afb10..338096a62 100644 --- a/src/bin_client/test/contracts/assert_eq.tz +++ b/src/bin_client/test/contracts/assert_eq.tz @@ -1,4 +1,3 @@ parameter (pair int int); storage unit; -return unit; -code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_EQ; UNIT; DUP; PAIR} +code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_EQ; UNIT; NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/assert_ge.tz b/src/bin_client/test/contracts/assert_ge.tz index b3a24b8a7..06bb3cec9 100644 --- a/src/bin_client/test/contracts/assert_ge.tz +++ b/src/bin_client/test/contracts/assert_ge.tz @@ -1,4 +1,3 @@ parameter (pair int int); storage unit; -return unit; -code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_GE; UNIT; DUP; PAIR} +code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_GE; UNIT; NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/assert_gt.tz b/src/bin_client/test/contracts/assert_gt.tz index 559c77f66..d041093b0 100644 --- a/src/bin_client/test/contracts/assert_gt.tz +++ b/src/bin_client/test/contracts/assert_gt.tz @@ -1,4 +1,3 @@ parameter (pair int int); storage unit; -return unit; -code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_GT; UNIT; DUP; PAIR} +code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_GT; UNIT; NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/assert_le.tz b/src/bin_client/test/contracts/assert_le.tz index c9ace4a7f..8250f3f3b 100644 --- a/src/bin_client/test/contracts/assert_le.tz +++ b/src/bin_client/test/contracts/assert_le.tz @@ -1,4 +1,3 @@ parameter (pair int int); storage unit; -return unit; -code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_LE; UNIT; DUP; PAIR} +code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_LE; UNIT; NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/assert_lt.tz b/src/bin_client/test/contracts/assert_lt.tz index 21f883dac..e387e9d74 100644 --- a/src/bin_client/test/contracts/assert_lt.tz +++ b/src/bin_client/test/contracts/assert_lt.tz @@ -1,4 +1,3 @@ parameter (pair int int); storage unit; -return unit; -code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_LT; UNIT; DUP; PAIR} +code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_LT; UNIT; NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/assert_neq.tz b/src/bin_client/test/contracts/assert_neq.tz index c381882df..83f19559e 100644 --- a/src/bin_client/test/contracts/assert_neq.tz +++ b/src/bin_client/test/contracts/assert_neq.tz @@ -1,4 +1,3 @@ parameter (pair int int); storage unit; -return unit; -code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_NEQ; UNIT; DUP; PAIR} +code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_NEQ; UNIT; NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/at_least.tz b/src/bin_client/test/contracts/at_least.tz index ae2180860..8fb126cbe 100644 --- a/src/bin_client/test/contracts/at_least.tz +++ b/src/bin_client/test/contracts/at_least.tz @@ -1,7 +1,6 @@ - parameter unit; -return unit; storage tez; # How much you have to send me code {CDR; DUP; # Get the amount required (once for comparison, once to save back in storage) AMOUNT; CMPLT; # Check to make sure no one is wasting my time - IF {FAIL} {UNIT; PAIR}} # Finish the transaction or reject the person + IF {FAIL} # Reject the person + {NIL operation;PAIR}} # Finish the transaction diff --git a/src/bin_client/test/contracts/auction.tz b/src/bin_client/test/contracts/auction.tz index 6d5de990a..48f477394 100644 --- a/src/bin_client/test/contracts/auction.tz +++ b/src/bin_client/test/contracts/auction.tz @@ -1,9 +1,8 @@ parameter key_hash; storage (pair timestamp (pair tez key_hash)); -return unit; code { DUP; CDAR; DUP; NOW; CMPGT; IF {FAIL} {}; SWAP; # Check if auction has ended DUP; CAR; DIP{CDDR}; AMOUNT; PAIR; SWAP; DIP{SWAP; PAIR}; # Setup replacement storage DUP; CAR; AMOUNT; CMPLE; IF {FAIL} {}; # Check to make sure that the new amount is greater DUP; CAR; # Get amount of refund DIP{CDR; IMPLICIT_ACCOUNT}; UNIT; TRANSFER_TOKENS; # Make refund - PAIR} # Calling convention + NIL operation; SWAP; CONS; PAIR} # Calling convention diff --git a/src/bin_client/test/contracts/bad_lockup.tz b/src/bin_client/test/contracts/bad_lockup.tz index 7ccd27993..b2ebfc266 100644 --- a/src/bin_client/test/contracts/bad_lockup.tz +++ b/src/bin_client/test/contracts/bad_lockup.tz @@ -1,6 +1,6 @@ parameter unit; -storage (pair timestamp (pair (contract unit unit) (contract unit unit))); -return unit; +storage (pair timestamp (pair (contract unit) (contract unit))); code { CDR; DUP; CAR; NOW; CMPLT; IF {FAIL} {}; - DUP; CDAR; PUSH tez "100"; UNIT; TRANSFER_TOKENS; DROP; - DUP; CDDR; PUSH tez "100"; UNIT; TRANSFER_TOKENS; PAIR } + DUP; CDAR; PUSH tez "100"; UNIT; TRANSFER_TOKENS; SWAP; + DUP; CDDR; PUSH tez "100"; UNIT; TRANSFER_TOKENS; DIP {SWAP} ; + NIL operation ; SWAP ; CONS ; SWAP ; CONS ; PAIR } diff --git a/src/bin_client/test/contracts/balance.tz b/src/bin_client/test/contracts/balance.tz index 2bd161da6..98568476e 100644 --- a/src/bin_client/test/contracts/balance.tz +++ b/src/bin_client/test/contracts/balance.tz @@ -1,4 +1,3 @@ parameter unit; -storage unit; -return tez; -code {DROP; UNIT; BALANCE; PAIR}; +storage tez; +code {DROP; BALANCE; NIL operation; PAIR}; diff --git a/src/bin_client/test/contracts/big_map_get_add.tz b/src/bin_client/test/contracts/big_map_get_add.tz index e4f736c83..63c6b5489 100644 --- a/src/bin_client/test/contracts/big_map_get_add.tz +++ b/src/bin_client/test/contracts/big_map_get_add.tz @@ -1,8 +1,7 @@ parameter (pair (pair @set_pair int (option int)) (pair @check_pair int (option int))) ; storage (pair (big_map int int) unit) ; -return unit ; code { DUP ; DIP { CDAR } ; DUP ; DIP { CADR; DUP ; CAR ; DIP { CDR } ; UPDATE ; DUP } ; CADR ; DUP ; CDR ; DIP { CAR ; GET } ; IF_SOME { SWAP ; IF_SOME { ASSERT_CMPEQ } {FAIL}} { ASSERT_NONE } ; - UNIT ; SWAP ; PAIR ; UNIT ; PAIR } + UNIT ; SWAP ; PAIR ; NIL operation ; PAIR } diff --git a/src/bin_client/test/contracts/big_map_mem.tz b/src/bin_client/test/contracts/big_map_mem.tz index 015819626..55736ab89 100644 --- a/src/bin_client/test/contracts/big_map_mem.tz +++ b/src/bin_client/test/contracts/big_map_mem.tz @@ -1,6 +1,5 @@ # Fails if the boolean does not match the membership criteria parameter (pair int bool) ; storage (pair (big_map int unit) unit) ; -return unit ; code { DUP ; DUP ; CADR ; DIP { CAAR ; DIP { CDAR ; DUP } ; MEM } ; - ASSERT_CMPEQ ; UNIT ; SWAP ; PAIR ; UNIT ; PAIR } + ASSERT_CMPEQ ; UNIT ; SWAP ; PAIR ; NIL operation ; PAIR } diff --git a/src/bin_client/test/contracts/big_map_union.tz b/src/bin_client/test/contracts/big_map_union.tz index 953b66ce9..6885c2fcb 100644 --- a/src/bin_client/test/contracts/big_map_union.tz +++ b/src/bin_client/test/contracts/big_map_union.tz @@ -1,9 +1,8 @@ parameter (list (pair string int)) ; storage (pair (big_map string int) unit) ; -return unit ; code { UNPAAIAIR ; ITER { UNPAIR ; DUUUP ; DUUP; GET ; IF_NONE { PUSH int 0 } {} ; SWAP ; DIP { ADD ; SOME } ; UPDATE } ; - PAIR ; UNIT ; PAIR } + PAIR ; NIL operation ; PAIR } diff --git a/src/bin_client/test/contracts/build_list.tz b/src/bin_client/test/contracts/build_list.tz index bb36dc2f7..842056d91 100644 --- a/src/bin_client/test/contracts/build_list.tz +++ b/src/bin_client/test/contracts/build_list.tz @@ -1,7 +1,6 @@ parameter nat; -return (list nat); -storage unit; +storage (list nat); code { CAR @counter; NIL @acc nat; SWAP; DUP @cmp_num; PUSH nat 0; CMPNEQ; LOOP { DUP; DIP {SWAP}; CONS @acc; SWAP; PUSH nat 1; SWAP; SUB @counter; DUP; DIP{ABS}; PUSH int 0; CMPNEQ}; - CONS; UNIT; SWAP; PAIR}; + CONS; NIL operation; PAIR}; diff --git a/src/bin_client/test/contracts/cadr_annotation.tz b/src/bin_client/test/contracts/cadr_annotation.tz index 43afa55d9..b83d483e5 100644 --- a/src/bin_client/test/contracts/cadr_annotation.tz +++ b/src/bin_client/test/contracts/cadr_annotation.tz @@ -1,4 +1,3 @@ parameter (pair (pair unit (string @no_name)) bool); storage unit; -return unit; -code { CAR @name; CADR @second_name; DROP; UNIT; UNIT; PAIR } +code { CAR @name; CADR @second_name; DROP; UNIT; NIL operation; PAIR } diff --git a/src/bin_client/test/contracts/check_signature.tz b/src/bin_client/test/contracts/check_signature.tz index 727eca8bc..6e9009bbc 100644 --- a/src/bin_client/test/contracts/check_signature.tz +++ b/src/bin_client/test/contracts/check_signature.tz @@ -1,7 +1,8 @@ parameter key; storage (pair signature string); -return bool; code { DUP; DUP; DIP{ CDR; DUP; CAR; DIP{CDR; H}; PAIR}; - CAR; CHECK_SIGNATURE; DIP{CDR}; PAIR}; + CAR; CHECK_SIGNATURE; + IF {} {FAIL} ; + CDR; NIL operation ; PAIR}; diff --git a/src/bin_client/test/contracts/compare.tz b/src/bin_client/test/contracts/compare.tz index ed661ec87..f31561c51 100644 --- a/src/bin_client/test/contracts/compare.tz +++ b/src/bin_client/test/contracts/compare.tz @@ -1,10 +1,9 @@ parameter (pair tez tez); -return (list bool); -storage unit; +storage (list bool); code {CAR; DUP; DUP; DUP; DUP; DIIIIIP {NIL bool}; DIIIIP {DUP; CAR; DIP {CDR}; COMPARE; LE; CONS}; DIIIP {DUP; CAR; DIP {CDR}; COMPARE; GE; CONS}; DIIP{DUP; CAR; DIP {CDR}; COMPARE; LT; CONS}; DIP {DUP; CAR; DIP {CDR}; COMPARE; GT; CONS}; DUP; CAR; DIP {CDR}; COMPARE; EQ; CONS; - UNIT; SWAP; PAIR}; + NIL operation; PAIR}; diff --git a/src/bin_client/test/contracts/concat.tz b/src/bin_client/test/contracts/concat.tz index 203d03b12..34aafed9a 100644 --- a/src/bin_client/test/contracts/concat.tz +++ b/src/bin_client/test/contracts/concat.tz @@ -1,11 +1,8 @@ - parameter string; storage string; -return string; code {DUP; # We're going to need both the storage and parameter CAR; # Get the parameter - DIP{CDR; # Get the storage value - DUP}; # We need to replace it in the storage, so we dup it + DIP{CDR}; # Get the storage value SWAP; # Get the order we want (this is optional) CONCAT; # Concatenate the strings - PAIR} # Pair them up, matching the calling convention + NIL operation; PAIR} # Match the calling convention diff --git a/src/bin_client/test/contracts/concat_hello.tz b/src/bin_client/test/contracts/concat_hello.tz index 3fe89e70c..772dc6632 100644 --- a/src/bin_client/test/contracts/concat_hello.tz +++ b/src/bin_client/test/contracts/concat_hello.tz @@ -1,5 +1,4 @@ parameter (list string); -return (list string); -storage unit; +storage (list string); code{ CAR; LAMBDA string string { PUSH @hello string "Hello "; CONCAT }; - MAP; UNIT; SWAP; PAIR}; + MAP; NIL operation; PAIR}; diff --git a/src/bin_client/test/contracts/concat_list.tz b/src/bin_client/test/contracts/concat_list.tz index 1c4b9339e..a2c752d93 100644 --- a/src/bin_client/test/contracts/concat_list.tz +++ b/src/bin_client/test/contracts/concat_list.tz @@ -1,6 +1,5 @@ parameter (list string); -return string; -storage unit; +storage string; code {CAR; PUSH string ""; SWAP; LAMBDA (pair string string) string {DUP; CDR; DIP{CAR}; CONCAT}; - REDUCE; UNIT; SWAP; PAIR}; + REDUCE; NIL operation; PAIR}; diff --git a/src/bin_client/test/contracts/conditionals.tz b/src/bin_client/test/contracts/conditionals.tz index 740e6bc82..16bf8e916 100644 --- a/src/bin_client/test/contracts/conditionals.tz +++ b/src/bin_client/test/contracts/conditionals.tz @@ -1,11 +1,9 @@ - parameter (or string (option int)); -storage unit; -return string; +storage string; code { CAR; # Access the storage IF_LEFT {} # The string is on top of the stack, nothing to do { IF_NONE { FAIL} # Fail if None { PUSH int 0; CMPGT; # Check for negative number IF {FAIL} # Fail if negative {PUSH string ""}}}; # Push the empty string - UNIT; SWAP; PAIR} # Calling convention + NIL operation; PAIR} # Calling convention diff --git a/src/bin_client/test/contracts/cons_twice.tz b/src/bin_client/test/contracts/cons_twice.tz index d0894f00f..4761b23f7 100644 --- a/src/bin_client/test/contracts/cons_twice.tz +++ b/src/bin_client/test/contracts/cons_twice.tz @@ -1,12 +1,9 @@ - parameter nat; storage (list nat); -return unit; code { DUP; # Duplicate the storage and parameter CAR; # Extract the parameter DIP{CDR}; # Extract the storage DUP; # Duplicate the parameter DIP{CONS}; # Add the first instance of the parameter to the list CONS; # Add the second instance of the parameter to the list - PUSH unit Unit; # Put the value Unit on the stack (calling convention) - PAIR} # Finish the calling convention + NIL operation; PAIR} # Finish the calling convention diff --git a/src/bin_client/test/contracts/contains_all.tz b/src/bin_client/test/contracts/contains_all.tz index 8b6d30583..f44628cc8 100644 --- a/src/bin_client/test/contracts/contains_all.tz +++ b/src/bin_client/test/contracts/contains_all.tz @@ -1,10 +1,9 @@ parameter (pair (list string) (list string)); -storage unit; -return bool; +storage (option bool); code {CAR; DUP; CAR; DIP{CDR}; EMPTY_SET string; SWAP; LAMBDA (pair string (set string)) (set string) {DUP; CAR; DIP{CDR}; PUSH bool True; SWAP; UPDATE}; REDUCE; PUSH bool True; SWAP; PAIR; SWAP; LAMBDA (pair string (pair (set string) bool)) (pair (set string) bool) {DUP; DUP; CAR; DIP{CDAR; DIP{CDDR}; DUP}; MEM; DIP{SWAP}; AND; SWAP; PAIR}; - REDUCE; CDR; UNIT; SWAP; PAIR}; + REDUCE; CDR; SOME; NIL operation; PAIR}; diff --git a/src/bin_client/test/contracts/cps_fact.tz b/src/bin_client/test/contracts/cps_fact.tz new file mode 100644 index 000000000..3b6ec70ca --- /dev/null +++ b/src/bin_client/test/contracts/cps_fact.tz @@ -0,0 +1,16 @@ +storage nat ; +parameter nat ; +code { UNPAIR ; + DIP { SELF ; ADDRESS ; SOURCE; + IFCMPEQ {} { DROP ; PUSH @storage nat 1 } }; + DUP ; + PUSH nat 1 ; + IFCMPGE + { DROP ; NIL operation ; PAIR } + { PUSH nat 1 ; SWAP ; SUB @parameter ; ISNAT ; + IF_NONE + { NIL operation ; PAIR } + { DUP ; DIP { PUSH nat 1 ; ADD ; MUL @storage } ; SWAP; + DIP { DIP { PUSH nat 4000 ; SELF; PUSH tez "0" } ; + TRANSFER_TOKENS ; NIL operation ; SWAP ; CONS } ; + SWAP ; PAIR } } } \ No newline at end of file diff --git a/src/bin_client/test/contracts/create_account.tz b/src/bin_client/test/contracts/create_account.tz index c04de7a26..b143f26bf 100644 --- a/src/bin_client/test/contracts/create_account.tz +++ b/src/bin_client/test/contracts/create_account.tz @@ -1,5 +1,4 @@ parameter key_hash; -return unit; -storage (contract unit unit); +storage (contract unit); code {CAR; DIP{PUSH tez "100.00"; PUSH bool False; NONE key_hash}; - CREATE_ACCOUNT; UNIT; PAIR}; + CREATE_ACCOUNT; NIL operation; PAIR}; diff --git a/src/bin_client/test/contracts/create_add1_lists.tz b/src/bin_client/test/contracts/create_add1_lists.tz index 43ea501d6..f82ef1b28 100644 --- a/src/bin_client/test/contracts/create_add1_lists.tz +++ b/src/bin_client/test/contracts/create_add1_lists.tz @@ -1,15 +1,13 @@ parameter unit; -return (contract (list int) (list int)); -storage unit; -code { CAR; # Get the UNIT value (starting storage for contract) - LAMBDA (pair (list int) unit) # Start of stack for contract (see above) - (pair (list int) unit) # End of stack for contract (see above) +storage (contract (list int)); +code { DROP; NIL int; # starting storage for contract + LAMBDA (pair (list int) (list int)) # Start of stack for contract (see above) + (pair (list operation) (list int)) # End of stack for contract (see above) # See the contract above. I copied and pasted { CAR; LAMBDA int int {PUSH int 1; ADD}; MAP; - UNIT; - SWAP; + NIL operation; PAIR }; AMOUNT; # Push the starting balance PUSH bool False; # Not spendable @@ -17,6 +15,4 @@ code { CAR; # Get the UNIT value (starting storage for cont NONE key_hash; # No delegate PUSH key_hash "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"; CREATE_CONTRACT; # Create the contract - UNIT; # Ending calling convention stuff - SWAP; - PAIR} + NIL operation; PAIR} # Ending calling convention stuff diff --git a/src/bin_client/test/contracts/create_contract.tz b/src/bin_client/test/contracts/create_contract.tz index 2138adecc..7c5ecc4ef 100644 --- a/src/bin_client/test/contracts/create_contract.tz +++ b/src/bin_client/test/contracts/create_contract.tz @@ -1,13 +1,12 @@ parameter key_hash; storage string; -return unit; code {CAR; - DIP{UNIT; - LAMBDA (pair string unit) - (pair string unit) - {CAR; UNIT; SWAP; PAIR}; + DIP{PUSH string "dummy"; + LAMBDA (pair string string) + (pair (list operation) string) + {CAR; NIL operation; PAIR}; PUSH tez "100.00"; PUSH bool False; PUSH bool False; NONE key_hash}; CREATE_CONTRACT; DIP{PUSH string ""}; PUSH tez "0.00"; PUSH string "abcdefg"; TRANSFER_TOKENS; - DIP{DROP}; UNIT; PAIR}; + NIL operation; SWAP; CONS; PAIR}; diff --git a/src/bin_client/test/contracts/create_contract_literal.tz b/src/bin_client/test/contracts/create_contract_literal.tz index 4043ef1ff..4600662ec 100644 --- a/src/bin_client/test/contracts/create_contract_literal.tz +++ b/src/bin_client/test/contracts/create_contract_literal.tz @@ -1,14 +1,12 @@ parameter key_hash; -storage string; -return unit; +storage unit; code { CAR; - DIP { UNIT; + DIP { PUSH string "dummy"; PUSH tez "100.00"; PUSH bool False; PUSH bool False; NONE key_hash }; CREATE_CONTRACT { parameter string ; - storage unit ; - return string ; - code {CAR; UNIT; SWAP; PAIR } } ; + storage string ; + code {CAR; NIL operation; PAIR } } ; DIP{PUSH string ""}; PUSH tez "0.00"; PUSH string "abcdefg"; TRANSFER_TOKENS; - DIP{DROP}; UNIT; PAIR}; + DIP{DROP}; NIL operation; SWAP; CONS; UNIT; SWAP; PAIR}; diff --git a/src/bin_client/test/contracts/data_publisher.tz b/src/bin_client/test/contracts/data_publisher.tz index 25f7b0c82..e161c3989 100644 --- a/src/bin_client/test/contracts/data_publisher.tz +++ b/src/bin_client/test/contracts/data_publisher.tz @@ -1,15 +1,8 @@ - -# NONE if user wants to get the value -# SOME (signed hash of the string, string) -parameter (option (pair signature (pair string nat))); -return string; +parameter (pair signature (pair string nat)); storage (pair (pair key nat) string); code { DUP; CAR; DIP{CDR; DUP}; - IF_NONE { AMOUNT; PUSH tez "1.00"; # The fee I'm charging for queries - CMPLE; IF {} {FAIL}; - CDR; PAIR} - { SWAP; DIP{DUP}; CAAR; DIP{DUP; CAR; DIP{CDR; H}; PAIR}; - CHECK_SIGNATURE; - IF { CDR; DUP; DIP{CAR; DIP{CAAR}}; CDR; PUSH nat 1; ADD; - DIP{SWAP}; SWAP; PAIR; PAIR; PUSH string ""; PAIR} - {FAIL}}} + SWAP; DIP{DUP}; CAAR; DIP{DUP; CAR; DIP{CDR; H}; PAIR}; + CHECK_SIGNATURE; + IF { CDR; DUP; DIP{CAR; DIP{CAAR}}; CDR; PUSH nat 1; ADD; + DIP{SWAP}; SWAP; PAIR; PAIR; NIL operation; PAIR} + {FAIL}} diff --git a/src/bin_client/test/contracts/default_account.tz b/src/bin_client/test/contracts/default_account.tz index c71564952..3a48fc1d9 100644 --- a/src/bin_client/test/contracts/default_account.tz +++ b/src/bin_client/test/contracts/default_account.tz @@ -1,5 +1,5 @@ parameter key_hash; -return unit; storage unit; code {DIP{UNIT}; CAR; IMPLICIT_ACCOUNT; - PUSH tez "100.00"; UNIT; TRANSFER_TOKENS; PAIR} + PUSH tez "100.00"; UNIT; TRANSFER_TOKENS; + NIL operation; SWAP; CONS; PAIR} diff --git a/src/bin_client/test/contracts/diff_timestamps.tz b/src/bin_client/test/contracts/diff_timestamps.tz index 5655a866b..f1991a37a 100644 --- a/src/bin_client/test/contracts/diff_timestamps.tz +++ b/src/bin_client/test/contracts/diff_timestamps.tz @@ -1,4 +1,3 @@ parameter (pair timestamp timestamp); -return int; -storage unit; -code { CAR; DUP; CAR; DIP{CDR}; SUB; UNIT; SWAP; PAIR } +storage int; +code { CAR; DUP; CAR; DIP{CDR}; SUB; NIL operation; PAIR } diff --git a/src/bin_client/test/contracts/dispatch.tz b/src/bin_client/test/contracts/dispatch.tz index 6f4fc468e..9c185133a 100644 --- a/src/bin_client/test/contracts/dispatch.tz +++ b/src/bin_client/test/contracts/dispatch.tz @@ -1,9 +1,9 @@ parameter (or string (pair string (lambda unit string))); -return string; -storage (map string (lambda unit string)); -code { DUP; DIP{CDR}; CAR; # Unpack stack +storage (pair string (map string (lambda unit string))); +code { DUP; DIP{CDDR}; CAR; # Unpack stack IF_LEFT { DIP{DUP}; GET; # Get lambda if it exists IF_NONE {FAIL} {}; # Fail if it doesn't UNIT; EXEC } # Execute the lambda { DUP; CAR; DIP {CDR; SOME}; UPDATE; PUSH string ""}; # Update the storage - PAIR} # Calling convention + PAIR; + NIL operation; PAIR} # Calling convention diff --git a/src/bin_client/test/contracts/empty.tz b/src/bin_client/test/contracts/empty.tz index 0edda09b3..d3aecdb25 100644 --- a/src/bin_client/test/contracts/empty.tz +++ b/src/bin_client/test/contracts/empty.tz @@ -1,5 +1,3 @@ - parameter unit; storage unit; -return unit; -code {} +code {CDR; NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/empty_map.tz b/src/bin_client/test/contracts/empty_map.tz index ff7b3d0d2..9023fe847 100644 --- a/src/bin_client/test/contracts/empty_map.tz +++ b/src/bin_client/test/contracts/empty_map.tz @@ -1,7 +1,6 @@ -storage unit; -return (map string string); +storage (map string string); parameter unit; code {DROP; EMPTY_MAP string string; PUSH string "world"; SOME; PUSH string "hello"; UPDATE; - UNIT; SWAP; PAIR}; + NIL operation; PAIR}; diff --git a/src/bin_client/test/contracts/exec_concat.tz b/src/bin_client/test/contracts/exec_concat.tz index 7278670a7..6828a52fc 100644 --- a/src/bin_client/test/contracts/exec_concat.tz +++ b/src/bin_client/test/contracts/exec_concat.tz @@ -1,6 +1,5 @@ parameter string; -return string; -storage unit; +storage string; code {CAR; LAMBDA string string {PUSH string "_abc"; SWAP; CONCAT}; - SWAP; EXEC; UNIT; SWAP; PAIR}; + SWAP; EXEC; NIL operation; PAIR}; diff --git a/src/bin_client/test/contracts/fail.tz b/src/bin_client/test/contracts/fail.tz index 92ac980c5..7f8bde252 100644 --- a/src/bin_client/test/contracts/fail.tz +++ b/src/bin_client/test/contracts/fail.tz @@ -1,6 +1,5 @@ parameter unit; +storage unit; code { # This contract will never accept a incoming transaction FAIL}; -return unit; -storage unit; diff --git a/src/bin_client/test/contracts/fail_amount.tz b/src/bin_client/test/contracts/fail_amount.tz index 9f9be1fcc..f4239b19e 100644 --- a/src/bin_client/test/contracts/fail_amount.tz +++ b/src/bin_client/test/contracts/fail_amount.tz @@ -1,5 +1,6 @@ # Fail if the amount transferred is less than 10 parameter unit; storage unit; -return unit; -code {AMOUNT; PUSH tez "10"; CMPGT; IF {FAIL} {}} +code { DROP; + AMOUNT; PUSH tez "10"; CMPGT; IF {FAIL} {}; + UNIT; NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/first.tz b/src/bin_client/test/contracts/first.tz index b2c9622c1..6e47b4c00 100644 --- a/src/bin_client/test/contracts/first.tz +++ b/src/bin_client/test/contracts/first.tz @@ -1,4 +1,3 @@ parameter (list nat); -return nat; -storage unit; -code{CAR; IF_CONS {DIP{DROP}} {FAIL}; UNIT; SWAP; PAIR}; +storage nat; +code{CAR; IF_CONS {DIP{DROP}} {FAIL}; NIL operation; PAIR}; diff --git a/src/bin_client/test/contracts/get_map_value.tz b/src/bin_client/test/contracts/get_map_value.tz index d8d95a783..f46639649 100644 --- a/src/bin_client/test/contracts/get_map_value.tz +++ b/src/bin_client/test/contracts/get_map_value.tz @@ -1,4 +1,3 @@ parameter string; -storage (map string string); -return (option string); -code {DUP; CAR; DIP{CDR; DUP}; GET; PAIR}; +storage (pair (option string) (map string string)); +code {DUP; CAR; DIP{CDDR; DUP}; GET; PAIR; NIL operation; PAIR}; diff --git a/src/bin_client/test/contracts/hardlimit.tz b/src/bin_client/test/contracts/hardlimit.tz index b9122789a..464062a52 100644 --- a/src/bin_client/test/contracts/hardlimit.tz +++ b/src/bin_client/test/contracts/hardlimit.tz @@ -1,7 +1,5 @@ parameter unit ; -code - { # This contract stops accepting transactions after N incoming transactions - CDR ; DUP ; PUSH int 0 ; CMPLT; IF {PUSH int -1 ; ADD} {FAIL}; - UNIT; PAIR} ; -return unit ; -storage int +storage int ; +code { # This contract stops accepting transactions after N incoming transactions + CDR ; DUP ; PUSH int 0 ; CMPLT; IF {PUSH int -1 ; ADD} {FAIL}; + NIL operation ; PAIR} ; diff --git a/src/bin_client/test/contracts/hash_consistency_checker.tz b/src/bin_client/test/contracts/hash_consistency_checker.tz index 6909ba82b..5d3c611ca 100644 --- a/src/bin_client/test/contracts/hash_consistency_checker.tz +++ b/src/bin_client/test/contracts/hash_consistency_checker.tz @@ -1,4 +1,3 @@ parameter (pair tez (pair timestamp int)) ; -return string ; -storage unit ; -code { CAR ; H ; UNIT ; SWAP ; PAIR } \ No newline at end of file +storage string ; +code { CAR ; H ; NIL operation ; PAIR } \ No newline at end of file diff --git a/src/bin_client/test/contracts/hash_key.tz b/src/bin_client/test/contracts/hash_key.tz index feba0b58d..6c7f78b4a 100644 --- a/src/bin_client/test/contracts/hash_key.tz +++ b/src/bin_client/test/contracts/hash_key.tz @@ -1,4 +1,3 @@ parameter key; -return key_hash; -storage unit; -code {CAR; HASH_KEY; DIP{UNIT}; PAIR} +storage (option key_hash); +code {CAR; HASH_KEY; SOME ;NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/hash_string.tz b/src/bin_client/test/contracts/hash_string.tz index 2afbfb56e..263cecb0e 100644 --- a/src/bin_client/test/contracts/hash_string.tz +++ b/src/bin_client/test/contracts/hash_string.tz @@ -1,4 +1,3 @@ parameter string; -return string; -storage unit; -code {CAR; H; UNIT; SWAP; PAIR}; +storage string; +code {CAR; H; NIL operation; PAIR}; diff --git a/src/bin_client/test/contracts/id.tz b/src/bin_client/test/contracts/id.tz index ae9b9612e..4eee565ca 100644 --- a/src/bin_client/test/contracts/id.tz +++ b/src/bin_client/test/contracts/id.tz @@ -1,5 +1,3 @@ - parameter string; -return string; -storage unit; -code {}; +storage string; +code {CAR; NIL operation; PAIR}; diff --git a/src/bin_client/test/contracts/if.tz b/src/bin_client/test/contracts/if.tz index 5a0d423a7..4bc0e353d 100644 --- a/src/bin_client/test/contracts/if.tz +++ b/src/bin_client/test/contracts/if.tz @@ -1,4 +1,3 @@ parameter bool; -storage unit; -return bool; -code {CAR; IF {PUSH bool True} {PUSH bool False}; UNIT; SWAP; PAIR}; +storage (option bool); +code {CAR; IF {PUSH bool True} {PUSH bool False}; SOME; NIL operation; PAIR}; diff --git a/src/bin_client/test/contracts/if_some.tz b/src/bin_client/test/contracts/if_some.tz index 2ccc280a7..5c3138b22 100644 --- a/src/bin_client/test/contracts/if_some.tz +++ b/src/bin_client/test/contracts/if_some.tz @@ -1,4 +1,3 @@ parameter (option string); -return string; -storage unit; -code { CAR; IF_SOME {} {PUSH string ""}; UNIT; SWAP; PAIR} +storage string; +code { CAR; IF_SOME {} {PUSH string ""}; NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/infinite_loop.tz b/src/bin_client/test/contracts/infinite_loop.tz index dc78d4d33..77cdbc48c 100644 --- a/src/bin_client/test/contracts/infinite_loop.tz +++ b/src/bin_client/test/contracts/infinite_loop.tz @@ -1,4 +1,3 @@ parameter unit; storage unit; -return unit; -code { DROP; PUSH bool True; LOOP {PUSH bool True}; UNIT; UNIT; PAIR } +code { DROP; PUSH bool True; LOOP {PUSH bool True}; UNIT; NIL operation; PAIR } diff --git a/src/bin_client/test/contracts/insertion_sort.tz b/src/bin_client/test/contracts/insertion_sort.tz index 47c7014f4..cc7ff0ed4 100644 --- a/src/bin_client/test/contracts/insertion_sort.tz +++ b/src/bin_client/test/contracts/insertion_sort.tz @@ -1,7 +1,5 @@ - parameter (list int); -return (list int); -storage unit; +storage (list int); code { CAR; # Access list # Insert procedure LAMBDA (pair int (list int)) @@ -23,5 +21,5 @@ code { CAR; # Access list {DUP; CAR; DIP{CDR}; CONS}; REDUCE}; NIL int; SWAP; DIP{SWAP}; # Accumulator for reverse onto - REDUCE; # Execute reverse onto - UNIT; SWAP; PAIR} # Calling convention + REDUCE; # Execute reverse onto + NIL operation; PAIR} # Calling convention diff --git a/src/bin_client/test/contracts/int_publisher.tz b/src/bin_client/test/contracts/int_publisher.tz index db8da7c10..b81af3813 100644 --- a/src/bin_client/test/contracts/int_publisher.tz +++ b/src/bin_client/test/contracts/int_publisher.tz @@ -1,9 +1,5 @@ -# NONE if user wants to get the value -# SOME (signed hash of the string, string) +# (signed hash of the string, string) parameter (option (pair signature int)); -return int; -# The key used to update the contract -# The data storage (pair key int); code {DUP; DUP; CAR; IF_NONE {PUSH tez "1.00"; # Fee pattern from July 26 @@ -18,4 +14,4 @@ code {DUP; DUP; CAR; # Revert the update. This could be replaced with FAIL {DROP; DUP; CDR; DIP{CDDR}}}; # Cleanup - SWAP; PAIR} + DIP{DROP}; NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/king_of_tez.tz b/src/bin_client/test/contracts/king_of_tez.tz index 3f3c978ac..796325f30 100644 --- a/src/bin_client/test/contracts/king_of_tez.tz +++ b/src/bin_client/test/contracts/king_of_tez.tz @@ -1,11 +1,11 @@ parameter key_hash; storage (pair timestamp (pair tez key_hash)); -return unit; code { DUP; CDAR; # If the time is more than 2 weeks, any amount makes you king NOW; CMPGT; # User becomes king of tez - IF { CAR; AMOUNT; PAIR; NOW; PUSH int 604800; ADD; PAIR } + IF { CAR; AMOUNT; PAIR; NOW; PUSH int 604800; ADD; PAIR; + NIL operation } # Check balance to see if user has paid enough to become the new king { DUP; CDDAR; AMOUNT; CMPLT; IF { FAIL } # user has not paid out @@ -13,6 +13,7 @@ code { DUP; CDAR; # New storage DIP{ AMOUNT; PAIR; NOW; PUSH int 604800; ADD; PAIR }; # Pay funds to old king - IMPLICIT_ACCOUNT; AMOUNT; UNIT; TRANSFER_TOKENS; DROP }}; + IMPLICIT_ACCOUNT; AMOUNT; UNIT; TRANSFER_TOKENS; + NIL operation; SWAP; CONS}}; # Cleanup - UNIT; PAIR }; + PAIR }; diff --git a/src/bin_client/test/contracts/list_id.tz b/src/bin_client/test/contracts/list_id.tz index 75a99e7c5..6cd3693a1 100644 --- a/src/bin_client/test/contracts/list_id.tz +++ b/src/bin_client/test/contracts/list_id.tz @@ -1,4 +1,3 @@ parameter (list string); -return (list string); -storage unit; -code {} +storage (list string); +code {CAR; NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/list_id_map.tz b/src/bin_client/test/contracts/list_id_map.tz index 3ae75b50f..e82cc2918 100644 --- a/src/bin_client/test/contracts/list_id_map.tz +++ b/src/bin_client/test/contracts/list_id_map.tz @@ -1,4 +1,3 @@ parameter (list string); -return (list string); -storage unit; -code {CAR; LAMBDA string string {}; MAP; UNIT; SWAP; PAIR} +storage (list string); +code {CAR; LAMBDA string string {}; MAP; NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/list_iter.tz b/src/bin_client/test/contracts/list_iter.tz index d09b75a24..df904d882 100644 --- a/src/bin_client/test/contracts/list_iter.tz +++ b/src/bin_client/test/contracts/list_iter.tz @@ -1,6 +1,5 @@ parameter (list int); -storage unit; -return int; +storage int; code { CAR; PUSH int 1; SWAP; ITER { MUL }; - UNIT; SWAP; PAIR} + NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/list_iter2.tz b/src/bin_client/test/contracts/list_iter2.tz index 39fd7706c..caf3e5771 100644 --- a/src/bin_client/test/contracts/list_iter2.tz +++ b/src/bin_client/test/contracts/list_iter2.tz @@ -1,6 +1,5 @@ parameter (list string); -return string; -storage unit; +storage string; code { CAR; PUSH string ""; SWAP; ITER { CONCAT }; - UNIT; SWAP; PAIR} + NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/list_map_block.tz b/src/bin_client/test/contracts/list_map_block.tz index a404af562..b5202dd9b 100644 --- a/src/bin_client/test/contracts/list_map_block.tz +++ b/src/bin_client/test/contracts/list_map_block.tz @@ -1,6 +1,5 @@ parameter (list int); -return (list int); -storage unit; +storage (list int); code { CAR; PUSH int 0; SWAP; MAP { DIP{DUP}; ADD; DIP{PUSH int 1; ADD}}; - UNIT; SWAP; PAIR; DIP{DROP}} + NIL operation; PAIR; DIP{DROP}} diff --git a/src/bin_client/test/contracts/list_of_transactions.tz b/src/bin_client/test/contracts/list_of_transactions.tz index 1be3259e3..039ff7596 100644 --- a/src/bin_client/test/contracts/list_of_transactions.tz +++ b/src/bin_client/test/contracts/list_of_transactions.tz @@ -1,9 +1,8 @@ - parameter unit; -storage (list (contract unit unit)); -return unit; -code { CDR; PUSH bool True; # Setup loop +storage (list (contract unit)); +code { CDR; DUP; + DIP {NIL operation}; PUSH bool True; # Setup loop LOOP {IF_CONS { PUSH tez "1.00"; UNIT; TRANSFER_TOKENS; # Make transfer - DROP; PUSH bool True} # Setup for next round of loop - { NIL (contract unit unit); PUSH bool False}}; # Data to satisfy types and end loop - UNIT; PAIR}; # Calling convention + SWAP; DIP {CONS}; PUSH bool True} # Setup for next round of loop + { NIL (contract unit); PUSH bool False}}; # Data to satisfy types and end loop + DROP; PAIR}; # Calling convention diff --git a/src/bin_client/test/contracts/lockup.tz b/src/bin_client/test/contracts/lockup.tz index 5b3f68516..5fffa36ec 100644 --- a/src/bin_client/test/contracts/lockup.tz +++ b/src/bin_client/test/contracts/lockup.tz @@ -1,6 +1,5 @@ parameter unit; -storage (pair timestamp (pair tez (contract unit unit))); -return unit; +storage (pair timestamp (pair tez (contract unit))); code { CDR; # Ignore the parameter DUP; # Duplicate the storage CAR; # Get the timestamp @@ -14,5 +13,6 @@ code { CDR; # Ignore the parameter CAR; # Get the amount of the transfer on top of the stack DIP{CDR}; # Put the contract underneath it UNIT; # Put the contract's argument type on top of the stack - TRANSFER_TOKENS; # Make the transfer + TRANSFER_TOKENS; # Emit the transfer + NIL operation; SWAP; CONS;# Make a singleton list of internal operations PAIR} # Pair up to meet the calling convention diff --git a/src/bin_client/test/contracts/loop_left.tz b/src/bin_client/test/contracts/loop_left.tz index 80bad5de5..64bcc76c8 100644 --- a/src/bin_client/test/contracts/loop_left.tz +++ b/src/bin_client/test/contracts/loop_left.tz @@ -1,8 +1,7 @@ parameter (list string); -return (list string); -storage unit; +storage (list string); code { CAR; NIL string; SWAP; PAIR; LEFT (list string); LOOP_LEFT { DUP; CAR; DIP{CDR}; IF_CONS { SWAP; DIP{CONS}; PAIR; LEFT (list string) } { RIGHT (pair (list string) (list string)) }; }; - UNIT; SWAP; PAIR } + NIL operation; PAIR } diff --git a/src/bin_client/test/contracts/macro_annotations.tz b/src/bin_client/test/contracts/macro_annotations.tz index fdc374061..368ba6a0c 100644 --- a/src/bin_client/test/contracts/macro_annotations.tz +++ b/src/bin_client/test/contracts/macro_annotations.tz @@ -1,6 +1,6 @@ -return unit; parameter unit; -storage unit; -code { PUSH unit Unit ; +storage (pair @truc unit unit); +code { DROP; UNIT ; UNIT ; PAIR ; UNIT ; DUUP @truc ; - DROP ; DROP } + DIP { DROP ; DROP } ; + NIL operation ; PAIR } diff --git a/src/bin_client/test/contracts/map_caddaadr.tz b/src/bin_client/test/contracts/map_caddaadr.tz index 75ea96744..b0b436795 100644 --- a/src/bin_client/test/contracts/map_caddaadr.tz +++ b/src/bin_client/test/contracts/map_caddaadr.tz @@ -1,4 +1,4 @@ parameter unit; storage (pair (pair nat (pair nat (pair (pair (pair nat tez) nat) nat))) nat); -return unit; -code { MAP_CDADDAADR { PUSH tez "1.00" ; ADD } }; +code { MAP_CDADDAADR { PUSH tez "1.00" ; ADD } ; + NIL operation ; SWAP; SET_CAR }; diff --git a/src/bin_client/test/contracts/map_car.tz b/src/bin_client/test/contracts/map_car.tz index 6d8dab481..7c50bffd6 100644 --- a/src/bin_client/test/contracts/map_car.tz +++ b/src/bin_client/test/contracts/map_car.tz @@ -1,4 +1,3 @@ parameter bool; storage (pair bool nat); -return unit; -code { DUP; CAR; DIP{CDR}; SWAP; MAP_CAR { AND } ; UNIT; PAIR }; +code { DUP; CAR; DIP{CDR}; SWAP; MAP_CAR { AND }; NIL operation; PAIR }; diff --git a/src/bin_client/test/contracts/map_id.tz b/src/bin_client/test/contracts/map_id.tz index 2d2981bb1..ff0a3bbbf 100644 --- a/src/bin_client/test/contracts/map_id.tz +++ b/src/bin_client/test/contracts/map_id.tz @@ -1,4 +1,3 @@ parameter (map nat nat); -return (map nat nat); -storage unit; -code {} +storage (map nat nat); +code { CAR ; NIL operation ; PAIR } diff --git a/src/bin_client/test/contracts/map_iter.tz b/src/bin_client/test/contracts/map_iter.tz index 2e1716330..1872c4906 100644 --- a/src/bin_client/test/contracts/map_iter.tz +++ b/src/bin_client/test/contracts/map_iter.tz @@ -1,7 +1,6 @@ parameter (map int int); -return (pair int int); -storage unit; +storage (pair int int); code { CAR; PUSH int 0; DUP; PAIR; SWAP; ITER { DIP {DUP; CAR; DIP{CDR}}; DUP; # Last instr DIP{CAR; ADD}; SWAP; DIP{CDR; ADD}; PAIR }; - UNIT; SWAP; PAIR} + NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/map_size.tz b/src/bin_client/test/contracts/map_size.tz index befa00755..4bd6417e6 100644 --- a/src/bin_client/test/contracts/map_size.tz +++ b/src/bin_client/test/contracts/map_size.tz @@ -1,4 +1,3 @@ parameter (map string nat); -return nat; -storage unit; -code {CAR; SIZE; UNIT; SWAP; PAIR} +storage nat; +code {CAR; SIZE; NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/max_in_list.tz b/src/bin_client/test/contracts/max_in_list.tz index 65a8ce4c6..229b37729 100644 --- a/src/bin_client/test/contracts/max_in_list.tz +++ b/src/bin_client/test/contracts/max_in_list.tz @@ -1,10 +1,9 @@ parameter (list int); -storage unit; -return (option int); +storage (option int); code {CAR; DIP{NONE int}; LAMBDA (pair int (option int)) (option int) {DUP; DUP; CAR; SWAP; CDR; IF_NONE {DIP{DROP}; SOME} {CMPGT; IF {CDR} {CAR; SOME}}}; - REDUCE; UNIT; SWAP; PAIR}; + REDUCE; NIL operation; PAIR}; diff --git a/src/bin_client/test/contracts/min.tz b/src/bin_client/test/contracts/min.tz index 5a7ac2643..cedd835bb 100644 --- a/src/bin_client/test/contracts/min.tz +++ b/src/bin_client/test/contracts/min.tz @@ -1,13 +1,11 @@ parameter (pair int int); -return int; -storage unit; +storage int; code { CAR; # Ignore the storage DUP; # Duplicate so we can get both the numbers passed as parameters DUP; # Second dup so we can access the lesser number CAR; DIP{CDR}; # Unpack the numbers on top of the stack CMPLT; # Compare the two numbers, placing a boolean on top of the stack IF {CAR} {CDR}; # Access the first number if the boolean was true - UNIT; # Push storage value - SWAP; # Correct order for calling convention pair + NIL operation; # Return no op PAIR} # Pair the numbers satisfying the calling convention diff --git a/src/bin_client/test/contracts/noop.tz b/src/bin_client/test/contracts/noop.tz index 54a511a24..bd19da15c 100644 --- a/src/bin_client/test/contracts/noop.tz +++ b/src/bin_client/test/contracts/noop.tz @@ -1,4 +1,3 @@ parameter unit; -code {}; -return unit; storage unit; +code {CDR; NIL operation; PAIR}; diff --git a/src/bin_client/test/contracts/not.tz b/src/bin_client/test/contracts/not.tz index b6155da09..f89394072 100644 --- a/src/bin_client/test/contracts/not.tz +++ b/src/bin_client/test/contracts/not.tz @@ -1,4 +1,3 @@ parameter bool; -return bool; -storage unit; -code {CAR; NOT; UNIT; SWAP; PAIR}; +storage (option bool); +code {CAR; NOT; SOME; NIL operation; PAIR}; diff --git a/src/bin_client/test/contracts/or.tz b/src/bin_client/test/contracts/or.tz index 1b45ccc8f..89d533c44 100644 --- a/src/bin_client/test/contracts/or.tz +++ b/src/bin_client/test/contracts/or.tz @@ -1,5 +1,3 @@ parameter (pair bool bool); -return bool; -storage unit; -code {CAR; DUP; CAR; SWAP; CDR; OR; - UNIT; SWAP; PAIR}; +storage (option bool); +code {CAR; DUP; CAR; SWAP; CDR; OR; SOME; NIL operation; PAIR}; diff --git a/src/bin_client/test/contracts/originator.tz b/src/bin_client/test/contracts/originator.tz index a03ab3fe5..777c2223a 100644 --- a/src/bin_client/test/contracts/originator.tz +++ b/src/bin_client/test/contracts/originator.tz @@ -1,9 +1,8 @@ -storage unit ; parameter nat ; -return (list (contract unit unit)) ; +storage (list (contract unit)) ; code { CAR ; DUP ; PUSH nat 0 ; CMPNEQ ; - DIIP { NIL (contract unit unit) } ; + DIIP { NIL (contract unit) } ; LOOP { PUSH tez "5.00" ; PUSH bool True ; # delegatable @@ -14,4 +13,4 @@ code PUSH nat 1 ; SWAP ; SUB ; ABS ; DUP ; PUSH nat 0 ; CMPNEQ } ; DROP ; - UNIT ; SWAP ; PAIR } + NIL operation ; PAIR } diff --git a/src/bin_client/test/contracts/pair_id.tz b/src/bin_client/test/contracts/pair_id.tz index 0284956e5..3bfedf2d8 100644 --- a/src/bin_client/test/contracts/pair_id.tz +++ b/src/bin_client/test/contracts/pair_id.tz @@ -1,4 +1,3 @@ parameter (pair bool bool); -return (pair bool bool); -storage unit; -code {} +storage (option (pair bool bool)); +code {CAR; SOME; NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/pair_macro.tz b/src/bin_client/test/contracts/pair_macro.tz index ab9246e17..db8f6a8a8 100644 --- a/src/bin_client/test/contracts/pair_macro.tz +++ b/src/bin_client/test/contracts/pair_macro.tz @@ -1,4 +1,4 @@ parameter unit; -return unit; storage unit; -code { UNIT; UNIT; UNIT; UNIT; UNIT; PAIAAIAIAIR @name; DROP} +code { UNIT; UNIT; UNIT; UNIT; UNIT; PAIAAIAIAIR @name; DROP; + CDR; NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/parameterizable_payments.tz b/src/bin_client/test/contracts/parameterizable_payments.tz deleted file mode 100644 index 2d95dafe2..000000000 --- a/src/bin_client/test/contracts/parameterizable_payments.tz +++ /dev/null @@ -1,26 +0,0 @@ -parameter (or (pair string (pair tez (contract unit unit))) nat); -return unit; -storage (pair (contract nat (pair nat bool)) (pair nat (map nat (pair string (pair tez (contract unit unit)))))); -code { DUP; DIP{CDR}; CAR; # Get the input while preserving the output - IF_LEFT { DIP{ DUP; CAR; SWAP; CDR; DUP; CAR; DIP{CDR}}; - SOME; SWAP; DUP; DIP{UPDATE}; # Add the element to the map - PUSH nat 1; ADD; PAIR; SWAP; # Add 1 to the index - PAIR; UNIT; PAIR} # Cleanup and finish - # Check our other contract to see if the transaction is allowed - { DIP{DUP; CAR}; PUSH tez "0.00"; SWAP; TRANSFER_TOKENS; - # Arrange the stack - DUP; CDR; - IF { CAR; DUP; DIIP{DUP; CDDR; DUP}; - DIP{ GET; # Get the value of the data - IF_NONE {FAIL} {}; # This should not happen - SWAP; - NONE (pair string (pair tez (contract unit unit)))}; - UPDATE; # Delete the element - SWAP; - # More stack arranging - DIP{ SWAP; DUP; CAR; DIP{CDR}}; - DIP{DIP{CAR; PAIR}; PAIR}; - DUP; CDAR; - DIP{CDDR}; UNIT; TRANSFER_TOKENS; # Make the transfer - PAIR} - { FAIL }}} diff --git a/src/bin_client/test/contracts/parameterized_multisig.tz b/src/bin_client/test/contracts/parameterized_multisig.tz index 22c7f94ac..cc1eb7057 100644 --- a/src/bin_client/test/contracts/parameterized_multisig.tz +++ b/src/bin_client/test/contracts/parameterized_multisig.tz @@ -1,7 +1,6 @@ -storage (pair (map nat (pair bool bool)) (pair key key)); -return bool; +storage (pair bool (pair (map nat (pair bool bool)) (pair key key))); parameter (or nat (pair signature nat)); -code { DUP; CAR; DIP{CDR}; # Stack rangling +code { DUP; CAR; DIP{CDDR}; # Stack rangling IF_LEFT { DIP{DUP; CAR}; GET; # Get the value stored for that index IF_NONE { PUSH bool False} # If not referenced, reject { DUP; CAR; DIP{CDR}; AND}; @@ -21,4 +20,5 @@ code { DUP; CAR; DIP{CDR}; # Stack rangling CAR; PUSH bool True; SWAP; PAIR; SOME; SWAP} {FAIL}}; # Update the stored value and finish off - UPDATE; PAIR; PUSH bool False; PAIR}} + UPDATE; PAIR; PUSH bool False; PAIR}; + NIL operation; PAIR } diff --git a/src/bin_client/test/contracts/publisher_payouts.tz b/src/bin_client/test/contracts/publisher_payouts.tz deleted file mode 100644 index 15bca5d55..000000000 --- a/src/bin_client/test/contracts/publisher_payouts.tz +++ /dev/null @@ -1,17 +0,0 @@ -parameter unit; -storage (option - (pair (pair (contract unit unit) (contract unit unit)) - (pair (pair timestamp (contract (option (pair signature int)) int)) - (pair tez int)))); -return unit; -code { CDR; IF_NONE {FAIL} {}; # Check if settlement has already ocurred - DUP; CDAAR; NOW; CMPLT; IF {FAIL} {}; # Check the timestamp - DUP; CDADR; DIP{SOME}; PUSH tez "1.01"; NONE (pair signature int); - TRANSFER_TOKENS; DIP{IF_NONE{FAIL} {}}; - DIP{DUP; CDDR; DUP; CDR}; CMPGT; - SWAP; - DIP{ IF {CAAR} {CADR}; - DIP{ NONE (pair (pair (contract unit unit) (contract unit unit)) - (pair (pair timestamp (contract (option (pair signature int)) int)) - (pair tez int)))}}; - CAR; UNIT; TRANSFER_TOKENS; PAIR} diff --git a/src/bin_client/test/contracts/queue.tz b/src/bin_client/test/contracts/queue.tz index 10a894fea..a074906dd 100644 --- a/src/bin_client/test/contracts/queue.tz +++ b/src/bin_client/test/contracts/queue.tz @@ -1,9 +1,8 @@ parameter (option string); -storage (pair (pair nat nat) (map nat string)); -return (option string); +storage (pair (option string) (pair (pair nat nat) (map nat string))); code { DUP; CAR; # Retrieving an element - IF_NONE { CDR; DUP; CAR; DIP{CDR; DUP}; DUP; + IF_NONE { CDDR; DUP; CAR; DIP{CDR; DUP}; DUP; CAR; SWAP; DIP{GET}; # Check if an element is available SWAP; # Put NONE on stack and finish @@ -15,10 +14,11 @@ code { DUP; CAR; DUP; CAR; PUSH nat 1; ADD; DIP{ CDR }; PAIR; PAIR}; PAIR }} # Arrange the stack - { DIP{DUP; CDAR; DIP{CDDR}; DUP}; SWAP; CAR; + { DIP{DUP; CDDAR; DIP{CDDDR}; DUP}; SWAP; CAR; # Add the element to the map DIP{ SOME; SWAP; CDR; DUP; DIP{UPDATE}; # Increment the second number PUSH nat 1; ADD}; # Cleanup and finish - PAIR; PAIR; NONE string; PAIR }} + PAIR; PAIR; NONE string; PAIR }; + NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/reduce_map.tz b/src/bin_client/test/contracts/reduce_map.tz index f112ff283..3f8f17d3f 100644 --- a/src/bin_client/test/contracts/reduce_map.tz +++ b/src/bin_client/test/contracts/reduce_map.tz @@ -1,7 +1,6 @@ parameter (pair (lambda int int) (list int)); -return (list int); -storage unit; +storage (list int); code { DIP{NIL int}; CAR; DUP; @@ -19,4 +18,4 @@ code { DIP{NIL int}; (list int) {DUP; CAR; DIP{CDR}; CONS}; REDUCE; # Correct list order - UNIT; SWAP; PAIR} # Calling convention + NIL operation; PAIR} # Calling convention diff --git a/src/bin_client/test/contracts/reentrancy.tz b/src/bin_client/test/contracts/reentrancy.tz index f30f21ae5..5d9ec49c1 100644 --- a/src/bin_client/test/contracts/reentrancy.tz +++ b/src/bin_client/test/contracts/reentrancy.tz @@ -1,6 +1,7 @@ parameter unit; -storage (pair (contract unit unit) (contract unit unit)); -return unit; +storage (pair (contract unit) (contract unit)); code { CDR; DUP; CAR; PUSH tez "5.00"; UNIT; - TRANSFER_TOKENS; DROP; DUP; CDR; - PUSH tez "5.00"; UNIT; TRANSFER_TOKENS; PAIR }; + TRANSFER_TOKENS; + DIP {DUP; CDR; + PUSH tez "5.00"; UNIT; TRANSFER_TOKENS}; + DIIP{NIL operation};DIP{CONS};CONS;PAIR}; diff --git a/src/bin_client/test/contracts/ret_int.tz b/src/bin_client/test/contracts/ret_int.tz index e6415d413..720a99568 100644 --- a/src/bin_client/test/contracts/ret_int.tz +++ b/src/bin_client/test/contracts/ret_int.tz @@ -1,4 +1,3 @@ parameter unit; -code {CAR; PUSH nat 300; PAIR}; -return nat; -storage unit; +storage (option nat); +code {DROP; PUSH nat 300; SOME; NIL operation; PAIR}; diff --git a/src/bin_client/test/contracts/reverse.tz b/src/bin_client/test/contracts/reverse.tz index 08a110e41..24419bc54 100644 --- a/src/bin_client/test/contracts/reverse.tz +++ b/src/bin_client/test/contracts/reverse.tz @@ -1,8 +1,7 @@ parameter (list string); -storage unit; -return (list string); +storage (list string); code { CAR; NIL string; SWAP; LAMBDA (pair string (list string)) (list string) {DUP; CAR; DIP{CDR}; CONS}; - REDUCE; UNIT; SWAP; PAIR}; + REDUCE; NIL operation; PAIR}; diff --git a/src/bin_client/test/contracts/reverse_loop.tz b/src/bin_client/test/contracts/reverse_loop.tz index ca626c4ec..d8117135c 100644 --- a/src/bin_client/test/contracts/reverse_loop.tz +++ b/src/bin_client/test/contracts/reverse_loop.tz @@ -1,6 +1,5 @@ parameter (list string); -return (list string); -storage unit; +storage (list string); code { CAR; NIL string; SWAP; PUSH bool True; LOOP { IF_CONS {SWAP; DIP{CONS}; PUSH bool True} {NIL string; PUSH bool False}}; - DROP; UNIT; SWAP; PAIR} + DROP; NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/self.tz b/src/bin_client/test/contracts/self.tz index ab682c252..728cd5f1d 100644 --- a/src/bin_client/test/contracts/self.tz +++ b/src/bin_client/test/contracts/self.tz @@ -1,4 +1,3 @@ parameter unit ; -storage (contract unit unit) ; -return unit ; -code { MAP_CDR { DROP ; SELF } } +storage (contract unit) ; +code { DROP ; SELF ; NIL operation ; PAIR } diff --git a/src/bin_client/test/contracts/set_caddaadr.tz b/src/bin_client/test/contracts/set_caddaadr.tz index 8a55c4109..39878a962 100644 --- a/src/bin_client/test/contracts/set_caddaadr.tz +++ b/src/bin_client/test/contracts/set_caddaadr.tz @@ -1,6 +1,5 @@ parameter tez; storage (pair (pair nat (pair nat (pair (pair (pair nat tez) nat) nat))) nat); -return unit; code { DUP ; CAR ; SWAP ; CDR ; SET_CADDAADR @annot ; - UNIT ; PAIR }; + NIL operation ; PAIR }; diff --git a/src/bin_client/test/contracts/set_car.tz b/src/bin_client/test/contracts/set_car.tz index 4c0d24c77..ec63718d6 100644 --- a/src/bin_client/test/contracts/set_car.tz +++ b/src/bin_client/test/contracts/set_car.tz @@ -1,4 +1,3 @@ parameter string; storage (pair string nat); -return (pair string nat); -code { DUP; CDR; DIP{CAR}; SET_CAR @hello; DUP; PAIR }; +code { DUP; CDR; DIP{CAR}; SET_CAR @hello; NIL operation; PAIR }; diff --git a/src/bin_client/test/contracts/set_cdr.tz b/src/bin_client/test/contracts/set_cdr.tz index 549787cfd..f4080a5e1 100644 --- a/src/bin_client/test/contracts/set_cdr.tz +++ b/src/bin_client/test/contracts/set_cdr.tz @@ -1,4 +1,3 @@ parameter nat; storage (pair string nat); -return (pair string nat); -code { DUP; CDR; DIP{CAR}; SET_CDR @annot; DUP; PAIR }; +code { DUP; CDR; DIP{CAR}; SET_CDR @annot; NIL operation; PAIR }; diff --git a/src/bin_client/test/contracts/set_id.tz b/src/bin_client/test/contracts/set_id.tz index e98f7f8fd..ede301b0e 100644 --- a/src/bin_client/test/contracts/set_id.tz +++ b/src/bin_client/test/contracts/set_id.tz @@ -1,4 +1,3 @@ parameter (set string); -return (set string); -storage unit; -code {} +storage (set string); +code { CAR ; NIL operation ; PAIR } diff --git a/src/bin_client/test/contracts/set_iter.tz b/src/bin_client/test/contracts/set_iter.tz index 27985ca20..55d8ae34a 100644 --- a/src/bin_client/test/contracts/set_iter.tz +++ b/src/bin_client/test/contracts/set_iter.tz @@ -1,4 +1,3 @@ parameter (set int); -return int; -storage unit; -code { CAR; PUSH int 0; SWAP; ITER { ADD }; UNIT; SWAP; PAIR } +storage int; +code { CAR; PUSH int 0; SWAP; ITER { ADD }; NIL operation; PAIR } diff --git a/src/bin_client/test/contracts/set_member.tz b/src/bin_client/test/contracts/set_member.tz index 3aa55693d..ae97cce14 100644 --- a/src/bin_client/test/contracts/set_member.tz +++ b/src/bin_client/test/contracts/set_member.tz @@ -1,4 +1,3 @@ parameter string; -storage (set string); -return bool; -code {DUP; CAR; DIP{CDR}; MEM; DIP{EMPTY_SET string}; PAIR}; +storage (pair (set string) (option bool)); +code {DUP; DUP; CAR; DIP{CDAR}; MEM; SOME; DIP {CDAR}; SWAP; PAIR ; NIL operation; PAIR}; diff --git a/src/bin_client/test/contracts/set_size.tz b/src/bin_client/test/contracts/set_size.tz index 0fb1b10ad..aa055cb02 100644 --- a/src/bin_client/test/contracts/set_size.tz +++ b/src/bin_client/test/contracts/set_size.tz @@ -1,4 +1,3 @@ parameter (set int); -storage unit; -return nat; -code {CAR; SIZE; UNIT; SWAP; PAIR} +storage nat; +code {CAR; SIZE; NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/spawn_identities.tz b/src/bin_client/test/contracts/spawn_identities.tz index 48ef21d29..5c6b47337 100644 --- a/src/bin_client/test/contracts/spawn_identities.tz +++ b/src/bin_client/test/contracts/spawn_identities.tz @@ -1,6 +1,5 @@ parameter nat; -return unit; -storage (list (contract string string)); +storage (list (contract string)); code { DUP; CAR; # Get the number DIP{CDR}; # Put the accumulator on the stack @@ -8,20 +7,16 @@ code { DUP; LOOP { DUP; PUSH nat 0; CMPEQ; # Check if the number is 0 IF { PUSH bool False} # End the loop { PUSH nat 1; SWAP; SUB; ABS; # Subtract 1. The ABS is to make it back into a nat - UNIT; # Storage type - LAMBDA (pair string unit) # Identity contract - (pair string unit) - {}; + PUSH string "init"; # Storage type + LAMBDA (pair string string) # Identity contract + (pair (list operation) string) + { CAR ; NIL operation ; PAIR }; PUSH tez "5.00"; # Strating balance PUSH bool False; DUP; # Not spendable or delegatable NONE key_hash; - # This is once again my key from the alphanet. - # I highly encourage you to send funds to it - # Will it help you? Will it help me? The answer is no, - # However, do it anyway PUSH key_hash "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"; CREATE_CONTRACT; # Make the contract SWAP; # Add to the list DIP{CONS}; PUSH bool True}}; # Continue the loop - DROP; UNIT; PAIR} # Calling convention + DROP; NIL operation; PAIR} # Calling convention diff --git a/src/bin_client/test/contracts/steps_to_quota.tz b/src/bin_client/test/contracts/steps_to_quota.tz index 35a1cea7e..4981864be 100644 --- a/src/bin_client/test/contracts/steps_to_quota.tz +++ b/src/bin_client/test/contracts/steps_to_quota.tz @@ -1,4 +1,3 @@ parameter unit; -return nat; -storage unit; -code {DROP; UNIT; STEPS_TO_QUOTA; PAIR}; +storage nat; +code {DROP; STEPS_TO_QUOTA; NIL operation; PAIR}; diff --git a/src/bin_client/test/contracts/store_input.tz b/src/bin_client/test/contracts/store_input.tz index 1ccaf78e1..4eee565ca 100644 --- a/src/bin_client/test/contracts/store_input.tz +++ b/src/bin_client/test/contracts/store_input.tz @@ -1,4 +1,3 @@ parameter string; -return unit; storage string; -code {CAR; UNIT; PAIR}; +code {CAR; NIL operation; PAIR}; diff --git a/src/bin_client/test/contracts/store_now.tz b/src/bin_client/test/contracts/store_now.tz index c88f7980f..1a868ac06 100644 --- a/src/bin_client/test/contracts/store_now.tz +++ b/src/bin_client/test/contracts/store_now.tz @@ -1,4 +1,3 @@ parameter unit; storage timestamp; -return unit; -code {DROP; NOW; UNIT; PAIR}; +code {DROP; NOW; NIL operation; PAIR}; diff --git a/src/bin_client/test/contracts/str_id.tz b/src/bin_client/test/contracts/str_id.tz index 1fc1cd60c..f9e0710c3 100644 --- a/src/bin_client/test/contracts/str_id.tz +++ b/src/bin_client/test/contracts/str_id.tz @@ -1,4 +1,3 @@ parameter string; -return string; -storage unit; -code {}; +storage (option string); +code { CAR ; SOME ; NIL operation ; PAIR }; diff --git a/src/bin_client/test/contracts/strategy_proxy.tz b/src/bin_client/test/contracts/strategy_proxy.tz deleted file mode 100644 index f80c90078..000000000 --- a/src/bin_client/test/contracts/strategy_proxy.tz +++ /dev/null @@ -1,9 +0,0 @@ -parameter nat; -storage (pair (option nat) (contract (or nat (pair signature nat)) bool)); -return (pair nat bool); -code { DUP; CAR; DIP{CDDR; DUP}; DUP; DIP{SOME; PAIR; SWAP}; # Store the nat in strorage - # Query our stored contract - LEFT (pair signature nat); DIP{PUSH tez "0.00"}; TRANSFER_TOKENS; - # Cleanup and finish - DIP{DUP; CAR}; DIP{IF_NONE {FAIL} {}}; SWAP; - PAIR; DIP{CDR; NONE nat; PAIR}; PAIR} diff --git a/src/bin_client/test/contracts/sub_timestamp_delta.tz b/src/bin_client/test/contracts/sub_timestamp_delta.tz index df7e98b35..f154e9524 100644 --- a/src/bin_client/test/contracts/sub_timestamp_delta.tz +++ b/src/bin_client/test/contracts/sub_timestamp_delta.tz @@ -1,4 +1,3 @@ parameter (pair timestamp int); -storage unit; -return timestamp; -code { CAR; DUP; CAR; DIP{CDR}; SUB; UNIT; SWAP; PAIR} +storage timestamp; +code { CAR; DUP; CAR; DIP{CDR}; SUB; NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/subset.tz b/src/bin_client/test/contracts/subset.tz index 6924c57fe..f06e1054e 100644 --- a/src/bin_client/test/contracts/subset.tz +++ b/src/bin_client/test/contracts/subset.tz @@ -1,6 +1,5 @@ parameter (pair (set string) (set string)); -return bool; -storage unit; +storage bool; code { CAR; DUP; CDR; DIP{CAR}; # Unpack lists PUSH bool True; PAIR; SWAP; # Setup accumulator @@ -15,4 +14,4 @@ code { CAR; DUP; CDR; DIP{CAR}; # Unpack lists PAIR}; REDUCE; # Reduce CAR; # Get the accumulator value - UNIT; SWAP; PAIR} # Calling convention + NIL operation; PAIR} # Calling convention diff --git a/src/bin_client/test/contracts/swap_left_right.tz b/src/bin_client/test/contracts/swap_left_right.tz index 00bcfcbf0..d5650c034 100644 --- a/src/bin_client/test/contracts/swap_left_right.tz +++ b/src/bin_client/test/contracts/swap_left_right.tz @@ -1,4 +1,3 @@ parameter (or bool string); -return (or string bool); -storage unit; -code {CAR; IF_LEFT {RIGHT string} {LEFT bool}; UNIT; SWAP; PAIR}; +storage (or string bool); +code {CAR; IF_LEFT {RIGHT string} {LEFT bool}; NIL operation; PAIR}; diff --git a/src/bin_client/test/contracts/swap_storage_input.tz b/src/bin_client/test/contracts/swap_storage_input.tz deleted file mode 100644 index a63a2179b..000000000 --- a/src/bin_client/test/contracts/swap_storage_input.tz +++ /dev/null @@ -1,9 +0,0 @@ - -parameter string; -return string; -storage string; # Note that all three values are of the same type -code { DUP; # In order to access both the storage and parameter, I need to duplicate the (pair parameter storage) - CAR; # Access the parameter - SWAP; # Exchange top and second element on the stack - CDR; # Get the storage in the pair - PAIR}; # Generate pair of elements diff --git a/src/bin_client/test/contracts/swap_storage_input_dip.tz b/src/bin_client/test/contracts/swap_storage_input_dip.tz deleted file mode 100644 index 5459623e1..000000000 --- a/src/bin_client/test/contracts/swap_storage_input_dip.tz +++ /dev/null @@ -1,8 +0,0 @@ - -parameter string; -storage string; -return string; -code { DUP; # Duplicate the (pair parameter storage) - CDR; # Access the storage - DIP{CAR}; # Access the parameter, but leave the storage unchanged on top of the stack - PAIR} # Pair the elements, fulfilling the calling convention diff --git a/src/bin_client/test/contracts/take_my_money.tz b/src/bin_client/test/contracts/take_my_money.tz index 9ddbebf4a..86cd1624b 100644 --- a/src/bin_client/test/contracts/take_my_money.tz +++ b/src/bin_client/test/contracts/take_my_money.tz @@ -1,9 +1,9 @@ parameter key_hash; -return unit; storage unit; code { CAR; IMPLICIT_ACCOUNT; # Create an account for the recipient of the funds DIP{UNIT}; # Push a value of the storage type below the contract PUSH tez "1.00"; # The person can have a ęś© UNIT; # Push the contract's argument type TRANSFER_TOKENS; # Run the transfer + NIL operation; SWAP; CONS; PAIR }; # Cleanup and put the return values diff --git a/src/bin_client/test/contracts/tez_add_sub.tz b/src/bin_client/test/contracts/tez_add_sub.tz index ad3a1c2d9..ad8bae659 100644 --- a/src/bin_client/test/contracts/tez_add_sub.tz +++ b/src/bin_client/test/contracts/tez_add_sub.tz @@ -1,6 +1,5 @@ parameter (pair tez tez); -storage unit; -return (pair tez tez); +storage (option (pair tez tez)); code {CAR; DUP; DUP; CAR; DIP{CDR}; ADD; DIP{DUP; CAR; DIP{CDR}; SUB}; - PAIR; UNIT; SWAP; PAIR}; + PAIR; SOME; NIL operation; PAIR}; diff --git a/src/bin_client/test/contracts/transfer_amount.tz b/src/bin_client/test/contracts/transfer_amount.tz index 1e562b603..8da204e83 100644 --- a/src/bin_client/test/contracts/transfer_amount.tz +++ b/src/bin_client/test/contracts/transfer_amount.tz @@ -1,4 +1,3 @@ parameter unit; storage tez; -return unit; -code { DROP; AMOUNT; UNIT; PAIR }; +code { DROP; AMOUNT; NIL operation; PAIR }; diff --git a/src/bin_client/test/contracts/transfer_to.tz b/src/bin_client/test/contracts/transfer_to.tz index c4a8673f5..bb8445bfe 100644 --- a/src/bin_client/test/contracts/transfer_to.tz +++ b/src/bin_client/test/contracts/transfer_to.tz @@ -1,4 +1,5 @@ -parameter (contract unit unit); -return unit; +parameter (contract unit); storage unit; -code {CAR; DIP{UNIT}; PUSH tez "100.00"; UNIT; TRANSFER_TOKENS; PAIR}; +code { CAR; DIP{UNIT}; PUSH tez "100.00"; UNIT; + TRANSFER_TOKENS; + NIL operation; SWAP; CONS; PAIR}; diff --git a/src/bin_client/test/contracts/two_vulnerabilities.tz b/src/bin_client/test/contracts/two_vulnerabilities.tz deleted file mode 100644 index 96786e639..000000000 --- a/src/bin_client/test/contracts/two_vulnerabilities.tz +++ /dev/null @@ -1,7 +0,0 @@ - -parameter unit; -storage (pair (contract unit unit) (contract unit unit)); -return unit; -code { CDR; DUP; CAR; PUSH tez "5.00"; UNIT; - TRANSFER_TOKENS; DROP; DUP; CDR; - PUSH tez "5.00"; UNIT; TRANSFER_TOKENS; PAIR }; diff --git a/src/bin_client/test/contracts/unpair_macro.tz b/src/bin_client/test/contracts/unpair_macro.tz index 12a4578df..6a33e2290 100644 --- a/src/bin_client/test/contracts/unpair_macro.tz +++ b/src/bin_client/test/contracts/unpair_macro.tz @@ -1,4 +1,3 @@ parameter unit; storage unit; -return unit; -code { UNIT; UNIT; UNIT; UNIT; PAIAAIR; UNPAIAAIR; DROP; DROP; DROP; DROP } +code { UNIT; UNIT; UNIT; UNIT; PAIAAIR; UNPAIAAIR; DROP; DROP; DROP; DROP; CAR; NIL operation; PAIR } diff --git a/src/bin_client/test/contracts/weather_insurance.tz b/src/bin_client/test/contracts/weather_insurance.tz index d437f87fa..fc0a05ada 100644 --- a/src/bin_client/test/contracts/weather_insurance.tz +++ b/src/bin_client/test/contracts/weather_insurance.tz @@ -1,10 +1,9 @@ # (pair signed_weather_data actual_level) parameter (pair (signature @sig) (nat @nat)); # (pair (under_key over_key) (pair weather_service_key (pair rain_level days_in_future))) -storage (pair (pair (contract @lt unit unit) - (contract @geq unit unit)) +storage (pair (pair (contract @lt unit) + (contract @geq unit)) (pair nat key)); -return unit; code { DUP; DUP; CAR; MAP_CDR{H}; SWAP; CDDDR; CHECK_SIGNATURE; # Check if the data has been correctly signed @@ -14,5 +13,6 @@ code { DUP; DUP; DIP{CADR}; # Get actual rain CDDAR; # Get rain threshold CMPLT; IF {CAR @winner} {CDR @winner}; # Select contract to receive tokens - BALANCE; UNIT; TRANSFER_TOKENS; # Setup and execute transfer - PAIR }; # Save storage + BALANCE; UNIT ; TRANSFER_TOKENS; # Setup and execute transfer + NIL operation ; SWAP ; CONS ; + PAIR }; diff --git a/src/bin_client/test/contracts/xor.tz b/src/bin_client/test/contracts/xor.tz index f7185a14a..ab8dcf57d 100644 --- a/src/bin_client/test/contracts/xor.tz +++ b/src/bin_client/test/contracts/xor.tz @@ -1,4 +1,3 @@ parameter (pair bool bool); -return bool; -storage unit; -code {CAR; DUP; CAR; DIP{CDR}; XOR; UNIT; SWAP; PAIR}; +storage (option bool); +code {CAR; DUP; CAR; DIP{CDR}; XOR; SOME; NIL operation ; PAIR}; diff --git a/src/bin_client/test/test_contracts.sh b/src/bin_client/test/test_contracts.sh index 6c9665235..72ece71e3 100755 --- a/src/bin_client/test/test_contracts.sh +++ b/src/bin_client/test/test_contracts.sh @@ -30,275 +30,275 @@ fi # FORMAT: assert_output contract_file storage input expected_result -assert_output $contract_dir/ret_int.tz Unit Unit 300 +assert_storage $contract_dir/ret_int.tz None Unit '(Some 300)' # Identity on strings -assert_output $contract_dir/str_id.tz Unit '"Hello"' '"Hello"' -assert_output $contract_dir/str_id.tz Unit '"abcd"' '"abcd"' +assert_storage $contract_dir/str_id.tz None '"Hello"' '(Some "Hello")' +assert_storage $contract_dir/str_id.tz None '"abcd"' '(Some "abcd")' # Identity on pairs -assert_output $contract_dir/pair_id.tz Unit '(Pair True False)' '(Pair True False)' -assert_output $contract_dir/pair_id.tz Unit '(Pair False True)' '(Pair False True)' -assert_output $contract_dir/pair_id.tz Unit '(Pair True True)' '(Pair True True)' -assert_output $contract_dir/pair_id.tz Unit '(Pair False False)' '(Pair False False)' +assert_storage $contract_dir/pair_id.tz None '(Pair True False)' '(Some (Pair True False))' +assert_storage $contract_dir/pair_id.tz None '(Pair False True)' '(Some (Pair False True))' +assert_storage $contract_dir/pair_id.tz None '(Pair True True)' '(Some (Pair True True))' +assert_storage $contract_dir/pair_id.tz None '(Pair False False)' '(Some (Pair False False))' # Logical not -assert_output $contract_dir/not.tz Unit True False -assert_output $contract_dir/not.tz Unit False True +assert_storage $contract_dir/not.tz None True '(Some False)' +assert_storage $contract_dir/not.tz None False '(Some True)' # Logical and -assert_output $contract_dir/and.tz Unit "(Pair False False)" False -assert_output $contract_dir/and.tz Unit "(Pair False True)" False -assert_output $contract_dir/and.tz Unit "(Pair True False)" False -assert_output $contract_dir/and.tz Unit "(Pair True True)" True +assert_storage $contract_dir/and.tz None "(Pair False False)" '(Some False)' +assert_storage $contract_dir/and.tz None "(Pair False True)" '(Some False)' +assert_storage $contract_dir/and.tz None "(Pair True False)" '(Some False)' +assert_storage $contract_dir/and.tz None "(Pair True True)" '(Some True)' # Logical or -assert_output $contract_dir/or.tz Unit "(Pair False False)" False -assert_output $contract_dir/or.tz Unit "(Pair False True)" True -assert_output $contract_dir/or.tz Unit "(Pair True False)" True -assert_output $contract_dir/or.tz Unit "(Pair True True)" True +assert_storage $contract_dir/or.tz None "(Pair False False)" '(Some False)' +assert_storage $contract_dir/or.tz None "(Pair False True)" '(Some True)' +assert_storage $contract_dir/or.tz None "(Pair True False)" '(Some True)' +assert_storage $contract_dir/or.tz None "(Pair True True)" '(Some True)' # XOR -assert_output $contract_dir/xor.tz Unit "(Pair False False)" False -assert_output $contract_dir/xor.tz Unit "(Pair False True)" True -assert_output $contract_dir/xor.tz Unit "(Pair True False)" True -assert_output $contract_dir/xor.tz Unit "(Pair True True)" False +assert_storage $contract_dir/xor.tz None "(Pair False False)" '(Some False)' +assert_storage $contract_dir/xor.tz None "(Pair False True)" '(Some True)' +assert_storage $contract_dir/xor.tz None "(Pair True False)" '(Some True)' +assert_storage $contract_dir/xor.tz None "(Pair True True)" '(Some False)' # Build list -assert_output $contract_dir/build_list.tz Unit 0 "{ 0 }" -assert_output $contract_dir/build_list.tz Unit 3 "{ 0 ; 1 ; 2 ; 3 }" -assert_output $contract_dir/build_list.tz Unit 10 \ +assert_storage $contract_dir/build_list.tz '{}' 0 "{ 0 }" +assert_storage $contract_dir/build_list.tz '{}' 3 "{ 0 ; 1 ; 2 ; 3 }" +assert_storage $contract_dir/build_list.tz '{}' 10 \ "{ 0 ; 1 ; 2 ; 3 ; 4 ; 5 ; 6 ; 7 ; 8 ; 9 ; 10 }" # Concatenate all strings of a list into one string -assert_output $contract_dir/concat_list.tz Unit '{ "a" ; "b" ; "c" }' '"abc"' -assert_output $contract_dir/concat_list.tz Unit '{}' '""' -assert_output $contract_dir/concat_list.tz \ - Unit '{ "Hello" ; " " ; "World" ; "!" }' '"Hello World!"' +assert_storage $contract_dir/concat_list.tz '""' '{ "a" ; "b" ; "c" }' '"abc"' +assert_storage $contract_dir/concat_list.tz '""' '{}' '""' +assert_storage $contract_dir/concat_list.tz \ + '""' '{ "Hello" ; " " ; "World" ; "!" }' '"Hello World!"' # Find maximum int in list -- returns None if not found -assert_output $contract_dir/max_in_list.tz Unit '{}' 'None' -assert_output $contract_dir/max_in_list.tz Unit '{ 1 }' '(Some 1)' -assert_output $contract_dir/max_in_list.tz Unit '{ -1 }' '(Some -1)' -assert_output $contract_dir/max_in_list.tz Unit \ +assert_storage $contract_dir/max_in_list.tz None '{}' 'None' +assert_storage $contract_dir/max_in_list.tz None '{ 1 }' '(Some 1)' +assert_storage $contract_dir/max_in_list.tz None '{ -1 }' '(Some -1)' +assert_storage $contract_dir/max_in_list.tz None \ '{ 10 ; -1 ; -20 ; 100 ; 0 }' '(Some 100)' -assert_output $contract_dir/max_in_list.tz Unit \ +assert_storage $contract_dir/max_in_list.tz None \ '{ 10 ; -1 ; -20 ; 100 ; 0 }' '(Some 100)' -assert_output $contract_dir/max_in_list.tz Unit \ +assert_storage $contract_dir/max_in_list.tz None \ '{ -10 ; -1 ; -20 ; -100 }' '(Some -1)' # Identity on lists -assert_output $contract_dir/list_id.tz Unit '{ "1" ; "2" ; "3" }' '{ "1" ; "2" ; "3" }' -assert_output $contract_dir/list_id.tz Unit '{}' '{}' -assert_output $contract_dir/list_id.tz Unit '{ "a" ; "b" ; "c" }' '{ "a" ; "b" ; "c" }' +assert_storage $contract_dir/list_id.tz '{""}' '{ "1" ; "2" ; "3" }' '{ "1" ; "2" ; "3" }' +assert_storage $contract_dir/list_id.tz '{""}' '{}' '{}' +assert_storage $contract_dir/list_id.tz '{""}' '{ "a" ; "b" ; "c" }' '{ "a" ; "b" ; "c" }' -assert_output $contract_dir/list_id_map.tz Unit '{ "1" ; "2" ; "3" }' '{ "1" ; "2" ; "3" }' -assert_output $contract_dir/list_id_map.tz Unit '{}' '{}' -assert_output $contract_dir/list_id_map.tz Unit '{ "a" ; "b" ; "c" }' '{ "a" ; "b" ; "c" }' +assert_storage $contract_dir/list_id_map.tz '{""}' '{ "1" ; "2" ; "3" }' '{ "1" ; "2" ; "3" }' +assert_storage $contract_dir/list_id_map.tz '{""}' '{}' '{}' +assert_storage $contract_dir/list_id_map.tz '{""}' '{ "a" ; "b" ; "c" }' '{ "a" ; "b" ; "c" }' # Identity on maps -assert_output $contract_dir/map_id.tz Unit '{ Elt 0 1 }' '{ Elt 0 1 }' -assert_output $contract_dir/map_id.tz Unit '{ Elt 0 0 }' '{ Elt 0 0 }' -assert_output $contract_dir/map_id.tz Unit '{ Elt 0 0 ; Elt 3 4 }' '{ Elt 0 0 ; Elt 3 4 }' +assert_storage $contract_dir/map_id.tz '{}' '{ Elt 0 1 }' '{ Elt 0 1 }' +assert_storage $contract_dir/map_id.tz '{}' '{ Elt 0 0 }' '{ Elt 0 0 }' +assert_storage $contract_dir/map_id.tz '{}' '{ Elt 0 0 ; Elt 3 4 }' '{ Elt 0 0 ; Elt 3 4 }' # Map block on lists -assert_output $contract_dir/list_map_block.tz Unit '{}' '{}' -assert_output $contract_dir/list_map_block.tz Unit '{ 1 ; 1 ; 1 ; 1 }' '{ 1 ; 2 ; 3 ; 4 }' -assert_output $contract_dir/list_map_block.tz Unit '{ 1 ; 2 ; 3 ; 0 }' '{ 1 ; 3 ; 5 ; 3 }' +assert_storage $contract_dir/list_map_block.tz '{0}' '{}' '{}' +assert_storage $contract_dir/list_map_block.tz '{0}' '{ 1 ; 1 ; 1 ; 1 }' '{ 1 ; 2 ; 3 ; 4 }' +assert_storage $contract_dir/list_map_block.tz '{0}' '{ 1 ; 2 ; 3 ; 0 }' '{ 1 ; 3 ; 5 ; 3 }' # List iter -assert_output $contract_dir/list_iter.tz Unit '{ 10 ; 2 ; 1 }' 20 -assert_output $contract_dir/list_iter.tz Unit '{ 3 ; 6 ; 9 }' 162 +assert_storage $contract_dir/list_iter.tz 0 '{ 10 ; 2 ; 1 }' 20 +assert_storage $contract_dir/list_iter.tz 0 '{ 3 ; 6 ; 9 }' 162 -assert_output $contract_dir/list_iter2.tz Unit '{ "a" ; "b" ; "c" }' '"cba"' -assert_output $contract_dir/list_iter2.tz Unit '{}' '""' +assert_storage $contract_dir/list_iter2.tz '"?"' '{ "a" ; "b" ; "c" }' '"cba"' +assert_storage $contract_dir/list_iter2.tz '"?"' '{}' '""' # Identity on sets -assert_output $contract_dir/set_id.tz Unit '{ "a" ; "b" ; "c" }' '{ "a" ; "b" ; "c" }' -assert_output $contract_dir/set_id.tz Unit '{}' '{}' -assert_output $contract_dir/set_id.tz Unit '{ "asdf" ; "bcde" }' '{ "asdf" ; "bcde" }' +assert_storage $contract_dir/set_id.tz '{}' '{ "a" ; "b" ; "c" }' '{ "a" ; "b" ; "c" }' +assert_storage $contract_dir/set_id.tz '{}' '{}' '{}' +assert_storage $contract_dir/set_id.tz '{}' '{ "asdf" ; "bcde" }' '{ "asdf" ; "bcde" }' # Set member -- set is in storage -assert_output $contract_dir/set_member.tz '{}' '"Hi"' 'False' -assert_output $contract_dir/set_member.tz '{ "Hi" }' '"Hi"' 'True' -assert_output $contract_dir/set_member.tz '{ "Hello" ; "World" }' '""' 'False' +assert_storage $contract_dir/set_member.tz '(Pair {} None)' '"Hi"' '(Pair {} (Some False))' +assert_storage $contract_dir/set_member.tz '(Pair { "Hi" } None)' '"Hi"' '(Pair { "Hi" } (Some True))' +assert_storage $contract_dir/set_member.tz '(Pair { "Hello" ; "World" } None)' '""' '(Pair { "Hello" ; "World" } (Some False))' # Set size -assert_output $contract_dir/set_size.tz Unit '{}' 0 -assert_output $contract_dir/set_size.tz Unit '{ 1 }' 1 -assert_output $contract_dir/set_size.tz Unit '{ 1 ; 2 ; 3 }' 3 -assert_output $contract_dir/set_size.tz Unit '{ 1 ; 2 ; 3 ; 4 ; 5 ; 6 }' 6 +assert_storage $contract_dir/set_size.tz 111 '{}' 0 +assert_storage $contract_dir/set_size.tz 111 '{ 1 }' 1 +assert_storage $contract_dir/set_size.tz 111 '{ 1 ; 2 ; 3 }' 3 +assert_storage $contract_dir/set_size.tz 111 '{ 1 ; 2 ; 3 ; 4 ; 5 ; 6 }' 6 # Set iter -assert_output $contract_dir/set_iter.tz Unit '{}' 0 -assert_output $contract_dir/set_iter.tz Unit '{ 1 }' 1 -assert_output $contract_dir/set_iter.tz Unit '{ -100 ; 1 ; 2 ; 3 }' '-94' +assert_storage $contract_dir/set_iter.tz 111 '{}' 0 +assert_storage $contract_dir/set_iter.tz 111 '{ 1 }' 1 +assert_storage $contract_dir/set_iter.tz 111 '{ -100 ; 1 ; 2 ; 3 }' '-94' # Map size -assert_output $contract_dir/map_size.tz Unit '{}' 0 -assert_output $contract_dir/map_size.tz Unit '{ Elt "a" 1 }' 1 -assert_output $contract_dir/map_size.tz Unit \ +assert_storage $contract_dir/map_size.tz 111 '{}' 0 +assert_storage $contract_dir/map_size.tz 111 '{ Elt "a" 1 }' 1 +assert_storage $contract_dir/map_size.tz 111 \ '{ Elt "a" 1 ; Elt "b" 2 ; Elt "c" 3 }' 3 -assert_output $contract_dir/map_size.tz Unit \ +assert_storage $contract_dir/map_size.tz 111 \ '{ Elt "a" 1 ; Elt "b" 2 ; Elt "c" 3 ; Elt "d" 4 ; Elt "e" 5 ; Elt "f" 6 }' 6 # Contains all elements -- does the second list contain all of the same elements # as the first one? I'm ignoring element multiplicity -assert_output $contract_dir/contains_all.tz \ - Unit '(Pair {} {})' 'True' -assert_output $contract_dir/contains_all.tz \ - Unit '(Pair { "a" } { "B" })' 'False' -assert_output $contract_dir/contains_all.tz \ - Unit '(Pair { "A" } { "B" })' 'False' -assert_output $contract_dir/contains_all.tz \ - Unit '(Pair { "B" } { "B" })' 'True' -assert_output $contract_dir/contains_all.tz Unit \ - '(Pair { "B" ; "C" ; "asdf" } { "B" ; "B" ; "asdf" ; "C" })' 'True' -assert_output $contract_dir/contains_all.tz Unit \ - '(Pair { "B" ; "B" ; "asdf" ; "C" } { "B" ; "C" ; "asdf" })' 'True' +assert_storage $contract_dir/contains_all.tz \ + None '(Pair {} {})' '(Some True)' +assert_storage $contract_dir/contains_all.tz \ + None '(Pair { "a" } { "B" })' '(Some False)' +assert_storage $contract_dir/contains_all.tz \ + None '(Pair { "A" } { "B" })' '(Some False)' +assert_storage $contract_dir/contains_all.tz \ + None '(Pair { "B" } { "B" })' '(Some True)' +assert_storage $contract_dir/contains_all.tz None \ + '(Pair { "B" ; "C" ; "asdf" } { "B" ; "B" ; "asdf" ; "C" })' '(Some True)' +assert_storage $contract_dir/contains_all.tz None \ + '(Pair { "B" ; "B" ; "asdf" ; "C" } { "B" ; "C" ; "asdf" })' '(Some True)' # Concatenate the string in storage with all strings in the given list -assert_output $contract_dir/concat_hello.tz Unit \ +assert_storage $contract_dir/concat_hello.tz '{}' \ '{ "World!" }' '{ "Hello World!" }' -assert_output $contract_dir/concat_hello.tz Unit \ +assert_storage $contract_dir/concat_hello.tz '{}' \ '{}' '{}' -assert_output $contract_dir/concat_hello.tz Unit \ +assert_storage $contract_dir/concat_hello.tz '{}' \ '{ "test1" ; "test2" }' '{ "Hello test1" ; "Hello test2" }' # Create an empty map and add a string to it -assert_output $contract_dir/empty_map.tz Unit Unit \ +assert_storage $contract_dir/empty_map.tz '{}' Unit \ '{ Elt "hello" "world" }' # Get the value stored at the given key in the map -assert_output $contract_dir/get_map_value.tz '{ Elt "hello" "hi" }' \ - '"hello"' '(Some "hi")' -assert_output $contract_dir/get_map_value.tz '{ Elt "hello" "hi" }' \ - '""' 'None' -assert_output $contract_dir/get_map_value.tz \ - '{ Elt "1" "one" ; Elt "2" "two" }' \ - '"1"' '(Some "one")' +assert_storage $contract_dir/get_map_value.tz '(Pair None { Elt "hello" "hi" })' \ + '"hello"' '(Pair (Some "hi") { Elt "hello" "hi" })' +assert_storage $contract_dir/get_map_value.tz '(Pair None { Elt "hello" "hi" })' \ + '""' '(Pair None { Elt "hello" "hi" })' +assert_storage $contract_dir/get_map_value.tz \ + '(Pair None { Elt "1" "one" ; Elt "2" "two" })' \ + '"1"' '(Pair (Some "one") { Elt "1" "one" ; Elt "2" "two" })' # Map iter -assert_output $contract_dir/map_iter.tz Unit '{ Elt 0 100 ; Elt 2 100 }' '(Pair 2 200)' -assert_output $contract_dir/map_iter.tz Unit '{ Elt 1 1 ; Elt 2 100 }' '(Pair 3 101)' +assert_storage $contract_dir/map_iter.tz '(Pair 0 0)' '{ Elt 0 100 ; Elt 2 100 }' '(Pair 2 200)' +assert_storage $contract_dir/map_iter.tz '(Pair 0 0)' '{ Elt 1 1 ; Elt 2 100 }' '(Pair 3 101)' # Return True if True branch of if was taken and False otherwise -assert_output $contract_dir/if.tz Unit True True -assert_output $contract_dir/if.tz Unit False False +assert_storage $contract_dir/if.tz None True '(Some True)' +assert_storage $contract_dir/if.tz None False '(Some False)' # Generate a pair of or types -assert_output $contract_dir/swap_left_right.tz Unit '(Left True)' '(Right True)' -assert_output $contract_dir/swap_left_right.tz Unit '(Right "a")' '(Left "a")' +assert_storage $contract_dir/swap_left_right.tz '(Left "X")' '(Left True)' '(Right True)' +assert_storage $contract_dir/swap_left_right.tz '(Left "X")' '(Right "a")' '(Left "a")' # Reverse a list -assert_output $contract_dir/reverse.tz Unit '{}' '{}' -assert_output $contract_dir/reverse.tz Unit '{ "c" ; "b" ; "a" }' '{ "a" ; "b" ; "c" }' -assert_output $contract_dir/reverse_loop.tz Unit '{}' '{}' -assert_output $contract_dir/reverse_loop.tz Unit '{ "c" ; "b" ; "a" }' '{ "a" ; "b" ; "c" }' +assert_storage $contract_dir/reverse.tz '{""}' '{}' '{}' +assert_storage $contract_dir/reverse.tz '{""}' '{ "c" ; "b" ; "a" }' '{ "a" ; "b" ; "c" }' +assert_storage $contract_dir/reverse_loop.tz '{""}' '{}' '{}' +assert_storage $contract_dir/reverse_loop.tz '{""}' '{ "c" ; "b" ; "a" }' '{ "a" ; "b" ; "c" }' # Reverse using LOOP_LEFT -assert_output $contract_dir/loop_left.tz Unit '{}' '{}' -assert_output $contract_dir/loop_left.tz Unit '{ "c" ; "b" ; "a" }' '{ "a" ; "b" ; "c" }' +assert_storage $contract_dir/loop_left.tz '{""}' '{}' '{}' +assert_storage $contract_dir/loop_left.tz '{""}' '{ "c" ; "b" ; "a" }' '{ "a" ; "b" ; "c" }' # Exec concat contract -assert_output $contract_dir/exec_concat.tz Unit '""' '"_abc"' -assert_output $contract_dir/exec_concat.tz Unit '"test"' '"test_abc"' +assert_storage $contract_dir/exec_concat.tz '"?"' '""' '"_abc"' +assert_storage $contract_dir/exec_concat.tz '"?"' '"test"' '"test_abc"' # Get current steps to quota -assert_output $contract_dir/steps_to_quota.tz Unit Unit 39989 +assert_storage $contract_dir/steps_to_quota.tz 111 Unit 399992 # Get the current balance of the contract -assert_output $contract_dir/balance.tz Unit Unit '"4,000,000"' +assert_storage $contract_dir/balance.tz '"111"' Unit '"4,000,000"' # Test comparisons on tez { EQ ; GT ; LT ; GE ; LE } -assert_output $contract_dir/compare.tz Unit '(Pair "1.00" "2.00")' '{ False ; False ; True ; False ; True }' -assert_output $contract_dir/compare.tz Unit '(Pair "2.00" "1.00")' '{ False ; True ; False ; True ; False }' -assert_output $contract_dir/compare.tz Unit '(Pair "2.37" "2.37")' '{ True ; False ; False ; True ; True }' +assert_storage $contract_dir/compare.tz '{}' '(Pair "1.00" "2.00")' '{ False ; False ; True ; False ; True }' +assert_storage $contract_dir/compare.tz '{}' '(Pair "2.00" "1.00")' '{ False ; True ; False ; True ; False }' +assert_storage $contract_dir/compare.tz '{}' '(Pair "2.37" "2.37")' '{ True ; False ; False ; True ; True }' # Test addition and subtraction on tez -assert_output $contract_dir/tez_add_sub.tz Unit '(Pair "2" "1")' '(Pair "3" "1")' -assert_output $contract_dir/tez_add_sub.tz Unit '(Pair "2.31" "1.01")' '(Pair "3.32" "1.3")' +assert_storage $contract_dir/tez_add_sub.tz None '(Pair "2" "1")' '(Some (Pair "3" "1"))' +assert_storage $contract_dir/tez_add_sub.tz None '(Pair "2.31" "1.01")' '(Some (Pair "3.32" "1.3"))' # Test get first element of list -assert_output $contract_dir/first.tz Unit '{ 1 ; 2 ; 3 ; 4 }' '1' -assert_output $contract_dir/first.tz Unit '{ 4 }' '4' +assert_storage $contract_dir/first.tz '111' '{ 1 ; 2 ; 3 ; 4 }' '1' +assert_storage $contract_dir/first.tz '111' '{ 4 }' '4' # Hash input string # Test assumed to be correct -- hash is based on encoding of AST -assert_output $contract_dir/hash_string.tz Unit '"abcdefg"' '"exprv3MnhXvjthGzZ7jDtXRRFremZyey9rsGtL7JRkeaQX1fThN7WF"' -assert_output $contract_dir/hash_string.tz Unit '"12345"' '"expru81QVHsW2qaWLNHnMHSxDNhqtat17ajadri6mKUvXyc2EWHZC3"' +assert_storage $contract_dir/hash_string.tz '"?"' '"abcdefg"' '"exprv3MnhXvjthGzZ7jDtXRRFremZyey9rsGtL7JRkeaQX1fThN7WF"' +assert_storage $contract_dir/hash_string.tz '"?"' '"12345"' '"expru81QVHsW2qaWLNHnMHSxDNhqtat17ajadri6mKUvXyc2EWHZC3"' # Test ASSERT -assert_output $contract_dir/assert.tz Unit True Unit -assert_fails ${TZCLIENT} run program $contract_dir/assert.tz on storage Unit and input False +assert_storage $contract_dir/assert.tz Unit True Unit +assert_fails $client run program $contract_dir/assert.tz on storage Unit and input False # COMPARE; ASSERT_ -assert_output $contract_dir/assert_eq.tz Unit '(Pair -1 -1)' Unit -assert_fails ${TZCLIENT} run program $contract_dir/assert_eq.tz on storage Unit and input '(Pair 0 -1)' +assert_storage $contract_dir/assert_eq.tz Unit '(Pair -1 -1)' Unit +assert_fails $client run program $contract_dir/assert_eq.tz on storage Unit and input '(Pair 0 -1)' -assert_output $contract_dir/assert_eq.tz Unit '(Pair -1 -1)' Unit -assert_fails ${TZCLIENT} run program $contract_dir/assert_eq.tz on storage Unit and input '(Pair 0 -1)' +assert_storage $contract_dir/assert_eq.tz Unit '(Pair -1 -1)' Unit +assert_fails $client run program $contract_dir/assert_eq.tz on storage Unit and input '(Pair 0 -1)' -assert_output $contract_dir/assert_neq.tz Unit '(Pair 0 -1)' Unit -assert_fails ${TZCLIENT} run program $contract_dir/assert_neq.tz on storage Unit and input '(Pair -1 -1)' +assert_storage $contract_dir/assert_neq.tz Unit '(Pair 0 -1)' Unit +assert_fails $client run program $contract_dir/assert_neq.tz on storage Unit and input '(Pair -1 -1)' -assert_output $contract_dir/assert_lt.tz Unit '(Pair -1 0)' Unit -assert_fails ${TZCLIENT} run program $contract_dir/assert_lt.tz on storage Unit and input '(Pair 0 -1)' -assert_fails ${TZCLIENT} run program $contract_dir/assert_lt.tz on storage Unit and input '(Pair 0 0)' +assert_storage $contract_dir/assert_lt.tz Unit '(Pair -1 0)' Unit +assert_fails $client run program $contract_dir/assert_lt.tz on storage Unit and input '(Pair 0 -1)' +assert_fails $client run program $contract_dir/assert_lt.tz on storage Unit and input '(Pair 0 0)' -assert_output $contract_dir/assert_le.tz Unit '(Pair 0 0)' Unit -assert_output $contract_dir/assert_le.tz Unit '(Pair -1 0)' Unit -assert_fails ${TZCLIENT} run program $contract_dir/assert_le.tz on storage Unit and input '(Pair 0 -1)' +assert_storage $contract_dir/assert_le.tz Unit '(Pair 0 0)' Unit +assert_storage $contract_dir/assert_le.tz Unit '(Pair -1 0)' Unit +assert_fails $client run program $contract_dir/assert_le.tz on storage Unit and input '(Pair 0 -1)' -assert_output $contract_dir/assert_gt.tz Unit '(Pair 0 -1)' Unit -assert_fails ${TZCLIENT} run program $contract_dir/assert_gt.tz on storage Unit and input '(Pair -1 0)' -assert_fails ${TZCLIENT} run program $contract_dir/assert_gt.tz on storage Unit and input '(Pair 0 0)' +assert_storage $contract_dir/assert_gt.tz Unit '(Pair 0 -1)' Unit +assert_fails $client run program $contract_dir/assert_gt.tz on storage Unit and input '(Pair -1 0)' +assert_fails $client run program $contract_dir/assert_gt.tz on storage Unit and input '(Pair 0 0)' -assert_output $contract_dir/assert_ge.tz Unit '(Pair 0 0)' Unit -assert_output $contract_dir/assert_ge.tz Unit '(Pair 0 -1)' Unit -assert_fails ${TZCLIENT} run program $contract_dir/assert_ge.tz on storage Unit and input '(Pair -1 0)' +assert_storage $contract_dir/assert_ge.tz Unit '(Pair 0 0)' Unit +assert_storage $contract_dir/assert_ge.tz Unit '(Pair 0 -1)' Unit +assert_fails $client run program $contract_dir/assert_ge.tz on storage Unit and input '(Pair -1 0)' # ASSERT_CMP -assert_output $contract_dir/assert_cmpeq.tz Unit '(Pair -1 -1)' Unit -assert_fails ${TZCLIENT} run program $contract_dir/assert_cmpeq.tz on storage Unit and input '(Pair 0 -1)' +assert_storage $contract_dir/assert_cmpeq.tz Unit '(Pair -1 -1)' Unit +assert_fails $client run program $contract_dir/assert_cmpeq.tz on storage Unit and input '(Pair 0 -1)' -assert_output $contract_dir/assert_cmpeq.tz Unit '(Pair -1 -1)' Unit -assert_fails ${TZCLIENT} run program $contract_dir/assert_cmpeq.tz on storage Unit and input '(Pair 0 -1)' +assert_storage $contract_dir/assert_cmpeq.tz Unit '(Pair -1 -1)' Unit +assert_fails $client run program $contract_dir/assert_cmpeq.tz on storage Unit and input '(Pair 0 -1)' -assert_output $contract_dir/assert_cmpneq.tz Unit '(Pair 0 -1)' Unit -assert_fails ${TZCLIENT} run program $contract_dir/assert_cmpneq.tz on storage Unit and input '(Pair -1 -1)' +assert_storage $contract_dir/assert_cmpneq.tz Unit '(Pair 0 -1)' Unit +assert_fails $client run program $contract_dir/assert_cmpneq.tz on storage Unit and input '(Pair -1 -1)' -assert_output $contract_dir/assert_cmplt.tz Unit '(Pair -1 0)' Unit -assert_fails ${TZCLIENT} run program $contract_dir/assert_cmplt.tz on storage Unit and input '(Pair 0 -1)' -assert_fails ${TZCLIENT} run program $contract_dir/assert_cmplt.tz on storage Unit and input '(Pair 0 0)' +assert_storage $contract_dir/assert_cmplt.tz Unit '(Pair -1 0)' Unit +assert_fails $client run program $contract_dir/assert_cmplt.tz on storage Unit and input '(Pair 0 -1)' +assert_fails $client run program $contract_dir/assert_cmplt.tz on storage Unit and input '(Pair 0 0)' -assert_output $contract_dir/assert_cmple.tz Unit '(Pair 0 0)' Unit -assert_output $contract_dir/assert_cmple.tz Unit '(Pair -1 0)' Unit -assert_fails ${TZCLIENT} run program $contract_dir/assert_cmple.tz on storage Unit and input '(Pair 0 -1)' +assert_storage $contract_dir/assert_cmple.tz Unit '(Pair 0 0)' Unit +assert_storage $contract_dir/assert_cmple.tz Unit '(Pair -1 0)' Unit +assert_fails $client run program $contract_dir/assert_cmple.tz on storage Unit and input '(Pair 0 -1)' -assert_output $contract_dir/assert_cmpgt.tz Unit '(Pair 0 -1)' Unit -assert_fails ${TZCLIENT} run program $contract_dir/assert_cmpgt.tz on storage Unit and input '(Pair -1 0)' -assert_fails ${TZCLIENT} run program $contract_dir/assert_cmpgt.tz on storage Unit and input '(Pair 0 0)' +assert_storage $contract_dir/assert_cmpgt.tz Unit '(Pair 0 -1)' Unit +assert_fails $client run program $contract_dir/assert_cmpgt.tz on storage Unit and input '(Pair -1 0)' +assert_fails $client run program $contract_dir/assert_cmpgt.tz on storage Unit and input '(Pair 0 0)' -assert_output $contract_dir/assert_cmpge.tz Unit '(Pair 0 0)' Unit -assert_output $contract_dir/assert_cmpge.tz Unit '(Pair 0 -1)' Unit -assert_fails ${TZCLIENT} run program $contract_dir/assert_cmpge.tz on storage Unit and input '(Pair -1 0)' +assert_storage $contract_dir/assert_cmpge.tz Unit '(Pair 0 0)' Unit +assert_storage $contract_dir/assert_cmpge.tz Unit '(Pair 0 -1)' Unit +assert_fails $client run program $contract_dir/assert_cmpge.tz on storage Unit and input '(Pair -1 0)' # IF_SOME -assert_output $contract_dir/if_some.tz Unit '(Some "hello")' '"hello"' -assert_output $contract_dir/if_some.tz Unit 'None' '""' +assert_storage $contract_dir/if_some.tz '"?"' '(Some "hello")' '"hello"' +assert_storage $contract_dir/if_some.tz '"?"' 'None' '""' # Tests the SET_CAR and SET_CDR instructions -assert_output $contract_dir/set_car.tz '(Pair "hello" 0)' '"world"' '(Pair "world" 0)' -assert_output $contract_dir/set_car.tz '(Pair "hello" 0)' '"abc"' '(Pair "abc" 0)' -assert_output $contract_dir/set_car.tz '(Pair "hello" 0)' '""' '(Pair "" 0)' +assert_storage $contract_dir/set_car.tz '(Pair "hello" 0)' '"world"' '(Pair "world" 0)' +assert_storage $contract_dir/set_car.tz '(Pair "hello" 0)' '"abc"' '(Pair "abc" 0)' +assert_storage $contract_dir/set_car.tz '(Pair "hello" 0)' '""' '(Pair "" 0)' -assert_output $contract_dir/set_cdr.tz '(Pair "hello" 0)' '1' '(Pair "hello" 1)' -assert_output $contract_dir/set_cdr.tz '(Pair "hello" 500)' '3' '(Pair "hello" 3)' -assert_output $contract_dir/set_cdr.tz '(Pair "hello" 7)' '100' '(Pair "hello" 100)' +assert_storage $contract_dir/set_cdr.tz '(Pair "hello" 0)' '1' '(Pair "hello" 1)' +assert_storage $contract_dir/set_cdr.tz '(Pair "hello" 500)' '3' '(Pair "hello" 3)' +assert_storage $contract_dir/set_cdr.tz '(Pair "hello" 7)' '100' '(Pair "hello" 100)' assert_storage $contract_dir/set_caddaadr.tz \ '(Pair (Pair 1 (Pair 2 (Pair (Pair (Pair 3 "0") 4) 5))) 6)' \ @@ -311,17 +311,20 @@ assert_storage $contract_dir/map_caddaadr.tz \ '(Pair (Pair 1 (Pair 2 (Pair (Pair (Pair 3 "1") 4) 5))) 6)' # Did the given key sign the string? (key is bootstrap1) -assert_output $contract_dir/check_signature.tz \ -'(Pair "1f19f8f37e80d96797b019f30d23ede6a26a0f698220f942103a3401f047623746e51a9c6e77e269b5df9593994ab96b001aae0f73728a2259187cb640b61e01" "hello")' \ -'"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav"' True +assert_success $client run program $contract_dir/check_signature.tz \ + on storage '(Pair "1f19f8f37e80d96797b019f30d23ede6a26a0f698220f942103a3401f047623746e51a9c6e77e269b5df9593994ab96b001aae0f73728a2259187cb640b61e01" "hello")' \ + and input '"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav"' + +assert_fails $client run program $contract_dir/check_signature.tz \ + on storage '(Pair "1f19f8f37e80d96797b019f30d23ede6a26a0f698220f942103a3401f047623746e51a9c6e77e269b5df9593994ab96b001aae0f73728a2259187cb640b61e01" "abcd")' \ + and input '"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav"' -assert_output $contract_dir/check_signature.tz \ -'(Pair "1f19f8f37e80d96797b019f30d23ede6a26a0f698220f942103a3401f047623746e51a9c6e77e269b5df9593994ab96b001aae0f73728a2259187cb640b61e01" "abcd")' \ -'"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav"' False # Convert a public key to a public key hash -assert_output $contract_dir/hash_key.tz Unit '"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav"' '"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx"' -assert_output $contract_dir/hash_key.tz Unit '"edpkuJqtDcA2m2muMxViSM47MPsGQzmyjnNTawUPqR8vZTAMcx61ES"' '"tz1XPTDmvT3vVE5Uunngmixm7gj7zmdbPq6k"' +assert_storage $contract_dir/hash_key.tz None '"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav"' \ + '(Some "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx")' +assert_storage $contract_dir/hash_key.tz None '"edpkuJqtDcA2m2muMxViSM47MPsGQzmyjnNTawUPqR8vZTAMcx61ES"' \ + '(Some "tz1XPTDmvT3vVE5Uunngmixm7gj7zmdbPq6k")' bake_after $client transfer 1,000 from bootstrap1 to $key1 @@ -349,22 +352,22 @@ bake_after $client transfer 500 from bootstrap1 to store_now -arg Unit assert_storage_contains store_now "$($client get timestamp)" # Test timestamp operations -assert_output $contract_dir/add_timestamp_delta.tz Unit '(Pair 100 100)' '"1970-01-01T00:03:20Z"' -assert_output $contract_dir/add_timestamp_delta.tz Unit '(Pair 100 -100)' '"1970-01-01T00:00:00Z"' -assert_output $contract_dir/add_timestamp_delta.tz Unit '(Pair "1970-01-01T00:00:00Z" 0)' '"1970-01-01T00:00:00Z"' +assert_storage $contract_dir/add_timestamp_delta.tz None '(Pair 100 100)' '(Some "1970-01-01T00:03:20Z")' +assert_storage $contract_dir/add_timestamp_delta.tz None '(Pair 100 -100)' '(Some "1970-01-01T00:00:00Z")' +assert_storage $contract_dir/add_timestamp_delta.tz None '(Pair "1970-01-01T00:00:00Z" 0)' '(Some "1970-01-01T00:00:00Z")' -assert_output $contract_dir/add_delta_timestamp.tz Unit '(Pair 100 100)' '"1970-01-01T00:03:20Z"' -assert_output $contract_dir/add_delta_timestamp.tz Unit '(Pair -100 100)' '"1970-01-01T00:00:00Z"' -assert_output $contract_dir/add_delta_timestamp.tz Unit '(Pair 0 "1970-01-01T00:00:00Z")' '"1970-01-01T00:00:00Z"' +assert_storage $contract_dir/add_delta_timestamp.tz None '(Pair 100 100)' '(Some "1970-01-01T00:03:20Z")' +assert_storage $contract_dir/add_delta_timestamp.tz None '(Pair -100 100)' '(Some "1970-01-01T00:00:00Z")' +assert_storage $contract_dir/add_delta_timestamp.tz None '(Pair 0 "1970-01-01T00:00:00Z")' '(Some "1970-01-01T00:00:00Z")' -assert_output $contract_dir/sub_timestamp_delta.tz Unit '(Pair 100 100)' '"1970-01-01T00:00:00Z"' -assert_output $contract_dir/sub_timestamp_delta.tz Unit '(Pair 100 -100)' '"1970-01-01T00:03:20Z"' -assert_output $contract_dir/sub_timestamp_delta.tz Unit '(Pair 100 2000000000000000000)' -1999999999999999900 +assert_storage $contract_dir/sub_timestamp_delta.tz 111 '(Pair 100 100)' '"1970-01-01T00:00:00Z"' +assert_storage $contract_dir/sub_timestamp_delta.tz 111 '(Pair 100 -100)' '"1970-01-01T00:03:20Z"' +assert_storage $contract_dir/sub_timestamp_delta.tz 111 '(Pair 100 2000000000000000000)' -1999999999999999900 -assert_output $contract_dir/diff_timestamps.tz Unit '(Pair 0 0)' 0 -assert_output $contract_dir/diff_timestamps.tz Unit '(Pair 0 1)' -1 -assert_output $contract_dir/diff_timestamps.tz Unit '(Pair 1 0)' 1 -assert_output $contract_dir/diff_timestamps.tz Unit '(Pair "1970-01-01T00:03:20Z" "1970-01-01T00:00:00Z")' 200 +assert_storage $contract_dir/diff_timestamps.tz 111 '(Pair 0 0)' 0 +assert_storage $contract_dir/diff_timestamps.tz 111 '(Pair 0 1)' -1 +assert_storage $contract_dir/diff_timestamps.tz 111 '(Pair 1 0)' 1 +assert_storage $contract_dir/diff_timestamps.tz 111 '(Pair "1970-01-01T00:03:20Z" "1970-01-01T00:00:00Z")' 200 # Tests TRANSFER_TO @@ -390,8 +393,13 @@ bake # Creates a contract, transfers data to it and stores the data init_with_transfer $contract_dir/create_contract.tz $key2 \ "\"$(get_contract_addr test_transfer_account1)\"" 1,000 bootstrap1 -bake_after $client transfer 0 from bootstrap1 to create_contract -arg '"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx"' -assert_storage_contains create_contract '"abcdefg"' +created_contract=\ +`$client transfer 0 from bootstrap1 to create_contract -arg '"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx"' \ +| grep 'New contract' \ +| sed -E 's/.*(TZ1[a-zA-Z0-9]+).*/\1/' \ +| head -1` +bake +assert_storage_contains $created_contract '"abcdefg"' # Test IMPLICIT_ACCOUNT init_with_transfer $contract_dir/default_account.tz $key1 \ @@ -418,10 +426,10 @@ assert_fails $client typecheck data '{ "A" ; "B" ; "B" }' against type '(set str hash_result=`$client hash data '(Pair "22220.00" (Pair "2017-12-13T04:49:00Z" 034))' \ of type '(pair tez (pair timestamp int))' | grep expr` -assert_output $contract_dir/hash_consistency_checker.tz Unit \ +assert_storage $contract_dir/hash_consistency_checker.tz '"?"' \ '(Pair "22220.00" (Pair "2017-12-13T04:49:00Z" 034))' "$hash_result" -assert_output $contract_dir/hash_consistency_checker.tz Unit \ +assert_storage $contract_dir/hash_consistency_checker.tz '"?"' \ '(Pair "22,220" (Pair "2017-12-13T04:49:00+00:00" 34))' "$hash_result" # Test for big maps diff --git a/src/bin_client/test/test_lib.inc.sh b/src/bin_client/test/test_lib.inc.sh index e94aae81e..dcd0756f8 100755 --- a/src/bin_client/test/test_lib.inc.sh +++ b/src/bin_client/test/test_lib.inc.sh @@ -85,24 +85,6 @@ run_contract_file () { $client run program "$contract" on storage "$storage" and input "$input" $amount_flag } -assert_output () { - local contract=$1; - local input=$2; - local storage=$3; - local expected=$4; - local amount=$5; - echo "Testing [$contract]" - local output=$(run_contract_file "$contract" "$input" "$storage" "$amount" | sed '1,/output/d' | - sed -e 's/^[[:space:]]*//' -e 's/[[:space:]]*$//' || - { printf '\nTest failed with error at line %s\n' "$(caller)" 1>&2; - exit 1; }); - if [ "$expected" != "$output" ]; then - echo "Test at " `caller` failed 1>&2 ; - printf "Expected %s but got %s" "$expected" "$output" 1>&2 ; - exit 1; - fi -} - assert_storage () { local contract=$1; local input=$2; @@ -206,6 +188,17 @@ assert() { fi } +assert_success() { + printf "[Asserting success]\n" + if "$@" 2> /dev/null; then + return 0 + else + printf "Expected command line to success, but failed:\n" + echo "$@" + exit 1 + fi +} + assert_fails() { printf "[Asserting failure]\n" if "$@" 2> /dev/null; then diff --git a/src/proto_alpha/lib_client/client_proto_context.ml b/src/proto_alpha/lib_client/client_proto_context.ml index 04f1c63f2..972ec6f86 100644 --- a/src/proto_alpha/lib_client/client_proto_context.ml +++ b/src/proto_alpha/lib_client/client_proto_context.ml @@ -36,6 +36,73 @@ let parse_expression arg = (Micheline_parser.no_parsing_error (Michelson_v1_parser.parse_expression arg)) +let pp_internal_operation ppf { source ; operation } = + Format.fprintf ppf "@[" ; + begin match operation with + | Alpha_context.Transaction { destination ; amount ; parameters } -> + Format.fprintf ppf + "@[Transaction:@,\ + Of: %a@,\ + From: %a@,\ + To: %a" + Tez.pp amount + Contract.pp source + Contract.pp destination ; + begin match parameters with + | None -> () + | Some expr -> + Format.fprintf ppf + "@,Parameter: @[%a@]" + Michelson_v1_printer.print_expr expr + end ; + Format.fprintf ppf "@]" ; + | Origination { manager ; delegate ; credit ; spendable ; delegatable ; script } -> + Format.fprintf ppf "@[Origination:@,\ + From: %a@,\ + For: %a@,\ + Credit: %a" + Contract.pp source + Signature.Public_key_hash.pp manager + Tez.pp credit ; + begin match script with + | None -> Format.fprintf ppf "@,No script (accepts all transactions)" + | Some { code ; storage } -> + Format.fprintf ppf + "@,@[Script:@,%a\ + @,@[Initial storage:@,%a@]" + Michelson_v1_printer.print_expr code + Michelson_v1_printer.print_expr storage + end ; + begin match delegate with + | None -> Format.fprintf ppf "@,Delegate is the manager" + | Some delegate -> Format.fprintf ppf "@,Delegate: %a" Signature.Public_key_hash.pp delegate + end ; + if spendable then Format.fprintf ppf "@,Spendable by its manager" ; + if delegatable then Format.fprintf ppf "@,Delegate can be changed later" ; + Format.fprintf ppf "@]" ; + | Reveal key -> + Format.fprintf ppf + "@[Revelation of manager public key:@,\ + Contract: %a@,\ + Key: %a@]" + Contract.pp source + Signature.Public_key.pp key + | Delegation None -> + Format.fprintf ppf + "@[Delegation:@,\ + Contract: %a@,\ + To: nobody@]" + Contract.pp source + | Delegation (Some delegate) -> + Format.fprintf ppf + "@[Delegation:@,\ + Contract: %a@,\ + To: %a@]" + Contract.pp source + Signature.Public_key_hash.pp delegate + end ; + Format.fprintf ppf "@]" + let transfer (cctxt : #Proto_alpha.full) block ?branch ~source ~src_pk ~src_sk ~destination ?arg ~amount ~fee ?gas_limit () = @@ -63,7 +130,7 @@ let transfer (cctxt : #Proto_alpha.full) let signed_bytes = Signature.concat bytes signature in let oph = Operation_hash.hash_bytes [ signed_bytes ] in Alpha_services.Helpers.apply_operation cctxt block - predecessor oph bytes (Some signature) >>=? fun (_, gas) -> + predecessor oph bytes (Some signature) >>=? fun (_, _, gas) -> match gas with | Limited { remaining } -> let gas = Z.sub max_gas remaining in @@ -85,7 +152,9 @@ let transfer (cctxt : #Proto_alpha.full) let signed_bytes = Signature.concat bytes signature in let oph = Operation_hash.hash_bytes [ signed_bytes ] in Alpha_services.Helpers.apply_operation cctxt block - predecessor oph bytes (Some signature) >>=? fun (contracts, _gas) -> + predecessor oph bytes (Some signature) >>=? fun (contracts, operations, _) -> + cctxt#message "@[This sequence of operations was run (including internal ones):@,%a@]" + (Format.pp_print_list pp_internal_operation) operations >>= fun () -> Shell_services.inject_operation cctxt ~chain_id signed_bytes >>=? fun injected_oph -> assert (Operation_hash.equal oph injected_oph) ; @@ -108,21 +177,24 @@ let reveal cctxt assert (Operation_hash.equal oph injected_oph) ; return oph -let originate rpc_config ?chain_id ~block ?signature bytes = +let originate (cctxt : #Client_context.full) ?chain_id ~block ?signature bytes = let signed_bytes = match signature with | None -> bytes | Some signature -> Signature.concat bytes signature in - Block_services.predecessor rpc_config block >>=? fun predecessor -> + Block_services.predecessor cctxt block >>=? fun predecessor -> let oph = Operation_hash.hash_bytes [ signed_bytes ] in - Alpha_services.Helpers.apply_operation rpc_config block + Alpha_services.Helpers.apply_operation cctxt block predecessor oph bytes signature >>=? function - | [ contract ], _ -> + | [ contract ], operations, _ -> + cctxt#message + "@[This sequence of operations was run (including internal ones):@,%a@]" + (Format.pp_print_list pp_internal_operation) operations >>= fun () -> Shell_services.inject_operation - rpc_config ?chain_id signed_bytes >>=? fun injected_oph -> + cctxt ?chain_id signed_bytes >>=? fun injected_oph -> assert (Operation_hash.equal oph injected_oph) ; return (oph, contract) - | contracts, _ -> + | contracts, _, _ -> failwith "The origination introduced %d contracts instead of one." (List.length contracts) @@ -262,6 +334,7 @@ let originate_contract cctxt block source >>=? fun pcounter -> let counter = Int32.succ pcounter in get_branch cctxt block None >>=? fun (_chain_id, branch) -> + Block_services.predecessor cctxt block >>=? fun predecessor -> begin match gas_limit with | Some gas_limit -> return gas_limit | None -> @@ -275,9 +348,8 @@ let originate_contract ~watermark:Generic_operation src_sk bytes >>=? fun signature -> let signed_bytes = Signature.concat bytes signature in let oph = Operation_hash.hash_bytes [ signed_bytes ] in - Block_services.predecessor cctxt block >>=? fun predecessor -> Alpha_services.Helpers.apply_operation cctxt block - predecessor oph bytes (Some signature) >>=? fun (_, gas) -> + predecessor oph bytes (Some signature) >>=? fun (_, _, gas) -> match gas with | Limited { remaining } -> let gas = Z.sub max_gas remaining in diff --git a/src/proto_alpha/lib_client/client_proto_context.mli b/src/proto_alpha/lib_client/client_proto_context.mli index 334dbd3f1..c3a06b07d 100644 --- a/src/proto_alpha/lib_client/client_proto_context.mli +++ b/src/proto_alpha/lib_client/client_proto_context.mli @@ -56,6 +56,9 @@ val operation_submitted_message : Operation_hash.t -> unit tzresult Lwt.t +val pp_internal_operation: + Format.formatter -> internal_operation -> unit + val source_to_keys: #Proto_alpha.full -> Block_services.block -> diff --git a/src/proto_alpha/lib_client/client_proto_programs.ml b/src/proto_alpha/lib_client/client_proto_programs.ml index f1030326b..3482fcdd8 100644 --- a/src/proto_alpha/lib_client/client_proto_programs.ml +++ b/src/proto_alpha/lib_client/client_proto_programs.ml @@ -55,10 +55,10 @@ let print_big_map_diff ppf = function diff let print_run_result (cctxt : #Client_context.printer) ~show_source ~parsed = function - | Ok (storage, output, maybe_diff) -> - cctxt#message "@[@[storage@,%a@]@,@[output@,%a@]@,@[%a@]@]@." + | Ok (storage, operations, maybe_diff) -> + cctxt#message "@[@[storage@,%a@]@,@[emitted operations@,%a@]@,@[%a@]@]@." print_expr storage - print_expr output + (Format.pp_print_list Client_proto_context.pp_internal_operation) operations print_big_map_diff maybe_diff >>= fun () -> return () | Error errs -> @@ -66,12 +66,12 @@ let print_run_result (cctxt : #Client_context.printer) ~show_source ~parsed = fu let print_trace_result (cctxt : #Client_context.printer) ~show_source ~parsed = function - | Ok (storage, output, trace, maybe_big_map_diff) -> + | Ok (storage, operations, trace, maybe_big_map_diff) -> cctxt#message "@[@[storage@,%a@]@,\ - @[output@,%a@]@,%a@[@[trace@,%a@]@]@." + @[emitted operations@,%a@]@,%a@[@[trace@,%a@]@]@." print_expr storage - print_expr output + (Format.pp_print_list Client_proto_context.pp_internal_operation) operations print_big_map_diff maybe_big_map_diff (Format.pp_print_list (fun ppf (loc, gas, stack) -> diff --git a/src/proto_alpha/lib_client/client_proto_programs.mli b/src/proto_alpha/lib_client/client_proto_programs.mli index d50790e19..150afef7d 100644 --- a/src/proto_alpha/lib_client/client_proto_programs.mli +++ b/src/proto_alpha/lib_client/client_proto_programs.mli @@ -22,7 +22,9 @@ val run : input:Michelson_v1_parser.parsed -> Block_services.block -> #Proto_alpha.rpc_context -> - (Script.expr * Script.expr * Contract.big_map_diff option) tzresult Lwt.t + (Script.expr * + internal_operation list * + Contract.big_map_diff option) tzresult Lwt.t val trace : ?contract:Contract.t -> @@ -32,7 +34,8 @@ val trace : input:Michelson_v1_parser.parsed -> Block_services.block -> #Proto_alpha.rpc_context -> - (Script.expr * Script.expr * + (Script.expr * + internal_operation list * Script_interpreter.execution_trace * Contract.big_map_diff option) tzresult Lwt.t @@ -40,14 +43,16 @@ val print_run_result : #Client_context.printer -> show_source:bool -> parsed:Michelson_v1_parser.parsed -> - (Script_repr.expr * Script_repr.expr * + (Script_repr.expr * + internal_operation list * Contract.big_map_diff option) tzresult -> unit tzresult Lwt.t val print_trace_result : #Client_context.printer -> show_source:bool -> parsed:Michelson_v1_parser.parsed -> - (Script_repr.expr * Script_repr.expr * + (Script_repr.expr * + internal_operation list * Script_interpreter.execution_trace * Contract.big_map_diff option) tzresult -> unit tzresult Lwt.t diff --git a/src/proto_alpha/lib_client/michelson_v1_emacs.ml b/src/proto_alpha/lib_client/michelson_v1_emacs.ml index 30cccb229..084227b0a 100644 --- a/src/proto_alpha/lib_client/michelson_v1_emacs.ml +++ b/src/proto_alpha/lib_client/michelson_v1_emacs.ml @@ -81,8 +81,6 @@ let first_error_location errs = | Bad_return (loc, _, _) | Bad_stack (loc, _, _, _) | Unmatched_branches (loc, _, _) - | Transfer_in_lambda loc - | Transfer_in_dip loc | Invalid_constant (loc, _, _) | Invalid_contract (loc, _) | Comparable_type_expected (loc, _) diff --git a/src/proto_alpha/lib_client/michelson_v1_error_reporter.ml b/src/proto_alpha/lib_client/michelson_v1_error_reporter.ml index 675e6eb6e..71a4143ec 100644 --- a/src/proto_alpha/lib_client/michelson_v1_error_reporter.ml +++ b/src/proto_alpha/lib_client/michelson_v1_error_reporter.ml @@ -77,9 +77,7 @@ let collect_error_locations errs = | Bad_return (loc, _, _) | Bad_stack (loc, _, _, _) | Unmatched_branches (loc, _, _) - | Transfer_in_lambda loc | Self_in_lambda loc - | Transfer_in_dip loc | Invalid_constant (loc, _, _) | Invalid_contract (loc, _) | Comparable_type_expected (loc, _) @@ -357,14 +355,6 @@ let report_errors ~details ~show_source ?parsed ppf errs = "@[%atype size (%d) exceeded maximum type size (%d)." print_loc loc size maximum_size - | Transfer_in_lambda loc -> - Format.fprintf ppf - "%aThe TRANSFER_TOKENS instruction cannot appear in a lambda." - print_loc loc - | Transfer_in_dip loc -> - Format.fprintf ppf - "%aThe TRANSFER_TOKENS instruction cannot appear within a DIP." - print_loc loc | Self_in_lambda loc -> Format.fprintf ppf "%aThe SELF instruction cannot appear in a lambda." diff --git a/src/proto_alpha/lib_protocol/src/alpha_context.mli b/src/proto_alpha/lib_protocol/src/alpha_context.mli index ba4a74a6a..881f21ae3 100644 --- a/src/proto_alpha/lib_protocol/src/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/src/alpha_context.mli @@ -160,7 +160,6 @@ module Script : sig type prim = Michelson_v1_primitives.prim = | K_parameter - | K_return | K_storage | K_code | D_False @@ -259,6 +258,7 @@ module Script : sig | T_tez | T_timestamp | T_unit + | T_operation type location = Micheline.canonical_location @@ -742,6 +742,7 @@ and sourced_operations = fee: Tez.t ; counter: counter ; operations: manager_operation list ; + gas_limit: Z.t ; } | Dictator_operation of dictator_operation @@ -769,7 +770,6 @@ and manager_operation = amount: Tez.t ; parameters: Script.expr option ; destination: Contract.contract ; - gas_limit: Z.t; } | Origination of { manager: public_key_hash ; @@ -778,7 +778,6 @@ and manager_operation = spendable: bool ; delegatable: bool ; credit: Tez.t ; - gas_limit: Z.t; } | Delegation of public_key_hash option @@ -788,6 +787,12 @@ and dictator_operation = and counter = Int32.t +type internal_operation = { + source: Contract.contract ; + operation: manager_operation ; + signature: Signature.t option +} + module Operation : sig type raw = Operation.t = { @@ -821,6 +826,8 @@ module Operation : sig val unsigned_operation_encoding: (Operation.shell_header * proto_operation) Data_encoding.t + val internal_operation_encoding: internal_operation Data_encoding.t + end module Roll : sig diff --git a/src/proto_alpha/lib_protocol/src/apply.ml b/src/proto_alpha/lib_protocol/src/apply.ml index 90443f218..eb0bfa3a2 100644 --- a/src/proto_alpha/lib_protocol/src/apply.ml +++ b/src/proto_alpha/lib_protocol/src/apply.ml @@ -369,59 +369,63 @@ let apply_amendment_operation_content ctxt delegate = function Amendment.record_ballot ctxt delegate proposal ballot let apply_manager_operation_content - ctxt origination_nonce source = function - | Reveal _ -> return (ctxt, origination_nonce, None, Tez.zero) - | Transaction { amount ; parameters ; destination ; gas_limit } -> - Lwt.return (Gas.set_limit ctxt gas_limit) >>=? fun ctxt -> + ctxt origination_nonce ~payer ~source ~internal = function + | Reveal _ -> return (ctxt, origination_nonce, None, Tez.zero, []) + | Transaction { amount ; parameters ; destination } -> begin - Contract.spend ctxt source amount >>=? fun ctxt -> + begin + if internal then + Contract.spend_from_script ctxt source amount + else + Contract.spend ctxt source amount + end >>=? fun ctxt -> Contract.credit ctxt destination amount >>=? fun ctxt -> Contract.get_script ctxt destination >>=? fun (ctxt, script) -> match script with | None -> begin match parameters with | None -> - return (ctxt, origination_nonce, None, Tez.zero) + return (ctxt, origination_nonce, None, Tez.zero, []) | Some arg -> match Micheline.root arg with | Prim (_, D_Unit, [], _) -> - return (ctxt, origination_nonce, None, Tez.zero) + return (ctxt, origination_nonce, None, Tez.zero, []) | _ -> fail (Bad_contract_parameter (destination, None, parameters)) end | Some script -> let call_contract ctxt parameter = Script_interpreter.execute ctxt origination_nonce - ~source ~self:(destination, script) ~amount ~parameter + ~check_operations:(not internal) + ~source ~payer ~self:(destination, script) ~amount ~parameter >>= function - | Ok { ctxt ; origination_nonce ; storage ; big_map_diff ; return_value = _ } -> + | Ok { ctxt ; origination_nonce ; storage ; big_map_diff ; operations } -> Contract.update_script_storage ctxt destination storage big_map_diff >>=? fun ctxt -> Fees.update_script_storage - ctxt ~source destination >>=? fun (ctxt, fees) -> - return (ctxt, origination_nonce, None, fees) + ctxt ~payer destination >>=? fun (ctxt, fees) -> + return (ctxt, origination_nonce, None, fees, operations) | Error err -> - return (ctxt, origination_nonce, Some err, Tez.zero) in - Lwt.return @@ Script_ir_translator.parse_toplevel script.code >>=? fun (arg_type, _, _, _) -> + return (ctxt, origination_nonce, Some err, Tez.zero, []) in + Lwt.return @@ Script_ir_translator.parse_toplevel script.code >>=? fun (arg_type, _, _) -> let arg_type = Micheline.strip_locations arg_type in match parameters, Micheline.root arg_type with | None, Prim (_, T_unit, _, _) -> call_contract ctxt (Micheline.strip_locations (Prim (0, Script.D_Unit, [], None))) | Some parameters, _ -> begin - Script_ir_translator.typecheck_data ctxt (parameters, arg_type) >>= function + Script_ir_translator.typecheck_data ctxt ~check_operations:true (parameters, arg_type) >>= function | 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)), Tez.zero) + return (ctxt, origination_nonce, Some ((err :: errs)), Tez.zero, []) end | None, _ -> fail (Bad_contract_parameter (destination, Some arg_type, None)) end | Origination { manager ; delegate ; script ; - spendable ; delegatable ; credit ; gas_limit } -> - Lwt.return (Gas.set_limit ctxt gas_limit) >>=? fun ctxt -> + spendable ; delegatable ; credit } -> begin match script with | None -> return (None, ctxt) | Some script -> - Script_ir_translator.parse_script ctxt script >>=? fun (_, ctxt) -> + Script_ir_translator.parse_script ctxt ~check_operations:true script >>=? fun (_, ctxt) -> Script_ir_translator.erase_big_map_initialization ctxt script >>=? fun (script, big_map_diff, ctxt) -> return (Some (script, big_map_diff), ctxt) end >>=? fun (script, ctxt) -> @@ -431,22 +435,62 @@ let apply_manager_operation_content ~manager ~delegate ~balance:credit ?script ~spendable ~delegatable >>=? fun (ctxt, contract, origination_nonce) -> - Fees.origination_burn ctxt ~source contract >>=? fun ctxt -> - return (ctxt, origination_nonce, None, Tez.zero) + Fees.origination_burn ctxt ~payer contract >>=? fun ctxt -> + return (ctxt, origination_nonce, None, Tez.zero, []) | Delegation delegate -> Delegate.set ctxt source delegate >>=? fun ctxt -> - return (ctxt, origination_nonce, None, Tez.zero) + return (ctxt, origination_nonce, None, Tez.zero, []) + +let apply_internal_manager_operations ctxt origination_nonce ~payer ops = + let rec apply ctxt origination_nonce storage_fees applied worklist = + match worklist with + | [] -> return (ctxt, origination_nonce, None, storage_fees, List.rev applied) + | { source ; operation ; + signature = _ (* at this point the signature must have been + checked if the operation has been + deserialized from the outside world *) } as op :: rest -> + apply_manager_operation_content ctxt origination_nonce ~source ~payer ~internal:true operation + >>=? fun (ctxt, origination_nonce, ignored_error, operation_storage_fees, emitted) -> + Lwt.return Tez.(storage_fees +? operation_storage_fees) >>=? fun storage_fees -> + match ignored_error with + | Some err -> + return (ctxt, origination_nonce, Some err, storage_fees, List.rev (op :: applied)) + | None -> + apply ctxt origination_nonce storage_fees (op :: applied) (rest @ emitted) in + apply ctxt origination_nonce Tez.zero [] ops + +let apply_manager_operations ctxt origination_nonce source ops = + let rec apply ctxt origination_nonce storage_fees applied ops = + match ops with + | [] -> return (ctxt, origination_nonce, None, storage_fees, List.rev applied) + | operation :: rest -> + Contract.must_exist ctxt source >>=? fun () -> + apply_manager_operation_content ctxt origination_nonce ~source ~payer:source ~internal:false operation + >>=? fun (ctxt, origination_nonce, ignored_error, operation_storage_fees, emitted) -> + Lwt.return Tez.(storage_fees +? operation_storage_fees) >>=? fun storage_fees -> + let op = { source ; operation ; signature = None } in + match ignored_error with + | Some _ -> return (ctxt, origination_nonce, ignored_error, storage_fees, List.rev (op :: applied)) + | None -> + apply_internal_manager_operations ctxt origination_nonce ~payer:source emitted + >>=? fun (ctxt, origination_nonce, ignored_error, internal_storage_fees, internal_applied) -> + let applied = List.rev internal_applied @ (op :: applied) in + Lwt.return Tez.(storage_fees +? internal_storage_fees) >>=? fun storage_fees -> + match ignored_error with + | Some _ -> return (ctxt, origination_nonce, ignored_error, storage_fees, List.rev applied) + | None -> apply ctxt origination_nonce storage_fees applied rest in + apply ctxt origination_nonce Tez.zero [] ops let apply_sourced_operation ctxt pred_block block_prio operation origination_nonce ops = match ops with - | Manager_operations { source ; fee ; counter ; operations = contents } -> + | Manager_operations { source ; fee ; counter ; operations ; gas_limit } -> let revealed_public_keys = List.fold_left (fun acc op -> match op with | Reveal pk -> pk :: acc - | _ -> acc) [] contents in + | _ -> acc) [] operations in Contract.must_be_allocated ctxt source >>=? fun () -> Contract.check_counter_increment ctxt source counter >>=? fun () -> begin @@ -462,42 +506,33 @@ let apply_sourced_operation Contract.increment_counter ctxt source >>=? fun ctxt -> Contract.spend ctxt source fee >>=? fun ctxt -> add_fees ctxt fee >>=? fun ctxt -> - fold_left_s (fun (ctxt, origination_nonce, err, storage_fees) content -> - match err with - | Some _ -> return (ctxt, origination_nonce, err, Tez.zero) - | None -> - Contract.must_exist ctxt source >>=? fun () -> - apply_manager_operation_content - ctxt origination_nonce source content - >>=? fun (ctxt, origination_nonce, err, operation_storage_fees) -> - Lwt.return Tez.(storage_fees +? operation_storage_fees) >>=? fun storage_fees -> - return (ctxt, origination_nonce, err, storage_fees)) - (ctxt, origination_nonce, None, Tez.zero) contents - >>=? fun (ctxt, origination_nonce, err,storage_fees) -> - return (ctxt, origination_nonce, err, storage_fees) + Lwt.return (Gas.set_limit ctxt gas_limit) >>=? fun ctxt -> + apply_manager_operations ctxt origination_nonce source operations + >>=? fun (ctxt, origination_nonce, ignored_error, storage_fees, applied) -> + return (ctxt, origination_nonce, ignored_error, storage_fees, applied) | Consensus_operation content -> apply_consensus_operation_content ctxt pred_block block_prio operation content >>=? fun ctxt -> - return (ctxt, origination_nonce, None, Tez.zero) + return (ctxt, origination_nonce, None, Tez.zero, []) | Amendment_operation { source ; operation = content } -> Roll.delegate_pubkey ctxt source >>=? fun delegate -> Operation.check_signature delegate operation >>=? fun () -> (* TODO, see how to extract the public key hash after this operation to pass it to apply_delegate_operation_content *) apply_amendment_operation_content ctxt source content >>=? fun ctxt -> - return (ctxt, origination_nonce, None, Tez.zero) + return (ctxt, origination_nonce, None, Tez.zero, []) | Dictator_operation (Activate hash) -> let dictator_pubkey = Constants.dictator_pubkey ctxt in Operation.check_signature dictator_pubkey operation >>=? fun () -> activate ctxt hash >>= fun ctxt -> - return (ctxt, origination_nonce, None, Tez.zero) + return (ctxt, origination_nonce, None, Tez.zero, []) | Dictator_operation (Activate_testchain hash) -> let dictator_pubkey = Constants.dictator_pubkey ctxt in Operation.check_signature dictator_pubkey operation >>=? fun () -> let expiration = (* in two days maximum... *) Time.add (Timestamp.current ctxt) (Int64.mul 48L 3600L) in fork_test_chain ctxt hash expiration >>= fun ctxt -> - return (ctxt, origination_nonce, None, Tez.zero) + return (ctxt, origination_nonce, None, Tez.zero, []) let apply_anonymous_operation ctxt _delegate origination_nonce kind = match kind with @@ -604,6 +639,7 @@ type operation_result = gas : Gas.t ; origination_nonce : Contract.origination_nonce ; ignored_error : error list option ; + internal_operations : internal_operation list ; fees : Tez.t ; rewards : Tez.t ; storage_fees : Tez.t } @@ -618,16 +654,17 @@ let apply_operation apply_anonymous_operation ctxt delegate origination_nonce op) (ctxt, origination_nonce) ops >>=? fun (ctxt, origination_nonce) -> - return (ctxt, origination_nonce, None, Tez.zero) + return (ctxt, origination_nonce, None, Tez.zero, []) | Sourced_operations op -> let origination_nonce = Contract.initial_origination_nonce hash in apply_sourced_operation ctxt pred_block block_prio operation origination_nonce op - end >>=? fun (ctxt, origination_nonce, ignored_error, storage_fees) -> + end >>=? fun (ctxt, origination_nonce, ignored_error, storage_fees, internal_operations) -> let gas = Gas.level ctxt in let ctxt = Gas.set_unlimited ctxt in return { ctxt ; gas ; origination_nonce ; ignored_error ; storage_fees ; + internal_operations ; fees = Alpha_context.get_fees ctxt ; rewards = Alpha_context.get_rewards ctxt } diff --git a/src/proto_alpha/lib_protocol/src/constants_repr.ml b/src/proto_alpha/lib_protocol/src/constants_repr.ml index 08f2669c0..65effb20a 100644 --- a/src/proto_alpha/lib_protocol/src/constants_repr.ml +++ b/src/proto_alpha/lib_protocol/src/constants_repr.ml @@ -78,7 +78,7 @@ let default = { List.map Period_repr.of_seconds_exn [ 60L ] ; first_free_baking_slot = 16 ; endorsers_per_block = 32 ; - hard_gas_limit_per_operation = Z.of_int 40_000 ; + hard_gas_limit_per_operation = Z.of_int 400_000 ; hard_gas_limit_per_block = Z.of_int 4_000_000 ; proof_of_work_threshold = Int64.(sub (shift_left 1L 56) 1L) ; diff --git a/src/proto_alpha/lib_protocol/src/fees.ml b/src/proto_alpha/lib_protocol/src/fees.ml index e085bc16f..8db8f4609 100644 --- a/src/proto_alpha/lib_protocol/src/fees.ml +++ b/src/proto_alpha/lib_protocol/src/fees.ml @@ -23,15 +23,15 @@ let () = (fun () -> Cannot_pay_storage_fee) -let origination_burn c ~source contract = +let origination_burn c ~payer contract = let origination_burn = Constants.origination_burn c in - Contract.spend_from_script c source origination_burn >>=? fun c -> + Contract.spend_from_script c payer origination_burn >>=? fun c -> Contract.fees c contract >>=? fun fees -> trace Cannot_pay_storage_fee - (Contract.spend_from_script c source fees >>=? fun c -> + (Contract.spend_from_script c payer fees >>=? fun c -> Contract.add_to_paid_fees c contract fees) -let update_script_storage c ~source contract = +let update_script_storage c ~payer contract = Contract.paid_fees c contract >>=? fun paid_fees -> Contract.fees c contract >>=? fun fees -> match Tez.(fees -? paid_fees) with @@ -41,6 +41,6 @@ let update_script_storage c ~source contract = | Ok to_be_paid -> (* Burning the fees... *) trace Cannot_pay_storage_fee - (Contract.spend_from_script c source to_be_paid >>=? fun c -> + (Contract.spend_from_script c payer to_be_paid >>=? fun c -> Contract.add_to_paid_fees c contract to_be_paid) >>=? fun c -> return (c, to_be_paid) diff --git a/src/proto_alpha/lib_protocol/src/fees.mli b/src/proto_alpha/lib_protocol/src/fees.mli index a1cda608a..d9aa9ae21 100644 --- a/src/proto_alpha/lib_protocol/src/fees.mli +++ b/src/proto_alpha/lib_protocol/src/fees.mli @@ -12,10 +12,10 @@ open Alpha_context type error += Cannot_pay_storage_fee val origination_burn: - Alpha_context.t -> source:Contract.t -> + Alpha_context.t -> payer:Contract.t -> Contract.t -> Alpha_context.t tzresult Lwt.t val update_script_storage: - Alpha_context.t -> source:Contract.t -> + Alpha_context.t -> payer:Contract.t -> Contract.t -> (Alpha_context.t * Tez.t) tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/src/helpers_services.ml b/src/proto_alpha/lib_protocol/src/helpers_services.ml index 7d4b64a5d..d9a2e2a10 100644 --- a/src/proto_alpha/lib_protocol/src/helpers_services.ml +++ b/src/proto_alpha/lib_protocol/src/helpers_services.ml @@ -39,7 +39,7 @@ module S = struct ~input: run_code_input_encoding ~output: (obj3 (req "storage" Script.expr_encoding) - (req "output" Script.expr_encoding) + (req "operations" (list Operation.internal_operation_encoding)) (opt "big_map_diff" (list (tup2 string (option Script.expr_encoding))))) RPC_path.(custom_root / "run_code") @@ -52,8 +52,9 @@ module S = struct (req "operation_hash" Operation_hash.encoding) (req "forged_operation" bytes) (opt "signature" Signature.encoding)) - ~output: (obj2 + ~output: (obj3 (req "contracts" (list Contract.encoding)) + (req "internal_operations" (list Operation.internal_operation_encoding)) (req "remaining_gas" Gas.encoding)) RPC_path.(custom_root / "apply_operation") @@ -65,7 +66,7 @@ module S = struct ~input: run_code_input_encoding ~output: (obj4 (req "storage" Script.expr_encoding) - (req "output" Script.expr_encoding) + (req "operations" (list Operation.internal_operation_encoding)) (req "trace" (list @@ obj3 (req "location" Script.location_encoding) @@ -152,9 +153,9 @@ module I = struct ctxt (Some baker_pkh) pred_block block_prio hash operation >>=? function | { ignored_error = Some script_err ; _ } -> Lwt.return (Error script_err) - | { gas ; origination_nonce ; _ } -> + | { gas ; origination_nonce ; internal_operations ; _ } -> let contracts = Contract.originated_contracts origination_nonce in - Lwt.return (Ok (contracts, gas)) + Lwt.return (Ok (contracts, internal_operations, gas)) let run_parameters ctxt (script, storage, input, amount, contract, origination_nonce) = @@ -187,11 +188,13 @@ let () = return (Gas.set_unlimited ctxt) end >>=? fun ctxt -> Script_interpreter.execute ctxt origination_nonce + ~check_operations:true ~source:contract (* transaction initiator *) + ~payer:contract (* storage fees payer *) ~self:(contract, { storage ; code }) (* script owner *) ~amount ~parameter - >>=? fun { Script_interpreter.storage ; return_value ; big_map_diff ; _ } -> - return (storage, return_value, big_map_diff) + >>=? fun { Script_interpreter.storage ; operations ; big_map_diff ; _ } -> + return (storage, operations, big_map_diff) end ; register0 S.trace_code begin fun ctxt () parameters -> let (code, storage, parameter, amount, contract, gas, origination_nonce) = @@ -202,11 +205,13 @@ let () = return (Gas.set_unlimited ctxt) end >>=? fun ctxt -> Script_interpreter.trace ctxt origination_nonce + ~check_operations:true ~source:contract (* transaction initiator *) + ~payer:contract (* storage fees payer *) ~self:(contract, { storage ; code }) (* script owner *) ~amount ~parameter - >>=? fun ({ Script_interpreter.storage ; return_value ; big_map_diff ; _ }, trace) -> - return (storage, return_value, trace, big_map_diff) + >>=? fun ({ Script_interpreter.storage ; operations ; big_map_diff ; _ }, trace) -> + return (storage, operations, trace, big_map_diff) end ; register0 S.typecheck_code begin fun ctxt () (expr, maybe_gas) -> begin match maybe_gas with @@ -219,7 +224,7 @@ let () = begin match maybe_gas with | None -> return (Gas.set_unlimited ctxt) | Some gas -> Lwt.return (Gas.set_limit ctxt gas) end >>=? fun ctxt -> - Script_ir_translator.typecheck_data ctxt (data, ty) >>=? fun ctxt -> + Script_ir_translator.typecheck_data ctxt ~check_operations:true (data, ty) >>=? fun ctxt -> return (Gas.level ctxt) end ; register0 S.hash_data begin fun ctxt () (expr, typ, maybe_gas) -> @@ -227,8 +232,8 @@ let () = begin match maybe_gas with | None -> return (Gas.set_unlimited ctxt) | Some gas -> Lwt.return (Gas.set_limit ctxt gas) end >>=? fun ctxt -> - Lwt.return (parse_ty false (Micheline.root typ)) >>=? fun (Ex_ty typ, _) -> - parse_data ctxt typ (Micheline.root expr) >>=? fun (data, ctxt) -> + Lwt.return (parse_ty ~allow_big_map:false (Micheline.root typ)) >>=? fun (Ex_ty typ, _) -> + parse_data ctxt ~check_operations:true typ (Micheline.root expr) >>=? fun (data, ctxt) -> Lwt.return (Script_ir_translator.hash_data ctxt typ data) >>=? fun (hash, ctxt) -> return (hash, Gas.level ctxt) end ; @@ -326,7 +331,7 @@ module Forge = struct module Manager = struct let operations ctxt - block ~branch ~source ?sourcePubKey ~counter ~fee operations = + block ~branch ~source ?sourcePubKey ~counter ~fee ~gas_limit operations = Contract_services.manager_key ctxt block source >>= function | Error _ as e -> Lwt.return e | Ok (_, revealed) -> @@ -339,19 +344,19 @@ module Forge = struct | Some pk -> Reveal pk :: operations in let ops = Manager_operations { source ; - counter ; operations ; fee } in + counter ; operations ; fee ; gas_limit } in (RPC_context.make_call0 S.operations ctxt block () ({ branch }, Sourced_operations ops)) let reveal ctxt block ~branch ~source ~sourcePubKey ~counter ~fee ()= - operations ctxt block ~branch ~source ~sourcePubKey ~counter ~fee [] + operations ctxt block ~branch ~source ~sourcePubKey ~counter ~fee ~gas_limit:Z.zero [] let transaction ctxt block ~branch ~source ?sourcePubKey ~counter ~amount ~destination ?parameters ~gas_limit ~fee ()= - operations ctxt block ~branch ~source ?sourcePubKey ~counter ~fee - Alpha_context.[Transaction { amount ; parameters ; destination ; gas_limit }] + operations ctxt block ~branch ~source ?sourcePubKey ~counter ~fee ~gas_limit + Alpha_context.[Transaction { amount ; parameters ; destination }] let origination ctxt block ~branch @@ -361,20 +366,19 @@ module Forge = struct ?(delegatable = true) ?delegatePubKey ?script ~gas_limit ~fee () = - operations ctxt block ~branch ~source ?sourcePubKey ~counter ~fee + operations ctxt block ~branch ~source ?sourcePubKey ~counter ~fee ~gas_limit Alpha_context.[ Origination { manager = managerPubKey ; delegate = delegatePubKey ; script ; spendable ; delegatable ; - credit = balance ; - gas_limit } + credit = balance } ] let delegation ctxt block ~branch ~source ?sourcePubKey ~counter ~fee delegate = - operations ctxt block ~branch ~source ?sourcePubKey ~counter ~fee + operations ctxt block ~branch ~source ?sourcePubKey ~counter ~fee ~gas_limit:Z.zero Alpha_context.[Delegation delegate] end diff --git a/src/proto_alpha/lib_protocol/src/helpers_services.mli b/src/proto_alpha/lib_protocol/src/helpers_services.mli index 1295d8a08..82d2fc89f 100644 --- a/src/proto_alpha/lib_protocol/src/helpers_services.mli +++ b/src/proto_alpha/lib_protocol/src/helpers_services.mli @@ -19,19 +19,22 @@ val minimal_time: val apply_operation: 'a #RPC_context.simple -> 'a -> Block_hash.t -> Operation_hash.t -> MBytes.t -> Signature.t option -> - (Contract.t list * Gas.t) shell_tzresult Lwt.t + (Contract.t list * internal_operation list * Gas.t) shell_tzresult Lwt.t val run_code: 'a #RPC_context.simple -> 'a -> Script.expr -> (Script.expr * Script.expr * Tez.t * Contract.t) -> - (Script.expr * Script.expr * Contract.big_map_diff option) shell_tzresult Lwt.t + (Script.expr * + internal_operation list * + Contract.big_map_diff option) shell_tzresult Lwt.t val trace_code: 'a #RPC_context.simple -> 'a -> Script.expr -> (Script.expr * Script.expr * Tez.t * Contract.t) -> - (Script.expr * Script.expr * + (Script.expr * + internal_operation list * Script_interpreter.execution_trace * Contract.big_map_diff option) shell_tzresult Lwt.t @@ -68,6 +71,7 @@ module Forge : sig ?sourcePubKey:public_key -> counter:int32 -> fee:Tez.t -> + gas_limit:Z.t -> manager_operation list -> MBytes.t shell_tzresult Lwt.t val reveal: diff --git a/src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml b/src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml index e862cfd7e..3d8194357 100644 --- a/src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml +++ b/src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml @@ -220,6 +220,10 @@ module Cost_of = struct let primitive_type = alloc_cost 1 let one_arg_type = alloc_cost 2 let two_arg_type = alloc_cost 3 + let operation s = + (* TODO: proper handling of (de)serialization costs *) + let len = String.length s in + alloc_cost len +@ step_cost (len * 10) end module Unparse = struct @@ -237,6 +241,7 @@ module Cost_of = struct prim_cost +@ (alloc_bytes_cost decimal_digits) let tez = string_cost 19 (* max length of 64 bit int *) let timestamp x = Script_timestamp.to_zint x |> Script_int.of_zint |> int + let operation bytes = string_cost (MBytes.length bytes * 2) let key = string_cost 54 let key_hash = string_cost 36 let signature = string_cost 128 diff --git a/src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli b/src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli index 3d8be9f50..6c7192978 100644 --- a/src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli +++ b/src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli @@ -123,6 +123,8 @@ module Cost_of : sig val primitive_type : Gas.cost val one_arg_type : Gas.cost val two_arg_type : Gas.cost + + val operation : string -> Gas.cost end module Unparse : sig @@ -136,6 +138,7 @@ module Cost_of : sig val key : Gas.cost val key_hash : Gas.cost val signature : Gas.cost + val operation : MBytes.t -> Gas.cost val contract : Gas.cost diff --git a/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.ml b/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.ml index 6f42c9b7f..4496ed596 100644 --- a/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.ml +++ b/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.ml @@ -15,7 +15,6 @@ type error += Invalid_primitive_name of string Micheline.canonical * Micheline.c type prim = | K_parameter - | K_return | K_storage | K_code | D_False @@ -114,6 +113,7 @@ type prim = | T_tez | T_timestamp | T_unit + | T_operation let valid_case name = let is_lower = function '_' | 'a'..'z' -> true | _ -> false in @@ -136,7 +136,6 @@ let valid_case name = let string_of_prim = function | K_parameter -> "parameter" - | K_return -> "return" | K_storage -> "storage" | K_code -> "code" | D_False -> "False" @@ -235,10 +234,10 @@ let string_of_prim = function | T_tez -> "tez" | T_timestamp -> "timestamp" | T_unit -> "unit" + | T_operation -> "operation" let prim_of_string = function | "parameter" -> ok K_parameter - | "return" -> ok K_return | "storage" -> ok K_storage | "code" -> ok K_code | "False" -> ok D_False @@ -337,6 +336,7 @@ let prim_of_string = function | "tez" -> ok T_tez | "timestamp" -> ok T_timestamp | "unit" -> ok T_unit + | "operation" -> ok T_operation | n -> if valid_case n then error (Unknown_primitive_name n) @@ -384,7 +384,6 @@ let prim_encoding = let open Data_encoding in string_enum [ ("parameter", K_parameter) ; - ("return", K_return) ; ("storage", K_storage) ; ("code", K_code) ; ("False", D_False) ; @@ -482,7 +481,8 @@ let prim_encoding = ("string", T_string) ; ("tez", T_tez) ; ("timestamp", T_timestamp) ; - ("unit", T_unit) ] + ("unit", T_unit) ; + ("operation", T_operation) ] let () = register_error_kind diff --git a/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.mli b/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.mli index 6251da4ba..d08ef261c 100644 --- a/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.mli +++ b/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.mli @@ -13,7 +13,6 @@ type error += Invalid_primitive_name of string Micheline.canonical * Micheline.c type prim = | K_parameter - | K_return | K_storage | K_code | D_False @@ -112,6 +111,7 @@ type prim = | T_tez | T_timestamp | T_unit + | T_operation val prim_encoding : prim Data_encoding.encoding diff --git a/src/proto_alpha/lib_protocol/src/operation_repr.ml b/src/proto_alpha/lib_protocol/src/operation_repr.ml index addee206e..b061053f0 100644 --- a/src/proto_alpha/lib_protocol/src/operation_repr.ml +++ b/src/proto_alpha/lib_protocol/src/operation_repr.ml @@ -55,6 +55,7 @@ and sourced_operations = fee: Tez_repr.tez ; counter: counter ; operations: manager_operation list ; + gas_limit: Z.t; } | Dictator_operation of dictator_operation @@ -82,7 +83,6 @@ and manager_operation = amount: Tez_repr.tez ; parameters: Script_repr.expr option ; destination: Contract_repr.contract ; - gas_limit: Z.t; } | Origination of { manager: Signature.Public_key_hash.t ; @@ -91,7 +91,6 @@ and manager_operation = spendable: bool ; delegatable: bool ; credit: Tez_repr.tez ; - gas_limit: Z.t; } | Delegation of Signature.Public_key_hash.t option @@ -101,6 +100,12 @@ and dictator_operation = and counter = Int32.t +type internal_operation = { + source: Contract_repr.contract ; + operation: manager_operation ; + signature: Signature.t option +} + module Encoding = struct open Data_encoding @@ -120,49 +125,47 @@ module Encoding = struct let transaction_encoding = describe ~title:"Transaction operation" @@ - obj5 + obj4 (req "kind" (constant "transaction")) (req "amount" Tez_repr.encoding) (req "destination" Contract_repr.encoding) (opt "parameters" Script_repr.expr_encoding) - (req "gas_limit" z) let transaction_case tag = case tag ~name:"Transaction" transaction_encoding (function - | Transaction { amount ; destination ; parameters ; gas_limit } -> - Some ((), amount, destination, parameters, gas_limit) + | Transaction { amount ; destination ; parameters } -> + Some ((), amount, destination, parameters) | _ -> None) - (fun ((), amount, destination, parameters, gas_limit) -> - Transaction { amount ; destination ; parameters ; gas_limit }) + (fun ((), amount, destination, parameters) -> + Transaction { amount ; destination ; parameters }) let origination_encoding = describe ~title:"Origination operation" @@ - (obj8 + (obj7 (req "kind" (constant "origination")) (req "managerPubkey" Signature.Public_key_hash.encoding) (req "balance" Tez_repr.encoding) (opt "spendable" bool) (opt "delegatable" bool) (opt "delegate" Signature.Public_key_hash.encoding) - (opt "script" Script_repr.encoding) - (req "gas_limit" z)) + (opt "script" Script_repr.encoding)) let origination_case tag = case tag ~name:"Origination" origination_encoding (function | Origination { manager ; credit ; spendable ; - delegatable ; delegate ; script ; gas_limit } -> + delegatable ; delegate ; script } -> Some ((), manager, credit, Some spendable, - Some delegatable, delegate, script, gas_limit) + Some delegatable, delegate, script) | _ -> None) - (fun ((), manager, credit, spendable, delegatable, delegate, script, gas_limit) -> + (fun ((), manager, credit, spendable, delegatable, delegate, script) -> let delegatable = match delegatable with None -> true | Some b -> b in let spendable = match spendable with None -> true | Some b -> b in Origination - {manager ; credit ; spendable ; delegatable ; delegate ; script ; gas_limit }) + {manager ; credit ; spendable ; delegatable ; delegate ; script }) let delegation_encoding = describe ~title:"Delegation operation" @@ @@ -177,7 +180,7 @@ module Encoding = struct (fun ((), key) -> Delegation key) let manager_kind_encoding = - obj5 + obj6 (req "kind" (constant "manager")) (req "source" Contract_repr.encoding) (req "fee" Tez_repr.encoding) @@ -189,15 +192,16 @@ module Encoding = struct origination_case (Tag 2) ; delegation_case (Tag 3) ; ]))) + (req "gas_limit" z) let manager_kind_case tag = case tag ~name:"Manager operations" manager_kind_encoding (function - | Manager_operations { source; fee ; counter ;operations } -> - Some ((), source, fee, counter, operations) + | Manager_operations { source; fee ; counter ; operations ; gas_limit } -> + Some ((), source, fee, counter, operations, gas_limit) | _ -> None) - (fun ((), source, fee, counter, operations) -> - Manager_operations { source; fee ; counter ; operations }) + (fun ((), source, fee, counter, operations, gas_limit) -> + Manager_operations { source; fee ; counter ; operations ; gas_limit }) let endorsement_encoding = (* describe ~title:"Endorsement operation" @@ *) @@ -416,6 +420,20 @@ module Encoding = struct Operation.shell_header_encoding proto_operation_encoding + let internal_operation_encoding = + conv + (fun { source ; operation ; signature } -> ((source, signature), operation)) + (fun ((source, signature), operation) -> { source ; operation ; signature }) + (merge_objs + (obj2 + (req "source" Contract_repr.encoding) + (opt "signature" Signature.encoding)) + (union ~tag_size:`Uint8 [ + reveal_case (Tag 0) ; + transaction_case (Tag 1) ; + origination_case (Tag 2) ; + delegation_case (Tag 3) ; + ])) end type error += Cannot_parse_operation diff --git a/src/proto_alpha/lib_protocol/src/operation_repr.mli b/src/proto_alpha/lib_protocol/src/operation_repr.mli index 7ccdd287b..5c32b7f47 100644 --- a/src/proto_alpha/lib_protocol/src/operation_repr.mli +++ b/src/proto_alpha/lib_protocol/src/operation_repr.mli @@ -55,6 +55,7 @@ and sourced_operations = fee: Tez_repr.tez ; counter: counter ; operations: manager_operation list ; + gas_limit: Z.t ; } | Dictator_operation of dictator_operation @@ -82,7 +83,6 @@ and manager_operation = amount: Tez_repr.tez ; parameters: Script_repr.expr option ; destination: Contract_repr.contract ; - gas_limit: Z.t ; } | Origination of { manager: Signature.Public_key_hash.t ; @@ -91,7 +91,6 @@ and manager_operation = spendable: bool ; delegatable: bool ; credit: Tez_repr.tez ; - gas_limit: Z.t ; } | Delegation of Signature.Public_key_hash.t option @@ -130,3 +129,12 @@ val proto_operation_encoding: val unsigned_operation_encoding: (Operation.shell_header * proto_operation) Data_encoding.t + +type internal_operation = { + source: Contract_repr.contract ; + operation: manager_operation ; + signature: Signature.t option +} + +val internal_operation_encoding: + internal_operation Data_encoding.t diff --git a/src/proto_alpha/lib_protocol/src/script_interpreter.ml b/src/proto_alpha/lib_protocol/src/script_interpreter.ml index b4251c878..d06c90a6a 100644 --- a/src/proto_alpha/lib_protocol/src/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/src/script_interpreter.ml @@ -10,7 +10,6 @@ open Alpha_context open Script open Script_typed_ir -open Script_tc_errors open Script_ir_translator (* ---- Run-time errors -----------------------------------------------------*) @@ -83,10 +82,10 @@ let rec interp : type p r. (?log: execution_trace ref -> context -> Contract.origination_nonce -> - source: Contract.t -> self: Contract.t -> Tez.t -> + source: Contract.t -> payer:Contract.t -> self: Contract.t -> Tez.t -> (p, r) lambda -> p -> (r * context * Contract.origination_nonce) tzresult Lwt.t) - = fun ?log ctxt origination ~source ~self amount (Lam (code, _)) arg -> + = fun ?log ctxt origination ~source ~payer ~self amount (Lam (code, _)) arg -> let rec step : type b a. Contract.origination_nonce -> context -> (b, a) descr -> b stack -> @@ -150,21 +149,19 @@ let rec interp Lwt.return (Gas.consume ctxt (cost x1 x2)) >>=? fun ctxt -> logged_return descr (Item (Script_int.of_int @@ op x1 x2, rest), ctxt) in let create_contract : - type param return rest storage. - (_, (param, return) typed_contract * rest) descr -> + type param rest storage. + (_, param typed_contract * rest) descr -> manager:public_key_hash -> delegate:public_key_hash option -> spendable:bool -> delegatable:bool -> credit:Tez.t -> code:prim Micheline.canonical -> init:storage -> param_type:param ty -> storage_type:storage ty -> - return_type:return ty -> rest:rest stack -> - (((param, return) typed_contract * rest) stack * context * Contract.origination_nonce) tzresult Lwt.t = + ((param typed_contract * rest) stack * context * Contract.origination_nonce) tzresult Lwt.t = fun descr ~manager ~delegate ~spendable ~delegatable - ~credit ~code ~init ~param_type ~storage_type ~return_type ~rest -> + ~credit ~code ~init ~param_type ~storage_type ~rest -> Lwt.return (Gas.consume ctxt Interp_costs.create_contract) >>=? fun ctxt -> let code = Micheline.strip_locations (Seq (0, [ Prim (0, K_parameter, [ unparse_ty None param_type ], None) ; - Prim (0, K_return, [ unparse_ty None return_type ], None) ; Prim (0, K_storage, [ unparse_ty None storage_type ], None) ; Prim (0, K_code, [ Micheline.root code ], None) ], None)) in Lwt.return @@ unparse_data ctxt storage_type init >>=? fun (storage, ctxt) -> @@ -176,8 +173,8 @@ let rec interp ~script:({ code ; storage }, None (* TODO: initialize a big map from a map *)) ~spendable ~delegatable >>=? fun (ctxt, contract, origination) -> - Fees.origination_burn ctxt ~source contract >>=? fun ctxt -> - logged_return descr ~origination (Item ((param_type, return_type, contract), rest), ctxt) in + Fees.origination_burn ctxt ~payer contract >>=? fun ctxt -> + logged_return descr ~origination (Item ((param_type, contract), rest), ctxt) in let logged_return : ?origination:Contract.origination_nonce -> a stack * context -> (a stack * context * Contract.origination_nonce) tzresult Lwt.t = @@ -251,7 +248,7 @@ let rec interp match l with | [] -> return (List.rev acc, ctxt, origination) | hd :: tl -> - interp ?log ctxt origination ~source ~self amount lam hd + interp ?log ctxt origination ~source ~payer ~self amount lam hd >>=? fun (hd, ctxt, origination) -> loop rest ctxt origination tl (hd :: acc) in loop rest ctxt origination l [] >>=? fun (res, ctxt, origination) -> @@ -273,7 +270,7 @@ let rec interp match l with | [] -> return (acc, ctxt, origination) | hd :: tl -> - interp ?log ctxt origination ~source ~self amount lam (hd, acc) + interp ?log ctxt origination ~source ~payer ~self amount lam (hd, acc) >>=? fun (acc, ctxt, origination) -> loop rest ctxt origination tl acc in loop rest ctxt origination l init >>=? fun (res, ctxt, origination) -> @@ -310,7 +307,7 @@ let rec interp match l with | [] -> return (acc, ctxt, origination) | hd :: tl -> - interp ?log ctxt origination ~source ~self amount lam (hd, acc) + interp ?log ctxt origination ~source ~payer ~self amount lam (hd, acc) >>=? fun (acc, ctxt, origination) -> loop rest ctxt origination tl acc in loop rest ctxt origination l init >>=? fun (res, ctxt, origination) -> @@ -346,7 +343,7 @@ let rec interp match l with | [] -> return (acc, ctxt, origination) | (k, _) as hd :: tl -> - interp ?log ctxt origination ~source ~self amount lam hd + interp ?log ctxt origination ~source ~payer ~self amount lam hd >>=? fun (hd, ctxt, origination) -> loop rest ctxt origination tl (map_update k (Some hd) acc) in loop rest ctxt origination l (empty_map (map_key_ty map)) >>=? fun (res, ctxt, origination) -> @@ -359,7 +356,7 @@ let rec interp match l with | [] -> return (acc, ctxt, origination) | hd :: tl -> - interp ?log ctxt origination ~source ~self amount lam (hd, acc) + interp ?log ctxt origination ~source ~payer ~self amount lam (hd, acc) >>=? fun (acc, ctxt, origination) -> loop rest ctxt origination tl acc in loop rest ctxt origination l init >>=? fun (res, ctxt, origination) -> @@ -583,7 +580,7 @@ let rec interp logged_return ~origination (Item (ign, res), ctxt) | Exec, Item (arg, Item (lam, rest)) -> Lwt.return (Gas.consume ctxt Interp_costs.exec) >>=? fun ctxt -> - interp ?log ctxt origination ~source ~self amount lam arg >>=? fun (res, ctxt, origination) -> + interp ?log ctxt origination ~source ~payer ~self amount lam arg >>=? fun (res, ctxt, origination) -> logged_return ~origination (Item (res, rest), ctxt) | Lambda lam, rest -> Lwt.return (Gas.consume ctxt Interp_costs.push) >>=? fun ctxt -> @@ -640,98 +637,19 @@ let rec interp Lwt.return (Gas.consume ctxt Interp_costs.compare_res) >>=? fun ctxt -> logged_return (Item (cmpres, rest), ctxt) (* protocol *) - | Manager, Item ((_, _, contract), rest) -> + | Manager, Item ((_, contract), rest) -> Lwt.return (Gas.consume ctxt Interp_costs.manager) >>=? fun ctxt -> Contract.get_manager ctxt contract >>=? fun manager -> logged_return (Item (manager, rest), ctxt) - | Transfer_tokens storage_type, - Item (p, Item (amount, Item ((tp, Unit_t, destination), Item (storage, Empty)))) -> begin + | Transfer_tokens, + Item (p, Item (amount, Item ((tp, destination), rest))) -> Lwt.return (Gas.consume ctxt Interp_costs.transfer) >>=? fun ctxt -> - Contract.spend_from_script ctxt self amount >>=? fun ctxt -> - Contract.credit ctxt destination amount >>=? fun ctxt -> - Contract.get_script ctxt destination >>=? fun (ctxt, destination_script) -> - Lwt.return (unparse_data ctxt storage_type storage) >>=? fun (sto, ctxt) -> - let sto = Micheline.strip_locations sto in - begin match Script_ir_translator.extract_big_map storage_type storage with - | None -> - return (None, ctxt) - | Some diff -> - Script_ir_translator.to_serializable_big_map ctxt diff >>=? fun (diff, ctxt) -> - return (Some diff, ctxt) - end >>=? fun (diff, ctxt) -> - Contract.update_script_storage ctxt self sto diff >>=? fun ctxt -> - Fees.update_script_storage ctxt ~source self >>=? fun (ctxt, _) -> - begin match destination_script with - | None -> - (* we see non scripted contracts as (unit, unit) contract *) - Lwt.return (ty_eq tp Unit_t |> - record_trace (Invalid_contract (loc, destination))) >>=? fun Eq -> - return (ctxt, origination) - | Some script -> - Lwt.return @@ unparse_data ctxt tp p >>=? fun (p, ctxt) -> - (* FIXME: add a sender parameter *) - execute ctxt origination ~source ~self:destination script amount p - >>=? fun (csto, ret, ctxt, origination, maybe_diff) -> - begin match maybe_diff with - | None -> - return (None, ctxt) - | Some diff -> - Script_ir_translator.to_serializable_big_map ctxt diff >>=? fun (diff, ctxt) -> - return (Some diff, ctxt) - end >>=? fun (maybe_diff, ctxt) -> - Contract.update_script_storage ctxt destination csto maybe_diff >>=? fun ctxt -> - trace - (Invalid_contract (loc, destination)) - (parse_data ctxt Unit_t ret) >>=? fun ((), ctxt) -> - Fees.update_script_storage ctxt ~source destination >>=? fun (ctxt, _) -> - return (ctxt, origination) - end >>=? fun (ctxt, origination) -> - Contract.get_script ctxt self >>=? (fun (ctxt, script) -> match script with - | None -> assert false - | Some { storage; _ } -> - parse_data ctxt storage_type (Micheline.root storage) >>=? fun (sto, ctxt) -> - logged_return ~origination (Item ((), Item (sto, Empty)), ctxt)) - end - | Transfer_tokens storage_type, - Item (p, Item (amount, Item ((tp, tr, destination), Item (sto, Empty)))) -> begin - Lwt.return (Gas.consume ctxt Interp_costs.transfer) >>=? fun ctxt -> - Contract.spend_from_script ctxt self amount >>=? fun ctxt -> - Contract.credit ctxt destination amount >>=? fun ctxt -> - Contract.get_script ctxt destination >>=? fun (ctxt, script) -> match script with - | None -> fail (Invalid_contract (loc, destination)) - | Some script -> - begin match extract_big_map storage_type sto with - | None -> - return (None, ctxt) - | Some diff -> - to_serializable_big_map ctxt diff >>=? fun (diff, ctxt) -> - return (Some diff, ctxt) - end >>=? fun (maybe_diff, ctxt) -> - Lwt.return (unparse_data ctxt storage_type sto) >>=? fun (sto, ctxt) -> - let sto = Micheline.strip_locations sto in - Contract.update_script_storage ctxt self sto maybe_diff >>=? fun ctxt -> - Fees.update_script_storage ctxt ~source self >>=? fun (ctxt, _) -> - Lwt.return (unparse_data ctxt tp p) >>=? fun (p, ctxt) -> - execute ctxt origination ~source ~self:destination script amount p - >>=? fun (sto, ret, ctxt, origination, maybe_diff) -> - begin match maybe_diff with - | None -> - return (None, ctxt) - | Some diff -> - Script_ir_translator.to_serializable_big_map ctxt diff >>=? fun (diff, ctxt) -> - return (Some diff, ctxt) - end >>=? fun (diff, ctxt) -> - Contract.update_script_storage ctxt destination sto diff >>=? fun ctxt -> - Fees.update_script_storage ctxt ~source destination >>=? fun (ctxt, _) -> - trace - (Invalid_contract (loc, destination)) - (parse_data ctxt tr ret) >>=? fun (v, ctxt) -> - Contract.get_script ctxt self >>=? (fun (ctxt, script) -> match script with - | None -> assert false - | Some { storage ; _ } -> - parse_data ctxt storage_type (Micheline.root storage) >>=? fun (sto, ctxt) -> - logged_return ~origination (Item (v, Item (sto, Empty)), ctxt)) - end + Lwt.return @@ unparse_data ctxt tp p >>=? fun (p, ctxt) -> + let operation = + Transaction + { amount ; destination ; + parameters = Some (Micheline.strip_locations p) } in + logged_return (Item ({ source = self ; operation ; signature = None }, rest), ctxt) | Create_account, Item (manager, Item (delegate, Item (delegatable, Item (credit, rest)))) -> Lwt.return (Gas.consume ctxt Interp_costs.create_account) >>=? fun ctxt -> @@ -741,13 +659,13 @@ let rec interp origination ~manager ~delegate ~balance ?script:None ~spendable:true ~delegatable >>=? fun (ctxt, contract, origination) -> - Fees.origination_burn ctxt ~source contract >>=? fun ctxt -> - logged_return ~origination (Item ((Unit_t, Unit_t, contract), rest), ctxt) + Fees.origination_burn ctxt ~payer contract >>=? fun ctxt -> + logged_return ~origination (Item ((Unit_t, contract), rest), ctxt) | Implicit_account, Item (key, rest) -> Lwt.return (Gas.consume ctxt Interp_costs.implicit_account) >>=? fun ctxt -> let contract = Contract.implicit_contract key in - logged_return (Item ((Unit_t, Unit_t, contract), rest), ctxt) - | Create_contract (storage_type, param_type, return_type), + logged_return (Item ((Unit_t, contract), rest), ctxt) + | Create_contract (storage_type, param_type), Item (manager, Item (delegate, Item (spendable, Item @@ -756,8 +674,8 @@ let rec interp (Lam (_, code), Item (init, rest))))))) -> create_contract descr ~manager ~delegate ~spendable ~delegatable ~credit ~code ~init - ~param_type ~return_type ~storage_type ~rest - | Create_contract_literal (storage_type, param_type, return_type, Lam (_, code)), + ~param_type ~storage_type ~rest + | Create_contract_literal (storage_type, param_type, Lam (_, code)), Item (manager, Item (delegate, Item (spendable, Item @@ -765,7 +683,7 @@ let rec interp (credit, Item (init, rest)))))) -> create_contract descr ~manager ~delegate ~spendable ~delegatable ~credit ~code ~init - ~param_type ~return_type ~storage_type ~rest + ~param_type ~storage_type ~rest | Balance, rest -> Lwt.return (Gas.consume ctxt Interp_costs.balance) >>=? fun ctxt -> Contract.get_balance ctxt self >>=? fun balance -> @@ -792,12 +710,12 @@ let rec interp | Limited { remaining } -> remaining | Unaccounted -> Z.of_string "99999999" in logged_return (Item (Script_int.(abs (of_zint steps)), rest), ctxt) - | Source (ta, tb), rest -> + | Source t, rest -> Lwt.return (Gas.consume ctxt Interp_costs.source) >>=? fun ctxt -> - logged_return (Item ((ta, tb, source), rest), ctxt) - | Self (ta, tb), rest -> + logged_return (Item ((t, source), rest), ctxt) + | Self t, rest -> Lwt.return (Gas.consume ctxt Interp_costs.self) >>=? fun ctxt -> - logged_return (Item ((ta, tb, self), rest), ctxt) + logged_return (Item ((t,self), rest), ctxt) | Amount, rest -> Lwt.return (Gas.consume ctxt Interp_costs.amount) >>=? fun ctxt -> logged_return (Item (amount, rest), ctxt) in @@ -812,19 +730,18 @@ let rec interp (* ---- contract handling ---------------------------------------------------*) -and execute ?log ctxt origination_nonce ~source ~self script amount arg : - (Script.expr * Script.node * context * Contract.origination_nonce * +and execute ?log ctxt ~check_operations origination_nonce ~source ~payer ~self script amount arg : + (Script.expr * internal_operation list * context * Contract.origination_nonce * Script_typed_ir.ex_big_map option) tzresult Lwt.t = - parse_script ctxt script - >>=? fun ((Ex_script { code; arg_type; ret_type; storage; storage_type }), ctxt) -> - parse_data ctxt arg_type arg >>=? fun (arg, ctxt) -> + parse_script ctxt ~check_operations script + >>=? fun ((Ex_script { code ; arg_type ; storage ; storage_type }), ctxt) -> + parse_data ctxt ~check_operations arg_type arg >>=? fun (arg, ctxt) -> trace (Runtime_contract_error (self, script.code)) - (interp ?log ctxt origination_nonce ~source ~self amount code (arg, storage)) - >>=? fun ((ret, sto), ctxt, origination) -> + (interp ?log ctxt origination_nonce ~source ~payer ~self amount code (arg, storage)) + >>=? fun ((ops, sto), ctxt, origination) -> Lwt.return @@ unparse_data ctxt storage_type sto >>=? fun (storage, ctxt) -> - Lwt.return @@ unparse_data ctxt ret_type ret >>=? fun (ret, ctxt) -> - return (Micheline.strip_locations storage, ret, ctxt, origination, + return (Micheline.strip_locations storage, ops, ctxt, origination, Script_ir_translator.extract_big_map storage_type sto) type execution_result = @@ -832,13 +749,12 @@ type execution_result = origination_nonce : Contract.origination_nonce ; storage : Script.expr ; big_map_diff : Contract.big_map_diff option ; - return_value : Script.expr } + operations : internal_operation list } -let trace ctxt origination_nonce ~source ~self:(self, script) ~parameter ~amount = +let trace ctxt origination_nonce ~check_operations ~source ~payer ~self:(self, script) ~parameter ~amount = let log = ref [] in - execute ~log ctxt origination_nonce ~source ~self script amount (Micheline.root parameter) - >>=? fun (storage, return_value, ctxt, origination_nonce, big_map_diff) -> - let return_value = Micheline.strip_locations return_value in + execute ~log ctxt ~check_operations origination_nonce ~source ~payer ~self script amount (Micheline.root parameter) + >>=? fun (storage, operations, ctxt, origination_nonce, big_map_diff) -> begin match big_map_diff with | None -> return (None, ctxt) | Some big_map_diff -> @@ -846,16 +762,15 @@ let trace ctxt origination_nonce ~source ~self:(self, script) ~parameter ~amount return (Some big_map_diff, ctxt) end >>=? fun (big_map_diff, ctxt) -> let trace = List.rev !log in - return ({ ctxt ; origination_nonce ; storage ; big_map_diff ; return_value }, trace) + return ({ ctxt ; origination_nonce ; storage ; big_map_diff ; operations }, trace) -let execute ctxt origination_nonce ~source ~self:(self, script) ~parameter ~amount = - execute ctxt origination_nonce ~source ~self script amount (Micheline.root parameter) - >>=? fun (storage, return_value, ctxt, origination_nonce, big_map_diff) -> - let return_value = Micheline.strip_locations return_value in +let execute ctxt origination_nonce ~check_operations ~source ~payer ~self:(self, script) ~parameter ~amount = + execute ctxt origination_nonce ~check_operations ~source ~payer ~self script amount (Micheline.root parameter) + >>=? fun (storage, operations, ctxt, origination_nonce, big_map_diff) -> begin match big_map_diff with | None -> return (None, ctxt) | Some big_map_diff -> Script_ir_translator.to_serializable_big_map ctxt big_map_diff >>=? fun (big_map_diff, ctxt) -> return (Some big_map_diff, ctxt) end >>=? fun (big_map_diff, ctxt) -> - return { ctxt ; origination_nonce ; storage ; big_map_diff ; return_value } + return { ctxt ; origination_nonce ; storage ; big_map_diff ; operations } diff --git a/src/proto_alpha/lib_protocol/src/script_interpreter.mli b/src/proto_alpha/lib_protocol/src/script_interpreter.mli index fe563660d..5c33ae5f5 100644 --- a/src/proto_alpha/lib_protocol/src/script_interpreter.mli +++ b/src/proto_alpha/lib_protocol/src/script_interpreter.mli @@ -18,11 +18,13 @@ type execution_result = origination_nonce : Contract.origination_nonce ; storage : Script.expr ; big_map_diff : Contract.big_map_diff option ; - return_value : Script.expr } + operations : internal_operation list } val execute: Alpha_context.t -> Contract.origination_nonce -> + check_operations: bool -> source: Contract.t -> + payer: Contract.t -> self: (Contract.t * Script.t) -> parameter: Script.expr -> amount: Tez.t -> @@ -33,7 +35,9 @@ type execution_trace = val trace: Alpha_context.t -> Contract.origination_nonce -> + check_operations: bool -> source: Contract.t -> + payer: Contract.t -> self: (Contract.t * Script.t) -> parameter: Script.expr -> amount: Tez.t -> diff --git a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml index 6c8ac1733..6a8c7c665 100644 --- a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml @@ -20,9 +20,7 @@ type ex_stack_ty = Ex_stack_ty : 'a stack_ty -> ex_stack_ty type tc_context = | Lambda : tc_context | Dip : 'a stack_ty * tc_context -> tc_context - | Toplevel : { storage_type : 'sto ty ; - param_type : 'param ty ; - ret_type : 'ret ty } -> tc_context + | Toplevel : { storage_type : 'sto ty ; param_type : 'param ty } -> tc_context let add_dip ty annot prev = match prev with @@ -60,6 +58,7 @@ let rec type_size : type t. t ty -> int = function | Key_t -> 1 | Timestamp_t -> 1 | Bool_t -> 1 + | Operation_t -> 1 | Pair_t ((l, _), (r, _)) -> 1 + type_size l + type_size r | Union_t ((l, _), (r, _)) -> @@ -76,8 +75,8 @@ let rec type_size : type t. t ty -> int = function 1 + comparable_type_size k + type_size v | Big_map_t (k, v) -> 1 + comparable_type_size k + type_size v - | Contract_t (arg, ret) -> - 1 + type_size arg + type_size ret + | Contract_t arg -> + 1 + type_size arg let rec type_size_of_stack_head : type st. st stack_ty -> up_to:int -> int @@ -191,7 +190,7 @@ let number_of_generated_growing_types : type b a. (b, a) instr -> int = function | Le -> 0 | Ge -> 0 | Manager -> 0 - | Transfer_tokens _ -> 1 + | Transfer_tokens -> 1 | Create_account -> 0 | Implicit_account -> 0 | Create_contract _ -> 1 @@ -222,7 +221,6 @@ let kind = function let namespace = function | K_parameter - | K_return | K_storage | K_code -> Keyword_namespace | D_False @@ -320,7 +318,8 @@ let namespace = function | T_string | T_tez | T_timestamp - | T_unit -> Type_namespace + | T_unit + | T_operation -> Type_namespace let unexpected expr exp_kinds exp_ns exp_prims = @@ -516,10 +515,10 @@ let rec unparse_ty | Key_t -> Prim (-1, T_key, [], annot) | Timestamp_t -> Prim (-1, T_timestamp, [], annot) | Signature_t -> Prim (-1, T_signature, [], annot) - | Contract_t (utl, utr) -> - let tl = unparse_ty None utl in - let tr = unparse_ty None utr in - Prim (-1, T_contract, [ tl; tr ], annot) + | Operation_t -> Prim (-1, T_operation, [], annot) + | Contract_t ut -> + let t = unparse_ty None ut in + Prim (-1, T_contract, [ t ], annot) | Pair_t ((utl, left_annot), (utr, right_annot)) -> let tl = unparse_ty left_annot utl in let tr = unparse_ty right_annot utr in @@ -582,7 +581,7 @@ let rec unparse_data | None -> ok @@ (Int (-1, Script_timestamp.to_zint t), gas) | Some s -> ok @@ (String (-1, s), gas) end - | Contract_t _, (_, _, c) -> + | Contract_t _, (_, c) -> Gas.consume ctxt Unparse_costs.contract >|? fun gas -> (String (-1, Contract.to_b58check c), gas) | Signature_t, s -> @@ -600,6 +599,11 @@ let rec unparse_data | Key_hash_t, k -> Gas.consume ctxt Unparse_costs.key_hash >|? fun gas -> (String (-1, Signature.Public_key_hash.to_b58check k), gas) + | Operation_t, op -> + let bytes = Data_encoding.Binary.to_bytes_exn Operation.internal_operation_encoding op in + let `Hex text = MBytes.to_hex bytes in + Gas.consume ctxt (Unparse_costs.operation bytes) >>? fun ctxt -> + ok (String (-1, text), ctxt) | Pair_t ((tl, _), (tr, _)), (l, r) -> Gas.consume ctxt Unparse_costs.pair >>? fun gas -> unparse_data gas tl l >>? fun (l, gas) -> @@ -688,6 +692,7 @@ let rec ty_eq | Tez_t, Tez_t -> Ok Eq | Timestamp_t, Timestamp_t -> Ok Eq | Bool_t, Bool_t -> Ok Eq + | Operation_t, Operation_t -> Ok Eq | Map_t (tal, tar), Map_t (tbl, tbr) -> (comparable_ty_eq tal tbl >>? fun Eq -> ty_eq tar tbr >>? fun Eq -> @@ -718,9 +723,8 @@ let rec ty_eq ty_eq tar tbr >>? fun Eq -> (Ok Eq : (ta ty, tb ty) eq tzresult)) |> record_trace (Inconsistent_types (ta, tb)) - | Contract_t (tal, tar), Contract_t (tbl, tbr) -> + | Contract_t tal, Contract_t tbl -> (ty_eq tal tbl >>? fun Eq -> - ty_eq tar tbr >>? fun Eq -> (Ok Eq : (ta ty, tb ty) eq tzresult)) |> record_trace (Inconsistent_types (ta, tb)) | Option_t tva, Option_t tvb -> @@ -798,6 +802,7 @@ let merge_types : | Tez_t, Tez_t -> ok Tez_t | Timestamp_t, Timestamp_t -> ok Timestamp_t | Bool_t, Bool_t -> ok Bool_t + | Operation_t, Operation_t -> ok Operation_t | Map_t (tal, tar), Map_t (tbl, tbr) -> help tar tbr >>? fun value -> ty_eq tar value >>? fun Eq -> @@ -826,10 +831,9 @@ let merge_types : help tal tbl >>? fun left_ty -> help tar tbr >|? fun right_ty -> Lambda_t (left_ty, right_ty) - | Contract_t (tal, tar), Contract_t (tbl, tbr) -> - help tal tbl >>? fun left_ty -> - help tar tbr >|? fun right_ty -> - Contract_t (left_ty, right_ty) + | Contract_t tal, Contract_t tbl -> + help tal tbl >|? fun arg_ty -> + Contract_t arg_ty | Option_t tva, Option_t tvb -> help tva tvb >|? fun ty -> Option_t ty @@ -910,7 +914,7 @@ let rec parse_comparable_ty | Prim (loc, (T_pair | T_or | T_set | T_map | T_list | T_option | T_lambda | T_unit | T_signature | T_contract), _, _) as expr -> - parse_ty false expr >>? fun (Ex_ty ty, _) -> + parse_ty ~allow_big_map:false expr >>? fun (Ex_ty ty, _) -> error (Comparable_type_expected (loc, ty)) | expr -> error @@ unexpected expr [] Type_namespace @@ -919,19 +923,19 @@ let rec parse_comparable_ty T_key ; T_key_hash ; T_timestamp ] and parse_ty - : bool -> Script.node -> (ex_ty * annot) tzresult - = fun big_map_possible node -> + : allow_big_map: bool -> Script.node -> (ex_ty * annot) tzresult + = fun ~allow_big_map node -> match node with | Prim (_, T_pair, [ Prim (big_map_loc, T_big_map, args, map_annot) ; remaining_storage ], storage_annot) - when big_map_possible -> + when allow_big_map -> begin match args with | [ key_ty ; value_ty ] -> parse_comparable_ty key_ty >>? fun (Ex_comparable_ty key_ty) -> - parse_ty false value_ty >>? fun (Ex_ty value_ty, right_annot) -> + parse_ty ~allow_big_map:false value_ty >>? fun (Ex_ty value_ty, right_annot) -> error_unexpected_annot big_map_loc right_annot >>? fun () -> - parse_ty false remaining_storage >>? fun (Ex_ty remaining_storage, remaining_annot) -> + parse_ty ~allow_big_map:false remaining_storage >>? fun (Ex_ty remaining_storage, remaining_annot) -> ok (Ex_ty (Pair_t ((Big_map_t (key_ty, value_ty), map_annot), (remaining_storage, remaining_annot))), storage_annot) @@ -957,30 +961,30 @@ and parse_ty ok (Ex_ty Timestamp_t, annot) | Prim (_, T_signature, [], annot) -> ok (Ex_ty Signature_t, annot) - | Prim (loc, T_contract, [ utl; utr ], annot) -> - parse_ty false utl >>? fun (Ex_ty tl, left_annot) -> - parse_ty false utr >>? fun (Ex_ty tr, right_annot) -> - error_unexpected_annot loc left_annot >>? fun () -> - error_unexpected_annot loc right_annot >|? fun () -> - (Ex_ty (Contract_t (tl, tr)), annot) + | Prim (_, T_operation, [], annot) -> + ok (Ex_ty Operation_t, annot) + | Prim (loc, T_contract, [ utl ], annot) -> + parse_ty ~allow_big_map:false utl >>? fun (Ex_ty tl, left_annot) -> + error_unexpected_annot loc left_annot >|? fun () -> + (Ex_ty (Contract_t tl), annot) | Prim (_, T_pair, [ utl; utr ], annot) -> - parse_ty false utl >>? fun (Ex_ty tl, left_annot) -> - parse_ty false utr >|? fun (Ex_ty tr, right_annot) -> + parse_ty ~allow_big_map:false utl >>? fun (Ex_ty tl, left_annot) -> + parse_ty ~allow_big_map:false utr >|? fun (Ex_ty tr, right_annot) -> (Ex_ty (Pair_t ((tl, left_annot), (tr, right_annot))), annot) | Prim (_, T_or, [ utl; utr ], annot) -> - parse_ty false utl >>? fun (Ex_ty tl, left_annot) -> - parse_ty false utr >|? fun (Ex_ty tr, right_annot) -> + parse_ty ~allow_big_map:false utl >>? fun (Ex_ty tl, left_annot) -> + parse_ty ~allow_big_map:false utr >|? fun (Ex_ty tr, right_annot) -> (Ex_ty (Union_t ((tl, left_annot), (tr, right_annot))), annot) | Prim (_, T_lambda, [ uta; utr ], annot) -> - parse_ty false uta >>? fun (Ex_ty ta, _) -> - parse_ty false utr >|? fun (Ex_ty tr, _) -> + parse_ty ~allow_big_map:false uta >>? fun (Ex_ty ta, _) -> + parse_ty ~allow_big_map:false utr >|? fun (Ex_ty tr, _) -> (Ex_ty (Lambda_t (ta, tr)), annot) | Prim (loc, T_option, [ ut ], annot) -> - parse_ty false ut >>? fun (Ex_ty t, opt_annot) -> + parse_ty ~allow_big_map:false ut >>? fun (Ex_ty t, opt_annot) -> error_unexpected_annot loc annot >|? fun () -> (Ex_ty (Option_t t), opt_annot) | Prim (loc, T_list, [ ut ], annot) -> - parse_ty false ut >>? fun (Ex_ty t, list_annot) -> + parse_ty ~allow_big_map:false ut >>? fun (Ex_ty t, list_annot) -> error_unexpected_annot loc list_annot >>? fun () -> ok (Ex_ty (List_t t), annot) | Prim (_, T_set, [ ut ], annot) -> @@ -988,7 +992,7 @@ and parse_ty ok (Ex_ty (Set_t t), annot) | Prim (_, T_map, [ uta; utr ], annot) -> parse_comparable_ty uta >>? fun (Ex_comparable_ty ta) -> - parse_ty false utr >>? fun (Ex_ty tr, _) -> + parse_ty ~allow_big_map:false utr >>? fun (Ex_ty tr, _) -> ok (Ex_ty (Map_t (ta, tr)), annot) | Prim (loc, T_big_map, _, _) -> error (Unexpected_big_map loc) @@ -1006,7 +1010,7 @@ and parse_ty [ T_pair ; T_or ; T_set ; T_map ; T_list ; T_option ; T_lambda ; T_unit ; T_signature ; T_contract ; - T_int ; T_nat ; + T_int ; T_nat ; T_operation ; T_string ; T_tez ; T_bool ; T_key ; T_key_hash ; T_timestamp ] @@ -1016,13 +1020,13 @@ let rec unparse_stack | Empty_t -> [] | Item_t (ty, rest, annot) -> strip_locations (unparse_ty annot ty) :: unparse_stack rest -type ex_script = Ex_script : ('a, 'b, 'c) script -> ex_script +type ex_script = Ex_script : ('a, 'c) script -> ex_script let rec parse_data : type a. ?type_logger: (int -> Script.expr list -> Script.expr list -> unit) -> - context -> a ty -> Script.node -> (a * context) tzresult Lwt.t - = fun ?type_logger ctxt ty script_data -> + context -> check_operations: bool -> a ty -> Script.node -> (a * context) tzresult Lwt.t + = fun ?type_logger ctxt ~check_operations ty script_data -> Lwt.return (Gas.consume ctxt Typecheck_costs.cycle) >>=? fun ctxt -> let error () = Invalid_constant (location script_data, strip_locations script_data, ty) in @@ -1035,7 +1039,7 @@ let rec parse_data match item with | Prim (_, D_Elt, [ k; v ], _) -> parse_comparable_data ?type_logger ctxt key_type k >>=? fun (k, ctxt) -> - parse_data ?type_logger ctxt value_type v >>=? fun (v, ctxt) -> + parse_data ?type_logger ctxt ~check_operations value_type v >>=? fun (v, ctxt) -> begin match last_value with | Some value -> if Compare.Int.(0 <= (compare_comparable key_type value k)) @@ -1149,21 +1153,48 @@ let rec parse_data end | Signature_t, expr -> traced (fail (Invalid_kind (location expr, [ String_kind ], kind expr))) + (* Operations *) + | Operation_t, String (_, s) -> begin try + Lwt.return (Gas.consume ctxt (Typecheck_costs.operation s)) >>=? fun ctxt -> + match Data_encoding.Binary.of_bytes + Operation.internal_operation_encoding + (MBytes.of_hex (`Hex s)) with + | Some op -> + begin match check_operations, op.signature with + | true, None -> fail (error ()) + | false, _ -> return (op, ctxt) + | true, Some signature -> + let unsigned = + Data_encoding.Binary.to_bytes_exn + Operation.internal_operation_encoding + { op with signature = None } in + Contract.get_manager_key ctxt op.source >>=? fun public_key -> + if Signature.check public_key signature unsigned then + return (op, ctxt) + else + fail (error ()) + end + | None -> raise Not_found + with _ -> + fail (error ()) + end + | Operation_t, expr -> + traced (fail (Invalid_kind (location expr, [ String_kind ], kind expr))) (* Contracts *) - | Contract_t (ty1, ty2), String (loc, s) -> + | Contract_t ty1, String (loc, s) -> Lwt.return (Gas.consume ctxt Typecheck_costs.contract) >>=? fun ctxt -> traced @@ (Lwt.return (Contract.of_b58check s)) >>=? fun c -> - parse_contract ctxt ty1 ty2 loc c >>=? fun _ -> - return ((ty1, ty2, c), ctxt) + parse_contract ctxt ty1 loc c >>=? fun _ -> + return ((ty1, c), ctxt) | Contract_t _, expr -> traced (fail (Invalid_kind (location expr, [ String_kind ], kind expr))) (* Pairs *) | Pair_t ((ta, _), (tb, _)), Prim (_, D_Pair, [ va; vb ], _) -> Lwt.return (Gas.consume ctxt Typecheck_costs.pair) >>=? fun ctxt -> traced @@ - parse_data ?type_logger ctxt ta va >>=? fun (va, ctxt) -> - parse_data ?type_logger ctxt tb vb >>=? fun (vb, ctxt) -> + parse_data ?type_logger ctxt ~check_operations ta va >>=? fun (va, ctxt) -> + parse_data ?type_logger ctxt ~check_operations tb vb >>=? fun (vb, ctxt) -> return ((va, vb), ctxt) | Pair_t _, Prim (loc, D_Pair, l, _) -> fail @@ Invalid_arity (loc, D_Pair, 2, List.length l) @@ -1173,14 +1204,14 @@ let rec parse_data | Union_t ((tl, _), _), Prim (_, D_Left, [ v ], _) -> Lwt.return (Gas.consume ctxt Typecheck_costs.union) >>=? fun ctxt -> traced @@ - parse_data ?type_logger ctxt tl v >>=? fun (v, ctxt) -> + parse_data ?type_logger ctxt ~check_operations tl v >>=? fun (v, ctxt) -> return (L v, ctxt) | Union_t _, Prim (loc, D_Left, l, _) -> fail @@ Invalid_arity (loc, D_Left, 1, List.length l) | Union_t (_, (tr, _)), Prim (_, D_Right, [ v ], _) -> Lwt.return (Gas.consume ctxt Typecheck_costs.union) >>=? fun ctxt -> traced @@ - parse_data ?type_logger ctxt tr v >>=? fun (v, ctxt) -> + parse_data ?type_logger ctxt ~check_operations tr v >>=? fun (v, ctxt) -> return (R v, ctxt) | Union_t _, Prim (loc, D_Right, l, _) -> fail @@ Invalid_arity (loc, D_Right, 1, List.length l) @@ -1190,14 +1221,14 @@ let rec parse_data | Lambda_t (ta, tr), (Seq _ as script_instr) -> Lwt.return (Gas.consume ctxt Typecheck_costs.lambda) >>=? fun ctxt -> traced @@ - parse_returning Lambda ?type_logger ctxt (ta, Some "@arg") tr script_instr + parse_returning Lambda ?type_logger ~check_operations ctxt (ta, Some "@arg") tr script_instr | Lambda_t _, expr -> traced (fail (Invalid_kind (location expr, [ Seq_kind ], kind expr))) (* Options *) | Option_t t, Prim (_, D_Some, [ v ], _) -> Lwt.return (Gas.consume ctxt Typecheck_costs.some) >>=? fun ctxt -> traced @@ - parse_data ?type_logger ctxt t v >>=? fun (v, ctxt) -> + parse_data ?type_logger ctxt ~check_operations t v >>=? fun (v, ctxt) -> return (Some v, ctxt) | Option_t _, Prim (loc, D_Some, l, _) -> fail @@ Invalid_arity (loc, D_Some, 1, List.length l) @@ -1215,7 +1246,7 @@ let rec parse_data fold_right_s (fun v (rest, ctxt) -> Lwt.return (Gas.consume ctxt Typecheck_costs.list_element) >>=? fun ctxt -> - parse_data ?type_logger ctxt t v >>=? fun (v, ctxt) -> + parse_data ?type_logger ctxt ~check_operations t v >>=? fun (v, ctxt) -> return ((v :: rest), ctxt)) items ([], ctxt) | List_t _, expr -> @@ -1258,17 +1289,20 @@ let rec parse_data traced (fail (Invalid_kind (location expr, [ Seq_kind ], kind expr))) and parse_comparable_data - : type a. ?type_logger:(int -> Script.expr list -> Script.expr list -> unit) -> + : type a. + ?type_logger:(int -> Script.expr list -> Script.expr list -> unit) -> context -> a comparable_ty -> Script.node -> (a * context) tzresult Lwt.t = fun ?type_logger ctxt ty script_data -> - parse_data ?type_logger ctxt (ty_of_comparable_ty ty) script_data + parse_data ?type_logger ctxt ~check_operations:false (ty_of_comparable_ty ty) script_data and parse_returning - : type arg ret. tc_context -> context -> + : type arg ret. ?type_logger: (int -> Script.expr list -> Script.expr list -> unit) -> - arg ty * annot -> ret ty -> Script.node -> ((arg, ret) lambda * context) tzresult Lwt.t = - fun tc_context ctxt ?type_logger (arg, arg_annot) ret script_instr -> - parse_instr tc_context ctxt ?type_logger + tc_context -> context -> + check_operations: bool -> + arg ty * annot -> ret ty -> Script.node -> ((arg, ret) lambda * context) tzresult Lwt.t = + fun ?type_logger tc_context ctxt ~check_operations (arg, arg_annot) ret script_instr -> + parse_instr ?type_logger tc_context ctxt ~check_operations script_instr (Item_t (arg, Empty_t, arg_annot)) >>=? function | (Typed ({ loc ; aft = (Item_t (ty, Empty_t, _) as stack_ty) ; _ } as descr), gas) -> trace @@ -1283,11 +1317,11 @@ and parse_returning and parse_instr : type bef. - tc_context -> - context -> ?type_logger: (int -> Script.expr list -> Script.expr list -> unit) -> - Script.node -> bef stack_ty -> (bef judgement * context) tzresult Lwt.t = - fun tc_context ctxt ?type_logger script_instr stack_ty -> + tc_context -> context -> + check_operations: bool -> + Script.node -> bef stack_ty -> (bef judgement * context) tzresult Lwt.t = + fun ?type_logger tc_context ctxt ~check_operations script_instr stack_ty -> let return : context -> bef judgement -> (bef judgement * context) tzresult Lwt.t = fun ctxt judgement -> match judgement with @@ -1338,8 +1372,8 @@ and parse_instr (Item_t (w, Item_t (v, rest, cur_top_annot), annot)) | Prim (loc, I_PUSH, [ t ; d ], instr_annot), stack -> - (Lwt.return (parse_ty false t)) >>=? fun (Ex_ty t, _) -> - parse_data ?type_logger ctxt t d >>=? fun (v, ctxt) -> + (Lwt.return (parse_ty ~allow_big_map:false t)) >>=? fun (Ex_ty t, _) -> + parse_data ?type_logger ctxt ~check_operations t d >>=? fun (v, ctxt) -> typed ctxt loc (Const v) (Item_t (t, stack, instr_annot)) | Prim (loc, I_UNIT, [], instr_annot), @@ -1353,15 +1387,15 @@ and parse_instr (Item_t (Option_t t, rest, instr_annot)) | Prim (loc, I_NONE, [ t ], instr_annot), stack -> - (Lwt.return (parse_ty false t)) >>=? fun (Ex_ty t, _) -> + (Lwt.return (parse_ty ~allow_big_map:false t)) >>=? fun (Ex_ty t, _) -> typed ctxt loc (Cons_none t) (Item_t (Option_t t, stack, instr_annot)) | Prim (loc, I_IF_NONE, [ bt ; bf ], instr_annot), (Item_t (Option_t t, rest, _) as bef) -> check_kind [ Seq_kind ] bt >>=? fun () -> check_kind [ Seq_kind ] bf >>=? fun () -> - parse_instr ?type_logger tc_context ctxt bt rest >>=? fun (btr, ctxt) -> - parse_instr ?type_logger tc_context ctxt bf (Item_t (t, rest, instr_annot)) >>=? fun (bfr, ctxt) -> + parse_instr ?type_logger tc_context ctxt ~check_operations bt rest >>=? fun (btr, ctxt) -> + parse_instr ?type_logger tc_context ctxt ~check_operations bf (Item_t (t, rest, instr_annot)) >>=? fun (bfr, ctxt) -> let branch ibt ibf = { loc ; instr = If_none (ibt, ibf) ; bef ; aft = ibt.aft } in merge_branches loc btr bfr { branch } >>=? fun judgement -> @@ -1384,12 +1418,12 @@ and parse_instr (* unions *) | Prim (loc, I_LEFT, [ tr ], instr_annot), Item_t (tl, rest, stack_annot) -> - (Lwt.return (parse_ty false tr)) >>=? fun (Ex_ty tr, _) -> + (Lwt.return (parse_ty ~allow_big_map:false tr)) >>=? fun (Ex_ty tr, _) -> typed ctxt loc Left (Item_t (Union_t ((tl, stack_annot), (tr, None)), rest, instr_annot)) | Prim (loc, I_RIGHT, [ tl ], instr_annot), Item_t (tr, rest, stack_annot) -> - (Lwt.return (parse_ty false tl)) >>=? fun (Ex_ty tl, _) -> + (Lwt.return (parse_ty ~allow_big_map:false tl)) >>=? fun (Ex_ty tl, _) -> typed ctxt loc Right (Item_t (Union_t ((tl, None), (tr, stack_annot)), rest, instr_annot)) | Prim (loc, I_IF_LEFT, [ bt ; bf ], instr_annot), @@ -1397,8 +1431,8 @@ and parse_instr check_kind [ Seq_kind ] bt >>=? fun () -> check_kind [ Seq_kind ] bf >>=? fun () -> fail_unexpected_annot loc instr_annot >>=? fun () -> - parse_instr ?type_logger tc_context ctxt bt (Item_t (tl, rest, left_annot)) >>=? fun (btr, ctxt) -> - parse_instr ?type_logger tc_context ctxt bf (Item_t (tr, rest, right_annot)) >>=? fun (bfr, ctxt) -> + parse_instr ?type_logger tc_context ctxt ~check_operations bt (Item_t (tl, rest, left_annot)) >>=? fun (btr, ctxt) -> + parse_instr ?type_logger tc_context ctxt ~check_operations bf (Item_t (tr, rest, right_annot)) >>=? fun (bfr, ctxt) -> let branch ibt ibf = { loc ; instr = If_left (ibt, ibf) ; bef ; aft = ibt.aft } in merge_branches loc btr bfr { branch } >>=? fun judgement -> @@ -1406,7 +1440,7 @@ and parse_instr (* lists *) | Prim (loc, I_NIL, [ t ], instr_annot), stack -> - (Lwt.return (parse_ty false t)) >>=? fun (Ex_ty t, _) -> + (Lwt.return (parse_ty ~allow_big_map:false t)) >>=? fun (Ex_ty t, _) -> typed ctxt loc Nil (Item_t (List_t t, stack, instr_annot)) | Prim (loc, I_CONS, [], instr_annot), @@ -1418,9 +1452,10 @@ and parse_instr (Item_t (List_t t, rest, stack_annot) as bef) -> check_kind [ Seq_kind ] bt >>=? fun () -> check_kind [ Seq_kind ] bf >>=? fun () -> - parse_instr ?type_logger tc_context ctxt bt + parse_instr ?type_logger tc_context ctxt ~check_operations bt (Item_t (t, Item_t (List_t t, rest, stack_annot), instr_annot)) >>=? fun (btr, ctxt) -> - parse_instr ?type_logger tc_context ctxt bf rest >>=? fun (bfr, ctxt) -> + parse_instr ?type_logger tc_context ctxt ~check_operations bf + rest >>=? fun (bfr, ctxt) -> let branch ibt ibf = { loc ; instr = If_cons (ibt, ibf) ; bef ; aft = ibt.aft } in merge_branches loc btr bfr { branch } >>=? fun judgement -> @@ -1437,7 +1472,8 @@ and parse_instr | Prim (loc, I_MAP, [ body ], instr_annot), (Item_t (List_t elt, starting_rest, _)) -> check_kind [ Seq_kind ] body >>=? fun () -> - parse_instr ?type_logger tc_context ctxt body (Item_t (elt, starting_rest, None)) >>=? begin fun (judgement, ctxt) -> + parse_instr ?type_logger tc_context ctxt ~check_operations + body (Item_t (elt, starting_rest, None)) >>=? begin fun (judgement, ctxt) -> match judgement with | Typed ({ aft = Item_t (ret, rest, _) ; _ } as ibody) -> trace @@ -1460,7 +1496,8 @@ and parse_instr Item_t (List_t elt, rest, _) -> check_kind [ Seq_kind ] body >>=? fun () -> fail_unexpected_annot loc instr_annot >>=? fun () -> - parse_instr ?type_logger tc_context ctxt body (Item_t (elt, rest, None)) >>=? begin fun (judgement, ctxt) -> + parse_instr ?type_logger tc_context ctxt ~check_operations + body (Item_t (elt, rest, None)) >>=? begin fun (judgement, ctxt) -> match judgement with | Typed ({ aft ; _ } as ibody) -> trace @@ -1490,7 +1527,8 @@ and parse_instr check_kind [ Seq_kind ] body >>=? fun () -> fail_unexpected_annot loc annot >>=? fun () -> let elt = ty_of_comparable_ty comp_elt in - parse_instr ?type_logger tc_context ctxt body (Item_t (elt, rest, None)) >>=? begin fun (judgement, ctxt) -> + parse_instr ?type_logger tc_context ctxt ~check_operations + body (Item_t (elt, rest, None)) >>=? begin fun (judgement, ctxt) -> match judgement with | Typed ({ aft ; _ } as ibody) -> trace @@ -1520,7 +1558,7 @@ and parse_instr | Prim (loc, I_EMPTY_MAP, [ tk ; tv ], instr_annot), stack -> (Lwt.return (parse_comparable_ty tk)) >>=? fun (Ex_comparable_ty tk) -> - (Lwt.return (parse_ty false tv)) >>=? fun (Ex_ty tv, _) -> + (Lwt.return (parse_ty ~allow_big_map:false tv)) >>=? fun (Ex_ty tv, _) -> typed ctxt loc (Empty_map (tk, tv)) (Item_t (Map_t (tk, tv), stack, instr_annot)) | Prim (loc, I_MAP, [], instr_annot), @@ -1547,7 +1585,7 @@ and parse_instr check_kind [ Seq_kind ] body >>=? fun () -> fail_unexpected_annot loc instr_annot >>=? fun () -> let key = ty_of_comparable_ty comp_elt in - parse_instr ?type_logger tc_context ctxt body + parse_instr ?type_logger tc_context ctxt ~check_operations body (Item_t (Pair_t ((key, None), (element_ty, None)), rest, None)) >>=? begin fun (judgement, ctxt) -> match judgement with | Typed ({ aft ; _ } as ibody) -> @@ -1609,7 +1647,8 @@ and parse_instr | Seq (loc, [ single ], annot), stack -> fail_unexpected_annot loc annot >>=? fun () -> - parse_instr ?type_logger tc_context ctxt single stack >>=? begin fun (judgement, ctxt) -> + parse_instr ?type_logger tc_context ctxt ~check_operations single + stack >>=? begin fun (judgement, ctxt) -> match judgement with | Typed ({ aft ; _ } as instr) -> let nop = { bef = aft ; loc = loc ; aft ; instr = Nop } in @@ -1624,12 +1663,14 @@ and parse_instr | Seq (loc, hd :: tl, annot), stack -> fail_unexpected_annot loc annot >>=? fun () -> - parse_instr ?type_logger tc_context ctxt hd stack >>=? begin fun (judgement, ctxt) -> + parse_instr ?type_logger tc_context ctxt ~check_operations hd + stack >>=? begin fun (judgement, ctxt) -> match judgement with | Failed _ -> fail (Fail_not_in_tail_position (Micheline.location hd)) | Typed ({ aft = middle ; _ } as ihd) -> - parse_instr ?type_logger tc_context ctxt (Seq (-1, tl, None)) middle >>=? fun (judgement, ctxt) -> + parse_instr ?type_logger tc_context ctxt ~check_operations (Seq (-1, tl, None)) + middle >>=? fun (judgement, ctxt) -> match judgement with | Failed { descr } -> let descr ret = @@ -1643,8 +1684,10 @@ and parse_instr (Item_t (Bool_t, rest, _) as bef) -> check_kind [ Seq_kind ] bt >>=? fun () -> check_kind [ Seq_kind ] bf >>=? fun () -> - parse_instr ?type_logger tc_context ctxt bt rest >>=? fun (btr, ctxt) -> - parse_instr ?type_logger tc_context ctxt bf rest >>=? fun (bfr, ctxt) -> + parse_instr ?type_logger tc_context ctxt ~check_operations bt + rest >>=? fun (btr, ctxt) -> + parse_instr ?type_logger tc_context ctxt ~check_operations bf + rest >>=? fun (bfr, ctxt) -> let branch ibt ibf = { loc ; instr = If (ibt, ibf) ; bef ; aft = ibt.aft } in merge_branches loc btr bfr { branch } >>=? fun judgement -> @@ -1652,7 +1695,8 @@ and parse_instr | Prim (loc, I_LOOP, [ body ], _), (Item_t (Bool_t, rest, stack_annot) as stack) -> check_kind [ Seq_kind ] body >>=? fun () -> - parse_instr ?type_logger tc_context ctxt body rest >>=? begin fun (judgement, ctxt) -> + parse_instr ?type_logger tc_context ctxt ~check_operations body + rest >>=? begin fun (judgement, ctxt) -> match judgement with | Typed ibody -> trace @@ -1667,8 +1711,8 @@ and parse_instr (Item_t (Union_t ((tl, tl_annot), (tr, tr_annot)), rest, _) as stack) -> check_kind [ Seq_kind ] body >>=? fun () -> fail_unexpected_annot loc instr_annot >>=? fun () -> - parse_instr ?type_logger tc_context ctxt body (Item_t (tl, rest, tl_annot)) - >>=? begin fun (judgement, ctxt) -> match judgement with + parse_instr ?type_logger tc_context ctxt ~check_operations body + (Item_t (tl, rest, tl_annot)) >>=? begin fun (judgement, ctxt) -> match judgement with | Typed ibody -> trace (Unmatched_branches (loc, ibody.aft, stack)) @@ -1680,10 +1724,10 @@ and parse_instr end | Prim (loc, I_LAMBDA, [ arg ; ret ; code ], instr_annot), stack -> - (Lwt.return (parse_ty false arg)) >>=? fun (Ex_ty arg, arg_annot) -> - (Lwt.return (parse_ty false ret)) >>=? fun (Ex_ty ret, _) -> + (Lwt.return (parse_ty ~allow_big_map:false arg)) >>=? fun (Ex_ty arg, arg_annot) -> + (Lwt.return (parse_ty ~allow_big_map:false ret)) >>=? fun (Ex_ty ret, _) -> check_kind [ Seq_kind ] code >>=? fun () -> - parse_returning Lambda ?type_logger ctxt + parse_returning Lambda ?type_logger ctxt ~check_operations (arg, default_annot ~default:default_arg_annot arg_annot) ret code >>=? fun (lambda, ctxt) -> typed ctxt loc (Lambda lambda) @@ -1697,8 +1741,8 @@ and parse_instr Item_t (v, rest, stack_annot) -> fail_unexpected_annot loc instr_annot >>=? fun () -> check_kind [ Seq_kind ] code >>=? fun () -> - parse_instr ?type_logger (add_dip v stack_annot tc_context) ctxt code rest - >>=? begin fun (judgement, ctxt) -> match judgement with + parse_instr ?type_logger (add_dip v stack_annot tc_context) ctxt ~check_operations code + rest >>=? begin fun (judgement, ctxt) -> match judgement with | Typed descr -> typed ctxt loc (Dip descr) (Item_t (v, descr.aft, stack_annot)) | Failed _ -> @@ -1944,17 +1988,9 @@ and parse_instr | Prim (loc, I_TRANSFER_TOKENS, [], instr_annot), Item_t (p, Item_t (Tez_t, Item_t - (Contract_t (cp, cr), Item_t - (storage, Empty_t, storage_annot), _), _), _) -> + (Contract_t cp, rest, _), _), _) -> check_item_ty p cp loc I_TRANSFER_TOKENS 1 4 >>=? fun Eq -> - begin match tc_context with - | Dip _ -> fail (Transfer_in_dip loc) - | Lambda -> fail (Transfer_in_lambda loc) - | Toplevel { storage_type ; _ } -> - check_item_ty storage storage_type loc I_TRANSFER_TOKENS 3 4 >>=? fun Eq -> - typed ctxt loc (Transfer_tokens storage) - (Item_t (cr, Item_t (storage, Empty_t, storage_annot), instr_annot)) - end + typed ctxt loc Transfer_tokens (Item_t (Operation_t, rest, instr_annot)) | Prim (loc, I_CREATE_ACCOUNT, [], instr_annot), Item_t (Key_hash_t, Item_t @@ -1962,11 +1998,11 @@ and parse_instr (Bool_t, Item_t (Tez_t, rest, _), _), _), _) -> typed ctxt loc Create_account - (Item_t (Contract_t (Unit_t, Unit_t), rest, instr_annot)) + (Item_t (Contract_t Unit_t, rest, instr_annot)) | Prim (loc, I_IMPLICIT_ACCOUNT, [], instr_annot), Item_t (Key_hash_t, rest, _) -> typed ctxt loc Implicit_account - (Item_t (Contract_t (Unit_t, Unit_t), rest, instr_annot)) + (Item_t (Contract_t Unit_t, rest, instr_annot)) | Prim (loc, I_CREATE_CONTRACT, [], instr_annot), Item_t (Key_hash_t, Item_t @@ -1975,12 +2011,12 @@ and parse_instr (Bool_t, Item_t (Tez_t, Item_t (Lambda_t (Pair_t ((p, _), (gp, _)), - Pair_t ((r, _), (gr, _))), Item_t + Pair_t ((List_t Operation_t, _), (gr, _))), Item_t (ginit, rest, _), _), _), _), _), _), _) -> check_item_ty gp gr loc I_CREATE_CONTRACT 5 7 >>=? fun Eq -> check_item_ty ginit gp loc I_CREATE_CONTRACT 6 7 >>=? fun Eq -> - typed ctxt loc (Create_contract (gp, p, r)) - (Item_t (Contract_t (p, r), rest, instr_annot)) + typed ctxt loc (Create_contract (gp, p)) + (Item_t (Contract_t p, rest, instr_annot)) | Prim (loc, I_CREATE_CONTRACT, [ (Seq (seq_loc, _, annot) as code)], instr_annot), Item_t (Key_hash_t, Item_t @@ -1991,30 +2027,27 @@ and parse_instr (ginit, rest, _), _), _), _), _), _) -> fail_unexpected_annot seq_loc annot >>=? fun () -> let cannonical_code = fst @@ Micheline.extract_locations code in - Lwt.return (parse_toplevel cannonical_code) >>=? fun (arg_type, ret_type, storage_type, code_field) -> + Lwt.return (parse_toplevel cannonical_code) >>=? fun (arg_type, storage_type, code_field) -> trace (Ill_formed_type (Some "parameter", cannonical_code, location arg_type)) - (Lwt.return (parse_ty false arg_type)) >>=? fun (Ex_ty arg_type, param_annot) -> - trace - (Ill_formed_type (Some "return", cannonical_code, location ret_type)) - (Lwt.return (parse_ty false ret_type)) >>=? fun (Ex_ty ret_type, _) -> + (Lwt.return (parse_ty ~allow_big_map:false arg_type)) >>=? fun (Ex_ty arg_type, param_annot) -> trace (Ill_formed_type (Some "storage", cannonical_code, location storage_type)) - (Lwt.return (parse_ty true storage_type)) >>=? fun (Ex_ty storage_type, storage_annot) -> + (Lwt.return (parse_ty ~allow_big_map:true storage_type)) >>=? fun (Ex_ty storage_type, storage_annot) -> let arg_type_full = Pair_t ((arg_type, default_annot ~default:default_param_annot param_annot), (storage_type, default_annot ~default:default_storage_annot storage_annot)) in - let ret_type_full = Pair_t ((ret_type, None), (storage_type, None)) in + let ret_type_full = Pair_t ((List_t Operation_t, None), (storage_type, None)) in trace (Ill_typed_contract (cannonical_code, [])) - (parse_returning (Toplevel { storage_type ; param_type = arg_type ; ret_type }) - ctxt ?type_logger (arg_type_full, None) ret_type_full code_field) >>=? + (parse_returning (Toplevel { storage_type ; param_type = arg_type }) + ctxt ?type_logger ~check_operations (arg_type_full, None) ret_type_full code_field) >>=? fun (Lam ({ bef = Item_t (arg, Empty_t, _) ; aft = Item_t (ret, Empty_t, _) ; _ }, _) as lambda, ctxt) -> Lwt.return @@ ty_eq arg arg_type_full >>=? fun Eq -> Lwt.return @@ ty_eq ret ret_type_full >>=? fun Eq -> Lwt.return @@ ty_eq storage_type ginit >>=? fun Eq -> - typed ctxt loc (Create_contract_literal (storage_type, arg_type, ret_type, lambda)) - (Item_t (Contract_t (arg_type, ret_type), rest, instr_annot)) + typed ctxt loc (Create_contract_literal (storage_type, arg_type, lambda)) + (Item_t (Contract_t arg_type, rest, instr_annot)) | Prim (loc, I_NOW, [], instr_annot), stack -> typed ctxt loc Now @@ -2043,20 +2076,19 @@ and parse_instr stack -> typed ctxt loc Steps_to_quota (Item_t (Nat_t, stack, instr_annot)) - | Prim (loc, I_SOURCE, [ ta; tb ], instr_annot), + | Prim (loc, I_SOURCE, [ ta ], instr_annot), stack -> (Lwt.return (parse_ty false ta)) >>=? fun (Ex_ty ta, _) -> - (Lwt.return (parse_ty false tb)) >>=? fun (Ex_ty tb, _) -> - typed ctxt loc (Source (ta, tb)) - (Item_t (Contract_t (ta, tb), stack, instr_annot)) + typed ctxt loc (Source ta) + (Item_t (Contract_t ta, stack, instr_annot)) | Prim (loc, I_SELF, [], instr_annot), stack -> let rec get_toplevel_type : tc_context -> (bef judgement * context) tzresult Lwt.t = function | Lambda -> fail (Self_in_lambda loc) | Dip (_, prev) -> get_toplevel_type prev - | Toplevel { param_type ; ret_type ; _ } -> - typed ctxt loc (Self (param_type, ret_type)) - (Item_t (Contract_t (param_type, ret_type), stack, instr_annot)) in + | Toplevel { param_type ; _ } -> + typed ctxt loc (Self param_type) + (Item_t (Contract_t param_type, stack, instr_annot)) in get_toplevel_type tc_context (* Primitive parsing errors *) | Prim (loc, (I_DROP | I_DUP | I_SWAP | I_SOME | I_UNIT @@ -2111,7 +2143,7 @@ and parse_instr fail (Bad_stack (loc, I_CREATE_ACCOUNT, 4, stack)) | Prim (loc, I_TRANSFER_TOKENS, [], _), stack -> - fail (Bad_stack (loc, I_TRANSFER_TOKENS, 3, stack)) + fail (Bad_stack (loc, I_TRANSFER_TOKENS, 4, stack)) | Prim (loc, (I_DROP | I_DUP | I_CAR | I_CDR | I_SOME | I_H | I_DIP | I_IF_NONE | I_LEFT | I_RIGHT | I_IF_LEFT | I_IF | I_LOOP | I_IF_CONS | I_MANAGER | I_IMPLICIT_ACCOUNT @@ -2149,9 +2181,9 @@ and parse_instr I_EMPTY_MAP ; I_IF ; I_SOURCE ; I_SELF ; I_LAMBDA ] and parse_contract - : type arg ret. context -> arg ty -> ret ty -> Script.location -> Contract.t -> - ((arg, ret) typed_contract * context) tzresult Lwt.t - = fun ctxt arg ret loc contract -> + : type arg. context -> arg ty -> Script.location -> Contract.t -> + (arg typed_contract * context) tzresult Lwt.t + = fun ctxt arg loc contract -> Lwt.return (Gas.consume ctxt Typecheck_costs.contract_exists) >>=? fun ctxt -> Contract.exists ctxt contract >>=? function | false -> fail (Invalid_contract (loc, contract)) @@ -2163,117 +2195,101 @@ and parse_contract | None -> Lwt.return (ty_eq arg Unit_t >>? fun Eq -> - ty_eq ret Unit_t >>? fun Eq -> - let contract : (arg, ret) typed_contract = - (arg, ret, contract) in + let contract : arg typed_contract = (arg, contract) in ok (contract, ctxt)) | Some { code ; _ } -> Lwt.return - (parse_toplevel code >>? fun (arg_type, ret_type, _, _) -> - parse_ty false arg_type >>? fun (Ex_ty targ, _) -> - parse_ty false ret_type >>? fun (Ex_ty tret, _) -> + (parse_toplevel code >>? fun (arg_type, _, _) -> + parse_ty ~allow_big_map:false arg_type >>? fun (Ex_ty targ, _) -> ty_eq targ arg >>? fun Eq -> - ty_eq tret ret >>? fun Eq -> - let contract : (arg, ret) typed_contract = - (arg, ret, contract) in + let contract : arg typed_contract = (arg, contract) in ok (contract, ctxt)) and parse_toplevel - : Script.expr -> (Script.node * Script.node * Script.node * Script.node) tzresult + : Script.expr -> (Script.node * Script.node * Script.node) tzresult = fun toplevel -> match root toplevel with | Int (loc, _) -> error (Invalid_kind (loc, [ Seq_kind ], Int_kind)) | String (loc, _) -> error (Invalid_kind (loc, [ Seq_kind ], String_kind)) | Prim (loc, _, _, _) -> error (Invalid_kind (loc, [ Seq_kind ], Prim_kind)) | Seq (_, fields, _) -> - let rec find_fields p r s c fields = + let rec find_fields p s c fields = match fields with - | [] -> ok (p, r, s, c) + | [] -> ok (p, s, c) | Int (loc, _) :: _ -> error (Invalid_kind (loc, [ Prim_kind ], Int_kind)) | String (loc, _) :: _ -> error (Invalid_kind (loc, [ Prim_kind ], String_kind)) | Seq (loc, _, _) :: _ -> error (Invalid_kind (loc, [ Prim_kind ], Seq_kind)) | Prim (loc, K_parameter, [ arg ], _) :: rest -> begin match p with - | None -> find_fields (Some arg) r s c rest + | None -> find_fields (Some arg) s c rest | Some _ -> error (Duplicate_field (loc, K_parameter)) end - | Prim (loc, K_return, [ arg ], _) :: rest -> - begin match r with - | None -> find_fields p (Some arg) s c rest - | Some _ -> error (Duplicate_field (loc, K_return)) - end | Prim (loc, K_storage, [ arg ], _) :: rest -> begin match s with - | None -> find_fields p r (Some arg) c rest + | None -> find_fields p (Some arg) c rest | Some _ -> error (Duplicate_field (loc, K_storage)) end | Prim (loc, K_code, [ arg ], _) :: rest -> begin match c with - | None -> find_fields p r s (Some arg) rest + | None -> find_fields p s (Some arg) rest | Some _ -> error (Duplicate_field (loc, K_code)) end - | Prim (loc, (K_parameter | K_return | K_storage | K_code as name), args, _) :: _ -> + | Prim (loc, (K_parameter | K_storage | K_code as name), args, _) :: _ -> error (Invalid_arity (loc, name, 1, List.length args)) | Prim (loc, name, _, _) :: _ -> - let allowed = [ K_parameter ; K_return ; K_storage ; K_code ] in + let allowed = [ K_parameter ; K_storage ; K_code ] in error (Invalid_primitive (loc, allowed, name)) in - find_fields None None None None fields >>? function - | (None, _, _, _) -> error (Missing_field K_parameter) - | (Some _, None, _, _) -> error (Missing_field K_return) - | (Some _, Some _, None, _) -> error (Missing_field K_storage) - | (Some _, Some _, Some _, None) -> error (Missing_field K_code) - | (Some p, Some r, Some s, Some c) -> ok (p, r, s, c) + find_fields None None None fields >>? function + | (None, _, _) -> error (Missing_field K_parameter) + | (Some _, None, _) -> error (Missing_field K_storage) + | (Some _, Some _, None) -> error (Missing_field K_code) + | (Some p, Some s, Some c) -> ok (p, s, c) let parse_script : ?type_logger: (int -> Script.expr list -> Script.expr list -> unit) -> - context -> Script.t -> (ex_script * context) tzresult Lwt.t - = fun ?type_logger ctxt { code ; storage } -> - Lwt.return (parse_toplevel code) >>=? fun (arg_type, ret_type, storage_type, code_field) -> + context -> check_operations:bool -> Script.t -> (ex_script * context) tzresult Lwt.t + = fun ?type_logger ctxt ~check_operations { code ; storage } -> + Lwt.return (parse_toplevel code) >>=? fun (arg_type, storage_type, code_field) -> trace (Ill_formed_type (Some "parameter", code, location arg_type)) - (Lwt.return (parse_ty false arg_type)) >>=? fun (Ex_ty arg_type, param_annot) -> - trace - (Ill_formed_type (Some "return", code, location ret_type)) - (Lwt.return (parse_ty false ret_type)) >>=? fun (Ex_ty ret_type, _) -> + (Lwt.return (parse_ty ~allow_big_map:false arg_type)) >>=? fun (Ex_ty arg_type, param_annot) -> trace (Ill_formed_type (Some "storage", code, location storage_type)) - (Lwt.return (parse_ty true storage_type)) >>=? fun (Ex_ty storage_type, storage_annot) -> + (Lwt.return (parse_ty ~allow_big_map:true storage_type)) >>=? fun (Ex_ty storage_type, storage_annot) -> let arg_type_full = Pair_t ((arg_type, default_annot ~default:default_param_annot param_annot), (storage_type, default_annot ~default:default_storage_annot storage_annot)) in - let ret_type_full = Pair_t ((ret_type, None), (storage_type, None)) in + let ret_type_full = Pair_t ((List_t Operation_t, None), (storage_type, None)) in trace (Ill_typed_data (None, storage, storage_type)) - (parse_data ?type_logger ctxt storage_type (root storage)) >>=? fun (storage, ctxt) -> + (parse_data ?type_logger ctxt ~check_operations storage_type (root storage)) >>=? fun (storage, ctxt) -> trace (Ill_typed_contract (code, [])) - (parse_returning (Toplevel { storage_type ; param_type = arg_type ; ret_type }) - ctxt ?type_logger (arg_type_full, None) ret_type_full code_field) >>=? fun (code, ctxt) -> - return (Ex_script { code ; arg_type; ret_type; storage; storage_type }, ctxt) + (parse_returning (Toplevel { storage_type ; param_type = arg_type }) + ctxt ?type_logger ~check_operations (arg_type_full, None) ret_type_full code_field) >>=? fun (code, ctxt) -> + return (Ex_script { code ; arg_type ; storage ; storage_type }, ctxt) let typecheck_code : context -> Script.expr -> (type_map * context) tzresult Lwt.t = fun ctxt code -> - Lwt.return (parse_toplevel code) >>=? fun (arg_type, ret_type, storage_type, code_field) -> + Lwt.return (parse_toplevel code) >>=? fun (arg_type, storage_type, code_field) -> let type_map = ref [] in (* TODO: annotation checking *) trace (Ill_formed_type (Some "parameter", code, location arg_type)) - (Lwt.return (parse_ty false arg_type)) >>=? fun (Ex_ty arg_type, param_annot) -> - trace - (Ill_formed_type (Some "return", code, location ret_type)) - (Lwt.return (parse_ty false ret_type)) >>=? fun (Ex_ty ret_type, _) -> + (Lwt.return (parse_ty ~allow_big_map:false arg_type)) >>=? fun (Ex_ty arg_type, param_annot) -> trace (Ill_formed_type (Some "storage", code, location storage_type)) - (Lwt.return (parse_ty true storage_type)) >>=? fun (Ex_ty storage_type, storage_annot) -> + (Lwt.return (parse_ty ~allow_big_map:true storage_type)) >>=? fun (Ex_ty storage_type, storage_annot) -> let arg_type_full = Pair_t ((arg_type, default_annot ~default:default_param_annot param_annot), (storage_type, default_annot ~default:default_storage_annot storage_annot)) in - let ret_type_full = Pair_t ((ret_type, None), (storage_type, None)) in + let ret_type_full = Pair_t ((List_t Operation_t, None), (storage_type, None)) in let result = parse_returning - (Toplevel { storage_type ; param_type = arg_type ; ret_type }) + (Toplevel { storage_type ; param_type = arg_type }) ctxt ~type_logger: (fun loc bef aft -> type_map := (loc, (bef, aft)) :: !type_map) + ~check_operations: true (arg_type_full, None) ret_type_full code_field in trace (Ill_typed_contract (code, !type_map)) @@ -2282,14 +2298,14 @@ let typecheck_code let typecheck_data : ?type_logger: (int -> Script.expr list -> Script.expr list -> unit) -> - context -> Script.expr * Script.expr -> context tzresult Lwt.t - = fun ?type_logger ctxt (data, exp_ty) -> + context -> check_operations:bool -> Script.expr * Script.expr -> context tzresult Lwt.t + = fun ?type_logger ctxt ~check_operations (data, exp_ty) -> trace (Ill_formed_type (None, exp_ty, 0)) - (Lwt.return (parse_ty true (root exp_ty))) >>=? fun (Ex_ty exp_ty, _) -> + (Lwt.return (parse_ty ~allow_big_map:true (root exp_ty))) >>=? fun (Ex_ty exp_ty, _) -> trace (Ill_typed_data (None, data, exp_ty)) - (parse_data ?type_logger ctxt exp_ty (root data)) >>=? fun (_, ctxt) -> + (parse_data ?type_logger ctxt ~check_operations exp_ty (root data)) >>=? fun (_, ctxt) -> return ctxt let hash_data ctxt typ data = @@ -2317,7 +2333,8 @@ let big_map_get ctxt contract key { diff ; key_type ; value_type } = ctxt contract hash >>=? begin function | (ctxt, None) -> return (None, ctxt) | (ctxt, Some value) -> - parse_data ctxt value_type (Micheline.root value) >>=? fun (x, ctxt) -> + parse_data ctxt ~check_operations:false value_type + (Micheline.root value) >>=? fun (x, ctxt) -> return (Some x, ctxt) end @@ -2366,9 +2383,10 @@ let to_printable_big_map ctxt (Ex_bm { diff ; key_type ; value_type }) = Option.map ~f:(fun x -> Micheline.strip_locations @@ unparse value_type x) value) :: acc)) [] pairs let erase_big_map_initialization ctxt ({ code ; storage } : Script.t) = - Lwt.return @@ parse_toplevel code >>=? fun (_, _, storage_type, _) -> - Lwt.return @@ parse_ty true storage_type >>=? fun (Ex_ty ty, _) -> - parse_data ctxt ty (Micheline.root storage) >>=? fun (storage, ctxt) -> + Lwt.return @@ parse_toplevel code >>=? fun (_, storage_type, _) -> + Lwt.return @@ parse_ty ~allow_big_map:true storage_type >>=? fun (Ex_ty ty, _) -> + parse_data ctxt ~check_operations:true ty + (Micheline.root storage) >>=? fun (storage, ctxt) -> begin match extract_big_map ty storage with | None -> return (None, ctxt) diff --git a/src/proto_alpha/lib_protocol/src/script_ir_translator.mli b/src/proto_alpha/lib_protocol/src/script_ir_translator.mli index 5c7e3b14e..e80351fd1 100644 --- a/src/proto_alpha/lib_protocol/src/script_ir_translator.mli +++ b/src/proto_alpha/lib_protocol/src/script_ir_translator.mli @@ -15,7 +15,7 @@ type ('ta, 'tb) eq = Eq : ('same, 'same) eq type ex_comparable_ty = Ex_comparable_ty : 'a Script_typed_ir.comparable_ty -> ex_comparable_ty type ex_ty = Ex_ty : 'a Script_typed_ir.ty -> ex_ty type ex_stack_ty = Ex_stack_ty : 'a Script_typed_ir.stack_ty -> ex_stack_ty -type ex_script = Ex_script : ('a, 'b, 'c) Script_typed_ir.script -> ex_script +type ex_script = Ex_script : ('a, 'b) Script_typed_ir.script -> ex_script (* ---- Sets and Maps -------------------------------------------------------*) @@ -57,29 +57,30 @@ val ty_eq : val parse_data : ?type_logger: (int -> Script.expr list -> Script.expr list -> unit) -> - context -> 'a Script_typed_ir.ty -> Script.node -> ('a * context) tzresult Lwt.t + context -> check_operations: bool -> + 'a Script_typed_ir.ty -> Script.node -> ('a * context) tzresult Lwt.t val unparse_data : context -> 'a Script_typed_ir.ty -> 'a -> (Script.node * context) tzresult val parse_ty : - bool -> Script.node -> + allow_big_map: bool -> Script.node -> (ex_ty * Script_typed_ir.annot) tzresult val unparse_ty : string option -> 'a Script_typed_ir.ty -> Script.node val parse_toplevel - : Script.expr -> (Script.node * Script.node * Script.node * Script.node) tzresult + : Script.expr -> (Script.node * Script.node * Script.node) tzresult val typecheck_code : context -> Script.expr -> (type_map * context) tzresult Lwt.t val typecheck_data : ?type_logger: (int -> Script.expr list -> Script.expr list -> unit) -> - context -> Script.expr * Script.expr -> context tzresult Lwt.t + context -> check_operations:bool ->Script.expr * Script.expr -> context tzresult Lwt.t val parse_script : ?type_logger: (int -> Script.expr list -> Script.expr list -> unit) -> - context -> Script.t -> (ex_script * context) tzresult Lwt.t + context -> check_operations: bool -> Script.t -> (ex_script * context) tzresult Lwt.t val hash_data : context -> 'a Script_typed_ir.ty -> 'a -> (string * context) tzresult diff --git a/src/proto_alpha/lib_protocol/src/script_tc_errors.ml b/src/proto_alpha/lib_protocol/src/script_tc_errors.ml index 5ac5d09d0..d6d66f784 100644 --- a/src/proto_alpha/lib_protocol/src/script_tc_errors.ml +++ b/src/proto_alpha/lib_protocol/src/script_tc_errors.ml @@ -35,8 +35,6 @@ type error += Undefined_unop : Script.location * prim * _ ty -> error type error += Bad_return : Script.location * _ stack_ty * _ ty -> error type error += Bad_stack : Script.location * prim * int * _ stack_ty -> error type error += Unmatched_branches : Script.location * _ stack_ty * _ stack_ty -> error -type error += Transfer_in_lambda of Script.location -type error += Transfer_in_dip of Script.location type error += Self_in_lambda of Script.location type error += Bad_stack_length type error += Bad_stack_item of int diff --git a/src/proto_alpha/lib_protocol/src/script_tc_errors_registration.ml b/src/proto_alpha/lib_protocol/src/script_tc_errors_registration.ml index 3d3a6cea7..d89b52059 100644 --- a/src/proto_alpha/lib_protocol/src/script_tc_errors_registration.ml +++ b/src/proto_alpha/lib_protocol/src/script_tc_errors_registration.ml @@ -376,32 +376,6 @@ let () = | _ -> None) (fun n -> Bad_stack_item n) ; - (* TRANSFER_TOKENS in lambda *) - register_error_kind - `Permanent - ~id:"TransferInLambdaTypeError" - ~title: "Transfer in lambda (typechecking error)" - ~description: - "A TRANSFER_TOKENS instruction was encountered in a lambda expression." - (located empty) - (function - | Transfer_in_lambda loc -> Some (loc, ()) - | _ -> None) - (fun (loc, ()) -> - Transfer_in_lambda loc) ; - (* TRANSFER_TOKENS in DIP *) - register_error_kind - `Permanent - ~id:"TransferInDipTypeError" - ~title: "Transfer in DIP (typechecking error)" - ~description: - "A TRANSFER_TOKENS instruction was encountered in a DIP instruction." - (located empty) - (function - | Transfer_in_dip loc -> Some (loc, ()) - | _ -> None) - (fun (loc, ()) -> - Transfer_in_dip loc) ; (* SELF in lambda *) register_error_kind `Permanent diff --git a/src/proto_alpha/lib_protocol/src/script_typed_ir.ml b/src/proto_alpha/lib_protocol/src/script_typed_ir.ml index 9e8dbb583..f8475437d 100644 --- a/src/proto_alpha/lib_protocol/src/script_typed_ir.ml +++ b/src/proto_alpha/lib_protocol/src/script_typed_ir.ml @@ -43,10 +43,9 @@ type ('key, 'value) map = (module Boxed_map with type key = 'key and type value type annot = string option -type ('arg, 'ret, 'storage) script = - { code : (('arg, 'storage) pair, ('ret, 'storage) pair) lambda ; +type ('arg, 'storage) script = + { code : (('arg, 'storage) pair, (internal_operation list, 'storage) pair) lambda ; arg_type : 'arg ty ; - ret_type : 'ret ty ; storage : 'storage ; storage_type : 'storage ty } @@ -59,8 +58,8 @@ and end_of_stack = unit and ('arg, 'ret) lambda = Lam of ('arg * end_of_stack, 'ret * end_of_stack) descr * Script.expr -and ('arg, 'ret) typed_contract = - 'arg ty * 'ret ty * Contract.t +and 'arg typed_contract = + 'arg ty * Contract.t and 'ty ty = | Unit_t : unit ty @@ -81,7 +80,8 @@ and 'ty ty = | Set_t : 'v comparable_ty -> 'v set ty | Map_t : 'k comparable_ty * 'v ty -> ('k, 'v) map ty | Big_map_t : 'k comparable_ty * 'v ty -> ('k, 'v) big_map ty - | Contract_t : 'arg ty * 'ret ty -> ('arg, 'ret) typed_contract ty + | Contract_t : 'arg ty -> 'arg typed_contract ty + | Operation_t : internal_operation ty and 'ty stack_ty = | Item_t : 'ty ty * 'rest stack_ty * annot -> ('ty * 'rest) stack_ty @@ -316,21 +316,22 @@ and ('bef, 'aft) instr = (* protocol *) | Manager : - (('arg, 'ret) typed_contract * 'rest, public_key_hash * 'rest) instr - | Transfer_tokens : 'sto ty -> - ('arg * (Tez.t * (('arg, 'ret) typed_contract * ('sto * end_of_stack))), 'ret * ('sto * end_of_stack)) instr + ('arg typed_contract * 'rest, public_key_hash * 'rest) instr + | Transfer_tokens : + ('arg * (Tez.t * ('arg typed_contract * 'rest)), internal_operation * 'rest) instr | Create_account : (public_key_hash * (public_key_hash option * (bool * (Tez.t * 'rest))), - (unit, unit) typed_contract * 'rest) instr + unit typed_contract * 'rest) instr | Implicit_account : - (public_key_hash * 'rest, (unit, unit) typed_contract * 'rest) instr - | Create_contract : 'g ty * 'p ty * 'r ty -> + (public_key_hash * 'rest, unit typed_contract * 'rest) instr + | Create_contract : 'g ty * 'p ty -> (public_key_hash * (public_key_hash option * (bool * (bool * (Tez.t * - (('p * 'g, 'r * 'g) lambda * ('g * 'rest)))))), - ('p, 'r) typed_contract * 'rest) instr - | Create_contract_literal : 'g ty * 'p ty * 'r ty * ('p * 'g, 'r * 'g) lambda -> + (('p * 'g, internal_operation list * 'g) lambda + * ('g * 'rest)))))), + 'p typed_contract * 'rest) instr + | Create_contract_literal : 'g ty * 'p ty * ('p * 'g, internal_operation list * 'g) lambda -> (public_key_hash * (public_key_hash option * (bool * (bool * (Tez.t * ('g * 'rest))))), - ('p, 'r) typed_contract * 'rest) instr + 'p typed_contract * 'rest) instr | Now : ('rest, Script_timestamp.t * 'rest) instr | Balance : @@ -343,10 +344,10 @@ and ('bef, 'aft) instr = ('a * 'rest, string * 'rest) instr | Steps_to_quota : (* TODO: check that it always returns a nat *) ('rest, n num * 'rest) instr - | Source : 'p ty * 'r ty -> - ('rest, ('p, 'r) typed_contract * 'rest) instr - | Self : 'p ty * 'r ty -> - ('rest, ('p, 'r) typed_contract * 'rest) instr + | Source : 'p ty -> + ('rest, 'p typed_contract * 'rest) instr + | Self : 'p ty -> + ('rest, 'p typed_contract * 'rest) instr | Amount : ('rest, Tez.t * 'rest) instr diff --git a/src/proto_alpha/lib_protocol/test/contracts/accounts.tz b/src/proto_alpha/lib_protocol/test/contracts/accounts.tz index 93f16946c..31944fe1f 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/accounts.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/accounts.tz @@ -6,15 +6,14 @@ parameter (or key_hash (pair key (pair tez signature))); # Maps the key to the balance they have stored storage (map key_hash tez); -return unit; code { DUP; CAR; # Deposit into account IF_LEFT { DUP; DIIP{ CDR; DUP }; DIP{ SWAP }; GET; # Create the account - IF_NONE { DIP{ AMOUNT; SOME }; UPDATE; UNIT; PAIR } + IF_NONE { DIP{ AMOUNT; SOME }; UPDATE; NIL operation; PAIR } # Add to an existing account - { AMOUNT; ADD; SOME; SWAP; UPDATE; UNIT; PAIR }} + { AMOUNT; ADD; SOME; SWAP; UPDATE; NIL operation; PAIR }} # Withdrawl { DUP; DUP; DUP; DUP; # Check signature on data @@ -38,5 +37,7 @@ code { DUP; CAR; SWAP; CAR; HASH_KEY; UPDATE; SWAP; DUP; CDAR; # Execute the transfer - DIP{ CAR; HASH_KEY; IMPLICIT_ACCOUNT }; UNIT; TRANSFER_TOKENS; + DIP{ CAR; HASH_KEY; IMPLICIT_ACCOUNT }; UNIT; + TRANSFER_TOKENS; + NIL operation; SWAP; CONS; PAIR }}}} diff --git a/src/proto_alpha/lib_protocol/test/contracts/add1.tz b/src/proto_alpha/lib_protocol/test/contracts/add1.tz index 858f70263..78d4f9d1c 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/add1.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/add1.tz @@ -1,10 +1,7 @@ - parameter int; -storage unit; -return int; +storage int; code {CAR; # Get the parameter PUSH int 1; # We're adding 1, so we need to put 1 on the stack ADD; # Add the two numbers - UNIT; # We need to put the storage value on the stack - SWAP; # The values must be rearranged to match the return calling convention + NIL operation; # We put an empty list of operations on the stack PAIR} # Create the end value diff --git a/src/proto_alpha/lib_protocol/test/contracts/add1_list.tz b/src/proto_alpha/lib_protocol/test/contracts/add1_list.tz index 811ba38b1..7fb50d977 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/add1_list.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/add1_list.tz @@ -1,9 +1,7 @@ parameter (list int); -storage unit; -return (list int); -code { CAR; # Get the parameter +storage (list int); +code { CAR; # Get the parameter LAMBDA int int { PUSH int 1; ADD }; # Create a lambda that adds 1 - MAP; # Map over the list - UNIT; # Push Unit - SWAP; # Reorder the stack for the PAIR - PAIR } # Match the calling convetion + MAP; # Map over the list + NIL operation; # No internal op + PAIR } # Match the calling convetion diff --git a/src/proto_alpha/lib_protocol/test/contracts/add_delta_timestamp.tz b/src/proto_alpha/lib_protocol/test/contracts/add_delta_timestamp.tz index b0a235731..b9ed86901 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/add_delta_timestamp.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/add_delta_timestamp.tz @@ -1,4 +1,3 @@ parameter (pair int timestamp); -storage unit; -return timestamp; -code { CAR; DUP; CAR; DIP{CDR}; ADD; UNIT; SWAP; PAIR} +storage (option timestamp); +code { CAR; DUP; CAR; DIP{CDR}; ADD; SOME; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/add_timestamp_delta.tz b/src/proto_alpha/lib_protocol/test/contracts/add_timestamp_delta.tz index 405cea517..766bf9f91 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/add_timestamp_delta.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/add_timestamp_delta.tz @@ -1,4 +1,3 @@ parameter (pair timestamp int); -storage unit; -return timestamp; -code { CAR; DUP; CAR; DIP{CDR}; ADD; UNIT; SWAP; PAIR} +storage (option timestamp); +code { CAR; DUP; CAR; DIP{CDR}; ADD; SOME; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/after_strategy.tz b/src/proto_alpha/lib_protocol/test/contracts/after_strategy.tz index 51e199707..70812e52b 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/after_strategy.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/after_strategy.tz @@ -1,4 +1,3 @@ parameter nat; -storage timestamp; -return (pair nat bool); -code {DUP; CAR; DIP{CDR; DUP; NOW; CMPGT}; PAIR; PAIR}; +storage (pair (pair nat bool) timestamp); +code {DUP; CAR; DIP{CDDR; DUP; NOW; CMPGT}; PAIR; PAIR ; NIL operation ; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/always.tz b/src/proto_alpha/lib_protocol/test/contracts/always.tz index a578996b2..a7802fec9 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/always.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/always.tz @@ -1,6 +1,4 @@ - parameter nat; -return (pair nat bool); -storage unit; +storage (pair nat bool); code { CAR; PUSH bool True; SWAP; - PAIR; UNIT; SWAP; PAIR} + PAIR; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/and.tz b/src/proto_alpha/lib_protocol/test/contracts/and.tz index dcd4ed46a..d723e72eb 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/and.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/and.tz @@ -1,4 +1,3 @@ parameter (pair (bool @first) (bool @second)); -return bool; -storage unit; -code { CAR @param; DUP; CAR @first; DIP{CDR @second}; AND; UNIT; SWAP; PAIR }; +storage (option bool); +code { CAR @param; DUP; CAR @first; DIP{CDR @second}; AND; SOME; NIL operation; PAIR }; diff --git a/src/proto_alpha/lib_protocol/test/contracts/append.tz b/src/proto_alpha/lib_protocol/test/contracts/append.tz index e3dcbc1b9..46a9d8217 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/append.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/append.tz @@ -1,7 +1,5 @@ - parameter (pair (list int) (list int)); -return (list int); -storage unit; +storage (list int); code { CAR; DUP; DIP{CDR}; CAR; # Unpack lists NIL int; SWAP; # Setup reverse accumulator LAMBDA (pair int (list int)) @@ -12,4 +10,4 @@ code { CAR; DUP; DIP{CDR}; CAR; # Unpack lists (list int) {DUP; CAR; DIP{CDR}; CONS}; REDUCE; # Append reversed list - UNIT; SWAP; PAIR} # Calling convention + NIL operation; PAIR} # Calling convention diff --git a/src/proto_alpha/lib_protocol/test/contracts/assert.tz b/src/proto_alpha/lib_protocol/test/contracts/assert.tz index 087b12907..6c5ce503b 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/assert.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/assert.tz @@ -1,4 +1,3 @@ parameter bool; storage unit; -return unit; -code {CAR; ASSERT; UNIT; UNIT; PAIR} +code {CAR; ASSERT; UNIT; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/assert_cmpeq.tz b/src/proto_alpha/lib_protocol/test/contracts/assert_cmpeq.tz index f5dd7d0f4..55621bac8 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/assert_cmpeq.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/assert_cmpeq.tz @@ -1,4 +1,3 @@ parameter (pair int int); storage unit; -return unit; -code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPEQ; UNIT; DUP; PAIR} +code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPEQ; UNIT; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/assert_cmpge.tz b/src/proto_alpha/lib_protocol/test/contracts/assert_cmpge.tz index 3db916747..e98b17044 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/assert_cmpge.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/assert_cmpge.tz @@ -1,4 +1,3 @@ parameter (pair int int); storage unit; -return unit; -code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPGE; UNIT; DUP; PAIR} +code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPGE; UNIT; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/assert_cmpgt.tz b/src/proto_alpha/lib_protocol/test/contracts/assert_cmpgt.tz index a2d172017..7a44174b7 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/assert_cmpgt.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/assert_cmpgt.tz @@ -1,4 +1,3 @@ parameter (pair int int); storage unit; -return unit; -code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPGT; UNIT; DUP; PAIR} +code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPGT; UNIT; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/assert_cmple.tz b/src/proto_alpha/lib_protocol/test/contracts/assert_cmple.tz index c728c2183..e4b61cfc4 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/assert_cmple.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/assert_cmple.tz @@ -1,4 +1,3 @@ parameter (pair int int); storage unit; -return unit; -code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPLE; UNIT; DUP; PAIR} +code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPLE; UNIT; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/assert_cmplt.tz b/src/proto_alpha/lib_protocol/test/contracts/assert_cmplt.tz index 200165564..290b49537 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/assert_cmplt.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/assert_cmplt.tz @@ -1,4 +1,3 @@ parameter (pair int int); storage unit; -return unit; -code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPLT; UNIT; DUP; PAIR} +code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPLT; UNIT; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/assert_cmpneq.tz b/src/proto_alpha/lib_protocol/test/contracts/assert_cmpneq.tz index 8c8e13b93..86b601393 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/assert_cmpneq.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/assert_cmpneq.tz @@ -1,4 +1,3 @@ parameter (pair int int); storage unit; -return unit; -code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPNEQ; UNIT; DUP; PAIR} +code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPNEQ; UNIT; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/assert_eq.tz b/src/proto_alpha/lib_protocol/test/contracts/assert_eq.tz index 45f6afb10..338096a62 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/assert_eq.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/assert_eq.tz @@ -1,4 +1,3 @@ parameter (pair int int); storage unit; -return unit; -code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_EQ; UNIT; DUP; PAIR} +code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_EQ; UNIT; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/assert_ge.tz b/src/proto_alpha/lib_protocol/test/contracts/assert_ge.tz index b3a24b8a7..06bb3cec9 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/assert_ge.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/assert_ge.tz @@ -1,4 +1,3 @@ parameter (pair int int); storage unit; -return unit; -code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_GE; UNIT; DUP; PAIR} +code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_GE; UNIT; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/assert_gt.tz b/src/proto_alpha/lib_protocol/test/contracts/assert_gt.tz index 559c77f66..d041093b0 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/assert_gt.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/assert_gt.tz @@ -1,4 +1,3 @@ parameter (pair int int); storage unit; -return unit; -code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_GT; UNIT; DUP; PAIR} +code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_GT; UNIT; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/assert_le.tz b/src/proto_alpha/lib_protocol/test/contracts/assert_le.tz index c9ace4a7f..8250f3f3b 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/assert_le.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/assert_le.tz @@ -1,4 +1,3 @@ parameter (pair int int); storage unit; -return unit; -code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_LE; UNIT; DUP; PAIR} +code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_LE; UNIT; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/assert_lt.tz b/src/proto_alpha/lib_protocol/test/contracts/assert_lt.tz index 21f883dac..e387e9d74 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/assert_lt.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/assert_lt.tz @@ -1,4 +1,3 @@ parameter (pair int int); storage unit; -return unit; -code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_LT; UNIT; DUP; PAIR} +code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_LT; UNIT; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/assert_neq.tz b/src/proto_alpha/lib_protocol/test/contracts/assert_neq.tz index c381882df..83f19559e 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/assert_neq.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/assert_neq.tz @@ -1,4 +1,3 @@ parameter (pair int int); storage unit; -return unit; -code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_NEQ; UNIT; DUP; PAIR} +code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_NEQ; UNIT; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/at_least.tz b/src/proto_alpha/lib_protocol/test/contracts/at_least.tz index ae2180860..8fb126cbe 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/at_least.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/at_least.tz @@ -1,7 +1,6 @@ - parameter unit; -return unit; storage tez; # How much you have to send me code {CDR; DUP; # Get the amount required (once for comparison, once to save back in storage) AMOUNT; CMPLT; # Check to make sure no one is wasting my time - IF {FAIL} {UNIT; PAIR}} # Finish the transaction or reject the person + IF {FAIL} # Reject the person + {NIL operation;PAIR}} # Finish the transaction diff --git a/src/proto_alpha/lib_protocol/test/contracts/auction.tz b/src/proto_alpha/lib_protocol/test/contracts/auction.tz index 6d5de990a..48f477394 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/auction.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/auction.tz @@ -1,9 +1,8 @@ parameter key_hash; storage (pair timestamp (pair tez key_hash)); -return unit; code { DUP; CDAR; DUP; NOW; CMPGT; IF {FAIL} {}; SWAP; # Check if auction has ended DUP; CAR; DIP{CDDR}; AMOUNT; PAIR; SWAP; DIP{SWAP; PAIR}; # Setup replacement storage DUP; CAR; AMOUNT; CMPLE; IF {FAIL} {}; # Check to make sure that the new amount is greater DUP; CAR; # Get amount of refund DIP{CDR; IMPLICIT_ACCOUNT}; UNIT; TRANSFER_TOKENS; # Make refund - PAIR} # Calling convention + NIL operation; SWAP; CONS; PAIR} # Calling convention diff --git a/src/proto_alpha/lib_protocol/test/contracts/bad_lockup.tz b/src/proto_alpha/lib_protocol/test/contracts/bad_lockup.tz index 7ccd27993..b2ebfc266 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/bad_lockup.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/bad_lockup.tz @@ -1,6 +1,6 @@ parameter unit; -storage (pair timestamp (pair (contract unit unit) (contract unit unit))); -return unit; +storage (pair timestamp (pair (contract unit) (contract unit))); code { CDR; DUP; CAR; NOW; CMPLT; IF {FAIL} {}; - DUP; CDAR; PUSH tez "100"; UNIT; TRANSFER_TOKENS; DROP; - DUP; CDDR; PUSH tez "100"; UNIT; TRANSFER_TOKENS; PAIR } + DUP; CDAR; PUSH tez "100"; UNIT; TRANSFER_TOKENS; SWAP; + DUP; CDDR; PUSH tez "100"; UNIT; TRANSFER_TOKENS; DIP {SWAP} ; + NIL operation ; SWAP ; CONS ; SWAP ; CONS ; PAIR } diff --git a/src/proto_alpha/lib_protocol/test/contracts/balance.tz b/src/proto_alpha/lib_protocol/test/contracts/balance.tz index 2bd161da6..98568476e 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/balance.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/balance.tz @@ -1,4 +1,3 @@ parameter unit; -storage unit; -return tez; -code {DROP; UNIT; BALANCE; PAIR}; +storage tez; +code {DROP; BALANCE; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/build_list.tz b/src/proto_alpha/lib_protocol/test/contracts/build_list.tz index bb36dc2f7..842056d91 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/build_list.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/build_list.tz @@ -1,7 +1,6 @@ parameter nat; -return (list nat); -storage unit; +storage (list nat); code { CAR @counter; NIL @acc nat; SWAP; DUP @cmp_num; PUSH nat 0; CMPNEQ; LOOP { DUP; DIP {SWAP}; CONS @acc; SWAP; PUSH nat 1; SWAP; SUB @counter; DUP; DIP{ABS}; PUSH int 0; CMPNEQ}; - CONS; UNIT; SWAP; PAIR}; + CONS; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/cadr_annotation.tz b/src/proto_alpha/lib_protocol/test/contracts/cadr_annotation.tz index 43afa55d9..b83d483e5 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/cadr_annotation.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/cadr_annotation.tz @@ -1,4 +1,3 @@ parameter (pair (pair unit (string @no_name)) bool); storage unit; -return unit; -code { CAR @name; CADR @second_name; DROP; UNIT; UNIT; PAIR } +code { CAR @name; CADR @second_name; DROP; UNIT; NIL operation; PAIR } diff --git a/src/proto_alpha/lib_protocol/test/contracts/check_signature.tz b/src/proto_alpha/lib_protocol/test/contracts/check_signature.tz index 727eca8bc..6e9009bbc 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/check_signature.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/check_signature.tz @@ -1,7 +1,8 @@ parameter key; storage (pair signature string); -return bool; code { DUP; DUP; DIP{ CDR; DUP; CAR; DIP{CDR; H}; PAIR}; - CAR; CHECK_SIGNATURE; DIP{CDR}; PAIR}; + CAR; CHECK_SIGNATURE; + IF {} {FAIL} ; + CDR; NIL operation ; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/compare.tz b/src/proto_alpha/lib_protocol/test/contracts/compare.tz index ed661ec87..f31561c51 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/compare.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/compare.tz @@ -1,10 +1,9 @@ parameter (pair tez tez); -return (list bool); -storage unit; +storage (list bool); code {CAR; DUP; DUP; DUP; DUP; DIIIIIP {NIL bool}; DIIIIP {DUP; CAR; DIP {CDR}; COMPARE; LE; CONS}; DIIIP {DUP; CAR; DIP {CDR}; COMPARE; GE; CONS}; DIIP{DUP; CAR; DIP {CDR}; COMPARE; LT; CONS}; DIP {DUP; CAR; DIP {CDR}; COMPARE; GT; CONS}; DUP; CAR; DIP {CDR}; COMPARE; EQ; CONS; - UNIT; SWAP; PAIR}; + NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/concat.tz b/src/proto_alpha/lib_protocol/test/contracts/concat.tz index 203d03b12..34aafed9a 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/concat.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/concat.tz @@ -1,11 +1,8 @@ - parameter string; storage string; -return string; code {DUP; # We're going to need both the storage and parameter CAR; # Get the parameter - DIP{CDR; # Get the storage value - DUP}; # We need to replace it in the storage, so we dup it + DIP{CDR}; # Get the storage value SWAP; # Get the order we want (this is optional) CONCAT; # Concatenate the strings - PAIR} # Pair them up, matching the calling convention + NIL operation; PAIR} # Match the calling convention diff --git a/src/proto_alpha/lib_protocol/test/contracts/concat_hello.tz b/src/proto_alpha/lib_protocol/test/contracts/concat_hello.tz index 3fe89e70c..772dc6632 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/concat_hello.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/concat_hello.tz @@ -1,5 +1,4 @@ parameter (list string); -return (list string); -storage unit; +storage (list string); code{ CAR; LAMBDA string string { PUSH @hello string "Hello "; CONCAT }; - MAP; UNIT; SWAP; PAIR}; + MAP; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/concat_list.tz b/src/proto_alpha/lib_protocol/test/contracts/concat_list.tz index 1c4b9339e..a2c752d93 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/concat_list.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/concat_list.tz @@ -1,6 +1,5 @@ parameter (list string); -return string; -storage unit; +storage string; code {CAR; PUSH string ""; SWAP; LAMBDA (pair string string) string {DUP; CDR; DIP{CAR}; CONCAT}; - REDUCE; UNIT; SWAP; PAIR}; + REDUCE; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/conditionals.tz b/src/proto_alpha/lib_protocol/test/contracts/conditionals.tz index 740e6bc82..16bf8e916 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/conditionals.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/conditionals.tz @@ -1,11 +1,9 @@ - parameter (or string (option int)); -storage unit; -return string; +storage string; code { CAR; # Access the storage IF_LEFT {} # The string is on top of the stack, nothing to do { IF_NONE { FAIL} # Fail if None { PUSH int 0; CMPGT; # Check for negative number IF {FAIL} # Fail if negative {PUSH string ""}}}; # Push the empty string - UNIT; SWAP; PAIR} # Calling convention + NIL operation; PAIR} # Calling convention diff --git a/src/proto_alpha/lib_protocol/test/contracts/cons_twice.tz b/src/proto_alpha/lib_protocol/test/contracts/cons_twice.tz index d0894f00f..4761b23f7 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/cons_twice.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/cons_twice.tz @@ -1,12 +1,9 @@ - parameter nat; storage (list nat); -return unit; code { DUP; # Duplicate the storage and parameter CAR; # Extract the parameter DIP{CDR}; # Extract the storage DUP; # Duplicate the parameter DIP{CONS}; # Add the first instance of the parameter to the list CONS; # Add the second instance of the parameter to the list - PUSH unit Unit; # Put the value Unit on the stack (calling convention) - PAIR} # Finish the calling convention + NIL operation; PAIR} # Finish the calling convention diff --git a/src/proto_alpha/lib_protocol/test/contracts/contains_all.tz b/src/proto_alpha/lib_protocol/test/contracts/contains_all.tz index 8b6d30583..f44628cc8 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/contains_all.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/contains_all.tz @@ -1,10 +1,9 @@ parameter (pair (list string) (list string)); -storage unit; -return bool; +storage (option bool); code {CAR; DUP; CAR; DIP{CDR}; EMPTY_SET string; SWAP; LAMBDA (pair string (set string)) (set string) {DUP; CAR; DIP{CDR}; PUSH bool True; SWAP; UPDATE}; REDUCE; PUSH bool True; SWAP; PAIR; SWAP; LAMBDA (pair string (pair (set string) bool)) (pair (set string) bool) {DUP; DUP; CAR; DIP{CDAR; DIP{CDDR}; DUP}; MEM; DIP{SWAP}; AND; SWAP; PAIR}; - REDUCE; CDR; UNIT; SWAP; PAIR}; + REDUCE; CDR; SOME; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/create_account.tz b/src/proto_alpha/lib_protocol/test/contracts/create_account.tz index c04de7a26..b143f26bf 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/create_account.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/create_account.tz @@ -1,5 +1,4 @@ parameter key_hash; -return unit; -storage (contract unit unit); +storage (contract unit); code {CAR; DIP{PUSH tez "100.00"; PUSH bool False; NONE key_hash}; - CREATE_ACCOUNT; UNIT; PAIR}; + CREATE_ACCOUNT; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/create_add1_lists.tz b/src/proto_alpha/lib_protocol/test/contracts/create_add1_lists.tz index 43ea501d6..f82ef1b28 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/create_add1_lists.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/create_add1_lists.tz @@ -1,15 +1,13 @@ parameter unit; -return (contract (list int) (list int)); -storage unit; -code { CAR; # Get the UNIT value (starting storage for contract) - LAMBDA (pair (list int) unit) # Start of stack for contract (see above) - (pair (list int) unit) # End of stack for contract (see above) +storage (contract (list int)); +code { DROP; NIL int; # starting storage for contract + LAMBDA (pair (list int) (list int)) # Start of stack for contract (see above) + (pair (list operation) (list int)) # End of stack for contract (see above) # See the contract above. I copied and pasted { CAR; LAMBDA int int {PUSH int 1; ADD}; MAP; - UNIT; - SWAP; + NIL operation; PAIR }; AMOUNT; # Push the starting balance PUSH bool False; # Not spendable @@ -17,6 +15,4 @@ code { CAR; # Get the UNIT value (starting storage for cont NONE key_hash; # No delegate PUSH key_hash "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"; CREATE_CONTRACT; # Create the contract - UNIT; # Ending calling convention stuff - SWAP; - PAIR} + NIL operation; PAIR} # Ending calling convention stuff diff --git a/src/proto_alpha/lib_protocol/test/contracts/create_contract.tz b/src/proto_alpha/lib_protocol/test/contracts/create_contract.tz index 2138adecc..7c5ecc4ef 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/create_contract.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/create_contract.tz @@ -1,13 +1,12 @@ parameter key_hash; storage string; -return unit; code {CAR; - DIP{UNIT; - LAMBDA (pair string unit) - (pair string unit) - {CAR; UNIT; SWAP; PAIR}; + DIP{PUSH string "dummy"; + LAMBDA (pair string string) + (pair (list operation) string) + {CAR; NIL operation; PAIR}; PUSH tez "100.00"; PUSH bool False; PUSH bool False; NONE key_hash}; CREATE_CONTRACT; DIP{PUSH string ""}; PUSH tez "0.00"; PUSH string "abcdefg"; TRANSFER_TOKENS; - DIP{DROP}; UNIT; PAIR}; + NIL operation; SWAP; CONS; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/create_contract_literal.tz b/src/proto_alpha/lib_protocol/test/contracts/create_contract_literal.tz index 4043ef1ff..4600662ec 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/create_contract_literal.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/create_contract_literal.tz @@ -1,14 +1,12 @@ parameter key_hash; -storage string; -return unit; +storage unit; code { CAR; - DIP { UNIT; + DIP { PUSH string "dummy"; PUSH tez "100.00"; PUSH bool False; PUSH bool False; NONE key_hash }; CREATE_CONTRACT { parameter string ; - storage unit ; - return string ; - code {CAR; UNIT; SWAP; PAIR } } ; + storage string ; + code {CAR; NIL operation; PAIR } } ; DIP{PUSH string ""}; PUSH tez "0.00"; PUSH string "abcdefg"; TRANSFER_TOKENS; - DIP{DROP}; UNIT; PAIR}; + DIP{DROP}; NIL operation; SWAP; CONS; UNIT; SWAP; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/data_publisher.tz b/src/proto_alpha/lib_protocol/test/contracts/data_publisher.tz index 25f7b0c82..e161c3989 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/data_publisher.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/data_publisher.tz @@ -1,15 +1,8 @@ - -# NONE if user wants to get the value -# SOME (signed hash of the string, string) -parameter (option (pair signature (pair string nat))); -return string; +parameter (pair signature (pair string nat)); storage (pair (pair key nat) string); code { DUP; CAR; DIP{CDR; DUP}; - IF_NONE { AMOUNT; PUSH tez "1.00"; # The fee I'm charging for queries - CMPLE; IF {} {FAIL}; - CDR; PAIR} - { SWAP; DIP{DUP}; CAAR; DIP{DUP; CAR; DIP{CDR; H}; PAIR}; - CHECK_SIGNATURE; - IF { CDR; DUP; DIP{CAR; DIP{CAAR}}; CDR; PUSH nat 1; ADD; - DIP{SWAP}; SWAP; PAIR; PAIR; PUSH string ""; PAIR} - {FAIL}}} + SWAP; DIP{DUP}; CAAR; DIP{DUP; CAR; DIP{CDR; H}; PAIR}; + CHECK_SIGNATURE; + IF { CDR; DUP; DIP{CAR; DIP{CAAR}}; CDR; PUSH nat 1; ADD; + DIP{SWAP}; SWAP; PAIR; PAIR; NIL operation; PAIR} + {FAIL}} diff --git a/src/proto_alpha/lib_protocol/test/contracts/default_account.tz b/src/proto_alpha/lib_protocol/test/contracts/default_account.tz index c71564952..3a48fc1d9 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/default_account.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/default_account.tz @@ -1,5 +1,5 @@ parameter key_hash; -return unit; storage unit; code {DIP{UNIT}; CAR; IMPLICIT_ACCOUNT; - PUSH tez "100.00"; UNIT; TRANSFER_TOKENS; PAIR} + PUSH tez "100.00"; UNIT; TRANSFER_TOKENS; + NIL operation; SWAP; CONS; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/diff_timestamps.tz b/src/proto_alpha/lib_protocol/test/contracts/diff_timestamps.tz index 5655a866b..f1991a37a 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/diff_timestamps.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/diff_timestamps.tz @@ -1,4 +1,3 @@ parameter (pair timestamp timestamp); -return int; -storage unit; -code { CAR; DUP; CAR; DIP{CDR}; SUB; UNIT; SWAP; PAIR } +storage int; +code { CAR; DUP; CAR; DIP{CDR}; SUB; NIL operation; PAIR } diff --git a/src/proto_alpha/lib_protocol/test/contracts/dispatch.tz b/src/proto_alpha/lib_protocol/test/contracts/dispatch.tz index 6f4fc468e..9c185133a 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/dispatch.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/dispatch.tz @@ -1,9 +1,9 @@ parameter (or string (pair string (lambda unit string))); -return string; -storage (map string (lambda unit string)); -code { DUP; DIP{CDR}; CAR; # Unpack stack +storage (pair string (map string (lambda unit string))); +code { DUP; DIP{CDDR}; CAR; # Unpack stack IF_LEFT { DIP{DUP}; GET; # Get lambda if it exists IF_NONE {FAIL} {}; # Fail if it doesn't UNIT; EXEC } # Execute the lambda { DUP; CAR; DIP {CDR; SOME}; UPDATE; PUSH string ""}; # Update the storage - PAIR} # Calling convention + PAIR; + NIL operation; PAIR} # Calling convention diff --git a/src/proto_alpha/lib_protocol/test/contracts/empty.tz b/src/proto_alpha/lib_protocol/test/contracts/empty.tz index 0edda09b3..d3aecdb25 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/empty.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/empty.tz @@ -1,5 +1,3 @@ - parameter unit; storage unit; -return unit; -code {} +code {CDR; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/empty_map.tz b/src/proto_alpha/lib_protocol/test/contracts/empty_map.tz index ff7b3d0d2..9023fe847 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/empty_map.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/empty_map.tz @@ -1,7 +1,6 @@ -storage unit; -return (map string string); +storage (map string string); parameter unit; code {DROP; EMPTY_MAP string string; PUSH string "world"; SOME; PUSH string "hello"; UPDATE; - UNIT; SWAP; PAIR}; + NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/exec_concat.tz b/src/proto_alpha/lib_protocol/test/contracts/exec_concat.tz index 7278670a7..6828a52fc 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/exec_concat.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/exec_concat.tz @@ -1,6 +1,5 @@ parameter string; -return string; -storage unit; +storage string; code {CAR; LAMBDA string string {PUSH string "_abc"; SWAP; CONCAT}; - SWAP; EXEC; UNIT; SWAP; PAIR}; + SWAP; EXEC; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/fail.tz b/src/proto_alpha/lib_protocol/test/contracts/fail.tz index 92ac980c5..7f8bde252 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/fail.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/fail.tz @@ -1,6 +1,5 @@ parameter unit; +storage unit; code { # This contract will never accept a incoming transaction FAIL}; -return unit; -storage unit; diff --git a/src/proto_alpha/lib_protocol/test/contracts/fail_amount.tz b/src/proto_alpha/lib_protocol/test/contracts/fail_amount.tz index 9f9be1fcc..f4239b19e 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/fail_amount.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/fail_amount.tz @@ -1,5 +1,6 @@ # Fail if the amount transferred is less than 10 parameter unit; storage unit; -return unit; -code {AMOUNT; PUSH tez "10"; CMPGT; IF {FAIL} {}} +code { DROP; + AMOUNT; PUSH tez "10"; CMPGT; IF {FAIL} {}; + UNIT; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/first.tz b/src/proto_alpha/lib_protocol/test/contracts/first.tz index b2c9622c1..6e47b4c00 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/first.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/first.tz @@ -1,4 +1,3 @@ parameter (list nat); -return nat; -storage unit; -code{CAR; IF_CONS {DIP{DROP}} {FAIL}; UNIT; SWAP; PAIR}; +storage nat; +code{CAR; IF_CONS {DIP{DROP}} {FAIL}; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/get_map_value.tz b/src/proto_alpha/lib_protocol/test/contracts/get_map_value.tz index d8d95a783..f46639649 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/get_map_value.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/get_map_value.tz @@ -1,4 +1,3 @@ parameter string; -storage (map string string); -return (option string); -code {DUP; CAR; DIP{CDR; DUP}; GET; PAIR}; +storage (pair (option string) (map string string)); +code {DUP; CAR; DIP{CDDR; DUP}; GET; PAIR; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/hardlimit.tz b/src/proto_alpha/lib_protocol/test/contracts/hardlimit.tz index b9122789a..464062a52 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/hardlimit.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/hardlimit.tz @@ -1,7 +1,5 @@ parameter unit ; -code - { # This contract stops accepting transactions after N incoming transactions - CDR ; DUP ; PUSH int 0 ; CMPLT; IF {PUSH int -1 ; ADD} {FAIL}; - UNIT; PAIR} ; -return unit ; -storage int +storage int ; +code { # This contract stops accepting transactions after N incoming transactions + CDR ; DUP ; PUSH int 0 ; CMPLT; IF {PUSH int -1 ; ADD} {FAIL}; + NIL operation ; PAIR} ; diff --git a/src/proto_alpha/lib_protocol/test/contracts/hash_consistency_checker.tz b/src/proto_alpha/lib_protocol/test/contracts/hash_consistency_checker.tz index 6909ba82b..5d3c611ca 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/hash_consistency_checker.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/hash_consistency_checker.tz @@ -1,4 +1,3 @@ parameter (pair tez (pair timestamp int)) ; -return string ; -storage unit ; -code { CAR ; H ; UNIT ; SWAP ; PAIR } \ No newline at end of file +storage string ; +code { CAR ; H ; NIL operation ; PAIR } \ No newline at end of file diff --git a/src/proto_alpha/lib_protocol/test/contracts/hash_key.tz b/src/proto_alpha/lib_protocol/test/contracts/hash_key.tz index feba0b58d..6c7f78b4a 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/hash_key.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/hash_key.tz @@ -1,4 +1,3 @@ parameter key; -return key_hash; -storage unit; -code {CAR; HASH_KEY; DIP{UNIT}; PAIR} +storage (option key_hash); +code {CAR; HASH_KEY; SOME ;NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/hash_string.tz b/src/proto_alpha/lib_protocol/test/contracts/hash_string.tz index 2afbfb56e..263cecb0e 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/hash_string.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/hash_string.tz @@ -1,4 +1,3 @@ parameter string; -return string; -storage unit; -code {CAR; H; UNIT; SWAP; PAIR}; +storage string; +code {CAR; H; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/id.tz b/src/proto_alpha/lib_protocol/test/contracts/id.tz index ae9b9612e..4eee565ca 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/id.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/id.tz @@ -1,5 +1,3 @@ - parameter string; -return string; -storage unit; -code {}; +storage string; +code {CAR; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/if.tz b/src/proto_alpha/lib_protocol/test/contracts/if.tz index 5a0d423a7..4bc0e353d 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/if.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/if.tz @@ -1,4 +1,3 @@ parameter bool; -storage unit; -return bool; -code {CAR; IF {PUSH bool True} {PUSH bool False}; UNIT; SWAP; PAIR}; +storage (option bool); +code {CAR; IF {PUSH bool True} {PUSH bool False}; SOME; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/if_some.tz b/src/proto_alpha/lib_protocol/test/contracts/if_some.tz index 2ccc280a7..5c3138b22 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/if_some.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/if_some.tz @@ -1,4 +1,3 @@ parameter (option string); -return string; -storage unit; -code { CAR; IF_SOME {} {PUSH string ""}; UNIT; SWAP; PAIR} +storage string; +code { CAR; IF_SOME {} {PUSH string ""}; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/infinite_loop.tz b/src/proto_alpha/lib_protocol/test/contracts/infinite_loop.tz index dc78d4d33..77cdbc48c 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/infinite_loop.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/infinite_loop.tz @@ -1,4 +1,3 @@ parameter unit; storage unit; -return unit; -code { DROP; PUSH bool True; LOOP {PUSH bool True}; UNIT; UNIT; PAIR } +code { DROP; PUSH bool True; LOOP {PUSH bool True}; UNIT; NIL operation; PAIR } diff --git a/src/proto_alpha/lib_protocol/test/contracts/insertion_sort.tz b/src/proto_alpha/lib_protocol/test/contracts/insertion_sort.tz index 47c7014f4..cc7ff0ed4 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/insertion_sort.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/insertion_sort.tz @@ -1,7 +1,5 @@ - parameter (list int); -return (list int); -storage unit; +storage (list int); code { CAR; # Access list # Insert procedure LAMBDA (pair int (list int)) @@ -23,5 +21,5 @@ code { CAR; # Access list {DUP; CAR; DIP{CDR}; CONS}; REDUCE}; NIL int; SWAP; DIP{SWAP}; # Accumulator for reverse onto - REDUCE; # Execute reverse onto - UNIT; SWAP; PAIR} # Calling convention + REDUCE; # Execute reverse onto + NIL operation; PAIR} # Calling convention diff --git a/src/proto_alpha/lib_protocol/test/contracts/int_publisher.tz b/src/proto_alpha/lib_protocol/test/contracts/int_publisher.tz index db8da7c10..b81af3813 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/int_publisher.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/int_publisher.tz @@ -1,9 +1,5 @@ -# NONE if user wants to get the value -# SOME (signed hash of the string, string) +# (signed hash of the string, string) parameter (option (pair signature int)); -return int; -# The key used to update the contract -# The data storage (pair key int); code {DUP; DUP; CAR; IF_NONE {PUSH tez "1.00"; # Fee pattern from July 26 @@ -18,4 +14,4 @@ code {DUP; DUP; CAR; # Revert the update. This could be replaced with FAIL {DROP; DUP; CDR; DIP{CDDR}}}; # Cleanup - SWAP; PAIR} + DIP{DROP}; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/king_of_tez.tz b/src/proto_alpha/lib_protocol/test/contracts/king_of_tez.tz index 3f3c978ac..796325f30 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/king_of_tez.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/king_of_tez.tz @@ -1,11 +1,11 @@ parameter key_hash; storage (pair timestamp (pair tez key_hash)); -return unit; code { DUP; CDAR; # If the time is more than 2 weeks, any amount makes you king NOW; CMPGT; # User becomes king of tez - IF { CAR; AMOUNT; PAIR; NOW; PUSH int 604800; ADD; PAIR } + IF { CAR; AMOUNT; PAIR; NOW; PUSH int 604800; ADD; PAIR; + NIL operation } # Check balance to see if user has paid enough to become the new king { DUP; CDDAR; AMOUNT; CMPLT; IF { FAIL } # user has not paid out @@ -13,6 +13,7 @@ code { DUP; CDAR; # New storage DIP{ AMOUNT; PAIR; NOW; PUSH int 604800; ADD; PAIR }; # Pay funds to old king - IMPLICIT_ACCOUNT; AMOUNT; UNIT; TRANSFER_TOKENS; DROP }}; + IMPLICIT_ACCOUNT; AMOUNT; UNIT; TRANSFER_TOKENS; + NIL operation; SWAP; CONS}}; # Cleanup - UNIT; PAIR }; + PAIR }; diff --git a/src/proto_alpha/lib_protocol/test/contracts/list_id.tz b/src/proto_alpha/lib_protocol/test/contracts/list_id.tz index 75a99e7c5..6cd3693a1 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/list_id.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/list_id.tz @@ -1,4 +1,3 @@ parameter (list string); -return (list string); -storage unit; -code {} +storage (list string); +code {CAR; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/list_id_map.tz b/src/proto_alpha/lib_protocol/test/contracts/list_id_map.tz index 3ae75b50f..e82cc2918 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/list_id_map.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/list_id_map.tz @@ -1,4 +1,3 @@ parameter (list string); -return (list string); -storage unit; -code {CAR; LAMBDA string string {}; MAP; UNIT; SWAP; PAIR} +storage (list string); +code {CAR; LAMBDA string string {}; MAP; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/list_iter.tz b/src/proto_alpha/lib_protocol/test/contracts/list_iter.tz index d09b75a24..df904d882 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/list_iter.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/list_iter.tz @@ -1,6 +1,5 @@ parameter (list int); -storage unit; -return int; +storage int; code { CAR; PUSH int 1; SWAP; ITER { MUL }; - UNIT; SWAP; PAIR} + NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/list_iter2.tz b/src/proto_alpha/lib_protocol/test/contracts/list_iter2.tz index 39fd7706c..caf3e5771 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/list_iter2.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/list_iter2.tz @@ -1,6 +1,5 @@ parameter (list string); -return string; -storage unit; +storage string; code { CAR; PUSH string ""; SWAP; ITER { CONCAT }; - UNIT; SWAP; PAIR} + NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/list_map_block.tz b/src/proto_alpha/lib_protocol/test/contracts/list_map_block.tz index a404af562..b5202dd9b 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/list_map_block.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/list_map_block.tz @@ -1,6 +1,5 @@ parameter (list int); -return (list int); -storage unit; +storage (list int); code { CAR; PUSH int 0; SWAP; MAP { DIP{DUP}; ADD; DIP{PUSH int 1; ADD}}; - UNIT; SWAP; PAIR; DIP{DROP}} + NIL operation; PAIR; DIP{DROP}} diff --git a/src/proto_alpha/lib_protocol/test/contracts/list_of_transactions.tz b/src/proto_alpha/lib_protocol/test/contracts/list_of_transactions.tz index 1be3259e3..039ff7596 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/list_of_transactions.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/list_of_transactions.tz @@ -1,9 +1,8 @@ - parameter unit; -storage (list (contract unit unit)); -return unit; -code { CDR; PUSH bool True; # Setup loop +storage (list (contract unit)); +code { CDR; DUP; + DIP {NIL operation}; PUSH bool True; # Setup loop LOOP {IF_CONS { PUSH tez "1.00"; UNIT; TRANSFER_TOKENS; # Make transfer - DROP; PUSH bool True} # Setup for next round of loop - { NIL (contract unit unit); PUSH bool False}}; # Data to satisfy types and end loop - UNIT; PAIR}; # Calling convention + SWAP; DIP {CONS}; PUSH bool True} # Setup for next round of loop + { NIL (contract unit); PUSH bool False}}; # Data to satisfy types and end loop + DROP; PAIR}; # Calling convention diff --git a/src/proto_alpha/lib_protocol/test/contracts/lockup.tz b/src/proto_alpha/lib_protocol/test/contracts/lockup.tz index 5b3f68516..5fffa36ec 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/lockup.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/lockup.tz @@ -1,6 +1,5 @@ parameter unit; -storage (pair timestamp (pair tez (contract unit unit))); -return unit; +storage (pair timestamp (pair tez (contract unit))); code { CDR; # Ignore the parameter DUP; # Duplicate the storage CAR; # Get the timestamp @@ -14,5 +13,6 @@ code { CDR; # Ignore the parameter CAR; # Get the amount of the transfer on top of the stack DIP{CDR}; # Put the contract underneath it UNIT; # Put the contract's argument type on top of the stack - TRANSFER_TOKENS; # Make the transfer + TRANSFER_TOKENS; # Emit the transfer + NIL operation; SWAP; CONS;# Make a singleton list of internal operations PAIR} # Pair up to meet the calling convention diff --git a/src/proto_alpha/lib_protocol/test/contracts/loop_left.tz b/src/proto_alpha/lib_protocol/test/contracts/loop_left.tz index 80bad5de5..64bcc76c8 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/loop_left.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/loop_left.tz @@ -1,8 +1,7 @@ parameter (list string); -return (list string); -storage unit; +storage (list string); code { CAR; NIL string; SWAP; PAIR; LEFT (list string); LOOP_LEFT { DUP; CAR; DIP{CDR}; IF_CONS { SWAP; DIP{CONS}; PAIR; LEFT (list string) } { RIGHT (pair (list string) (list string)) }; }; - UNIT; SWAP; PAIR } + NIL operation; PAIR } diff --git a/src/proto_alpha/lib_protocol/test/contracts/macro_annotations.tz b/src/proto_alpha/lib_protocol/test/contracts/macro_annotations.tz index fdc374061..368ba6a0c 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/macro_annotations.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/macro_annotations.tz @@ -1,6 +1,6 @@ -return unit; parameter unit; -storage unit; -code { PUSH unit Unit ; +storage (pair @truc unit unit); +code { DROP; UNIT ; UNIT ; PAIR ; UNIT ; DUUP @truc ; - DROP ; DROP } + DIP { DROP ; DROP } ; + NIL operation ; PAIR } diff --git a/src/proto_alpha/lib_protocol/test/contracts/map_caddaadr.tz b/src/proto_alpha/lib_protocol/test/contracts/map_caddaadr.tz index 75ea96744..b0b436795 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/map_caddaadr.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/map_caddaadr.tz @@ -1,4 +1,4 @@ parameter unit; storage (pair (pair nat (pair nat (pair (pair (pair nat tez) nat) nat))) nat); -return unit; -code { MAP_CDADDAADR { PUSH tez "1.00" ; ADD } }; +code { MAP_CDADDAADR { PUSH tez "1.00" ; ADD } ; + NIL operation ; SWAP; SET_CAR }; diff --git a/src/proto_alpha/lib_protocol/test/contracts/map_car.tz b/src/proto_alpha/lib_protocol/test/contracts/map_car.tz index 6d8dab481..7c50bffd6 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/map_car.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/map_car.tz @@ -1,4 +1,3 @@ parameter bool; storage (pair bool nat); -return unit; -code { DUP; CAR; DIP{CDR}; SWAP; MAP_CAR { AND } ; UNIT; PAIR }; +code { DUP; CAR; DIP{CDR}; SWAP; MAP_CAR { AND }; NIL operation; PAIR }; diff --git a/src/proto_alpha/lib_protocol/test/contracts/map_id.tz b/src/proto_alpha/lib_protocol/test/contracts/map_id.tz index 2d2981bb1..ff0a3bbbf 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/map_id.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/map_id.tz @@ -1,4 +1,3 @@ parameter (map nat nat); -return (map nat nat); -storage unit; -code {} +storage (map nat nat); +code { CAR ; NIL operation ; PAIR } diff --git a/src/proto_alpha/lib_protocol/test/contracts/map_iter.tz b/src/proto_alpha/lib_protocol/test/contracts/map_iter.tz index 2e1716330..1872c4906 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/map_iter.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/map_iter.tz @@ -1,7 +1,6 @@ parameter (map int int); -return (pair int int); -storage unit; +storage (pair int int); code { CAR; PUSH int 0; DUP; PAIR; SWAP; ITER { DIP {DUP; CAR; DIP{CDR}}; DUP; # Last instr DIP{CAR; ADD}; SWAP; DIP{CDR; ADD}; PAIR }; - UNIT; SWAP; PAIR} + NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/map_size.tz b/src/proto_alpha/lib_protocol/test/contracts/map_size.tz index befa00755..4bd6417e6 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/map_size.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/map_size.tz @@ -1,4 +1,3 @@ parameter (map string nat); -return nat; -storage unit; -code {CAR; SIZE; UNIT; SWAP; PAIR} +storage nat; +code {CAR; SIZE; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/max_in_list.tz b/src/proto_alpha/lib_protocol/test/contracts/max_in_list.tz index 65a8ce4c6..229b37729 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/max_in_list.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/max_in_list.tz @@ -1,10 +1,9 @@ parameter (list int); -storage unit; -return (option int); +storage (option int); code {CAR; DIP{NONE int}; LAMBDA (pair int (option int)) (option int) {DUP; DUP; CAR; SWAP; CDR; IF_NONE {DIP{DROP}; SOME} {CMPGT; IF {CDR} {CAR; SOME}}}; - REDUCE; UNIT; SWAP; PAIR}; + REDUCE; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/min.tz b/src/proto_alpha/lib_protocol/test/contracts/min.tz index 5a7ac2643..cedd835bb 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/min.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/min.tz @@ -1,13 +1,11 @@ parameter (pair int int); -return int; -storage unit; +storage int; code { CAR; # Ignore the storage DUP; # Duplicate so we can get both the numbers passed as parameters DUP; # Second dup so we can access the lesser number CAR; DIP{CDR}; # Unpack the numbers on top of the stack CMPLT; # Compare the two numbers, placing a boolean on top of the stack IF {CAR} {CDR}; # Access the first number if the boolean was true - UNIT; # Push storage value - SWAP; # Correct order for calling convention pair + NIL operation; # Return no op PAIR} # Pair the numbers satisfying the calling convention diff --git a/src/proto_alpha/lib_protocol/test/contracts/noop.tz b/src/proto_alpha/lib_protocol/test/contracts/noop.tz index 54a511a24..bd19da15c 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/noop.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/noop.tz @@ -1,4 +1,3 @@ parameter unit; -code {}; -return unit; storage unit; +code {CDR; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/not.tz b/src/proto_alpha/lib_protocol/test/contracts/not.tz index b6155da09..f89394072 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/not.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/not.tz @@ -1,4 +1,3 @@ parameter bool; -return bool; -storage unit; -code {CAR; NOT; UNIT; SWAP; PAIR}; +storage (option bool); +code {CAR; NOT; SOME; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/or.tz b/src/proto_alpha/lib_protocol/test/contracts/or.tz index 1b45ccc8f..89d533c44 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/or.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/or.tz @@ -1,5 +1,3 @@ parameter (pair bool bool); -return bool; -storage unit; -code {CAR; DUP; CAR; SWAP; CDR; OR; - UNIT; SWAP; PAIR}; +storage (option bool); +code {CAR; DUP; CAR; SWAP; CDR; OR; SOME; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/originator.tz b/src/proto_alpha/lib_protocol/test/contracts/originator.tz index a03ab3fe5..777c2223a 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/originator.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/originator.tz @@ -1,9 +1,8 @@ -storage unit ; parameter nat ; -return (list (contract unit unit)) ; +storage (list (contract unit)) ; code { CAR ; DUP ; PUSH nat 0 ; CMPNEQ ; - DIIP { NIL (contract unit unit) } ; + DIIP { NIL (contract unit) } ; LOOP { PUSH tez "5.00" ; PUSH bool True ; # delegatable @@ -14,4 +13,4 @@ code PUSH nat 1 ; SWAP ; SUB ; ABS ; DUP ; PUSH nat 0 ; CMPNEQ } ; DROP ; - UNIT ; SWAP ; PAIR } + NIL operation ; PAIR } diff --git a/src/proto_alpha/lib_protocol/test/contracts/pair_id.tz b/src/proto_alpha/lib_protocol/test/contracts/pair_id.tz index 0284956e5..3bfedf2d8 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/pair_id.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/pair_id.tz @@ -1,4 +1,3 @@ parameter (pair bool bool); -return (pair bool bool); -storage unit; -code {} +storage (option (pair bool bool)); +code {CAR; SOME; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/pair_macro.tz b/src/proto_alpha/lib_protocol/test/contracts/pair_macro.tz index ab9246e17..db8f6a8a8 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/pair_macro.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/pair_macro.tz @@ -1,4 +1,4 @@ parameter unit; -return unit; storage unit; -code { UNIT; UNIT; UNIT; UNIT; UNIT; PAIAAIAIAIR @name; DROP} +code { UNIT; UNIT; UNIT; UNIT; UNIT; PAIAAIAIAIR @name; DROP; + CDR; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/parameterizable_payments.tz b/src/proto_alpha/lib_protocol/test/contracts/parameterizable_payments.tz deleted file mode 100644 index 2d95dafe2..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/parameterizable_payments.tz +++ /dev/null @@ -1,26 +0,0 @@ -parameter (or (pair string (pair tez (contract unit unit))) nat); -return unit; -storage (pair (contract nat (pair nat bool)) (pair nat (map nat (pair string (pair tez (contract unit unit)))))); -code { DUP; DIP{CDR}; CAR; # Get the input while preserving the output - IF_LEFT { DIP{ DUP; CAR; SWAP; CDR; DUP; CAR; DIP{CDR}}; - SOME; SWAP; DUP; DIP{UPDATE}; # Add the element to the map - PUSH nat 1; ADD; PAIR; SWAP; # Add 1 to the index - PAIR; UNIT; PAIR} # Cleanup and finish - # Check our other contract to see if the transaction is allowed - { DIP{DUP; CAR}; PUSH tez "0.00"; SWAP; TRANSFER_TOKENS; - # Arrange the stack - DUP; CDR; - IF { CAR; DUP; DIIP{DUP; CDDR; DUP}; - DIP{ GET; # Get the value of the data - IF_NONE {FAIL} {}; # This should not happen - SWAP; - NONE (pair string (pair tez (contract unit unit)))}; - UPDATE; # Delete the element - SWAP; - # More stack arranging - DIP{ SWAP; DUP; CAR; DIP{CDR}}; - DIP{DIP{CAR; PAIR}; PAIR}; - DUP; CDAR; - DIP{CDDR}; UNIT; TRANSFER_TOKENS; # Make the transfer - PAIR} - { FAIL }}} diff --git a/src/proto_alpha/lib_protocol/test/contracts/parameterized_multisig.tz b/src/proto_alpha/lib_protocol/test/contracts/parameterized_multisig.tz index 22c7f94ac..cc1eb7057 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/parameterized_multisig.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/parameterized_multisig.tz @@ -1,7 +1,6 @@ -storage (pair (map nat (pair bool bool)) (pair key key)); -return bool; +storage (pair bool (pair (map nat (pair bool bool)) (pair key key))); parameter (or nat (pair signature nat)); -code { DUP; CAR; DIP{CDR}; # Stack rangling +code { DUP; CAR; DIP{CDDR}; # Stack rangling IF_LEFT { DIP{DUP; CAR}; GET; # Get the value stored for that index IF_NONE { PUSH bool False} # If not referenced, reject { DUP; CAR; DIP{CDR}; AND}; @@ -21,4 +20,5 @@ code { DUP; CAR; DIP{CDR}; # Stack rangling CAR; PUSH bool True; SWAP; PAIR; SOME; SWAP} {FAIL}}; # Update the stored value and finish off - UPDATE; PAIR; PUSH bool False; PAIR}} + UPDATE; PAIR; PUSH bool False; PAIR}; + NIL operation; PAIR } diff --git a/src/proto_alpha/lib_protocol/test/contracts/publisher_payouts.tz b/src/proto_alpha/lib_protocol/test/contracts/publisher_payouts.tz deleted file mode 100644 index 15bca5d55..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/publisher_payouts.tz +++ /dev/null @@ -1,17 +0,0 @@ -parameter unit; -storage (option - (pair (pair (contract unit unit) (contract unit unit)) - (pair (pair timestamp (contract (option (pair signature int)) int)) - (pair tez int)))); -return unit; -code { CDR; IF_NONE {FAIL} {}; # Check if settlement has already ocurred - DUP; CDAAR; NOW; CMPLT; IF {FAIL} {}; # Check the timestamp - DUP; CDADR; DIP{SOME}; PUSH tez "1.01"; NONE (pair signature int); - TRANSFER_TOKENS; DIP{IF_NONE{FAIL} {}}; - DIP{DUP; CDDR; DUP; CDR}; CMPGT; - SWAP; - DIP{ IF {CAAR} {CADR}; - DIP{ NONE (pair (pair (contract unit unit) (contract unit unit)) - (pair (pair timestamp (contract (option (pair signature int)) int)) - (pair tez int)))}}; - CAR; UNIT; TRANSFER_TOKENS; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/queue.tz b/src/proto_alpha/lib_protocol/test/contracts/queue.tz index 10a894fea..a074906dd 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/queue.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/queue.tz @@ -1,9 +1,8 @@ parameter (option string); -storage (pair (pair nat nat) (map nat string)); -return (option string); +storage (pair (option string) (pair (pair nat nat) (map nat string))); code { DUP; CAR; # Retrieving an element - IF_NONE { CDR; DUP; CAR; DIP{CDR; DUP}; DUP; + IF_NONE { CDDR; DUP; CAR; DIP{CDR; DUP}; DUP; CAR; SWAP; DIP{GET}; # Check if an element is available SWAP; # Put NONE on stack and finish @@ -15,10 +14,11 @@ code { DUP; CAR; DUP; CAR; PUSH nat 1; ADD; DIP{ CDR }; PAIR; PAIR}; PAIR }} # Arrange the stack - { DIP{DUP; CDAR; DIP{CDDR}; DUP}; SWAP; CAR; + { DIP{DUP; CDDAR; DIP{CDDDR}; DUP}; SWAP; CAR; # Add the element to the map DIP{ SOME; SWAP; CDR; DUP; DIP{UPDATE}; # Increment the second number PUSH nat 1; ADD}; # Cleanup and finish - PAIR; PAIR; NONE string; PAIR }} + PAIR; PAIR; NONE string; PAIR }; + NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/reduce_map.tz b/src/proto_alpha/lib_protocol/test/contracts/reduce_map.tz index f112ff283..3f8f17d3f 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/reduce_map.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/reduce_map.tz @@ -1,7 +1,6 @@ parameter (pair (lambda int int) (list int)); -return (list int); -storage unit; +storage (list int); code { DIP{NIL int}; CAR; DUP; @@ -19,4 +18,4 @@ code { DIP{NIL int}; (list int) {DUP; CAR; DIP{CDR}; CONS}; REDUCE; # Correct list order - UNIT; SWAP; PAIR} # Calling convention + NIL operation; PAIR} # Calling convention diff --git a/src/proto_alpha/lib_protocol/test/contracts/reentrancy.tz b/src/proto_alpha/lib_protocol/test/contracts/reentrancy.tz index f30f21ae5..5d9ec49c1 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/reentrancy.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/reentrancy.tz @@ -1,6 +1,7 @@ parameter unit; -storage (pair (contract unit unit) (contract unit unit)); -return unit; +storage (pair (contract unit) (contract unit)); code { CDR; DUP; CAR; PUSH tez "5.00"; UNIT; - TRANSFER_TOKENS; DROP; DUP; CDR; - PUSH tez "5.00"; UNIT; TRANSFER_TOKENS; PAIR }; + TRANSFER_TOKENS; + DIP {DUP; CDR; + PUSH tez "5.00"; UNIT; TRANSFER_TOKENS}; + DIIP{NIL operation};DIP{CONS};CONS;PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/ret_int.tz b/src/proto_alpha/lib_protocol/test/contracts/ret_int.tz index e6415d413..720a99568 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/ret_int.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/ret_int.tz @@ -1,4 +1,3 @@ parameter unit; -code {CAR; PUSH nat 300; PAIR}; -return nat; -storage unit; +storage (option nat); +code {DROP; PUSH nat 300; SOME; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/reverse.tz b/src/proto_alpha/lib_protocol/test/contracts/reverse.tz index 08a110e41..24419bc54 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/reverse.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/reverse.tz @@ -1,8 +1,7 @@ parameter (list string); -storage unit; -return (list string); +storage (list string); code { CAR; NIL string; SWAP; LAMBDA (pair string (list string)) (list string) {DUP; CAR; DIP{CDR}; CONS}; - REDUCE; UNIT; SWAP; PAIR}; + REDUCE; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/reverse_loop.tz b/src/proto_alpha/lib_protocol/test/contracts/reverse_loop.tz index ca626c4ec..d8117135c 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/reverse_loop.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/reverse_loop.tz @@ -1,6 +1,5 @@ parameter (list string); -return (list string); -storage unit; +storage (list string); code { CAR; NIL string; SWAP; PUSH bool True; LOOP { IF_CONS {SWAP; DIP{CONS}; PUSH bool True} {NIL string; PUSH bool False}}; - DROP; UNIT; SWAP; PAIR} + DROP; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/self.tz b/src/proto_alpha/lib_protocol/test/contracts/self.tz index ab682c252..728cd5f1d 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/self.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/self.tz @@ -1,4 +1,3 @@ parameter unit ; -storage (contract unit unit) ; -return unit ; -code { MAP_CDR { DROP ; SELF } } +storage (contract unit) ; +code { DROP ; SELF ; NIL operation ; PAIR } diff --git a/src/proto_alpha/lib_protocol/test/contracts/set_caddaadr.tz b/src/proto_alpha/lib_protocol/test/contracts/set_caddaadr.tz index 8a55c4109..39878a962 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/set_caddaadr.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/set_caddaadr.tz @@ -1,6 +1,5 @@ parameter tez; storage (pair (pair nat (pair nat (pair (pair (pair nat tez) nat) nat))) nat); -return unit; code { DUP ; CAR ; SWAP ; CDR ; SET_CADDAADR @annot ; - UNIT ; PAIR }; + NIL operation ; PAIR }; diff --git a/src/proto_alpha/lib_protocol/test/contracts/set_car.tz b/src/proto_alpha/lib_protocol/test/contracts/set_car.tz index 4c0d24c77..ec63718d6 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/set_car.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/set_car.tz @@ -1,4 +1,3 @@ parameter string; storage (pair string nat); -return (pair string nat); -code { DUP; CDR; DIP{CAR}; SET_CAR @hello; DUP; PAIR }; +code { DUP; CDR; DIP{CAR}; SET_CAR @hello; NIL operation; PAIR }; diff --git a/src/proto_alpha/lib_protocol/test/contracts/set_cdr.tz b/src/proto_alpha/lib_protocol/test/contracts/set_cdr.tz index 549787cfd..f4080a5e1 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/set_cdr.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/set_cdr.tz @@ -1,4 +1,3 @@ parameter nat; storage (pair string nat); -return (pair string nat); -code { DUP; CDR; DIP{CAR}; SET_CDR @annot; DUP; PAIR }; +code { DUP; CDR; DIP{CAR}; SET_CDR @annot; NIL operation; PAIR }; diff --git a/src/proto_alpha/lib_protocol/test/contracts/set_id.tz b/src/proto_alpha/lib_protocol/test/contracts/set_id.tz index e98f7f8fd..ede301b0e 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/set_id.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/set_id.tz @@ -1,4 +1,3 @@ parameter (set string); -return (set string); -storage unit; -code {} +storage (set string); +code { CAR ; NIL operation ; PAIR } diff --git a/src/proto_alpha/lib_protocol/test/contracts/set_iter.tz b/src/proto_alpha/lib_protocol/test/contracts/set_iter.tz index 27985ca20..55d8ae34a 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/set_iter.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/set_iter.tz @@ -1,4 +1,3 @@ parameter (set int); -return int; -storage unit; -code { CAR; PUSH int 0; SWAP; ITER { ADD }; UNIT; SWAP; PAIR } +storage int; +code { CAR; PUSH int 0; SWAP; ITER { ADD }; NIL operation; PAIR } diff --git a/src/proto_alpha/lib_protocol/test/contracts/set_member.tz b/src/proto_alpha/lib_protocol/test/contracts/set_member.tz index 3aa55693d..ae97cce14 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/set_member.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/set_member.tz @@ -1,4 +1,3 @@ parameter string; -storage (set string); -return bool; -code {DUP; CAR; DIP{CDR}; MEM; DIP{EMPTY_SET string}; PAIR}; +storage (pair (set string) (option bool)); +code {DUP; DUP; CAR; DIP{CDAR}; MEM; SOME; DIP {CDAR}; SWAP; PAIR ; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/set_size.tz b/src/proto_alpha/lib_protocol/test/contracts/set_size.tz index 0fb1b10ad..aa055cb02 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/set_size.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/set_size.tz @@ -1,4 +1,3 @@ parameter (set int); -storage unit; -return nat; -code {CAR; SIZE; UNIT; SWAP; PAIR} +storage nat; +code {CAR; SIZE; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/spawn_identities.tz b/src/proto_alpha/lib_protocol/test/contracts/spawn_identities.tz index 48ef21d29..5c6b47337 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/spawn_identities.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/spawn_identities.tz @@ -1,6 +1,5 @@ parameter nat; -return unit; -storage (list (contract string string)); +storage (list (contract string)); code { DUP; CAR; # Get the number DIP{CDR}; # Put the accumulator on the stack @@ -8,20 +7,16 @@ code { DUP; LOOP { DUP; PUSH nat 0; CMPEQ; # Check if the number is 0 IF { PUSH bool False} # End the loop { PUSH nat 1; SWAP; SUB; ABS; # Subtract 1. The ABS is to make it back into a nat - UNIT; # Storage type - LAMBDA (pair string unit) # Identity contract - (pair string unit) - {}; + PUSH string "init"; # Storage type + LAMBDA (pair string string) # Identity contract + (pair (list operation) string) + { CAR ; NIL operation ; PAIR }; PUSH tez "5.00"; # Strating balance PUSH bool False; DUP; # Not spendable or delegatable NONE key_hash; - # This is once again my key from the alphanet. - # I highly encourage you to send funds to it - # Will it help you? Will it help me? The answer is no, - # However, do it anyway PUSH key_hash "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"; CREATE_CONTRACT; # Make the contract SWAP; # Add to the list DIP{CONS}; PUSH bool True}}; # Continue the loop - DROP; UNIT; PAIR} # Calling convention + DROP; NIL operation; PAIR} # Calling convention diff --git a/src/proto_alpha/lib_protocol/test/contracts/steps_to_quota.tz b/src/proto_alpha/lib_protocol/test/contracts/steps_to_quota.tz index 35a1cea7e..4981864be 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/steps_to_quota.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/steps_to_quota.tz @@ -1,4 +1,3 @@ parameter unit; -return nat; -storage unit; -code {DROP; UNIT; STEPS_TO_QUOTA; PAIR}; +storage nat; +code {DROP; STEPS_TO_QUOTA; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/store_input.tz b/src/proto_alpha/lib_protocol/test/contracts/store_input.tz index 1ccaf78e1..4eee565ca 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/store_input.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/store_input.tz @@ -1,4 +1,3 @@ parameter string; -return unit; storage string; -code {CAR; UNIT; PAIR}; +code {CAR; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/store_now.tz b/src/proto_alpha/lib_protocol/test/contracts/store_now.tz index c88f7980f..1a868ac06 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/store_now.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/store_now.tz @@ -1,4 +1,3 @@ parameter unit; storage timestamp; -return unit; -code {DROP; NOW; UNIT; PAIR}; +code {DROP; NOW; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/str_id.tz b/src/proto_alpha/lib_protocol/test/contracts/str_id.tz index 1fc1cd60c..f9e0710c3 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/str_id.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/str_id.tz @@ -1,4 +1,3 @@ parameter string; -return string; -storage unit; -code {}; +storage (option string); +code { CAR ; SOME ; NIL operation ; PAIR }; diff --git a/src/proto_alpha/lib_protocol/test/contracts/strategy_proxy.tz b/src/proto_alpha/lib_protocol/test/contracts/strategy_proxy.tz deleted file mode 100644 index f80c90078..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/strategy_proxy.tz +++ /dev/null @@ -1,9 +0,0 @@ -parameter nat; -storage (pair (option nat) (contract (or nat (pair signature nat)) bool)); -return (pair nat bool); -code { DUP; CAR; DIP{CDDR; DUP}; DUP; DIP{SOME; PAIR; SWAP}; # Store the nat in strorage - # Query our stored contract - LEFT (pair signature nat); DIP{PUSH tez "0.00"}; TRANSFER_TOKENS; - # Cleanup and finish - DIP{DUP; CAR}; DIP{IF_NONE {FAIL} {}}; SWAP; - PAIR; DIP{CDR; NONE nat; PAIR}; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/sub_timestamp_delta.tz b/src/proto_alpha/lib_protocol/test/contracts/sub_timestamp_delta.tz index df7e98b35..f154e9524 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/sub_timestamp_delta.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/sub_timestamp_delta.tz @@ -1,4 +1,3 @@ parameter (pair timestamp int); -storage unit; -return timestamp; -code { CAR; DUP; CAR; DIP{CDR}; SUB; UNIT; SWAP; PAIR} +storage timestamp; +code { CAR; DUP; CAR; DIP{CDR}; SUB; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/subset.tz b/src/proto_alpha/lib_protocol/test/contracts/subset.tz index 6924c57fe..f06e1054e 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/subset.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/subset.tz @@ -1,6 +1,5 @@ parameter (pair (set string) (set string)); -return bool; -storage unit; +storage bool; code { CAR; DUP; CDR; DIP{CAR}; # Unpack lists PUSH bool True; PAIR; SWAP; # Setup accumulator @@ -15,4 +14,4 @@ code { CAR; DUP; CDR; DIP{CAR}; # Unpack lists PAIR}; REDUCE; # Reduce CAR; # Get the accumulator value - UNIT; SWAP; PAIR} # Calling convention + NIL operation; PAIR} # Calling convention diff --git a/src/proto_alpha/lib_protocol/test/contracts/swap_left_right.tz b/src/proto_alpha/lib_protocol/test/contracts/swap_left_right.tz index 00bcfcbf0..d5650c034 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/swap_left_right.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/swap_left_right.tz @@ -1,4 +1,3 @@ parameter (or bool string); -return (or string bool); -storage unit; -code {CAR; IF_LEFT {RIGHT string} {LEFT bool}; UNIT; SWAP; PAIR}; +storage (or string bool); +code {CAR; IF_LEFT {RIGHT string} {LEFT bool}; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/swap_storage_input.tz b/src/proto_alpha/lib_protocol/test/contracts/swap_storage_input.tz deleted file mode 100644 index a63a2179b..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/swap_storage_input.tz +++ /dev/null @@ -1,9 +0,0 @@ - -parameter string; -return string; -storage string; # Note that all three values are of the same type -code { DUP; # In order to access both the storage and parameter, I need to duplicate the (pair parameter storage) - CAR; # Access the parameter - SWAP; # Exchange top and second element on the stack - CDR; # Get the storage in the pair - PAIR}; # Generate pair of elements diff --git a/src/proto_alpha/lib_protocol/test/contracts/swap_storage_input_dip.tz b/src/proto_alpha/lib_protocol/test/contracts/swap_storage_input_dip.tz deleted file mode 100644 index 5459623e1..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/swap_storage_input_dip.tz +++ /dev/null @@ -1,8 +0,0 @@ - -parameter string; -storage string; -return string; -code { DUP; # Duplicate the (pair parameter storage) - CDR; # Access the storage - DIP{CAR}; # Access the parameter, but leave the storage unchanged on top of the stack - PAIR} # Pair the elements, fulfilling the calling convention diff --git a/src/proto_alpha/lib_protocol/test/contracts/take_my_money.tz b/src/proto_alpha/lib_protocol/test/contracts/take_my_money.tz index 9ddbebf4a..86cd1624b 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/take_my_money.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/take_my_money.tz @@ -1,9 +1,9 @@ parameter key_hash; -return unit; storage unit; code { CAR; IMPLICIT_ACCOUNT; # Create an account for the recipient of the funds DIP{UNIT}; # Push a value of the storage type below the contract PUSH tez "1.00"; # The person can have a ęś© UNIT; # Push the contract's argument type TRANSFER_TOKENS; # Run the transfer + NIL operation; SWAP; CONS; PAIR }; # Cleanup and put the return values diff --git a/src/proto_alpha/lib_protocol/test/contracts/tez_add_sub.tz b/src/proto_alpha/lib_protocol/test/contracts/tez_add_sub.tz index ad3a1c2d9..ad8bae659 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/tez_add_sub.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/tez_add_sub.tz @@ -1,6 +1,5 @@ parameter (pair tez tez); -storage unit; -return (pair tez tez); +storage (option (pair tez tez)); code {CAR; DUP; DUP; CAR; DIP{CDR}; ADD; DIP{DUP; CAR; DIP{CDR}; SUB}; - PAIR; UNIT; SWAP; PAIR}; + PAIR; SOME; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/transfer_amount.tz b/src/proto_alpha/lib_protocol/test/contracts/transfer_amount.tz index 1e562b603..8da204e83 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/transfer_amount.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/transfer_amount.tz @@ -1,4 +1,3 @@ parameter unit; storage tez; -return unit; -code { DROP; AMOUNT; UNIT; PAIR }; +code { DROP; AMOUNT; NIL operation; PAIR }; diff --git a/src/proto_alpha/lib_protocol/test/contracts/transfer_to.tz b/src/proto_alpha/lib_protocol/test/contracts/transfer_to.tz index c4a8673f5..bb8445bfe 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/transfer_to.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/transfer_to.tz @@ -1,4 +1,5 @@ -parameter (contract unit unit); -return unit; +parameter (contract unit); storage unit; -code {CAR; DIP{UNIT}; PUSH tez "100.00"; UNIT; TRANSFER_TOKENS; PAIR}; +code { CAR; DIP{UNIT}; PUSH tez "100.00"; UNIT; + TRANSFER_TOKENS; + NIL operation; SWAP; CONS; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/two_vulnerabilities.tz b/src/proto_alpha/lib_protocol/test/contracts/two_vulnerabilities.tz deleted file mode 100644 index 96786e639..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/two_vulnerabilities.tz +++ /dev/null @@ -1,7 +0,0 @@ - -parameter unit; -storage (pair (contract unit unit) (contract unit unit)); -return unit; -code { CDR; DUP; CAR; PUSH tez "5.00"; UNIT; - TRANSFER_TOKENS; DROP; DUP; CDR; - PUSH tez "5.00"; UNIT; TRANSFER_TOKENS; PAIR }; diff --git a/src/proto_alpha/lib_protocol/test/contracts/unpair_macro.tz b/src/proto_alpha/lib_protocol/test/contracts/unpair_macro.tz index 12a4578df..6a33e2290 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/unpair_macro.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/unpair_macro.tz @@ -1,4 +1,3 @@ parameter unit; storage unit; -return unit; -code { UNIT; UNIT; UNIT; UNIT; PAIAAIR; UNPAIAAIR; DROP; DROP; DROP; DROP } +code { UNIT; UNIT; UNIT; UNIT; PAIAAIR; UNPAIAAIR; DROP; DROP; DROP; DROP; CAR; NIL operation; PAIR } diff --git a/src/proto_alpha/lib_protocol/test/contracts/weather_insurance.tz b/src/proto_alpha/lib_protocol/test/contracts/weather_insurance.tz index d437f87fa..fc0a05ada 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/weather_insurance.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/weather_insurance.tz @@ -1,10 +1,9 @@ # (pair signed_weather_data actual_level) parameter (pair (signature @sig) (nat @nat)); # (pair (under_key over_key) (pair weather_service_key (pair rain_level days_in_future))) -storage (pair (pair (contract @lt unit unit) - (contract @geq unit unit)) +storage (pair (pair (contract @lt unit) + (contract @geq unit)) (pair nat key)); -return unit; code { DUP; DUP; CAR; MAP_CDR{H}; SWAP; CDDDR; CHECK_SIGNATURE; # Check if the data has been correctly signed @@ -14,5 +13,6 @@ code { DUP; DUP; DIP{CADR}; # Get actual rain CDDAR; # Get rain threshold CMPLT; IF {CAR @winner} {CDR @winner}; # Select contract to receive tokens - BALANCE; UNIT; TRANSFER_TOKENS; # Setup and execute transfer - PAIR }; # Save storage + BALANCE; UNIT ; TRANSFER_TOKENS; # Setup and execute transfer + NIL operation ; SWAP ; CONS ; + PAIR }; diff --git a/src/proto_alpha/lib_protocol/test/contracts/xor.tz b/src/proto_alpha/lib_protocol/test/contracts/xor.tz index f7185a14a..ab8dcf57d 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/xor.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/xor.tz @@ -1,4 +1,3 @@ parameter (pair bool bool); -return bool; -storage unit; -code {CAR; DUP; CAR; DIP{CDR}; XOR; UNIT; SWAP; PAIR}; +storage (option bool); +code {CAR; DUP; CAR; DIP{CDR}; XOR; SOME; NIL operation ; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_operation.ml b/src/proto_alpha/lib_protocol/test/helpers/helpers_operation.ml index 8c4e7ba04..b903b7818 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_operation.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/helpers_operation.ml @@ -13,7 +13,7 @@ open Alpha_context let sourced ops = Sourced_operations ops -let manager (src : Helpers_account.t) ?(fee = Tez.zero) operations context = +let manager (src : Helpers_account.t) ?(fee = Tez.zero) operations context gas_limit = Alpha_context.prepare ~level:0l ~timestamp:(Time.now ()) ~fitness:[] context >>=? fun context -> Contract.get_counter context src.contract >>=? fun counter -> @@ -25,26 +25,26 @@ let manager (src : Helpers_account.t) ?(fee = Tez.zero) operations context = fee ; counter ; operations = (if revealed then operations else Reveal src.pub :: operations) ; + gas_limit ; } -let manager_full src ?(fee = Tez.zero) ops context = - manager src ~fee ops context >>=? fun ops -> return @@ sourced ops +let manager_full src ?(fee = Tez.zero) ops context gas_limit = + manager src ~fee ops context gas_limit >>=? fun ops -> return @@ sourced ops -let transaction ?parameters amount destination gas_limit = +let transaction ?parameters amount destination = Transaction { amount ; parameters ; destination ; - gas_limit } let origination ?(delegatable = true) ?(script = None) ?(spendable = true) ?(delegate = None) - (manager: Helpers_account.t) credit gas_limit + (manager: Helpers_account.t) credit = Origination { manager = manager.hpub ; @@ -52,8 +52,7 @@ let origination spendable ; delegatable ; script ; - credit ; - gas_limit + credit } @@ -62,19 +61,19 @@ let delegation delegate = let delegation_full ?(fee = Tez.zero) src delegate context = - manager_full src ~fee [delegation delegate] context + manager_full src ~fee [delegation delegate] context Z.zero let script_origination_full script src credit gas_limit context = - manager_full src ~fee: Tez.zero [origination ~script src credit gas_limit] context + manager_full src ~fee: Tez.zero [origination ~script src credit] context gas_limit let origination_full ?(spendable = true) ?(delegatable = true) ?(fee = Tez.zero) src credit gas_limit context = - manager_full src ~fee [origination ~spendable ~delegatable src credit gas_limit] context + manager_full src ~fee [origination ~spendable ~delegatable src credit] context gas_limit let transaction_full ?(fee = Tez.zero) ?parameters src dst amount gas_limit context = - manager src ~fee [transaction ?parameters amount dst gas_limit] context + manager src ~fee [transaction ?parameters amount dst] context gas_limit >>=? fun manager_op -> return @@ sourced manager_op diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_operation.mli b/src/proto_alpha/lib_protocol/test/helpers/helpers_operation.mli index 445f01164..e394263f9 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_operation.mli +++ b/src/proto_alpha/lib_protocol/test/helpers/helpers_operation.mli @@ -16,19 +16,19 @@ val sourced : sourced_operations -> proto_operation val manager : Helpers_account.t -> ?fee:Tez.tez -> manager_operation list -> - Alpha_environment.Context.t -> sourced_operations proto_tzresult Lwt.t + Alpha_environment.Context.t -> Z.t -> sourced_operations proto_tzresult Lwt.t val manager_full : Helpers_account.t -> ?fee:Tez.tez -> manager_operation list -> - Alpha_environment.Context.t -> proto_operation proto_tzresult Lwt.t + Alpha_environment.Context.t -> Z.t -> proto_operation proto_tzresult Lwt.t val transaction : - ?parameters:Script.expr -> Tez.t -> Contract.contract -> Z.t -> + ?parameters:Script.expr -> Tez.t -> Contract.contract -> manager_operation val origination : ?delegatable:bool -> ?script:Script.t option -> ?spendable:bool -> - ?delegate:public_key_hash option -> Helpers_account.t -> Tez.t -> Z.t -> manager_operation + ?delegate:public_key_hash option -> Helpers_account.t -> Tez.t -> manager_operation val delegation : public_key_hash -> manager_operation diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_script.ml b/src/proto_alpha/lib_protocol/test/helpers/helpers_script.ml index 50ab3a118..80a327617 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_script.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/helpers_script.ml @@ -31,11 +31,14 @@ let execute_code_pred let dummy_nonce = Contract.initial_origination_nonce hash in let amount = Tez.zero in Lwt.return (Proto_alpha.Alpha_context.Gas.set_limit tc gas) >>=? fun tc -> - let return = Script_interpreter.execute - tc dummy_nonce - ~source: op.contract - ~self: (dst, script) - ~amount ~parameter in - return + Script_interpreter.execute + tc dummy_nonce + ~check_operations: true + ~source: op.contract + ~payer: op.contract + ~self: (dst, script) + ~amount ~parameter >>=? fun ({ ctxt ; storage ; big_map_diff } as res) -> + Proto_alpha.Alpha_context.Contract.update_script_storage ctxt dst storage big_map_diff >>=? fun ctxt -> + return (dst, { res with ctxt }) diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_script.mli b/src/proto_alpha/lib_protocol/test/helpers/helpers_script.mli index 0ca097eb5..4439e74aa 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_script.mli +++ b/src/proto_alpha/lib_protocol/test/helpers/helpers_script.mli @@ -13,5 +13,5 @@ open Alpha_context val init_amount : int val execute_code_pred : ?tc:Alpha_context.t -> Helpers_block.result -> Script.t -> Script.expr -> - Script_interpreter.execution_result proto_tzresult Lwt.t + (Alpha_context.Contract.t * Script_interpreter.execution_result) proto_tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/test/main.ml b/src/proto_alpha/lib_protocol/test/main.ml index 56d25a6ab..b7588ec67 100644 --- a/src/proto_alpha/lib_protocol/test/main.ml +++ b/src/proto_alpha/lib_protocol/test/main.ml @@ -12,7 +12,10 @@ let wrap (n, f) = f () >>= function | Ok () -> Lwt.return_unit | Error error -> - Format.kasprintf Pervasives.failwith "%a" pp_print_error error + Format.kasprintf Pervasives.failwith "%a" + (Format.pp_print_list + (fun ppf e -> Data_encoding.Json.pp ppf (Error_monad.json_of_error e))) + error end let () = diff --git a/src/proto_alpha/lib_protocol/test/test_big_maps.ml b/src/proto_alpha/lib_protocol/test/test_big_maps.ml index 37f32aa41..78f8ffc86 100644 --- a/src/proto_alpha/lib_protocol/test/test_big_maps.ml +++ b/src/proto_alpha/lib_protocol/test/test_big_maps.ml @@ -31,13 +31,12 @@ let parse_script code_str storage_str : Proto_alpha.Alpha_context.Script.t tzres let code = {| { parameter (list (pair string int)) ; storage (pair (big_map string int) unit) ; - return unit ; code { UNPAAIAIR ; ITER { UNPAIR ; DUUUP ; DUUP; GET ; IF_NONE { PUSH int 0 } {} ; SWAP ; DIP { ADD ; SOME } ; UPDATE } ; - PAIR ; UNIT ; PAIR } } + PAIR ; NIL operation ; PAIR } } |} let storage = {| Pair { Elt "A" 1 ; Elt "B" 2 } Unit |} @@ -56,11 +55,13 @@ let expect_big_map tc contract print_key key_type print_data data_type contents 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 data_type (Micheline.root data) >>=? fun (data, _tc) -> + Proto_alpha.Script_ir_translator.parse_data tc ~check_operations: false + 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 data_type (Micheline.root data) >>=? fun (data, _tc) -> + Proto_alpha.Script_ir_translator.parse_data tc ~check_operations: false + 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 ()) diff --git a/src/proto_alpha/lib_protocol/test/test_michelson.ml b/src/proto_alpha/lib_protocol/test/test_michelson.ml index 8a0a7e81b..b8593ce7c 100644 --- a/src/proto_alpha/lib_protocol/test/test_michelson.ml +++ b/src/proto_alpha/lib_protocol/test/test_michelson.ml @@ -37,11 +37,10 @@ let parse_script code_str storage_str : Proto_alpha.Alpha_context.Script.t = return -let program param ret st code = +let program param st code = let storage s = " storage " ^ s ^ " ; \n" in let parameter s = " parameter " ^ s ^ " ; \n" in - let return s = " return " ^ s ^ " ; \n" in - "{\n" ^ (storage st) ^ (parameter param) ^ (return ret) ^ " " ^ code ^ "}" + "{\n" ^ (storage st) ^ (parameter param) ^ " " ^ code ^ "}" let quote s = "\"" ^ s ^ "\"" @@ -49,10 +48,21 @@ 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 { return_value = ret ; storage = st ; ctxt = tc ; - origination_nonce = nonce ; big_map_diff = bgm } -> + >>=?? fun (dst, { ctxt = tc ; operations = ops ; + origination_nonce = nonce ; big_map_diff = bgm }) -> + let payer = + (List.hd Account.bootstrap_accounts).contract in + Proto_alpha.Apply.apply_internal_manager_operations tc ~payer nonce ops >>=?? fun (tc, nonce, err, _, ops) -> let contracts = Contract.originated_contracts nonce in - return (st, ret, tc, contracts, bgm) + match err with + | None -> + let tc = Proto_alpha.Alpha_context.Gas.set_unlimited tc in + Proto_alpha.Alpha_context.Contract.get_storage tc dst >>=?? begin function + | (_, None) -> assert false + | (tc, Some st) -> return (st, ops, tc, contracts, bgm) + end + | Some err -> + Lwt.return (Alpha_environment.wrap_error (Error_monad.error (List.hd err))) let test ctxt ?tc (file_name: string) (storage: string) (input: string) = let full_path = contract_path // file_name ^ ".tz" in @@ -79,22 +89,11 @@ let string_of_canon output_prim = output let test_print ctxt fn s i = - test ctxt fn s i >>=? fun (sp, op, _, _, _bgm) -> + test ctxt fn s i >>=? fun (sp, _, _, _, _bgm) -> let ss = string_of_canon sp in - let os = string_of_canon op in debug "Storage : %s" ss ; - debug "Output : %s" os ; return () - -let test_output ctxt ?tc ?location (file_name: string) (storage: string) (input: string) (expected_output: string) = - 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 ; - return () - - let test_tc ctxt ?tc (file_name: string) (storage: string) (input: string) = test ctxt ?tc file_name storage input >>=? fun (_storage_prim, _output_prim, tc, _contracts, _bgm) -> return (tc) @@ -107,17 +106,24 @@ let test_contract ctxt ?tc (file_name: string) (storage: string) (input: string) let test_storage ctxt ?location (file_name: string) (storage: string) (input: string) (expected_storage: string) = + let msg = Option.unopt ~default:"strings aren't equal" location in + generic_trace "%s" msg @@ test ctxt file_name storage input >>=? fun (storage_prim, _output_prim, _tc, _contracts, _bgm) -> let storage = string_of_canon storage_prim in - let msg = Option.unopt ~default:"strings aren't equal" location in Assert.equal_string ~msg expected_storage storage ; return () +let test_success ctxt ?location (file_name: string) (storage: string) (input: string) = + let msg = Option.unopt ~default:"strings aren't equal" location in + generic_trace "%s" msg @@ + test ctxt file_name storage input >>=? fun (_storage_prim, _output_prim, _tc, _contracts, _bgm) -> + return () + let test_example () = Init.main () >>=?? fun sb -> let test_output ?location a b c d = - test_output sb ?location a b c d >>= function + test_storage sb ?location a b c d >>= function | Ok(x) -> return x | Error(errs) -> ( match location with @@ -126,194 +132,195 @@ let test_example () = ) ; Lwt.return (Error(errs)) in let test_fails ?location = test_fails ?location sb in + let test_success ?location = test_success ?location sb in let test_tc ?tc = test_tc ?tc sb in let test_contract ?tc = test_contract ?tc sb in (* let test_print ?location = test_print ?location sb in*) let test_storage ?location = test_storage ?location sb in (* FORMAT: assert_output contract_file storage input expected_result *) - test_output ~location: __LOC__ "ret_int" "Unit" "Unit" "300" >>=? fun _ -> + test_output ~location: __LOC__ "ret_int" "None" "Unit" "(Some 300)" >>=? fun _ -> (* Identity on strings *) - test_output ~location: __LOC__ "str_id" "Unit" "\"Hello\"" "\"Hello\"" >>=? fun _ -> - test_output ~location: __LOC__ "str_id" "Unit" "\"abcd\"" "\"abcd\"" >>=? fun _ -> + test_output ~location: __LOC__ "str_id" "None" "\"Hello\"" "(Some \"Hello\")" >>=? fun _ -> + test_output ~location: __LOC__ "str_id" "None" "\"abcd\"" "(Some \"abcd\")" >>=? fun _ -> (* Identity on pairs *) - test_output ~location: __LOC__ "pair_id" "Unit" "(Pair True False)" "(Pair True False)" >>=? fun _ -> - test_output ~location: __LOC__ "pair_id" "Unit" "(Pair False True)" "(Pair False True)" >>=? fun _ -> - test_output ~location: __LOC__ "pair_id" "Unit" "(Pair True True)" "(Pair True True)" >>=? fun _ -> - test_output ~location: __LOC__ "pair_id" "Unit" "(Pair False False)" "(Pair False False)" >>=? fun _ -> + test_output ~location: __LOC__ "pair_id" "None" "(Pair True False)" "(Some (Pair True False))" >>=? fun _ -> + test_output ~location: __LOC__ "pair_id" "None" "(Pair False True)" "(Some (Pair False True))" >>=? fun _ -> + test_output ~location: __LOC__ "pair_id" "None" "(Pair True True)" "(Some (Pair True True))" >>=? fun _ -> + test_output ~location: __LOC__ "pair_id" "None" "(Pair False False)" "(Some (Pair False False))" >>=? fun _ -> (* Logical not *) - test_output ~location: __LOC__ "not" "Unit" "True" "False" >>=? fun _ -> - test_output ~location: __LOC__ "not" "Unit" "False" "True" >>=? fun _ -> + test_output ~location: __LOC__ "not" "None" "True" "(Some False)" >>=? fun _ -> + test_output ~location: __LOC__ "not" "None" "False" "(Some True)" >>=? fun _ -> (* Logical and *) - test_output ~location: __LOC__ "and" "Unit" "(Pair False False)" "False" >>=? fun _ -> - test_output ~location: __LOC__ "and" "Unit" "(Pair False True)" "False" >>=? fun _ -> - test_output ~location: __LOC__ "and" "Unit" "(Pair True False)" "False" >>=? fun _ -> - test_output ~location: __LOC__ "and" "Unit" "(Pair True True)" "True" >>=? fun _ -> + test_output ~location: __LOC__ "and" "None" "(Pair False False)" "(Some False)" >>=? fun _ -> + test_output ~location: __LOC__ "and" "None" "(Pair False True)" "(Some False)" >>=? fun _ -> + test_output ~location: __LOC__ "and" "None" "(Pair True False)" "(Some False)" >>=? fun _ -> + test_output ~location: __LOC__ "and" "None" "(Pair True True)" "(Some True)" >>=? fun _ -> (* Logical or *) - test_output ~location: __LOC__ "or" "Unit" "(Pair False False)" "False" >>=? fun _ -> - test_output ~location: __LOC__ "or" "Unit" "(Pair False True)" "True" >>=? fun _ -> - test_output ~location: __LOC__ "or" "Unit" "(Pair True False)" "True" >>=? fun _ -> - test_output ~location: __LOC__ "or" "Unit" "(Pair True True)" "True" >>=? fun _ -> + test_output ~location: __LOC__ "or" "None" "(Pair False False)" "(Some False)" >>=? fun _ -> + test_output ~location: __LOC__ "or" "None" "(Pair False True)" "(Some True)" >>=? fun _ -> + test_output ~location: __LOC__ "or" "None" "(Pair True False)" "(Some True)" >>=? fun _ -> + test_output ~location: __LOC__ "or" "None" "(Pair True True)" "(Some True)" >>=? fun _ -> (* XOR *) - test_output ~location: __LOC__ "xor" "Unit" "(Pair False False)" "False" >>=? fun _ -> - test_output ~location: __LOC__ "xor" "Unit" "(Pair False True)" "True" >>=? fun _ -> - test_output ~location: __LOC__ "xor" "Unit" "(Pair True False)" "True" >>=? fun _ -> - test_output ~location: __LOC__ "xor" "Unit" "(Pair True True)" "False" >>=? fun _ -> + test_output ~location: __LOC__ "xor" "None" "(Pair False False)" "(Some False)" >>=? fun _ -> + test_output ~location: __LOC__ "xor" "None" "(Pair False True)" "(Some True)" >>=? fun _ -> + test_output ~location: __LOC__ "xor" "None" "(Pair True False)" "(Some True)" >>=? fun _ -> + test_output ~location: __LOC__ "xor" "None" "(Pair True True)" "(Some False)" >>=? fun _ -> (* Build list *) - test_output ~location: __LOC__ "build_list" "Unit" "0" "{ 0 }" >>=? fun _ -> - test_output ~location: __LOC__ "build_list" "Unit" "3" "{ 0 ; 1 ; 2 ; 3 }" >>=? fun _ -> - test_output ~location: __LOC__ "build_list" "Unit" "10" "{ 0 ; 1 ; 2 ; 3 ; 4 ; 5 ; 6 ; 7 ; 8 ; 9 ; 10 }" >>=? fun _ -> + test_output ~location: __LOC__ "build_list" "{111}" "0" "{ 0 }" >>=? fun _ -> + test_output ~location: __LOC__ "build_list" "{111}" "3" "{ 0 ; 1 ; 2 ; 3 }" >>=? fun _ -> + test_output ~location: __LOC__ "build_list" "{111}" "10" "{ 0 ; 1 ; 2 ; 3 ; 4 ; 5 ; 6 ; 7 ; 8 ; 9 ; 10 }" >>=? fun _ -> (* Concatenate all strings of a list into one string *) - test_output ~location: __LOC__ "concat_list" "Unit" "{ \"a\" ; \"b\" ; \"c\" }" "\"abc\"" >>=? fun _ -> - test_output ~location: __LOC__ "concat_list" "Unit" "{}" "\"\"" >>=? fun _ -> - test_output ~location: __LOC__ "concat_list" "Unit" "{ \"Hello\" ; \" \" ; \"World\" ; \"!\" }" "\"Hello World!\"" >>=? fun _ -> + test_output ~location: __LOC__ "concat_list" "\"?\"" "{ \"a\" ; \"b\" ; \"c\" }" "\"abc\"" >>=? fun _ -> + test_output ~location: __LOC__ "concat_list" "\"?\"" "{}" "\"\"" >>=? fun _ -> + test_output ~location: __LOC__ "concat_list" "\"?\"" "{ \"Hello\" ; \" \" ; \"World\" ; \"!\" }" "\"Hello World!\"" >>=? fun _ -> (* Find maximum int in list -- returns None if not found *) - test_output ~location: __LOC__ "max_in_list" "Unit" "{}" "None" >>=? fun _ -> - test_output ~location: __LOC__ "max_in_list" "Unit" "{ 1 }" "(Some 1)" >>=? fun _ -> - test_output ~location: __LOC__ "max_in_list" "Unit" "{ -1 }" "(Some -1)" >>=? fun _ -> - test_output ~location: __LOC__ "max_in_list" "Unit" "{ 10 ; -1 ; -20 ; 100 ; 0 }" "(Some 100)" >>=? fun _ -> - test_output ~location: __LOC__ "max_in_list" "Unit" "{ 10 ; -1 ; -20 ; 100 ; 0 }" "(Some 100)" >>=? fun _ -> - test_output ~location: __LOC__ "max_in_list" "Unit" "{ -10 ; -1 ; -20 ; -100 }" "(Some -1)" >>=? fun _ -> + test_output ~location: __LOC__ "max_in_list" "None" "{}" "None" >>=? fun _ -> + test_output ~location: __LOC__ "max_in_list" "None" "{ 1 }" "(Some 1)" >>=? fun _ -> + test_output ~location: __LOC__ "max_in_list" "None" "{ -1 }" "(Some -1)" >>=? fun _ -> + test_output ~location: __LOC__ "max_in_list" "None" "{ 10 ; -1 ; -20 ; 100 ; 0 }" "(Some 100)" >>=? fun _ -> + test_output ~location: __LOC__ "max_in_list" "None" "{ 10 ; -1 ; -20 ; 100 ; 0 }" "(Some 100)" >>=? fun _ -> + test_output ~location: __LOC__ "max_in_list" "None" "{ -10 ; -1 ; -20 ; -100 }" "(Some -1)" >>=? fun _ -> (* Identity on lists *) - test_output ~location: __LOC__ "list_id" "Unit" "{ \"1\" ; \"2\" ; \"3\" }" "{ \"1\" ; \"2\" ; \"3\" }" >>=? fun _ -> - test_output ~location: __LOC__ "list_id" "Unit" "{}" "{}" >>=? fun _ -> - test_output ~location: __LOC__ "list_id" "Unit" "{ \"a\" ; \"b\" ; \"c\" }" "{ \"a\" ; \"b\" ; \"c\" }" >>=? fun _ -> + test_output ~location: __LOC__ "list_id" "{\"?\"}" "{ \"1\" ; \"2\" ; \"3\" }" "{ \"1\" ; \"2\" ; \"3\" }" >>=? fun _ -> + test_output ~location: __LOC__ "list_id" "{\"?\"}" "{}" "{}" >>=? fun _ -> + test_output ~location: __LOC__ "list_id" "{\"?\"}" "{ \"a\" ; \"b\" ; \"c\" }" "{ \"a\" ; \"b\" ; \"c\" }" >>=? fun _ -> - test_output ~location: __LOC__ "list_id_map" "Unit" "{ \"1\" ; \"2\" ; \"3\" }" "{ \"1\" ; \"2\" ; \"3\" }" >>=? fun _ -> - test_output ~location: __LOC__ "list_id_map" "Unit" "{}" "{}" >>=? fun _ -> - test_output ~location: __LOC__ "list_id_map" "Unit" "{ \"a\" ; \"b\" ; \"c\" }" "{ \"a\" ; \"b\" ; \"c\" }" >>=? fun _ -> + test_output ~location: __LOC__ "list_id_map" "{\"?\"}" "{ \"1\" ; \"2\" ; \"3\" }" "{ \"1\" ; \"2\" ; \"3\" }" >>=? fun _ -> + test_output ~location: __LOC__ "list_id_map" "{\"?\"}" "{}" "{}" >>=? fun _ -> + test_output ~location: __LOC__ "list_id_map" "{\"?\"}" "{ \"a\" ; \"b\" ; \"c\" }" "{ \"a\" ; \"b\" ; \"c\" }" >>=? fun _ -> (* Identity on maps *) - test_output ~location: __LOC__ "map_id" "Unit" "{ Elt 0 1 }" "{ Elt 0 1 }" >>=? fun _ -> - test_output ~location: __LOC__ "map_id" "Unit" "{ Elt 0 0 }" "{ Elt 0 0 }" >>=? fun _ -> - test_output ~location: __LOC__ "map_id" "Unit" "{ Elt 0 0 ; Elt 3 4 }" "{ Elt 0 0 ; Elt 3 4 }" >>=? fun _ -> + test_output ~location: __LOC__ "map_id" "{}" "{ Elt 0 1 }" "{ Elt 0 1 }" >>=? fun _ -> + test_output ~location: __LOC__ "map_id" "{}" "{ Elt 0 0 }" "{ Elt 0 0 }" >>=? fun _ -> + test_output ~location: __LOC__ "map_id" "{}" "{ Elt 0 0 ; Elt 3 4 }" "{ Elt 0 0 ; Elt 3 4 }" >>=? fun _ -> (* Map block on lists *) - test_output ~location: __LOC__ "list_map_block" "Unit" "{}" "{}" >>=? fun _ -> - test_output ~location: __LOC__ "list_map_block" "Unit" "{ 1 ; 1 ; 1 ; 1 }" "{ 1 ; 2 ; 3 ; 4 }" >>=? fun _ -> - test_output ~location: __LOC__ "list_map_block" "Unit" "{ 1 ; 2 ; 3 ; 0 }" "{ 1 ; 3 ; 5 ; 3 }" >>=? fun _ -> + test_output ~location: __LOC__ "list_map_block" "{111}" "{}" "{}" >>=? fun _ -> + test_output ~location: __LOC__ "list_map_block" "{111}" "{ 1 ; 1 ; 1 ; 1 }" "{ 1 ; 2 ; 3 ; 4 }" >>=? fun _ -> + test_output ~location: __LOC__ "list_map_block" "{111}" "{ 1 ; 2 ; 3 ; 0 }" "{ 1 ; 3 ; 5 ; 3 }" >>=? fun _ -> (* List iter *) - test_output ~location: __LOC__ "list_iter" "Unit" "{ 10 ; 2 ; 1 }" "20" >>=? fun _ -> - test_output ~location: __LOC__ "list_iter" "Unit" "{ 3 ; 6 ; 9 }" "162" >>=? fun _ -> + test_output ~location: __LOC__ "list_iter" "111" "{ 10 ; 2 ; 1 }" "20" >>=? fun _ -> + test_output ~location: __LOC__ "list_iter" "111" "{ 3 ; 6 ; 9 }" "162" >>=? fun _ -> - test_output ~location: __LOC__ "list_iter2" "Unit" "{ \"a\" ; \"b\" ; \"c\" }" "\"cba\"" >>=? fun _ -> - test_output ~location: __LOC__ "list_iter2" "Unit" "{}" "\"\"" >>=? fun _ -> + test_output ~location: __LOC__ "list_iter2" "\"?\"" "{ \"a\" ; \"b\" ; \"c\" }" "\"cba\"" >>=? fun _ -> + test_output ~location: __LOC__ "list_iter2" "\"?\"" "{}" "\"\"" >>=? fun _ -> (* Identity on sets *) - test_output ~location: __LOC__ "set_id" "Unit" "{ \"a\" ; \"b\" ; \"c\" }" "{ \"a\" ; \"b\" ; \"c\" }" >>=? fun _ -> - test_output ~location: __LOC__ "set_id" "Unit" "{}" "{}" >>=? fun _ -> - test_output ~location: __LOC__ "set_id" "Unit" "{ \"asdf\" ; \"bcde\" }" "{ \"asdf\" ; \"bcde\" }" >>=? fun _ -> + test_output ~location: __LOC__ "set_id" "{\"?\"}" "{ \"a\" ; \"b\" ; \"c\" }" "{ \"a\" ; \"b\" ; \"c\" }" >>=? fun _ -> + test_output ~location: __LOC__ "set_id" "{\"?\"}" "{}" "{}" >>=? fun _ -> + test_output ~location: __LOC__ "set_id" "{\"?\"}" "{ \"asdf\" ; \"bcde\" }" "{ \"asdf\" ; \"bcde\" }" >>=? fun _ -> (* Set member -- set is in storage *) - test_output ~location: __LOC__ "set_member" "{}" "\"Hi\"" "False" >>=? fun _ -> - test_output ~location: __LOC__ "set_member" "{ \"Hi\" }" "\"Hi\"" "True" >>=? fun _ -> - test_output ~location: __LOC__ "set_member" "{ \"Hello\" ; \"World\" }" "\"\"" "False" >>=? fun _ -> + test_output ~location: __LOC__ "set_member" "(Pair {} None)" "\"Hi\"" "(Pair {} (Some False))" >>=? fun _ -> + test_output ~location: __LOC__ "set_member" "(Pair { \"Hi\" } None)" "\"Hi\"" "(Pair { \"Hi\" } (Some True))" >>=? fun _ -> + test_output ~location: __LOC__ "set_member" "(Pair { \"Hello\" ; \"World\" } None)" "\"\"" "(Pair { \"Hello\" ; \"World\" } (Some False))" >>=? fun _ -> (* Set size *) - test_output ~location: __LOC__ "set_size" "Unit" "{}" "0" >>=? fun _ -> - test_output ~location: __LOC__ "set_size" "Unit" "{ 1 }" "1" >>=? fun _ -> - test_output ~location: __LOC__ "set_size" "Unit" "{ 1 ; 2 ; 3 }" "3" >>=? fun _ -> - test_output ~location: __LOC__ "set_size" "Unit" "{ 1 ; 2 ; 3 ; 4 ; 5 ; 6 }" "6" >>=? fun _ -> + test_output ~location: __LOC__ "set_size" "111" "{}" "0" >>=? fun _ -> + test_output ~location: __LOC__ "set_size" "111" "{ 1 }" "1" >>=? fun _ -> + test_output ~location: __LOC__ "set_size" "111" "{ 1 ; 2 ; 3 }" "3" >>=? fun _ -> + test_output ~location: __LOC__ "set_size" "111" "{ 1 ; 2 ; 3 ; 4 ; 5 ; 6 }" "6" >>=? fun _ -> (* Set iter *) - test_output ~location: __LOC__ "set_iter" "Unit" "{}" "0" >>=? fun _ -> - test_output ~location: __LOC__ "set_iter" "Unit" "{ 1 }" "1" >>=? fun _ -> - test_output ~location: __LOC__ "set_iter" "Unit" "{ -100 ; 1 ; 2 ; 3 }" "-94" >>=? fun _ -> + test_output ~location: __LOC__ "set_iter" "111" "{}" "0" >>=? fun _ -> + test_output ~location: __LOC__ "set_iter" "111" "{ 1 }" "1" >>=? fun _ -> + test_output ~location: __LOC__ "set_iter" "111" "{ -100 ; 1 ; 2 ; 3 }" "-94" >>=? fun _ -> (* Map size *) - test_output ~location: __LOC__ "map_size" "Unit" "{}" "0" >>=? fun _ -> - test_output ~location: __LOC__ "map_size" "Unit" "{ Elt \"a\" 1 }" "1" >>=? fun _ -> - test_output ~location: __LOC__ "map_size" "Unit" "{ Elt \"a\" 1 ; Elt \"b\" 2 ; Elt \"c\" 3 }" "3" >>=? fun _ -> - test_output ~location: __LOC__ "map_size" "Unit" "{ Elt \"a\" 1 ; Elt \"b\" 2 ; Elt \"c\" 3 ; Elt \"d\" 4 ; Elt \"e\" 5 ; Elt \"f\" 6 }" "6" >>=? fun _ -> + test_output ~location: __LOC__ "map_size" "111" "{}" "0" >>=? fun _ -> + test_output ~location: __LOC__ "map_size" "111" "{ Elt \"a\" 1 }" "1" >>=? fun _ -> + test_output ~location: __LOC__ "map_size" "111" "{ Elt \"a\" 1 ; Elt \"b\" 2 ; Elt \"c\" 3 }" "3" >>=? fun _ -> + test_output ~location: __LOC__ "map_size" "111" "{ Elt \"a\" 1 ; Elt \"b\" 2 ; Elt \"c\" 3 ; Elt \"d\" 4 ; Elt \"e\" 5 ; Elt \"f\" 6 }" "6" >>=? fun _ -> (* Contains all elements -- does the second list contain all of the same elements *) (* as the first one? I'm ignoring element multiplicity *) - test_output ~location: __LOC__ "contains_all" "Unit" "(Pair {} {})" "True" >>=? fun _ -> - test_output ~location: __LOC__ "contains_all" "Unit" "(Pair { \"a\" } { \"B\" })" "False" >>=? fun _ -> - test_output ~location: __LOC__ "contains_all" "Unit" "(Pair { \"A\" } { \"B\" })" "False" >>=? fun _ -> - test_output ~location: __LOC__ "contains_all" "Unit" "(Pair { \"B\" } { \"B\" })" "True" >>=? fun _ -> - test_output ~location: __LOC__ "contains_all" "Unit" "(Pair { \"B\" ; \"C\" ; \"asdf\" } { \"B\" ; \"B\" ; \"asdf\" ; \"C\" })" "True" >>=? fun _ -> - test_output ~location: __LOC__ "contains_all" "Unit" "(Pair { \"B\" ; \"B\" ; \"asdf\" ; \"C\" } { \"B\" ; \"C\" ; \"asdf\" })" "True" >>=? fun _ -> + test_output ~location: __LOC__ "contains_all" "None" "(Pair {} {})" "(Some True)" >>=? fun _ -> + test_output ~location: __LOC__ "contains_all" "None" "(Pair { \"a\" } { \"B\" })" "(Some False)" >>=? fun _ -> + test_output ~location: __LOC__ "contains_all" "None" "(Pair { \"A\" } { \"B\" })" "(Some False)" >>=? fun _ -> + test_output ~location: __LOC__ "contains_all" "None" "(Pair { \"B\" } { \"B\" })" "(Some True)" >>=? fun _ -> + test_output ~location: __LOC__ "contains_all" "None" "(Pair { \"B\" ; \"C\" ; \"asdf\" } { \"B\" ; \"B\" ; \"asdf\" ; \"C\" })" "(Some True)" >>=? fun _ -> + test_output ~location: __LOC__ "contains_all" "None" "(Pair { \"B\" ; \"B\" ; \"asdf\" ; \"C\" } { \"B\" ; \"C\" ; \"asdf\" })" "(Some True)" >>=? fun _ -> (* Concatenate the string in storage with all strings in the given list *) - test_output ~location: __LOC__ "concat_hello" "Unit" "{ \"World!\" }" "{ \"Hello World!\" }" >>=? fun _ -> - test_output ~location: __LOC__ "concat_hello" "Unit" "{}" "{}" >>=? fun _ -> - test_output ~location: __LOC__ "concat_hello" "Unit" "{ \"test1\" ; \"test2\" }" "{ \"Hello test1\" ; \"Hello test2\" }" >>=? fun _ -> + test_output ~location: __LOC__ "concat_hello" "{\"?\"}" "{ \"World!\" }" "{ \"Hello World!\" }" >>=? fun _ -> + test_output ~location: __LOC__ "concat_hello" "{\"?\"}" "{}" "{}" >>=? fun _ -> + test_output ~location: __LOC__ "concat_hello" "{\"?\"}" "{ \"test1\" ; \"test2\" }" "{ \"Hello test1\" ; \"Hello test2\" }" >>=? fun _ -> (* Create an empty map and add a string to it *) - test_output ~location: __LOC__ "empty_map" "Unit" "Unit" "{ Elt \"hello\" \"world\" }" >>=? fun _ -> + test_output ~location: __LOC__ "empty_map" "{}" "Unit" "{ Elt \"hello\" \"world\" }" >>=? fun _ -> (* Get the value stored at the given key in the map *) - test_output ~location: __LOC__ "get_map_value" "{ Elt \"hello\" \"hi\" }" "\"hello\"" "(Some \"hi\")" >>=? fun _ -> - test_output ~location: __LOC__ "get_map_value" "{ Elt \"hello\" \"hi\" }" "\"\"" "None" >>=? fun _ -> - test_output ~location: __LOC__ "get_map_value" "{ Elt \"1\" \"one\" ; Elt \"2\" \"two\" }" "\"1\"" "(Some \"one\")" >>=? fun _ -> + test_output ~location: __LOC__ "get_map_value" "(Pair None { Elt \"hello\" \"hi\" })" "\"hello\"" "(Pair (Some \"hi\") { Elt \"hello\" \"hi\" })" >>=? fun _ -> + test_output ~location: __LOC__ "get_map_value" "(Pair None { Elt \"hello\" \"hi\" }" "\"\"" "(Pair None { Elt \"hello\" \"hi\" })" >>=? fun _ -> + test_output ~location: __LOC__ "get_map_value" "(Pair None { Elt \"1\" \"one\" ; Elt \"2\" \"two\" })" "\"1\"" "(Pair (Some \"one\") { Elt \"1\" \"one\" ; Elt \"2\" \"two\" })" >>=? fun _ -> (* Map iter *) - test_output ~location: __LOC__ "map_iter" "Unit" "{ Elt 0 100 ; Elt 2 100 }" "(Pair 2 200)" >>=? fun _ -> - test_output ~location: __LOC__ "map_iter" "Unit" "{ Elt 1 1 ; Elt 2 100 }" "(Pair 3 101)" >>=? fun _ -> + test_output ~location: __LOC__ "map_iter" "(Pair 3 3)" "{ Elt 0 100 ; Elt 2 100 }" "(Pair 2 200)" >>=? fun _ -> + test_output ~location: __LOC__ "map_iter" "(Pair 3 3)" "{ Elt 1 1 ; Elt 2 100 }" "(Pair 3 101)" >>=? fun _ -> (* Return True if True branch of if was taken and False otherwise *) - test_output ~location: __LOC__ "if" "Unit" "True" "True" >>=? fun _ -> - test_output ~location: __LOC__ "if" "Unit" "False" "False" >>=? fun _ -> + test_output ~location: __LOC__ "if" "None" "True" "(Some True)" >>=? fun _ -> + test_output ~location: __LOC__ "if" "None" "False" "(Some False)" >>=? fun _ -> (* Generate a pair of or types *) - test_output ~location: __LOC__ "swap_left_right" "Unit" "(Left True)" "(Right True)" >>=? fun _ -> - test_output ~location: __LOC__ "swap_left_right" "Unit" "(Right \"a\")" "(Left \"a\")" >>=? fun _ -> + test_output ~location: __LOC__ "swap_left_right" "(Left \"\")" "(Left True)" "(Right True)" >>=? fun _ -> + test_output ~location: __LOC__ "swap_left_right" "(Right False)" "(Right \"a\")" "(Left \"a\")" >>=? fun _ -> (* Reverse a list *) - test_output ~location: __LOC__ "reverse" "Unit" "{}" "{}" >>=? fun _ -> - test_output ~location: __LOC__ "reverse" "Unit" "{ \"c\" ; \"b\" ; \"a\" }" "{ \"a\" ; \"b\" ; \"c\" }" >>=? fun _ -> - test_output ~location: __LOC__ "reverse_loop" "Unit" "{}" "{}" >>=? fun _ -> - test_output ~location: __LOC__ "reverse_loop" "Unit" "{ \"c\" ; \"b\" ; \"a\" }" "{ \"a\" ; \"b\" ; \"c\" }" >>=? fun _ -> + test_output ~location: __LOC__ "reverse" "{\"?\"}" "{}" "{}" >>=? fun _ -> + test_output ~location: __LOC__ "reverse" "{\"?\"}" "{ \"c\" ; \"b\" ; \"a\" }" "{ \"a\" ; \"b\" ; \"c\" }" >>=? fun _ -> + test_output ~location: __LOC__ "reverse_loop" "{\"?\"}" "{}" "{}" >>=? fun _ -> + test_output ~location: __LOC__ "reverse_loop" "{\"?\"}" "{ \"c\" ; \"b\" ; \"a\" }" "{ \"a\" ; \"b\" ; \"c\" }" >>=? fun _ -> (* Reverse using LOOP_LEFT *) - test_output ~location: __LOC__ "loop_left" "Unit" "{}" "{}" >>=? fun _ -> - test_output ~location: __LOC__ "loop_left" "Unit" "{ \"c\" ; \"b\" ; \"a\" }" "{ \"a\" ; \"b\" ; \"c\" }" >>=? fun _ -> + test_output ~location: __LOC__ "loop_left" "{\"?\"}" "{}" "{}" >>=? fun _ -> + test_output ~location: __LOC__ "loop_left" "{\"?\"}" "{ \"c\" ; \"b\" ; \"a\" }" "{ \"a\" ; \"b\" ; \"c\" }" >>=? fun _ -> (* Exec concat contract *) - test_output ~location: __LOC__ "exec_concat" "Unit" "\"\"" "\"_abc\"" >>=? fun _ -> - test_output ~location: __LOC__ "exec_concat" "Unit" "\"test\"" "\"test_abc\"" >>=? fun _ -> + test_output ~location: __LOC__ "exec_concat" "\"?\"" "\"\"" "\"_abc\"" >>=? fun _ -> + test_output ~location: __LOC__ "exec_concat" "\"?\"" "\"test\"" "\"test_abc\"" >>=? fun _ -> (* Get current steps to quota *) - test_output ~location: __LOC__ "steps_to_quota" "Unit" "Unit" "39989" >>=? fun _ -> + test_output ~location: __LOC__ "steps_to_quota" "111" "Unit" "399992" >>=? fun _ -> let bootstrap_0 = List.nth Account.bootstrap_accounts 0 in get_balance_res bootstrap_0 sb >>=?? fun _balance -> let amount = Proto_alpha.Alpha_context.Tez.to_string @@ Cast.cents_of_int Script.init_amount in (* Get the current balance of the contract *) - test_output ~location: __LOC__ "balance" "Unit" "Unit" ("\"" ^ amount ^ "\"") >>=? fun _ -> + test_output ~location: __LOC__ "balance" "\"111\"" "Unit" ("\"" ^ amount ^ "\"") >>=? fun _ -> (* Test comparisons on tez { EQ ; GT ; LT ; GE ; LE } *) - test_output ~location: __LOC__ "compare" "Unit" "(Pair \"1.00\" \"2.00\")" "{ False ; False ; True ; False ; True }" >>=? fun _ -> - test_output ~location: __LOC__ "compare" "Unit" "(Pair \"2.00\" \"1.00\")" "{ False ; True ; False ; True ; False }" >>=? fun _ -> - test_output ~location: __LOC__ "compare" "Unit" "(Pair \"2.37\" \"2.37\")" "{ True ; False ; False ; True ; True }" >>=? fun _ -> + test_output ~location: __LOC__ "compare" "{}" "(Pair \"1.00\" \"2.00\")" "{ False ; False ; True ; False ; True }" >>=? fun _ -> + test_output ~location: __LOC__ "compare" "{}" "(Pair \"2.00\" \"1.00\")" "{ False ; True ; False ; True ; False }" >>=? fun _ -> + test_output ~location: __LOC__ "compare" "{}" "(Pair \"2.37\" \"2.37\")" "{ True ; False ; False ; True ; True }" >>=? fun _ -> (* Test addition and subtraction on tez *) - test_output ~location: __LOC__ "tez_add_sub" "Unit" "(Pair \"2\" \"1\")" "(Pair \"3\" \"1\")" >>=? fun _ -> - test_output ~location: __LOC__ "tez_add_sub" "Unit" "(Pair \"2.31\" \"1.01\")" "(Pair \"3.32\" \"1.3\")" >>=? fun _ -> + test_output ~location: __LOC__ "tez_add_sub" "None" "(Pair \"2\" \"1\")" "(Some (Pair \"3\" \"1\"))" >>=? fun _ -> + test_output ~location: __LOC__ "tez_add_sub" "None" "(Pair \"2.31\" \"1.01\")" "(Some (Pair \"3.32\" \"1.3\"))" >>=? fun _ -> (* Test get first element of list *) - test_output ~location: __LOC__ "first" "Unit" "{ 1 ; 2 ; 3 ; 4 }" "1" >>=? fun _ -> - test_output ~location: __LOC__ "first" "Unit" "{ 4 }" "4" >>=? fun _ -> + test_output ~location: __LOC__ "first" "111" "{ 1 ; 2 ; 3 ; 4 }" "1" >>=? fun _ -> + test_output ~location: __LOC__ "first" "111" "{ 4 }" "4" >>=? fun _ -> (* Hash input string *) (* Test assumed to be correct -- hash is based on encoding of AST *) - test_output ~location: __LOC__ "hash_string" "Unit" "\"abcdefg\"" "\"exprv3MnhXvjthGzZ7jDtXRRFremZyey9rsGtL7JRkeaQX1fThN7WF\"" >>=? fun _ -> - test_output ~location: __LOC__ "hash_string" "Unit" "\"12345\"" "\"expru81QVHsW2qaWLNHnMHSxDNhqtat17ajadri6mKUvXyc2EWHZC3\"" >>=? fun _ -> + test_output ~location: __LOC__ "hash_string" "\"?\"" "\"abcdefg\"" "\"exprv3MnhXvjthGzZ7jDtXRRFremZyey9rsGtL7JRkeaQX1fThN7WF\"" >>=? fun _ -> + test_output ~location: __LOC__ "hash_string" "\"?\"" "\"12345\"" "\"expru81QVHsW2qaWLNHnMHSxDNhqtat17ajadri6mKUvXyc2EWHZC3\"" >>=? fun _ -> (* Test ASSERT *) test_output ~location: __LOC__ "assert" "Unit" "True" "Unit" >>=? fun _ -> @@ -372,8 +379,8 @@ let test_example () = test_fails ~location: __LOC__ "assert_cmpge" "Unit" "(Pair -1 0)" >>=? fun _ -> (* IF_SOME *) - test_output ~location: __LOC__ "if_some" "Unit" "(Some \"hello\")" "\"hello\"" >>=? fun _ -> - test_output ~location: __LOC__ "if_some" "Unit" "None" "\"\"" >>=? fun _ -> + test_output ~location: __LOC__ "if_some" "\"?\"" "(Some \"hello\")" "\"hello\"" >>=? fun _ -> + test_output ~location: __LOC__ "if_some" "\"?\"" "None" "\"\"" >>=? fun _ -> (* Tests the SET_CAR and SET_CDR instructions *) test_output ~location: __LOC__ "set_car" "(Pair \"hello\" 0)" "\"world\"" "(Pair \"world\" 0)" >>=? fun _ -> @@ -389,30 +396,31 @@ let test_example () = test_storage ~location: __LOC__ "map_caddaadr" "(Pair (Pair 1 (Pair 2 (Pair (Pair (Pair 3 \"0\") 4) 5))) 6)" "Unit" "(Pair (Pair 1 (Pair 2 (Pair (Pair (Pair 3 \"1\") 4) 5))) 6)" >>=? fun _ -> (* Did the given key sign the string? (key is bootstrap1) *) - test_output ~location: __LOC__ "check_signature" "(Pair \"1f19f8f37e80d96797b019f30d23ede6a26a0f698220f942103a3401f047623746e51a9c6e77e269b5df9593994ab96b001aae0f73728a2259187cb640b61e01\" \"hello\")" "\"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav\"" "True" >>=? fun _ -> - test_output ~location: __LOC__ "check_signature" "(Pair \"1f19f8f37e80d96797b019f30d23ede6a26a0f698220f942103a3401f047623746e51a9c6e77e269b5df9593994ab96b001aae0f73728a2259187cb640b61e01\" \"abcd\")" "\"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav\"" "False" >>=? fun _ -> + test_success ~location: __LOC__ "check_signature" "(Pair \"1f19f8f37e80d96797b019f30d23ede6a26a0f698220f942103a3401f047623746e51a9c6e77e269b5df9593994ab96b001aae0f73728a2259187cb640b61e01\" \"hello\")" "\"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav\"" >>=? fun _ -> + + test_fails ~location: __LOC__ "check_signature" "(Pair \"1f19f8f37e80d96797b019f30d23ede6a26a0f698220f942103a3401f047623746e51a9c6e77e269b5df9593994ab96b001aae0f73728a2259187cb640b61e01\" \"abcd\")" "\"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav\"" >>=? fun _ -> (* Convert a public key to a public key hash *) - test_output ~location: __LOC__ "hash_key" "Unit" "\"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav\"" "\"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx\"" >>=? fun _ -> - test_output ~location: __LOC__ "hash_key" "Unit" "\"edpkuJqtDcA2m2muMxViSM47MPsGQzmyjnNTawUPqR8vZTAMcx61ES\"" "\"tz1XPTDmvT3vVE5Uunngmixm7gj7zmdbPq6k\"" >>=? fun _ -> + test_output ~location: __LOC__ "hash_key" "None" "\"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav\"" "(Some \"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx\")" >>=? fun _ -> + test_output ~location: __LOC__ "hash_key" "None" "\"edpkuJqtDcA2m2muMxViSM47MPsGQzmyjnNTawUPqR8vZTAMcx61ES\"" "(Some \"tz1XPTDmvT3vVE5Uunngmixm7gj7zmdbPq6k\")" >>=? fun _ -> (* Test timestamp operations *) - test_output ~location: __LOC__ "add_timestamp_delta" "Unit" "(Pair 100 100)" "\"1970-01-01T00:03:20Z\"" >>=? fun _ -> - test_output ~location: __LOC__ "add_timestamp_delta" "Unit" "(Pair 100 -100)" "\"1970-01-01T00:00:00Z\"" >>=? fun _ -> - test_output ~location: __LOC__ "add_timestamp_delta" "Unit" "(Pair \"1970-01-01T00:00:00Z\" 0)" "\"1970-01-01T00:00:00Z\"" >>=? fun _ -> + test_output ~location: __LOC__ "add_timestamp_delta" "None" "(Pair 100 100)" "(Some \"1970-01-01T00:03:20Z\")" >>=? fun _ -> + test_output ~location: __LOC__ "add_timestamp_delta" "None" "(Pair 100 -100)" "(Some \"1970-01-01T00:00:00Z\")" >>=? fun _ -> + test_output ~location: __LOC__ "add_timestamp_delta" "None" "(Pair \"1970-01-01T00:00:00Z\" 0)" "(Some \"1970-01-01T00:00:00Z\")" >>=? fun _ -> - test_output ~location: __LOC__ "add_delta_timestamp" "Unit" "(Pair 100 100)" "\"1970-01-01T00:03:20Z\"" >>=? fun _ -> - test_output ~location: __LOC__ "add_delta_timestamp" "Unit" "(Pair -100 100)" "\"1970-01-01T00:00:00Z\"" >>=? fun _ -> - test_output ~location: __LOC__ "add_delta_timestamp" "Unit" "(Pair 0 \"1970-01-01T00:00:00Z\")" "\"1970-01-01T00:00:00Z\"" >>=? fun _ -> + test_output ~location: __LOC__ "add_delta_timestamp" "None" "(Pair 100 100)" "(Some \"1970-01-01T00:03:20Z\")" >>=? fun _ -> + test_output ~location: __LOC__ "add_delta_timestamp" "None" "(Pair -100 100)" "(Some \"1970-01-01T00:00:00Z\")" >>=? fun _ -> + test_output ~location: __LOC__ "add_delta_timestamp" "None" "(Pair 0 \"1970-01-01T00:00:00Z\")" "(Some \"1970-01-01T00:00:00Z\")" >>=? fun _ -> - test_output ~location: __LOC__ "sub_timestamp_delta" "Unit" "(Pair 100 100)" "\"1970-01-01T00:00:00Z\"" >>=? fun _ -> - test_output ~location: __LOC__ "sub_timestamp_delta" "Unit" "(Pair 100 -100)" "\"1970-01-01T00:03:20Z\"" >>=? fun _ -> - test_output ~location: __LOC__ "sub_timestamp_delta" "Unit" "(Pair 100 2000000000000000000)" "-1999999999999999900" >>=? fun _ -> + test_output ~location: __LOC__ "sub_timestamp_delta" "111" "(Pair 100 100)" "\"1970-01-01T00:00:00Z\"" >>=? fun _ -> + test_output ~location: __LOC__ "sub_timestamp_delta" "111" "(Pair 100 -100)" "\"1970-01-01T00:03:20Z\"" >>=? fun _ -> + test_output ~location: __LOC__ "sub_timestamp_delta" "111" "(Pair 100 2000000000000000000)" "-1999999999999999900" >>=? fun _ -> - test_output ~location: __LOC__ "diff_timestamps" "Unit" "(Pair 0 0)" "0" >>=? fun _ -> - test_output ~location: __LOC__ "diff_timestamps" "Unit" "(Pair 0 1)" "-1" >>=? fun _ -> - test_output ~location: __LOC__ "diff_timestamps" "Unit" "(Pair 1 0)" "1" >>=? fun _ -> - test_output ~location: __LOC__ "diff_timestamps" "Unit" "(Pair \"1970-01-01T00:03:20Z\" \"1970-01-01T00:00:00Z\")" "200" >>=? fun _ -> + test_output ~location: __LOC__ "diff_timestamps" "111" "(Pair 0 0)" "0" >>=? fun _ -> + test_output ~location: __LOC__ "diff_timestamps" "111" "(Pair 0 1)" "-1" >>=? fun _ -> + test_output ~location: __LOC__ "diff_timestamps" "111" "(Pair 1 0)" "1" >>=? fun _ -> + test_output ~location: __LOC__ "diff_timestamps" "111" "(Pair \"1970-01-01T00:03:20Z\" \"1970-01-01T00:00:00Z\")" "200" >>=? fun _ -> (* Test NOW *) let now = sb.tezos_header.shell.timestamp in @@ -438,8 +446,8 @@ 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 { return_value = ret } -> - Assert.equal_string ~msg: __LOC__ "\"abc\"" @@ string_of_canon ret ; + Script.execute_code_pred ~tc sb script (parse_param "\"abc\"") >>=?? fun (_, { storage }) -> + Assert.equal_string ~msg: __LOC__ "\"abc\"" @@ string_of_canon storage ; (* Test IMPLICIT_ACCOUNT *) let account = Account.new_account () in @@ -452,30 +460,31 @@ let test_example () = let test_program () = Init.main () >>=?? fun sb -> let id_code = "code - { DUP ; - PAIR ; - CAR }" in - let id_int_program = - program "int" "int" "int" id_code in - let id_ill_param_program = - program "string" "int" "string" id_code in - let id_ill_return_program = - program "int" "string" "int" id_code in - let id_pbool_program = - program "(pair bool bool)" "(pair bool bool)" "unit" id_code in - let push_300_code = "code { CAR ; + NIL operation ; + PAIR }" in + let id_int_program = + program "int" "int" id_code in + let id_ill_param_program = + program "string" "string" id_code in + let id_ill_return_program = + program "int" "int" "code {}" in + let id_pbool_program = + program "(pair bool bool)" "(pair bool bool)" id_code in + let push_300_code = "code + { DROP ; PUSH nat 300 ; + NIL operation ; PAIR }" in let push_300 = - program "unit" "nat" "unit" push_300_code in + program "unit" "nat" push_300_code in parse_execute sb id_int_program "2" "3" >>=? fun _ -> parse_execute sb id_ill_param_program "2" "3" >>= fun x -> Assert.ill_typed_data_error ~msg: "Good data type" x ; parse_execute sb id_ill_return_program "2" "3" >>= fun x -> Assert.ill_typed_return_error ~msg: "Good return type" x ; - parse_execute sb push_300 "Unit" "Unit" >>=? fun _ -> - parse_execute sb id_pbool_program "(Pair True True)" "Unit" >>=? fun _ -> + parse_execute sb push_300 "Unit" "111" >>=? fun _ -> + parse_execute sb id_pbool_program "(Pair True True)" "(Pair False False)" >>=? fun _ -> return () let tests = [