diff --git a/docs/whitedoc/michelson.rst b/docs/whitedoc/michelson.rst index b83fb973e..afac6376f 100644 --- a/docs/whitedoc/michelson.rst +++ b/docs/whitedoc/michelson.rst @@ -73,7 +73,7 @@ The rules have the main following form. > (syntax pattern) / (initial stack pattern) => (result stack pattern) iff (conditions) where (recursions) - and (more recursions) + and (more recursions) The left hand side of the ``=>`` sign is used for selecting the rule. Given a program and an initial stack, one (and only one) rule can be @@ -899,17 +899,6 @@ Operations on sets > UPDATE / x : true : { hd ; } : S => { x ; hd ; } : S iff COMPARE / x : hd : [] => -1 : [] -- ``REDUCE``: Apply a function on a set passing the result of each - application to the next one and return the last. - -:: - - :: lambda (pair 'elt * 'b) 'b : set 'elt : 'b : 'S -> 'b : 'S - - > REDUCE / f : {} : b : S => b : S - > REDUCE / f : { hd : } : b : S => REDUCE / f : { } : c : S - where f / Pair hd b : [] => c : [] - - ``ITER body``: Apply the body expression to each element of a set. The body sequence has access to the stack. @@ -957,7 +946,7 @@ Operations on maps > GET / x : {} : S => None : S > GET / x : { Elt k v ; } : S => opt_y : S iff COMPARE / x : k : [] => 1 : [] - where GET / x : { } : S => opt_y : S + where GET / x : { } : S => opt_y : S > GET / x : { Elt k v ; } : S => Some v : S iff COMPARE / x : k : [] => 0 : [] > GET / x : { Elt k v ; } : S => None : S @@ -988,7 +977,7 @@ Operations on maps > UPDATE / x : Some y : {} : S => { Elt x y } : S > UPDATE / x : opt_y : { Elt k v ; } : S => { Elt k v ; } : S iff COMPARE / x : k : [] => 1 : [] - where UPDATE / x : opt_y : { } : S => { } : S + where UPDATE / x : opt_y : { } : S => { } : S > UPDATE / x : None : { Elt k v ; } : S => { } : S iff COMPARE / x : k : [] => 0 : [] > UPDATE / x : Some y : { Elt k v ; } : S => { Elt k y ; } : S @@ -998,19 +987,6 @@ Operations on maps > UPDATE / x : Some y : { Elt k v ; } : S => { Elt x y ; Elt k v ; } : S iff COMPARE / x : k : [] => -1 : [] - -- ``MAP``: Apply a function on a map and return the map of results - under the same bindings. - -:: - - :: lambda (pair 'key 'val) 'b : map 'key 'val : 'S -> map 'key 'b : 'S - - > MAP / f : {} : S => {} : S - > MAP / f : { Elt k v ; } : S => { Elt k (f (Pair k v)) ; } : S - where MAP / f : { } : S => { } : S - - - ``MAP body``: Apply the body expression to each element of a map. The body sequence has access to the stack. @@ -1023,18 +999,6 @@ Operations on maps > MAP body / { Elt k v ; } : S => { Elt k (body (Pair k v)) ; } : S where MAP body / { } : S => { } : S - -- ``REDUCE``: Apply a function on a map passing the result of each - application to the next one and return the last. - -:: - - :: lambda (pair (pair 'key 'val) 'b) 'b : map 'key 'val : 'b : 'S -> 'b : 'S - - > REDUCE / f : {} : b : S => b : S - > REDUCE / f : { Elt k v ; } : b : S => REDUCE / f : { } : c : S - where f / Pair (Pair k v) b : [] => c - - ``ITER body``: Apply the body expression to each element of a map. The body sequence has access to the stack. @@ -1186,18 +1150,6 @@ Operations on lists > IF_CONS bt bf / { a ; } : S => bt / a : { } : S > IF_CONS bt bf / {} : S => bf / S -- ``MAP``: Apply a function on a list from left to right and return the - list of results in the same order. - -:: - - :: lambda 'a 'b : list 'a : 'S -> list 'b : 'S - - > MAP / f : { a ; } : S => { f a ; } : S - where MAP / f : { } : S => { } : S - > MAP / f : {} : S => {} : S - - - ``MAP body``: Apply the body expression to each element of the list. The body sequence has access to the stack. @@ -1210,19 +1162,6 @@ Operations on lists where MAP body / { } : S => { } : S > MAP body / {} : S => {} : S - -- ``REDUCE``: Apply a function on a list from left to right passing the - result of each application to the next one and return the last. - -:: - - :: lambda (pair 'a 'b) 'b : list 'a : 'b : 'S -> 'b : 'S - - > REDUCE / f : { a : } : b : S => REDUCE / f : { } : c : S - where f / Pair a b : [] => c - > REDUCE / f : {} : b : S => b : S - - - ``SIZE``: Get the number of elements in the list. :: @@ -2439,9 +2378,7 @@ XII - Full grammar | IF_CONS { ... } { ... } | EMPTY_SET | EMPTY_MAP - | MAP | MAP { ... } - | REDUCE | ITER { ... } | MEM | GET diff --git a/src/bin_client/test/contracts/add1_list.tz b/src/bin_client/test/contracts/add1_list.tz index 7fb50d977..084868c5e 100644 --- a/src/bin_client/test/contracts/add1_list.tz +++ b/src/bin_client/test/contracts/add1_list.tz @@ -1,7 +1,6 @@ parameter (list int); 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 + MAP { PUSH int 1; ADD }; # Map over the list adding one NIL operation; # No internal op PAIR } # Match the calling convetion diff --git a/src/bin_client/test/contracts/append.tz b/src/bin_client/test/contracts/append.tz index 46a9d8217..3b8335455 100644 --- a/src/bin_client/test/contracts/append.tz +++ b/src/bin_client/test/contracts/append.tz @@ -1,13 +1,8 @@ parameter (pair (list int) (list int)); storage (list int); -code { CAR; DUP; DIP{CDR}; CAR; # Unpack lists - NIL int; SWAP; # Setup reverse accumulator - LAMBDA (pair int (list int)) - (list int) - {DUP; CAR; DIP{CDR}; CONS}; - REDUCE; # Reverse list - LAMBDA (pair int (list int)) - (list int) - {DUP; CAR; DIP{CDR}; CONS}; - REDUCE; # Append reversed list - NIL operation; PAIR} # Calling convention +code { CAR; UNPAIR ; # Unpack lists + NIL int; SWAP; # Setup reverse accumulator + ITER {CONS}; # Reverse list + ITER {CONS}; # Append reversed list + NIL operation; + PAIR} diff --git a/src/bin_client/test/contracts/concat_hello.tz b/src/bin_client/test/contracts/concat_hello.tz index 772dc6632..e290b90fb 100644 --- a/src/bin_client/test/contracts/concat_hello.tz +++ b/src/bin_client/test/contracts/concat_hello.tz @@ -1,4 +1,4 @@ parameter (list string); storage (list string); -code{ CAR; LAMBDA string string { PUSH @hello string "Hello "; CONCAT }; - MAP; NIL operation; PAIR}; +code{ CAR; + MAP { PUSH @hello string "Hello "; CONCAT }; NIL operation; PAIR}; diff --git a/src/bin_client/test/contracts/concat_list.tz b/src/bin_client/test/contracts/concat_list.tz index a2c752d93..f805d1b16 100644 --- a/src/bin_client/test/contracts/concat_list.tz +++ b/src/bin_client/test/contracts/concat_list.tz @@ -1,5 +1,5 @@ parameter (list string); storage string; code {CAR; PUSH string ""; SWAP; - LAMBDA (pair string string) string {DUP; CDR; DIP{CAR}; CONCAT}; - REDUCE; NIL operation; PAIR}; + ITER {SWAP; CONCAT}; + NIL operation; PAIR}; diff --git a/src/bin_client/test/contracts/contains_all.tz b/src/bin_client/test/contracts/contains_all.tz index f44628cc8..fe4160f87 100644 --- a/src/bin_client/test/contracts/contains_all.tz +++ b/src/bin_client/test/contracts/contains_all.tz @@ -1,9 +1,7 @@ parameter (pair (list string) (list string)); 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; SOME; NIL operation; PAIR}; + ITER {PAIR; DUP; CAR; DIP{CDR}; PUSH bool True; SWAP; UPDATE}; + PUSH bool True; SWAP; PAIR; SWAP; + ITER {PAIR; DUP; DUP; CAR; DIP{CDAR; DIP{CDDR}; DUP}; MEM; DIP{SWAP}; AND; SWAP; PAIR}; + CDR; SOME; 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 d4b5fc21c..c183ad1e2 100644 --- a/src/bin_client/test/contracts/create_add1_lists.tz +++ b/src/bin_client/test/contracts/create_add1_lists.tz @@ -1,18 +1,17 @@ parameter unit; storage address; 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; - NIL operation; - PAIR }; AMOUNT; # Push the starting balance PUSH bool False; # Not spendable DUP; # Or delegatable NONE key_hash; # No delegate PUSH key_hash "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"; - CREATE_CONTRACT; # Create the contract + CREATE_CONTRACT # Create the contract + { parameter (list int) ; + storage (list int) ; + code + { CAR; + MAP {PUSH int 1; ADD}; + NIL operation; + PAIR } }; NIL operation; SWAP; CONS; 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 eb7bc0d31..d9aa97348 100644 --- a/src/bin_client/test/contracts/create_contract.tz +++ b/src/bin_client/test/contracts/create_contract.tz @@ -3,12 +3,12 @@ storage unit; code { CAR; IF_LEFT { 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 ; + CREATE_CONTRACT + { parameter string ; + storage string ; + code { CAR ; NIL operation ; PAIR } } ; DIP { RIGHT key_hash ; DIP { SELF ; PUSH tez "0" } ; TRANSFER_TOKENS ; NIL operation ; SWAP ; CONS } ; CONS ; UNIT ; SWAP ; PAIR } diff --git a/src/bin_client/test/contracts/create_contract_literal.tz b/src/bin_client/test/contracts/create_contract_literal.tz deleted file mode 100644 index d9aa97348..000000000 --- a/src/bin_client/test/contracts/create_contract_literal.tz +++ /dev/null @@ -1,18 +0,0 @@ -parameter (or key_hash address); -storage unit; -code { CAR; - IF_LEFT - { DIP { PUSH string "dummy"; - PUSH tez "100.00" ; PUSH bool False ; - PUSH bool False ; NONE key_hash } ; - CREATE_CONTRACT - { parameter string ; - storage string ; - code { CAR ; NIL operation ; PAIR } } ; - DIP { RIGHT key_hash ; DIP { SELF ; PUSH tez "0" } ; TRANSFER_TOKENS ; - NIL operation ; SWAP ; CONS } ; - CONS ; UNIT ; SWAP ; PAIR } - { SELF ; ADDRESS ; SOURCE ; IFCMPNEQ { FAIL } {} ; - CONTRACT string ; IF_SOME {} { FAIL } ; - PUSH tez "0.00" ; PUSH string "abcdefg" ; TRANSFER_TOKENS ; - NIL operation; SWAP; CONS ; UNIT ; SWAP ; PAIR } }; diff --git a/src/bin_client/test/contracts/insertion_sort.tz b/src/bin_client/test/contracts/insertion_sort.tz index cc7ff0ed4..34eca64d0 100644 --- a/src/bin_client/test/contracts/insertion_sort.tz +++ b/src/bin_client/test/contracts/insertion_sort.tz @@ -1,25 +1,16 @@ -parameter (list int); -storage (list int); -code { CAR; # Access list - # Insert procedure - LAMBDA (pair int (list int)) - (list int) - { DUP; CDR; DIP{CAR}; # Unpack accumulator and existing list - DIIP{NIL int}; PUSH bool True; # Setup loop - LOOP { IF_CONS { SWAP; - DIP{DUP; DIIP{DUP}; DIP{CMPLT}; SWAP}; # Duplicate numbers - SWAP; - # If less than - IF { DIP{SWAP; DIP{CONS}}; PUSH bool True} - # Otherwise - { SWAP; CONS; PUSH bool False}} - # Ending case - { NIL int; PUSH bool False}}; - SWAP; CONS; SWAP; # Finish lists - LAMBDA (pair int (list int)) - (list int) - {DUP; CAR; DIP{CDR}; CONS}; - REDUCE}; - NIL int; SWAP; DIP{SWAP}; # Accumulator for reverse onto - REDUCE; # Execute reverse onto - NIL operation; PAIR} # Calling convention +parameter (list int) ; +storage (list int) ; +code { CAR ; + NIL int ; SWAP ; + ITER { SWAP; DIIP{NIL int} ; PUSH bool True ; + LOOP + { IF_CONS + { SWAP ; + DIP{DUP ; DIIP{DUP} ; DIP{CMPLT} ; SWAP} ; + SWAP ; + IF { DIP{SWAP ; DIP{CONS}} ; PUSH bool True} + { SWAP ; CONS ; PUSH bool False}} + { NIL int ; PUSH bool False}} ; + SWAP ; CONS ; SWAP ; + ITER {CONS}} ; + 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 e82cc2918..38b4493e8 100644 --- a/src/bin_client/test/contracts/list_id_map.tz +++ b/src/bin_client/test/contracts/list_id_map.tz @@ -1,3 +1,3 @@ parameter (list string); storage (list string); -code {CAR; LAMBDA string string {}; MAP; NIL operation; PAIR} +code {CAR; MAP {}; 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 229b37729..89c4955e9 100644 --- a/src/bin_client/test/contracts/max_in_list.tz +++ b/src/bin_client/test/contracts/max_in_list.tz @@ -1,9 +1,9 @@ parameter (list 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; NIL operation; PAIR}; + ITER {SWAP; + IF_NONE {SOME} + {DIP {DUP}; DUP; DIP{SWAP}; + CMPLE; IF {DROP} {DIP {DROP}}; + SOME}}; + NIL operation; PAIR}; diff --git a/src/bin_client/test/contracts/reduce_map.tz b/src/bin_client/test/contracts/reduce_map.tz index 3f8f17d3f..aab8ea60d 100644 --- a/src/bin_client/test/contracts/reduce_map.tz +++ b/src/bin_client/test/contracts/reduce_map.tz @@ -6,16 +6,11 @@ code { DIP{NIL int}; DUP; DIP{CAR; PAIR}; # Unpack data and setup accumulator CDR; - LAMBDA (pair int (pair (lambda int int) (list int))) - (pair (lambda int int) (list int)) - # Apply the lambda and add the new element to the list - { DUP; CDAR; - DIP{ DUP; DIP{CDAR}; DUP; - CAR; DIP{CDDR; SWAP}; EXEC; CONS}; - PAIR}; - REDUCE; CDR; DIP{NIL int}; # First reduce - LAMBDA (pair int (list int)) - (list int) - {DUP; CAR; DIP{CDR}; CONS}; - REDUCE; # Correct list order + ITER {PAIR; + DUP; CDAR; + DIP{ DUP; DIP{CDAR}; DUP; + CAR; DIP{CDDR; SWAP}; EXEC; CONS}; + PAIR}; + CDR; DIP{NIL int}; # First reduce + ITER {CONS}; # Reverse NIL operation; PAIR} # Calling convention diff --git a/src/bin_client/test/contracts/reverse.tz b/src/bin_client/test/contracts/reverse.tz index 24419bc54..5a851f3e2 100644 --- a/src/bin_client/test/contracts/reverse.tz +++ b/src/bin_client/test/contracts/reverse.tz @@ -1,7 +1,5 @@ parameter (list string); storage (list string); code { CAR; NIL string; SWAP; - LAMBDA (pair string (list string)) - (list string) - {DUP; CAR; DIP{CDR}; CONS}; - REDUCE; NIL operation; PAIR}; + ITER {CONS}; + NIL operation; PAIR}; diff --git a/src/bin_client/test/contracts/spawn_identities.tz b/src/bin_client/test/contracts/spawn_identities.tz index 8f0a514fd..717c7c374 100644 --- a/src/bin_client/test/contracts/spawn_identities.tz +++ b/src/bin_client/test/contracts/spawn_identities.tz @@ -8,14 +8,14 @@ code { DUP; 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 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; PUSH key_hash "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"; - CREATE_CONTRACT; # Make the contract + CREATE_CONTRACT + { parameter string ; + storage string ; + code { CAR ; NIL operation ; PAIR } } ; # Make the contract SWAP ; DIP { SWAP ; DIP { CONS } } ; # emit the operation SWAP ; DIP { SWAP ; DIP { CONS } } ; # add to the list PUSH bool True}}; # Continue the loop diff --git a/src/bin_client/test/contracts/subset.tz b/src/bin_client/test/contracts/subset.tz index f06e1054e..a16ef1695 100644 --- a/src/bin_client/test/contracts/subset.tz +++ b/src/bin_client/test/contracts/subset.tz @@ -3,15 +3,10 @@ storage bool; code { CAR; DUP; CDR; DIP{CAR}; # Unpack lists PUSH bool True; PAIR; SWAP; # Setup accumulator - LAMBDA (pair string (pair bool (set string))) - (pair bool (set string)) - { DUP; # Unpack accumulator and input - CAR; - DIP{ CDR; DUP; DUP; CDR; - DIP{CAR; DIP{CDR}}}; - MEM; # Check membership - AND; # Combine accumulator and input - PAIR}; - REDUCE; # Reduce + ITER { DIP{ DUP; DUP; CDR; + DIP{CAR; DIP{CDR}}}; + MEM; # Check membership + AND; # Combine accumulator and input + PAIR}; CAR; # Get the accumulator value NIL operation; PAIR} # Calling convention diff --git a/src/proto_alpha/lib_protocol/src/alpha_context.mli b/src/proto_alpha/lib_protocol/src/alpha_context.mli index a74778b82..95a62eb9f 100644 --- a/src/proto_alpha/lib_protocol/src/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/src/alpha_context.mli @@ -227,7 +227,6 @@ module Script : sig | I_OR | I_PAIR | I_PUSH - | I_REDUCE | I_RIGHT | I_SIZE | I_SOME 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 3e3111e1e..021f652cd 100644 --- a/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.ml +++ b/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.ml @@ -79,7 +79,6 @@ type prim = | I_OR | I_PAIR | I_PUSH - | I_REDUCE | I_RIGHT | I_SIZE | I_SOME @@ -205,7 +204,6 @@ let string_of_prim = function | I_OR -> "OR" | I_PAIR -> "PAIR" | I_PUSH -> "PUSH" - | I_REDUCE -> "REDUCE" | I_RIGHT -> "RIGHT" | I_SIZE -> "SIZE" | I_SOME -> "SOME" @@ -312,7 +310,6 @@ let prim_of_string = function | "OR" -> ok I_OR | "PAIR" -> ok I_PAIR | "PUSH" -> ok I_PUSH - | "REDUCE" -> ok I_REDUCE | "RIGHT" -> ok I_RIGHT | "SIZE" -> ok I_SIZE | "SOME" -> ok I_SOME @@ -463,7 +460,6 @@ let prim_encoding = ("OR", I_OR) ; ("PAIR", I_PAIR) ; ("PUSH", I_PUSH) ; - ("REDUCE", I_REDUCE) ; ("RIGHT", I_RIGHT) ; ("SIZE", I_SIZE) ; ("SOME", I_SOME) ; 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 be549ad89..b982921ab 100644 --- a/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.mli +++ b/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.mli @@ -77,7 +77,6 @@ type prim = | I_OR | I_PAIR | I_PUSH - | I_REDUCE | I_RIGHT | I_SIZE | I_SOME diff --git a/src/proto_alpha/lib_protocol/src/script_interpreter.ml b/src/proto_alpha/lib_protocol/src/script_interpreter.ml index bcf9fc0fd..af5c19ca7 100644 --- a/src/proto_alpha/lib_protocol/src/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/src/script_interpreter.ml @@ -142,34 +142,6 @@ let rec interp fun descr op cost x1 x2 rest -> 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 rest storage. - (_, internal_operation * (Contract.t * 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 -> - rest:rest stack -> - ((internal_operation * (Contract.t * rest)) stack * context) tzresult Lwt.t = - fun descr ~manager ~delegate ~spendable ~delegatable - ~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_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) -> - let storage = Micheline.strip_locations storage in - Contract.spend_from_script ctxt self credit >>=? fun ctxt -> - Contract.fresh_contract_from_current_nonce ctxt >>=? fun (ctxt, contract) -> - let operation = - Origination - { credit ; manager ; delegate ; preorigination = Some contract ; - delegatable ; spendable ; - script = Some { code = Script.lazy_expr code ; - storage = Script.lazy_expr storage } } in - logged_return descr (Item ({ source = self ; operation ; signature = None }, - Item (contract, rest)), ctxt) in let logged_return : a stack * context -> (a stack * context) tzresult Lwt.t = @@ -237,18 +209,7 @@ let rec interp | If_cons (bt, _), Item (hd :: tl, rest) -> Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt -> step ctxt bt (Item (hd, Item (tl, rest))) - | List_map, Item (lam, Item (l, rest)) -> - let rec loop rest ctxt l acc = - Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt -> - match l with - | [] -> return (List.rev acc, ctxt) - | hd :: tl -> - interp ?log ctxt ~source ~payer ~self amount lam hd - >>=? fun (hd, ctxt) -> - loop rest ctxt tl (hd :: acc) - in loop rest ctxt l [] >>=? fun (res, ctxt) -> - logged_return (Item (res, rest), ctxt) - | List_map_body body, Item (l, rest) -> + | List_map body, Item (l, rest) -> let rec loop rest ctxt l acc = Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt -> match l with @@ -259,17 +220,6 @@ let rec interp loop rest ctxt tl (hd :: acc) in loop rest ctxt l [] >>=? fun (res, ctxt) -> logged_return (res, ctxt) - | List_reduce, Item (lam, Item (l, Item (init, rest))) -> - let rec loop rest ctxt l acc = - Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt -> - match l with - | [] -> return (acc, ctxt) - | hd :: tl -> - interp ?log ctxt ~source ~payer ~self amount lam (hd, acc) - >>=? fun (acc, ctxt) -> - loop rest ctxt tl acc - in loop rest ctxt l init >>=? fun (res, ctxt) -> - logged_return (Item (res, rest), ctxt) | List_size, Item (list, rest) -> Lwt.return (List.fold_left @@ -294,19 +244,6 @@ let rec interp | Empty_set t, rest -> Lwt.return (Gas.consume ctxt Interp_costs.empty_set) >>=? fun ctxt -> logged_return (Item (empty_set t, rest), ctxt) - | Set_reduce, Item (lam, Item (set, Item (init, rest))) -> - Lwt.return (Gas.consume ctxt (Interp_costs.set_to_list set)) >>=? fun ctxt -> - let l = List.rev (set_fold (fun e acc -> e :: acc) set []) in - let rec loop rest ctxt l acc = - Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt -> - match l with - | [] -> return (acc, ctxt) - | hd :: tl -> - interp ?log ctxt ~source ~payer ~self amount lam (hd, acc) - >>=? fun (acc, ctxt) -> - loop rest ctxt tl acc - in loop rest ctxt l init >>=? fun (res, ctxt) -> - logged_return (Item (res, rest), ctxt) | Set_iter body, Item (set, init) -> Lwt.return (Gas.consume ctxt (Interp_costs.set_to_list set)) >>=? fun ctxt -> let l = List.rev (set_fold (fun e acc -> e :: acc) set []) in @@ -330,7 +267,7 @@ let rec interp | Empty_map (t, _), rest -> Lwt.return (Gas.consume ctxt Interp_costs.empty_map) >>=? fun ctxt -> logged_return (Item (empty_map t, rest), ctxt) - | Map_map, Item (lam, Item (map, rest)) -> + | Map_map body, Item (map, rest) -> Lwt.return (Gas.consume ctxt (Interp_costs.map_to_list map)) >>=? fun ctxt -> let l = List.rev (map_fold (fun k v acc -> (k, v) :: acc) map []) in let rec loop rest ctxt l acc = @@ -338,24 +275,11 @@ let rec interp match l with | [] -> return (acc, ctxt) | (k, _) as hd :: tl -> - interp ?log ctxt ~source ~payer ~self amount lam hd - >>=? fun (hd, ctxt) -> + step ctxt body (Item (hd, rest)) + >>=? fun (Item (hd, rest), ctxt) -> loop rest ctxt tl (map_update k (Some hd) acc) in loop rest ctxt l (empty_map (map_key_ty map)) >>=? fun (res, ctxt) -> logged_return (Item (res, rest), ctxt) - | Map_reduce, Item (lam, Item (map, Item (init, rest))) -> - Lwt.return (Gas.consume ctxt (Interp_costs.map_to_list map)) >>=? fun ctxt -> - let l = List.rev (map_fold (fun k v acc -> (k, v) :: acc) map []) in - let rec loop rest ctxt l acc = - Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt -> - match l with - | [] -> return (acc, ctxt) - | hd :: tl -> - interp ?log ctxt ~source ~payer ~self amount lam (hd, acc) - >>=? fun (acc, ctxt) -> - loop rest ctxt tl acc - in loop rest ctxt l init >>=? fun (res, ctxt) -> - logged_return (Item (res, rest), ctxt) | Map_iter body, Item (map, init) -> Lwt.return (Gas.consume ctxt (Interp_costs.map_to_list map)) >>=? fun ctxt -> let l = List.rev (map_fold (fun k v acc -> (k, v) :: acc) map []) in @@ -684,25 +608,32 @@ let rec interp Lwt.return (Gas.consume ctxt Interp_costs.implicit_account) >>=? fun ctxt -> let contract = Contract.implicit_contract key in logged_return (Item ((Unit_t, contract), rest), ctxt) - | Create_contract (storage_type, param_type), - Item (manager, Item - (delegate, Item - (spendable, Item - (delegatable, Item - (credit, Item - (Lam (_, code), Item - (init, rest))))))) -> - create_contract descr ~manager ~delegate ~spendable ~delegatable ~credit ~code ~init - ~param_type ~storage_type ~rest - | Create_contract_literal (storage_type, param_type, Lam (_, code)), + | Create_contract (storage_type, param_type, Lam (_, code)), Item (manager, Item (delegate, Item (spendable, Item (delegatable, Item (credit, Item (init, rest)))))) -> - create_contract descr ~manager ~delegate ~spendable ~delegatable ~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_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) -> + let storage = Micheline.strip_locations storage in + Contract.spend_from_script ctxt self credit >>=? fun ctxt -> + Contract.fresh_contract_from_current_nonce ctxt >>=? fun (ctxt, contract) -> + let operation = + Origination + { credit ; manager ; delegate ; preorigination = Some contract ; + delegatable ; spendable ; + script = Some { code = Script.lazy_expr code ; + storage = Script.lazy_expr storage } } in + logged_return + (Item ({ source = self ; operation ; signature = None }, + Item (contract, rest)), ctxt) | Set_delegate, Item (delegate, rest) -> Lwt.return (Gas.consume ctxt Interp_costs.create_account) >>=? fun ctxt -> 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 b0393139a..d7a307124 100644 --- a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml @@ -114,20 +114,16 @@ let number_of_generated_growing_types : type b a. (b, a) instr -> int = function | Cons_list -> 1 | Nil -> 1 | If_cons _ -> 0 - | List_map -> 1 - | List_map_body _ -> 1 - | List_reduce -> 0 + | List_map _ -> 1 | List_size -> 0 | List_iter _ -> 1 | Empty_set _ -> 1 - | Set_reduce -> 0 | Set_iter _ -> 0 | Set_mem -> 0 | Set_update -> 0 | Set_size -> 0 | Empty_map _ -> 1 - | Map_map -> 1 - | Map_reduce -> 0 + | Map_map _ -> 1 | Map_iter _ -> 1 | Map_mem -> 0 | Map_get -> 0 @@ -201,7 +197,6 @@ let number_of_generated_growing_types : type b a. (b, a) instr -> int = function | Create_account -> 0 | Implicit_account -> 0 | Create_contract _ -> 1 - | Create_contract_literal _ -> 1 | Now -> 0 | Balance -> 0 | Check_signature -> 0 @@ -293,7 +288,6 @@ let namespace = function | I_OR | I_PAIR | I_PUSH - | I_REDUCE | I_RIGHT | I_SIZE | I_SOME @@ -1508,11 +1502,6 @@ and parse_instr Item_t (List_t _, rest, _) -> typed ctxt loc List_size (Item_t (Nat_t, rest, instr_annot)) - | Prim (loc, I_MAP, [], instr_annot), - Item_t (Lambda_t (param, ret), Item_t (List_t elt, rest, _), _) -> - check_item_ty elt param loc I_MAP 2 2 >>=? fun Eq -> - typed ctxt loc List_map - (Item_t (List_t ret, rest, instr_annot)) | Prim (loc, I_MAP, [ body ], instr_annot), (Item_t (List_t elt, starting_rest, _)) -> check_kind [ Seq_kind ] body >>=? fun () -> @@ -1523,19 +1512,11 @@ and parse_instr trace (Invalid_map_body (loc, ibody.aft)) (Lwt.return (stack_ty_eq 1 rest starting_rest)) >>=? fun Eq -> - typed ctxt loc (List_map_body ibody) + typed ctxt loc (List_map ibody) (Item_t (List_t ret, rest, instr_annot)) | Typed { aft ; _ } -> fail (Invalid_map_body (loc, aft)) | Failed _ -> fail (Invalid_map_block_fail loc) end - | Prim (loc, I_REDUCE, [], instr_annot), - Item_t (Lambda_t (Pair_t ((pelt, _), (pr, _)), r), - Item_t (List_t elt, Item_t (init, rest, _), _), _) -> - check_item_ty r pr loc I_REDUCE 1 3 >>=? fun Eq -> - check_item_ty elt pelt loc I_REDUCE 2 3 >>=? fun Eq -> - check_item_ty init r loc I_REDUCE 3 3 >>=? fun Eq -> - typed ctxt loc List_reduce - (Item_t (r, rest, instr_annot)) | Prim (loc, I_ITER, [ body ], instr_annot), Item_t (List_t elt, rest, _) -> check_kind [ Seq_kind ] body >>=? fun () -> @@ -1557,15 +1538,6 @@ and parse_instr (Lwt.return (parse_comparable_ty t)) >>=? fun (Ex_comparable_ty t) -> typed ctxt loc (Empty_set t) (Item_t (Set_t t, rest, instr_annot)) - | Prim (loc, I_REDUCE, [], instr_annot), - Item_t (Lambda_t (Pair_t ((pelt, _), (pr, _)), r), - Item_t (Set_t elt, Item_t (init, rest, _), _), _) -> - let elt = ty_of_comparable_ty elt in - check_item_ty r pr loc I_REDUCE 1 3 >>=? fun Eq -> - check_item_ty elt pelt loc I_REDUCE 2 3 >>=? fun Eq -> - check_item_ty init r loc I_REDUCE 3 3 >>=? fun Eq -> - typed ctxt loc Set_reduce - (Item_t (r, rest, instr_annot)) | Prim (loc, I_ITER, [ body ], annot), Item_t (Set_t comp_elt, rest, _) -> check_kind [ Seq_kind ] body >>=? fun () -> @@ -1605,25 +1577,22 @@ and parse_instr (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), - Item_t (Lambda_t (Pair_t ((pk, _), (pv, _)), ret), - Item_t (Map_t (ck, v), rest, _), _) -> + | Prim (loc, I_MAP, [ body ], instr_annot), + Item_t (Map_t (ck, elt), starting_rest, _) -> let k = ty_of_comparable_ty ck in - check_item_ty pk k loc I_MAP 1 2 >>=? fun Eq -> - check_item_ty pv v loc I_MAP 1 2 >>=? fun Eq -> - typed ctxt loc Map_map - (Item_t (Map_t (ck, ret), rest, instr_annot)) - | Prim (loc, I_REDUCE, [], instr_annot), - Item_t (Lambda_t (Pair_t ((Pair_t ((pk, _), (pv, _)), _), (pr, _)), r), - Item_t (Map_t (ck, v), - Item_t (init, rest, _), _), _) -> - let k = ty_of_comparable_ty ck in - check_item_ty pk k loc I_REDUCE 2 3 >>=? fun Eq -> - check_item_ty pv v loc I_REDUCE 2 3 >>=? fun Eq -> - check_item_ty r pr loc I_REDUCE 1 3 >>=? fun Eq -> - check_item_ty init r loc I_REDUCE 3 3 >>=? fun Eq -> - typed ctxt loc Map_reduce - (Item_t (r, rest, instr_annot)) + check_kind [ Seq_kind ] body >>=? fun () -> + parse_instr ?type_logger tc_context ctxt ~check_operations + body (Item_t (Pair_t ((k, None), (elt, None)), starting_rest, None)) >>=? begin fun (judgement, ctxt) -> + match judgement with + | Typed ({ aft = Item_t (ret, rest, _) ; _ } as ibody) -> + trace + (Invalid_map_body (loc, ibody.aft)) + (Lwt.return (stack_ty_eq 1 rest starting_rest)) >>=? fun Eq -> + typed ctxt loc (Map_map ibody) + (Item_t (Map_t (ck, ret), rest, instr_annot)) + | Typed { aft ; _ } -> fail (Invalid_map_body (loc, aft)) + | Failed _ -> fail (Invalid_map_block_fail loc) + end | Prim (loc, I_ITER, [ body ], instr_annot), Item_t (Map_t (comp_elt, element_ty), rest, _) -> check_kind [ Seq_kind ] body >>=? fun () -> @@ -2080,20 +2049,6 @@ and parse_instr Item_t (Key_hash_t, rest, _) -> typed ctxt loc Implicit_account (Item_t (Contract_t Unit_t, rest, instr_annot)) - | Prim (loc, I_CREATE_CONTRACT, [], instr_annot), - Item_t - (Key_hash_t, Item_t - (Option_t Key_hash_t, Item_t - (Bool_t, Item_t - (Bool_t, Item_t - (Tez_t, Item_t - (Lambda_t (Pair_t ((p, _), (gp, _)), - 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)) - (Item_t (Operation_t, Item_t (Address_t, rest, None), instr_annot)) | Prim (loc, I_CREATE_CONTRACT, [ (Seq (seq_loc, _, annot) as code)], instr_annot), Item_t (Key_hash_t, Item_t @@ -2123,7 +2078,7 @@ and parse_instr 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, lambda)) + typed ctxt loc (Create_contract (storage_type, arg_type, lambda)) (Item_t (Operation_t, Item_t (Address_t, rest, None), instr_annot)) | Prim (loc, I_NOW, [], instr_annot), stack -> @@ -2169,7 +2124,7 @@ and parse_instr (* Primitive parsing errors *) | Prim (loc, (I_DROP | I_DUP | I_SWAP | I_SOME | I_UNIT | I_PAIR | I_CAR | I_CDR | I_CONS - | I_MEM | I_UPDATE | I_MAP | I_REDUCE + | I_MEM | I_UPDATE | I_MAP | I_GET | I_EXEC | I_FAIL | I_SIZE | I_CONCAT | I_ADD | I_SUB | I_MUL | I_EDIV | I_OR | I_AND | I_XOR @@ -2208,9 +2163,9 @@ and parse_instr [], _), Item_t (t, _, _) -> fail (Undefined_unop (loc, name, t)) - | Prim (loc, (I_REDUCE | I_UPDATE as name), [], _), + | Prim (loc, I_UPDATE, [], _), stack -> - fail (Bad_stack (loc, name, 3, stack)) + fail (Bad_stack (loc, I_UPDATE, 3, stack)) | Prim (loc, I_CREATE_CONTRACT, [], _), stack -> fail (Bad_stack (loc, I_CREATE_CONTRACT, 7, stack)) @@ -2239,7 +2194,7 @@ and parse_instr fail @@ unexpected expr [ Seq_kind ] Instr_namespace [ I_DROP ; I_DUP ; I_SWAP ; I_SOME ; I_UNIT ; I_PAIR ; I_CAR ; I_CDR ; I_CONS ; - I_MEM ; I_UPDATE ; I_MAP ; I_REDUCE ; I_ITER ; + I_MEM ; I_UPDATE ; I_MAP ; I_ITER ; I_GET ; I_EXEC ; I_FAIL ; I_SIZE ; I_CONCAT ; I_ADD ; I_SUB ; I_MUL ; I_EDIV ; I_OR ; I_AND ; I_XOR ; 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 bb7241155..30306b3aa 100644 --- a/src/proto_alpha/lib_protocol/src/script_typed_ir.ml +++ b/src/proto_alpha/lib_protocol/src/script_typed_ir.ml @@ -140,25 +140,15 @@ and ('bef, 'aft) instr = ('rest, ('a list * 'rest)) instr | If_cons : ('a * ('a list * 'bef), 'aft) descr * ('bef, 'aft) descr -> ('a list * 'bef, 'aft) instr - | List_map : - (('param, 'ret) lambda * ('param list * 'rest), 'ret list * 'rest) instr - | List_map_body : ('a * 'rest, 'b * 'rest) descr -> + | List_map : ('a * 'rest, 'b * 'rest) descr -> ('a list * 'rest, 'b list * 'rest) instr - | List_reduce : - (('param * 'res, 'res) lambda * - ('param list * ('res * 'rest)), 'res * 'rest) instr - | List_size : ('a list * 'rest, n num * 'rest) instr - | List_iter : - ('a * 'rest, 'rest) descr -> + | List_iter : ('a * 'rest, 'rest) descr -> ('a list * 'rest, 'rest) instr + | List_size : ('a list * 'rest, n num * 'rest) instr (* sets *) | Empty_set : 'a comparable_ty -> ('rest, 'a set * 'rest) instr - | Set_reduce : - (('param * 'res, 'res) lambda * - ('param set * ('res * 'rest)), 'res * 'rest) instr - | Set_iter : - ('a * 'rest, 'rest) descr -> + | Set_iter : ('a * 'rest, 'rest) descr -> ('a set * 'rest, 'rest) instr | Set_mem : ('elt * ('elt set * 'rest), bool * 'rest) instr @@ -168,13 +158,9 @@ and ('bef, 'aft) instr = (* maps *) | Empty_map : 'a comparable_ty * 'v ty -> ('rest, ('a, 'v) map * 'rest) instr - | Map_map : - (('a * 'v, 'r) lambda * (('a, 'v) map * 'rest), ('a, 'r) map * 'rest) instr - | Map_reduce : - ((('a * 'v) * 'res, 'res) lambda * - (('a, 'v) map * ('res * 'rest)), 'res * 'rest) instr - | Map_iter : - (('a * 'v) * 'rest, 'rest) descr -> + | Map_map : (('a * 'v) * 'rest, 'r * 'rest) descr -> + (('a, 'v) map * 'rest, ('a, 'r) map * 'rest) instr + | Map_iter : (('a * 'v) * 'rest, 'rest) descr -> (('a, 'v) map * 'rest, 'rest) instr | Map_mem : ('a * (('a, 'v) map * 'rest), bool * 'rest) instr @@ -336,12 +322,7 @@ and ('bef, 'aft) instr = internal_operation * (Contract.t * 'rest)) instr | Implicit_account : (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, internal_operation list * 'g) lambda - * ('g * 'rest)))))), - internal_operation * (Contract.t * 'rest)) instr - | Create_contract_literal : 'g ty * 'p ty * ('p * 'g, internal_operation list * 'g) lambda -> + | Create_contract : 'g ty * 'p ty * ('p * 'g, internal_operation list * 'g) lambda -> (public_key_hash * (public_key_hash option * (bool * (bool * (Tez.t * ('g * 'rest))))), internal_operation * (Contract.t * 'rest)) instr | Set_delegate : 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 7fb50d977..084868c5e 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/add1_list.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/add1_list.tz @@ -1,7 +1,6 @@ parameter (list int); 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 + MAP { PUSH int 1; ADD }; # Map over the list adding one NIL operation; # No internal op PAIR } # Match the calling convetion 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 772dc6632..e290b90fb 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/concat_hello.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/concat_hello.tz @@ -1,4 +1,4 @@ parameter (list string); storage (list string); -code{ CAR; LAMBDA string string { PUSH @hello string "Hello "; CONCAT }; - MAP; NIL operation; PAIR}; +code{ CAR; + MAP { PUSH @hello string "Hello "; CONCAT }; 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 a2c752d93..f805d1b16 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/concat_list.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/concat_list.tz @@ -1,5 +1,5 @@ parameter (list string); storage string; code {CAR; PUSH string ""; SWAP; - LAMBDA (pair string string) string {DUP; CDR; DIP{CAR}; CONCAT}; - REDUCE; NIL operation; PAIR}; + ITER {SWAP; CONCAT}; + NIL operation; PAIR}; 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 f44628cc8..fe4160f87 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/contains_all.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/contains_all.tz @@ -1,9 +1,7 @@ parameter (pair (list string) (list string)); 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; SOME; NIL operation; PAIR}; + ITER {PAIR; DUP; CAR; DIP{CDR}; PUSH bool True; SWAP; UPDATE}; + PUSH bool True; SWAP; PAIR; SWAP; + ITER {PAIR; DUP; DUP; CAR; DIP{CDAR; DIP{CDDR}; DUP}; MEM; DIP{SWAP}; AND; SWAP; PAIR}; + CDR; SOME; 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 d4b5fc21c..c183ad1e2 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,18 +1,17 @@ parameter unit; storage address; 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; - NIL operation; - PAIR }; AMOUNT; # Push the starting balance PUSH bool False; # Not spendable DUP; # Or delegatable NONE key_hash; # No delegate PUSH key_hash "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"; - CREATE_CONTRACT; # Create the contract + CREATE_CONTRACT # Create the contract + { parameter (list int) ; + storage (list int) ; + code + { CAR; + MAP {PUSH int 1; ADD}; + NIL operation; + PAIR } }; NIL operation; SWAP; CONS; 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 eb7bc0d31..d9aa97348 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/create_contract.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/create_contract.tz @@ -3,12 +3,12 @@ storage unit; code { CAR; IF_LEFT { 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 ; + CREATE_CONTRACT + { parameter string ; + storage string ; + code { CAR ; NIL operation ; PAIR } } ; DIP { RIGHT key_hash ; DIP { SELF ; PUSH tez "0" } ; TRANSFER_TOKENS ; NIL operation ; SWAP ; CONS } ; CONS ; UNIT ; SWAP ; 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 deleted file mode 100644 index d9aa97348..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/create_contract_literal.tz +++ /dev/null @@ -1,18 +0,0 @@ -parameter (or key_hash address); -storage unit; -code { CAR; - IF_LEFT - { DIP { PUSH string "dummy"; - PUSH tez "100.00" ; PUSH bool False ; - PUSH bool False ; NONE key_hash } ; - CREATE_CONTRACT - { parameter string ; - storage string ; - code { CAR ; NIL operation ; PAIR } } ; - DIP { RIGHT key_hash ; DIP { SELF ; PUSH tez "0" } ; TRANSFER_TOKENS ; - NIL operation ; SWAP ; CONS } ; - CONS ; UNIT ; SWAP ; PAIR } - { SELF ; ADDRESS ; SOURCE ; IFCMPNEQ { FAIL } {} ; - CONTRACT string ; IF_SOME {} { FAIL } ; - PUSH tez "0.00" ; PUSH string "abcdefg" ; TRANSFER_TOKENS ; - NIL operation; SWAP; CONS ; UNIT ; SWAP ; 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 e82cc2918..38b4493e8 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,3 +1,3 @@ parameter (list string); storage (list string); -code {CAR; LAMBDA string string {}; MAP; NIL operation; PAIR} +code {CAR; MAP {}; 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 229b37729..89c4955e9 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,9 +1,9 @@ parameter (list 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; NIL operation; PAIR}; + ITER {SWAP; + IF_NONE {SOME} + {DIP {DUP}; DUP; DIP{SWAP}; + CMPLE; IF {DROP} {DIP {DROP}}; + 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 24419bc54..5a851f3e2 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/reverse.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/reverse.tz @@ -1,7 +1,5 @@ parameter (list string); storage (list string); code { CAR; NIL string; SWAP; - LAMBDA (pair string (list string)) - (list string) - {DUP; CAR; DIP{CDR}; CONS}; - REDUCE; NIL operation; PAIR}; + ITER {CONS}; + 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 8f0a514fd..717c7c374 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/spawn_identities.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/spawn_identities.tz @@ -8,14 +8,14 @@ code { DUP; 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 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; PUSH key_hash "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"; - CREATE_CONTRACT; # Make the contract + CREATE_CONTRACT + { parameter string ; + storage string ; + code { CAR ; NIL operation ; PAIR } } ; # Make the contract SWAP ; DIP { SWAP ; DIP { CONS } } ; # emit the operation SWAP ; DIP { SWAP ; DIP { CONS } } ; # add to the list PUSH bool True}}; # Continue the loop