Michelson: cleanup iterator opcodes

This commit is contained in:
Benjamin Canou 2018-05-02 01:45:15 +02:00 committed by Grégoire Henry
parent c57458ea01
commit a425b3dc27
33 changed files with 160 additions and 434 deletions

View File

@ -73,7 +73,7 @@ The rules have the main following form.
> (syntax pattern) / (initial stack pattern) => (result stack pattern) > (syntax pattern) / (initial stack pattern) => (result stack pattern)
iff (conditions) iff (conditions)
where (recursions) where (recursions)
and (more recursions) and (more recursions)
The left hand side of the ``=>`` sign is used for selecting the rule. 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 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 ; <tl> } : S => { x ; hd ; <tl> } : S > UPDATE / x : true : { hd ; <tl> } : S => { x ; hd ; <tl> } : S
iff COMPARE / x : hd : [] => -1 : [] 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 : <tl> } : b : S => REDUCE / f : { <tl> } : c : S
where f / Pair hd b : [] => c : []
- ``ITER body``: Apply the body expression to each element of a set. - ``ITER body``: Apply the body expression to each element of a set.
The body sequence has access to the stack. The body sequence has access to the stack.
@ -957,7 +946,7 @@ Operations on maps
> GET / x : {} : S => None : S > GET / x : {} : S => None : S
> GET / x : { Elt k v ; <tl> } : S => opt_y : S > GET / x : { Elt k v ; <tl> } : S => opt_y : S
iff COMPARE / x : k : [] => 1 : [] iff COMPARE / x : k : [] => 1 : []
where GET / x : { <tl> } : S => opt_y : S where GET / x : { <tl> } : S => opt_y : S
> GET / x : { Elt k v ; <tl> } : S => Some v : S > GET / x : { Elt k v ; <tl> } : S => Some v : S
iff COMPARE / x : k : [] => 0 : [] iff COMPARE / x : k : [] => 0 : []
> GET / x : { Elt k v ; <tl> } : S => None : S > GET / x : { Elt k v ; <tl> } : S => None : S
@ -988,7 +977,7 @@ Operations on maps
> UPDATE / x : Some y : {} : S => { Elt x y } : S > UPDATE / x : Some y : {} : S => { Elt x y } : S
> UPDATE / x : opt_y : { Elt k v ; <tl> } : S => { Elt k v ; <tl'> } : S > UPDATE / x : opt_y : { Elt k v ; <tl> } : S => { Elt k v ; <tl'> } : S
iff COMPARE / x : k : [] => 1 : [] iff COMPARE / x : k : [] => 1 : []
where UPDATE / x : opt_y : { <tl> } : S => { <tl'> } : S where UPDATE / x : opt_y : { <tl> } : S => { <tl'> } : S
> UPDATE / x : None : { Elt k v ; <tl> } : S => { <tl> } : S > UPDATE / x : None : { Elt k v ; <tl> } : S => { <tl> } : S
iff COMPARE / x : k : [] => 0 : [] iff COMPARE / x : k : [] => 0 : []
> UPDATE / x : Some y : { Elt k v ; <tl> } : S => { Elt k y ; <tl> } : S > UPDATE / x : Some y : { Elt k v ; <tl> } : S => { Elt k y ; <tl> } : S
@ -998,19 +987,6 @@ Operations on maps
> UPDATE / x : Some y : { Elt k v ; <tl> } : S => { Elt x y ; Elt k v ; <tl> } : S > UPDATE / x : Some y : { Elt k v ; <tl> } : S => { Elt x y ; Elt k v ; <tl> } : S
iff COMPARE / x : k : [] => -1 : [] 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 ; <tl> } : S => { Elt k (f (Pair k v)) ; <tl'> } : S
where MAP / f : { <tl> } : S => { <tl'> } : S
- ``MAP body``: Apply the body expression to each element of a map. The - ``MAP body``: Apply the body expression to each element of a map. The
body sequence has access to the stack. body sequence has access to the stack.
@ -1023,18 +999,6 @@ Operations on maps
> MAP body / { Elt k v ; <tl> } : S => { Elt k (body (Pair k v)) ; <tl'> } : S > MAP body / { Elt k v ; <tl> } : S => { Elt k (body (Pair k v)) ; <tl'> } : S
where MAP body / { <tl> } : S => { <tl'> } : S where MAP body / { <tl> } : S => { <tl'> } : 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 ; <tl> } : b : S => REDUCE / f : { <tl> } : c : S
where f / Pair (Pair k v) b : [] => c
- ``ITER body``: Apply the body expression to each element of a map. - ``ITER body``: Apply the body expression to each element of a map.
The body sequence has access to the stack. The body sequence has access to the stack.
@ -1186,18 +1150,6 @@ Operations on lists
> IF_CONS bt bf / { a ; <rest> } : S => bt / a : { <rest> } : S > IF_CONS bt bf / { a ; <rest> } : S => bt / a : { <rest> } : S
> IF_CONS bt bf / {} : S => bf / 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 ; <rest> } : S => { f a ; <rest'> } : S
where MAP / f : { <rest> } : S => { <rest'> } : S
> MAP / f : {} : S => {} : S
- ``MAP body``: Apply the body expression to each element of the list. - ``MAP body``: Apply the body expression to each element of the list.
The body sequence has access to the stack. The body sequence has access to the stack.
@ -1210,19 +1162,6 @@ Operations on lists
where MAP body / { <rest> } : S => { <rest'> } : S where MAP body / { <rest> } : S => { <rest'> } : S
> 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 : <rest> } : b : S => REDUCE / f : { <rest> } : c : S
where f / Pair a b : [] => c
> REDUCE / f : {} : b : S => b : S
- ``SIZE``: Get the number of elements in the list. - ``SIZE``: Get the number of elements in the list.
:: ::
@ -2439,9 +2378,7 @@ XII - Full grammar
| IF_CONS { <instruction> ... } { <instruction> ... } | IF_CONS { <instruction> ... } { <instruction> ... }
| EMPTY_SET <type> | EMPTY_SET <type>
| EMPTY_MAP <comparable type> <type> | EMPTY_MAP <comparable type> <type>
| MAP
| MAP { <instruction> ... } | MAP { <instruction> ... }
| REDUCE
| ITER { <instruction> ... } | ITER { <instruction> ... }
| MEM | MEM
| GET | GET

View File

@ -1,7 +1,6 @@
parameter (list int); parameter (list int);
storage (list int); storage (list int);
code { CAR; # Get the parameter code { CAR; # Get the parameter
LAMBDA int int { PUSH int 1; ADD }; # Create a lambda that adds 1 MAP { PUSH int 1; ADD }; # Map over the list adding one
MAP; # Map over the list
NIL operation; # No internal op NIL operation; # No internal op
PAIR } # Match the calling convetion PAIR } # Match the calling convetion

View File

@ -1,13 +1,8 @@
parameter (pair (list int) (list int)); parameter (pair (list int) (list int));
storage (list int); storage (list int);
code { CAR; DUP; DIP{CDR}; CAR; # Unpack lists code { CAR; UNPAIR ; # Unpack lists
NIL int; SWAP; # Setup reverse accumulator NIL int; SWAP; # Setup reverse accumulator
LAMBDA (pair int (list int)) ITER {CONS}; # Reverse list
(list int) ITER {CONS}; # Append reversed list
{DUP; CAR; DIP{CDR}; CONS}; NIL operation;
REDUCE; # Reverse list PAIR}
LAMBDA (pair int (list int))
(list int)
{DUP; CAR; DIP{CDR}; CONS};
REDUCE; # Append reversed list
NIL operation; PAIR} # Calling convention

View File

@ -1,4 +1,4 @@
parameter (list string); parameter (list string);
storage (list string); storage (list string);
code{ CAR; LAMBDA string string { PUSH @hello string "Hello "; CONCAT }; code{ CAR;
MAP; NIL operation; PAIR}; MAP { PUSH @hello string "Hello "; CONCAT }; NIL operation; PAIR};

View File

@ -1,5 +1,5 @@
parameter (list string); parameter (list string);
storage string; storage string;
code {CAR; PUSH string ""; SWAP; code {CAR; PUSH string ""; SWAP;
LAMBDA (pair string string) string {DUP; CDR; DIP{CAR}; CONCAT}; ITER {SWAP; CONCAT};
REDUCE; NIL operation; PAIR}; NIL operation; PAIR};

View File

@ -1,9 +1,7 @@
parameter (pair (list string) (list string)); parameter (pair (list string) (list string));
storage (option bool); storage (option bool);
code {CAR; DUP; CAR; DIP{CDR}; EMPTY_SET string; SWAP; 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}; ITER {PAIR; DUP; CAR; DIP{CDR}; PUSH bool True; SWAP; UPDATE};
REDUCE; PUSH bool True; SWAP; PAIR; SWAP; PUSH bool True; SWAP; PAIR; SWAP;
LAMBDA (pair string (pair (set string) bool)) ITER {PAIR; DUP; DUP; CAR; DIP{CDAR; DIP{CDDR}; DUP}; MEM; DIP{SWAP}; AND; SWAP; PAIR};
(pair (set string) bool) CDR; SOME; NIL operation; PAIR};
{DUP; DUP; CAR; DIP{CDAR; DIP{CDDR}; DUP}; MEM; DIP{SWAP}; AND; SWAP; PAIR};
REDUCE; CDR; SOME; NIL operation; PAIR};

View File

@ -1,18 +1,17 @@
parameter unit; parameter unit;
storage address; storage address;
code { DROP; NIL int; # starting storage for contract 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 AMOUNT; # Push the starting balance
PUSH bool False; # Not spendable PUSH bool False; # Not spendable
DUP; # Or delegatable DUP; # Or delegatable
NONE key_hash; # No delegate NONE key_hash; # No delegate
PUSH key_hash "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"; 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 NIL operation; SWAP; CONS; PAIR} # Ending calling convention stuff

View File

@ -3,12 +3,12 @@ storage unit;
code { CAR; code { CAR;
IF_LEFT IF_LEFT
{ DIP { PUSH string "dummy"; { DIP { PUSH string "dummy";
LAMBDA (pair string string)
(pair (list operation) string)
{ CAR ; NIL operation ; PAIR };
PUSH tez "100.00" ; PUSH bool False ; PUSH tez "100.00" ; PUSH bool False ;
PUSH bool False ; NONE key_hash } ; 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 ; DIP { RIGHT key_hash ; DIP { SELF ; PUSH tez "0" } ; TRANSFER_TOKENS ;
NIL operation ; SWAP ; CONS } ; NIL operation ; SWAP ; CONS } ;
CONS ; UNIT ; SWAP ; PAIR } CONS ; UNIT ; SWAP ; PAIR }

View File

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

View File

@ -1,25 +1,16 @@
parameter (list int); parameter (list int) ;
storage (list int); storage (list int) ;
code { CAR; # Access list code { CAR ;
# Insert procedure NIL int ; SWAP ;
LAMBDA (pair int (list int)) ITER { SWAP; DIIP{NIL int} ; PUSH bool True ;
(list int) LOOP
{ DUP; CDR; DIP{CAR}; # Unpack accumulator and existing list { IF_CONS
DIIP{NIL int}; PUSH bool True; # Setup loop { SWAP ;
LOOP { IF_CONS { SWAP; DIP{DUP ; DIIP{DUP} ; DIP{CMPLT} ; SWAP} ;
DIP{DUP; DIIP{DUP}; DIP{CMPLT}; SWAP}; # Duplicate numbers SWAP ;
SWAP; IF { DIP{SWAP ; DIP{CONS}} ; PUSH bool True}
# If less than { SWAP ; CONS ; PUSH bool False}}
IF { DIP{SWAP; DIP{CONS}}; PUSH bool True} { NIL int ; PUSH bool False}} ;
# Otherwise SWAP ; CONS ; SWAP ;
{ SWAP; CONS; PUSH bool False}} ITER {CONS}} ;
# Ending case NIL operation ; PAIR }
{ 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

View File

@ -1,3 +1,3 @@
parameter (list string); parameter (list string);
storage (list string); storage (list string);
code {CAR; LAMBDA string string {}; MAP; NIL operation; PAIR} code {CAR; MAP {}; NIL operation; PAIR}

View File

@ -1,9 +1,9 @@
parameter (list int); parameter (list int);
storage (option int); storage (option int);
code {CAR; DIP{NONE int}; code {CAR; DIP{NONE int};
LAMBDA ITER {SWAP;
(pair int (option int)) IF_NONE {SOME}
(option int) {DIP {DUP}; DUP; DIP{SWAP};
{DUP; DUP; CAR; SWAP; CDR; CMPLE; IF {DROP} {DIP {DROP}};
IF_NONE {DIP{DROP}; SOME} {CMPGT; IF {CDR} {CAR; SOME}}}; SOME}};
REDUCE; NIL operation; PAIR}; NIL operation; PAIR};

View File

@ -6,16 +6,11 @@ code { DIP{NIL int};
DUP; DUP;
DIP{CAR; PAIR}; # Unpack data and setup accumulator DIP{CAR; PAIR}; # Unpack data and setup accumulator
CDR; CDR;
LAMBDA (pair int (pair (lambda int int) (list int))) ITER {PAIR;
(pair (lambda int int) (list int)) DUP; CDAR;
# Apply the lambda and add the new element to the list DIP{ DUP; DIP{CDAR}; DUP;
{ DUP; CDAR; CAR; DIP{CDDR; SWAP}; EXEC; CONS};
DIP{ DUP; DIP{CDAR}; DUP; PAIR};
CAR; DIP{CDDR; SWAP}; EXEC; CONS}; CDR; DIP{NIL int}; # First reduce
PAIR}; ITER {CONS}; # Reverse
REDUCE; CDR; DIP{NIL int}; # First reduce
LAMBDA (pair int (list int))
(list int)
{DUP; CAR; DIP{CDR}; CONS};
REDUCE; # Correct list order
NIL operation; PAIR} # Calling convention NIL operation; PAIR} # Calling convention

View File

@ -1,7 +1,5 @@
parameter (list string); parameter (list string);
storage (list string); storage (list string);
code { CAR; NIL string; SWAP; code { CAR; NIL string; SWAP;
LAMBDA (pair string (list string)) ITER {CONS};
(list string) NIL operation; PAIR};
{DUP; CAR; DIP{CDR}; CONS};
REDUCE; NIL operation; PAIR};

View File

@ -8,14 +8,14 @@ code { DUP;
IF { PUSH bool False} # End the loop 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 nat 1; SWAP; SUB; ABS; # Subtract 1. The ABS is to make it back into a nat
PUSH string "init"; # Storage type 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 tez "5.00"; # Strating balance
PUSH bool False; DUP; # Not spendable or delegatable PUSH bool False; DUP; # Not spendable or delegatable
NONE key_hash; NONE key_hash;
PUSH key_hash "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"; 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 } } ; # emit the operation
SWAP ; DIP { SWAP ; DIP { CONS } } ; # add to the list SWAP ; DIP { SWAP ; DIP { CONS } } ; # add to the list
PUSH bool True}}; # Continue the loop PUSH bool True}}; # Continue the loop

View File

@ -3,15 +3,10 @@ storage bool;
code { CAR; DUP; CDR; DIP{CAR}; # Unpack lists code { CAR; DUP; CDR; DIP{CAR}; # Unpack lists
PUSH bool True; PUSH bool True;
PAIR; SWAP; # Setup accumulator PAIR; SWAP; # Setup accumulator
LAMBDA (pair string (pair bool (set string))) ITER { DIP{ DUP; DUP; CDR;
(pair bool (set string)) DIP{CAR; DIP{CDR}}};
{ DUP; # Unpack accumulator and input MEM; # Check membership
CAR; AND; # Combine accumulator and input
DIP{ CDR; DUP; DUP; CDR; PAIR};
DIP{CAR; DIP{CDR}}};
MEM; # Check membership
AND; # Combine accumulator and input
PAIR};
REDUCE; # Reduce
CAR; # Get the accumulator value CAR; # Get the accumulator value
NIL operation; PAIR} # Calling convention NIL operation; PAIR} # Calling convention

View File

@ -227,7 +227,6 @@ module Script : sig
| I_OR | I_OR
| I_PAIR | I_PAIR
| I_PUSH | I_PUSH
| I_REDUCE
| I_RIGHT | I_RIGHT
| I_SIZE | I_SIZE
| I_SOME | I_SOME

View File

@ -79,7 +79,6 @@ type prim =
| I_OR | I_OR
| I_PAIR | I_PAIR
| I_PUSH | I_PUSH
| I_REDUCE
| I_RIGHT | I_RIGHT
| I_SIZE | I_SIZE
| I_SOME | I_SOME
@ -205,7 +204,6 @@ let string_of_prim = function
| I_OR -> "OR" | I_OR -> "OR"
| I_PAIR -> "PAIR" | I_PAIR -> "PAIR"
| I_PUSH -> "PUSH" | I_PUSH -> "PUSH"
| I_REDUCE -> "REDUCE"
| I_RIGHT -> "RIGHT" | I_RIGHT -> "RIGHT"
| I_SIZE -> "SIZE" | I_SIZE -> "SIZE"
| I_SOME -> "SOME" | I_SOME -> "SOME"
@ -312,7 +310,6 @@ let prim_of_string = function
| "OR" -> ok I_OR | "OR" -> ok I_OR
| "PAIR" -> ok I_PAIR | "PAIR" -> ok I_PAIR
| "PUSH" -> ok I_PUSH | "PUSH" -> ok I_PUSH
| "REDUCE" -> ok I_REDUCE
| "RIGHT" -> ok I_RIGHT | "RIGHT" -> ok I_RIGHT
| "SIZE" -> ok I_SIZE | "SIZE" -> ok I_SIZE
| "SOME" -> ok I_SOME | "SOME" -> ok I_SOME
@ -463,7 +460,6 @@ let prim_encoding =
("OR", I_OR) ; ("OR", I_OR) ;
("PAIR", I_PAIR) ; ("PAIR", I_PAIR) ;
("PUSH", I_PUSH) ; ("PUSH", I_PUSH) ;
("REDUCE", I_REDUCE) ;
("RIGHT", I_RIGHT) ; ("RIGHT", I_RIGHT) ;
("SIZE", I_SIZE) ; ("SIZE", I_SIZE) ;
("SOME", I_SOME) ; ("SOME", I_SOME) ;

View File

@ -77,7 +77,6 @@ type prim =
| I_OR | I_OR
| I_PAIR | I_PAIR
| I_PUSH | I_PUSH
| I_REDUCE
| I_RIGHT | I_RIGHT
| I_SIZE | I_SIZE
| I_SOME | I_SOME

View File

@ -142,34 +142,6 @@ let rec interp
fun descr op cost x1 x2 rest -> fun descr op cost x1 x2 rest ->
Lwt.return (Gas.consume ctxt (cost x1 x2)) >>=? fun ctxt -> Lwt.return (Gas.consume ctxt (cost x1 x2)) >>=? fun ctxt ->
logged_return descr (Item (Script_int.of_int @@ op x1 x2, rest), ctxt) in 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 : let logged_return :
a stack * context -> a stack * context ->
(a stack * context) tzresult Lwt.t = (a stack * context) tzresult Lwt.t =
@ -237,18 +209,7 @@ let rec interp
| If_cons (bt, _), Item (hd :: tl, rest) -> | If_cons (bt, _), Item (hd :: tl, rest) ->
Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt -> Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
step ctxt bt (Item (hd, Item (tl, rest))) step ctxt bt (Item (hd, Item (tl, rest)))
| List_map, Item (lam, 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
| [] -> 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) ->
let rec loop rest ctxt l acc = let rec loop rest ctxt l acc =
Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt -> Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
match l with match l with
@ -259,17 +220,6 @@ let rec interp
loop rest ctxt tl (hd :: acc) loop rest ctxt tl (hd :: acc)
in loop rest ctxt l [] >>=? fun (res, ctxt) -> in loop rest ctxt l [] >>=? fun (res, ctxt) ->
logged_return (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) -> | List_size, Item (list, rest) ->
Lwt.return Lwt.return
(List.fold_left (List.fold_left
@ -294,19 +244,6 @@ let rec interp
| Empty_set t, rest -> | Empty_set t, rest ->
Lwt.return (Gas.consume ctxt Interp_costs.empty_set) >>=? fun ctxt -> Lwt.return (Gas.consume ctxt Interp_costs.empty_set) >>=? fun ctxt ->
logged_return (Item (empty_set t, rest), 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) -> | Set_iter body, Item (set, init) ->
Lwt.return (Gas.consume ctxt (Interp_costs.set_to_list set)) >>=? fun ctxt -> 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 l = List.rev (set_fold (fun e acc -> e :: acc) set []) in
@ -330,7 +267,7 @@ let rec interp
| Empty_map (t, _), rest -> | Empty_map (t, _), rest ->
Lwt.return (Gas.consume ctxt Interp_costs.empty_map) >>=? fun ctxt -> Lwt.return (Gas.consume ctxt Interp_costs.empty_map) >>=? fun ctxt ->
logged_return (Item (empty_map t, rest), 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 -> 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 l = List.rev (map_fold (fun k v acc -> (k, v) :: acc) map []) in
let rec loop rest ctxt l acc = let rec loop rest ctxt l acc =
@ -338,24 +275,11 @@ let rec interp
match l with match l with
| [] -> return (acc, ctxt) | [] -> return (acc, ctxt)
| (k, _) as hd :: tl -> | (k, _) as hd :: tl ->
interp ?log ctxt ~source ~payer ~self amount lam hd step ctxt body (Item (hd, rest))
>>=? fun (hd, ctxt) -> >>=? fun (Item (hd, rest), ctxt) ->
loop rest ctxt tl (map_update k (Some hd) acc) loop rest ctxt tl (map_update k (Some hd) acc)
in loop rest ctxt l (empty_map (map_key_ty map)) >>=? fun (res, ctxt) -> in loop rest ctxt l (empty_map (map_key_ty map)) >>=? fun (res, ctxt) ->
logged_return (Item (res, rest), 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) -> | Map_iter body, Item (map, init) ->
Lwt.return (Gas.consume ctxt (Interp_costs.map_to_list map)) >>=? fun ctxt -> 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 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 -> Lwt.return (Gas.consume ctxt Interp_costs.implicit_account) >>=? fun ctxt ->
let contract = Contract.implicit_contract key in let contract = Contract.implicit_contract key in
logged_return (Item ((Unit_t, contract), rest), ctxt) logged_return (Item ((Unit_t, contract), rest), ctxt)
| Create_contract (storage_type, param_type), | Create_contract (storage_type, param_type, Lam (_, code)),
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)),
Item (manager, Item Item (manager, Item
(delegate, Item (delegate, Item
(spendable, Item (spendable, Item
(delegatable, Item (delegatable, Item
(credit, Item (credit, Item
(init, rest)))))) -> (init, rest)))))) ->
create_contract descr ~manager ~delegate ~spendable ~delegatable ~credit ~code ~init Lwt.return (Gas.consume ctxt Interp_costs.create_contract) >>=? fun ctxt ->
~param_type ~storage_type ~rest 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, | Set_delegate,
Item (delegate, rest) -> Item (delegate, rest) ->
Lwt.return (Gas.consume ctxt Interp_costs.create_account) >>=? fun ctxt -> Lwt.return (Gas.consume ctxt Interp_costs.create_account) >>=? fun ctxt ->

View File

@ -114,20 +114,16 @@ let number_of_generated_growing_types : type b a. (b, a) instr -> int = function
| Cons_list -> 1 | Cons_list -> 1
| Nil -> 1 | Nil -> 1
| If_cons _ -> 0 | If_cons _ -> 0
| List_map -> 1 | List_map _ -> 1
| List_map_body _ -> 1
| List_reduce -> 0
| List_size -> 0 | List_size -> 0
| List_iter _ -> 1 | List_iter _ -> 1
| Empty_set _ -> 1 | Empty_set _ -> 1
| Set_reduce -> 0
| Set_iter _ -> 0 | Set_iter _ -> 0
| Set_mem -> 0 | Set_mem -> 0
| Set_update -> 0 | Set_update -> 0
| Set_size -> 0 | Set_size -> 0
| Empty_map _ -> 1 | Empty_map _ -> 1
| Map_map -> 1 | Map_map _ -> 1
| Map_reduce -> 0
| Map_iter _ -> 1 | Map_iter _ -> 1
| Map_mem -> 0 | Map_mem -> 0
| Map_get -> 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 | Create_account -> 0
| Implicit_account -> 0 | Implicit_account -> 0
| Create_contract _ -> 1 | Create_contract _ -> 1
| Create_contract_literal _ -> 1
| Now -> 0 | Now -> 0
| Balance -> 0 | Balance -> 0
| Check_signature -> 0 | Check_signature -> 0
@ -293,7 +288,6 @@ let namespace = function
| I_OR | I_OR
| I_PAIR | I_PAIR
| I_PUSH | I_PUSH
| I_REDUCE
| I_RIGHT | I_RIGHT
| I_SIZE | I_SIZE
| I_SOME | I_SOME
@ -1508,11 +1502,6 @@ and parse_instr
Item_t (List_t _, rest, _) -> Item_t (List_t _, rest, _) ->
typed ctxt loc List_size typed ctxt loc List_size
(Item_t (Nat_t, rest, instr_annot)) (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), | Prim (loc, I_MAP, [ body ], instr_annot),
(Item_t (List_t elt, starting_rest, _)) -> (Item_t (List_t elt, starting_rest, _)) ->
check_kind [ Seq_kind ] body >>=? fun () -> check_kind [ Seq_kind ] body >>=? fun () ->
@ -1523,19 +1512,11 @@ and parse_instr
trace trace
(Invalid_map_body (loc, ibody.aft)) (Invalid_map_body (loc, ibody.aft))
(Lwt.return (stack_ty_eq 1 rest starting_rest)) >>=? fun Eq -> (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)) (Item_t (List_t ret, rest, instr_annot))
| Typed { aft ; _ } -> fail (Invalid_map_body (loc, aft)) | Typed { aft ; _ } -> fail (Invalid_map_body (loc, aft))
| Failed _ -> fail (Invalid_map_block_fail loc) | Failed _ -> fail (Invalid_map_block_fail loc)
end 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), | Prim (loc, I_ITER, [ body ], instr_annot),
Item_t (List_t elt, rest, _) -> Item_t (List_t elt, rest, _) ->
check_kind [ Seq_kind ] body >>=? fun () -> check_kind [ Seq_kind ] body >>=? fun () ->
@ -1557,15 +1538,6 @@ and parse_instr
(Lwt.return (parse_comparable_ty t)) >>=? fun (Ex_comparable_ty t) -> (Lwt.return (parse_comparable_ty t)) >>=? fun (Ex_comparable_ty t) ->
typed ctxt loc (Empty_set t) typed ctxt loc (Empty_set t)
(Item_t (Set_t t, rest, instr_annot)) (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), | Prim (loc, I_ITER, [ body ], annot),
Item_t (Set_t comp_elt, rest, _) -> Item_t (Set_t comp_elt, rest, _) ->
check_kind [ Seq_kind ] body >>=? fun () -> 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, _) -> (Lwt.return (parse_ty ~allow_big_map:false tv)) >>=? fun (Ex_ty tv, _) ->
typed ctxt loc (Empty_map (tk, tv)) typed ctxt loc (Empty_map (tk, tv))
(Item_t (Map_t (tk, tv), stack, instr_annot)) (Item_t (Map_t (tk, tv), stack, instr_annot))
| Prim (loc, I_MAP, [], instr_annot), | Prim (loc, I_MAP, [ body ], instr_annot),
Item_t (Lambda_t (Pair_t ((pk, _), (pv, _)), ret), Item_t (Map_t (ck, elt), starting_rest, _) ->
Item_t (Map_t (ck, v), rest, _), _) ->
let k = ty_of_comparable_ty ck in let k = ty_of_comparable_ty ck in
check_item_ty pk k loc I_MAP 1 2 >>=? fun Eq -> check_kind [ Seq_kind ] body >>=? fun () ->
check_item_ty pv v loc I_MAP 1 2 >>=? fun Eq -> parse_instr ?type_logger tc_context ctxt ~check_operations
typed ctxt loc Map_map body (Item_t (Pair_t ((k, None), (elt, None)), starting_rest, None)) >>=? begin fun (judgement, ctxt) ->
(Item_t (Map_t (ck, ret), rest, instr_annot)) match judgement with
| Prim (loc, I_REDUCE, [], instr_annot), | Typed ({ aft = Item_t (ret, rest, _) ; _ } as ibody) ->
Item_t (Lambda_t (Pair_t ((Pair_t ((pk, _), (pv, _)), _), (pr, _)), r), trace
Item_t (Map_t (ck, v), (Invalid_map_body (loc, ibody.aft))
Item_t (init, rest, _), _), _) -> (Lwt.return (stack_ty_eq 1 rest starting_rest)) >>=? fun Eq ->
let k = ty_of_comparable_ty ck in typed ctxt loc (Map_map ibody)
check_item_ty pk k loc I_REDUCE 2 3 >>=? fun Eq -> (Item_t (Map_t (ck, ret), rest, instr_annot))
check_item_ty pv v loc I_REDUCE 2 3 >>=? fun Eq -> | Typed { aft ; _ } -> fail (Invalid_map_body (loc, aft))
check_item_ty r pr loc I_REDUCE 1 3 >>=? fun Eq -> | Failed _ -> fail (Invalid_map_block_fail loc)
check_item_ty init r loc I_REDUCE 3 3 >>=? fun Eq -> end
typed ctxt loc Map_reduce
(Item_t (r, rest, instr_annot))
| Prim (loc, I_ITER, [ body ], instr_annot), | Prim (loc, I_ITER, [ body ], instr_annot),
Item_t (Map_t (comp_elt, element_ty), rest, _) -> Item_t (Map_t (comp_elt, element_ty), rest, _) ->
check_kind [ Seq_kind ] body >>=? fun () -> check_kind [ Seq_kind ] body >>=? fun () ->
@ -2080,20 +2049,6 @@ and parse_instr
Item_t (Key_hash_t, rest, _) -> Item_t (Key_hash_t, rest, _) ->
typed ctxt loc Implicit_account typed ctxt loc Implicit_account
(Item_t (Contract_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
(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), | Prim (loc, I_CREATE_CONTRACT, [ (Seq (seq_loc, _, annot) as code)], instr_annot),
Item_t Item_t
(Key_hash_t, 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 arg arg_type_full >>=? fun Eq ->
Lwt.return @@ ty_eq ret ret_type_full >>=? fun Eq -> Lwt.return @@ ty_eq ret ret_type_full >>=? fun Eq ->
Lwt.return @@ ty_eq storage_type ginit >>=? 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)) (Item_t (Operation_t, Item_t (Address_t, rest, None), instr_annot))
| Prim (loc, I_NOW, [], instr_annot), | Prim (loc, I_NOW, [], instr_annot),
stack -> stack ->
@ -2169,7 +2124,7 @@ and parse_instr
(* Primitive parsing errors *) (* Primitive parsing errors *)
| Prim (loc, (I_DROP | I_DUP | I_SWAP | I_SOME | I_UNIT | Prim (loc, (I_DROP | I_DUP | I_SWAP | I_SOME | I_UNIT
| I_PAIR | I_CAR | I_CDR | I_CONS | 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_GET | I_EXEC | I_FAIL | I_SIZE
| I_CONCAT | I_ADD | I_SUB | I_CONCAT | I_ADD | I_SUB
| I_MUL | I_EDIV | I_OR | I_AND | I_XOR | I_MUL | I_EDIV | I_OR | I_AND | I_XOR
@ -2208,9 +2163,9 @@ and parse_instr
[], _), [], _),
Item_t (t, _, _) -> Item_t (t, _, _) ->
fail (Undefined_unop (loc, name, t)) fail (Undefined_unop (loc, name, t))
| Prim (loc, (I_REDUCE | I_UPDATE as name), [], _), | Prim (loc, I_UPDATE, [], _),
stack -> stack ->
fail (Bad_stack (loc, name, 3, stack)) fail (Bad_stack (loc, I_UPDATE, 3, stack))
| Prim (loc, I_CREATE_CONTRACT, [], _), | Prim (loc, I_CREATE_CONTRACT, [], _),
stack -> stack ->
fail (Bad_stack (loc, I_CREATE_CONTRACT, 7, stack)) fail (Bad_stack (loc, I_CREATE_CONTRACT, 7, stack))
@ -2239,7 +2194,7 @@ and parse_instr
fail @@ unexpected expr [ Seq_kind ] Instr_namespace fail @@ unexpected expr [ Seq_kind ] Instr_namespace
[ I_DROP ; I_DUP ; I_SWAP ; I_SOME ; I_UNIT ; [ I_DROP ; I_DUP ; I_SWAP ; I_SOME ; I_UNIT ;
I_PAIR ; I_CAR ; I_CDR ; I_CONS ; 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_GET ; I_EXEC ; I_FAIL ; I_SIZE ;
I_CONCAT ; I_ADD ; I_SUB ; I_CONCAT ; I_ADD ; I_SUB ;
I_MUL ; I_EDIV ; I_OR ; I_AND ; I_XOR ; I_MUL ; I_EDIV ; I_OR ; I_AND ; I_XOR ;

View File

@ -140,25 +140,15 @@ and ('bef, 'aft) instr =
('rest, ('a list * 'rest)) instr ('rest, ('a list * 'rest)) instr
| If_cons : ('a * ('a list * 'bef), 'aft) descr * ('bef, 'aft) descr -> | If_cons : ('a * ('a list * 'bef), 'aft) descr * ('bef, 'aft) descr ->
('a list * 'bef, 'aft) instr ('a list * 'bef, 'aft) instr
| List_map : | List_map : ('a * 'rest, 'b * 'rest) descr ->
(('param, 'ret) lambda * ('param list * 'rest), 'ret list * 'rest) instr
| List_map_body : ('a * 'rest, 'b * 'rest) descr ->
('a list * 'rest, 'b list * 'rest) instr ('a list * 'rest, 'b list * 'rest) instr
| List_reduce : | List_iter : ('a * 'rest, 'rest) descr ->
(('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 ->
('a list * 'rest, 'rest) instr ('a list * 'rest, 'rest) instr
| List_size : ('a list * 'rest, n num * 'rest) instr
(* sets *) (* sets *)
| Empty_set : 'a comparable_ty -> | Empty_set : 'a comparable_ty ->
('rest, 'a set * 'rest) instr ('rest, 'a set * 'rest) instr
| Set_reduce : | Set_iter : ('a * 'rest, 'rest) descr ->
(('param * 'res, 'res) lambda *
('param set * ('res * 'rest)), 'res * 'rest) instr
| Set_iter :
('a * 'rest, 'rest) descr ->
('a set * 'rest, 'rest) instr ('a set * 'rest, 'rest) instr
| Set_mem : | Set_mem :
('elt * ('elt set * 'rest), bool * 'rest) instr ('elt * ('elt set * 'rest), bool * 'rest) instr
@ -168,13 +158,9 @@ and ('bef, 'aft) instr =
(* maps *) (* maps *)
| Empty_map : 'a comparable_ty * 'v ty -> | Empty_map : 'a comparable_ty * 'v ty ->
('rest, ('a, 'v) map * 'rest) instr ('rest, ('a, 'v) map * 'rest) instr
| Map_map : | Map_map : (('a * 'v) * 'rest, 'r * 'rest) descr ->
(('a * 'v, 'r) lambda * (('a, 'v) map * 'rest), ('a, 'r) map * 'rest) instr (('a, 'v) map * 'rest, ('a, 'r) map * 'rest) instr
| Map_reduce : | Map_iter : (('a * 'v) * 'rest, 'rest) descr ->
((('a * 'v) * 'res, 'res) lambda *
(('a, 'v) map * ('res * 'rest)), 'res * 'rest) instr
| Map_iter :
(('a * 'v) * 'rest, 'rest) descr ->
(('a, 'v) map * 'rest, 'rest) instr (('a, 'v) map * 'rest, 'rest) instr
| Map_mem : | Map_mem :
('a * (('a, 'v) map * 'rest), bool * 'rest) instr ('a * (('a, 'v) map * 'rest), bool * 'rest) instr
@ -336,12 +322,7 @@ and ('bef, 'aft) instr =
internal_operation * (Contract.t * 'rest)) instr internal_operation * (Contract.t * 'rest)) instr
| Implicit_account : | Implicit_account :
(public_key_hash * 'rest, unit typed_contract * 'rest) instr (public_key_hash * 'rest, unit typed_contract * 'rest) instr
| Create_contract : 'g ty * 'p ty -> | Create_contract : 'g ty * 'p ty * ('p * 'g, internal_operation list * 'g) lambda ->
(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 ->
(public_key_hash * (public_key_hash option * (bool * (bool * (Tez.t * ('g * 'rest))))), (public_key_hash * (public_key_hash option * (bool * (bool * (Tez.t * ('g * 'rest))))),
internal_operation * (Contract.t * 'rest)) instr internal_operation * (Contract.t * 'rest)) instr
| Set_delegate : | Set_delegate :

View File

@ -1,7 +1,6 @@
parameter (list int); parameter (list int);
storage (list int); storage (list int);
code { CAR; # Get the parameter code { CAR; # Get the parameter
LAMBDA int int { PUSH int 1; ADD }; # Create a lambda that adds 1 MAP { PUSH int 1; ADD }; # Map over the list adding one
MAP; # Map over the list
NIL operation; # No internal op NIL operation; # No internal op
PAIR } # Match the calling convetion PAIR } # Match the calling convetion

View File

@ -1,4 +1,4 @@
parameter (list string); parameter (list string);
storage (list string); storage (list string);
code{ CAR; LAMBDA string string { PUSH @hello string "Hello "; CONCAT }; code{ CAR;
MAP; NIL operation; PAIR}; MAP { PUSH @hello string "Hello "; CONCAT }; NIL operation; PAIR};

View File

@ -1,5 +1,5 @@
parameter (list string); parameter (list string);
storage string; storage string;
code {CAR; PUSH string ""; SWAP; code {CAR; PUSH string ""; SWAP;
LAMBDA (pair string string) string {DUP; CDR; DIP{CAR}; CONCAT}; ITER {SWAP; CONCAT};
REDUCE; NIL operation; PAIR}; NIL operation; PAIR};

View File

@ -1,9 +1,7 @@
parameter (pair (list string) (list string)); parameter (pair (list string) (list string));
storage (option bool); storage (option bool);
code {CAR; DUP; CAR; DIP{CDR}; EMPTY_SET string; SWAP; 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}; ITER {PAIR; DUP; CAR; DIP{CDR}; PUSH bool True; SWAP; UPDATE};
REDUCE; PUSH bool True; SWAP; PAIR; SWAP; PUSH bool True; SWAP; PAIR; SWAP;
LAMBDA (pair string (pair (set string) bool)) ITER {PAIR; DUP; DUP; CAR; DIP{CDAR; DIP{CDDR}; DUP}; MEM; DIP{SWAP}; AND; SWAP; PAIR};
(pair (set string) bool) CDR; SOME; NIL operation; PAIR};
{DUP; DUP; CAR; DIP{CDAR; DIP{CDDR}; DUP}; MEM; DIP{SWAP}; AND; SWAP; PAIR};
REDUCE; CDR; SOME; NIL operation; PAIR};

View File

@ -1,18 +1,17 @@
parameter unit; parameter unit;
storage address; storage address;
code { DROP; NIL int; # starting storage for contract 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 AMOUNT; # Push the starting balance
PUSH bool False; # Not spendable PUSH bool False; # Not spendable
DUP; # Or delegatable DUP; # Or delegatable
NONE key_hash; # No delegate NONE key_hash; # No delegate
PUSH key_hash "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"; 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 NIL operation; SWAP; CONS; PAIR} # Ending calling convention stuff

View File

@ -3,12 +3,12 @@ storage unit;
code { CAR; code { CAR;
IF_LEFT IF_LEFT
{ DIP { PUSH string "dummy"; { DIP { PUSH string "dummy";
LAMBDA (pair string string)
(pair (list operation) string)
{ CAR ; NIL operation ; PAIR };
PUSH tez "100.00" ; PUSH bool False ; PUSH tez "100.00" ; PUSH bool False ;
PUSH bool False ; NONE key_hash } ; 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 ; DIP { RIGHT key_hash ; DIP { SELF ; PUSH tez "0" } ; TRANSFER_TOKENS ;
NIL operation ; SWAP ; CONS } ; NIL operation ; SWAP ; CONS } ;
CONS ; UNIT ; SWAP ; PAIR } CONS ; UNIT ; SWAP ; PAIR }

View File

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

View File

@ -1,3 +1,3 @@
parameter (list string); parameter (list string);
storage (list string); storage (list string);
code {CAR; LAMBDA string string {}; MAP; NIL operation; PAIR} code {CAR; MAP {}; NIL operation; PAIR}

View File

@ -1,9 +1,9 @@
parameter (list int); parameter (list int);
storage (option int); storage (option int);
code {CAR; DIP{NONE int}; code {CAR; DIP{NONE int};
LAMBDA ITER {SWAP;
(pair int (option int)) IF_NONE {SOME}
(option int) {DIP {DUP}; DUP; DIP{SWAP};
{DUP; DUP; CAR; SWAP; CDR; CMPLE; IF {DROP} {DIP {DROP}};
IF_NONE {DIP{DROP}; SOME} {CMPGT; IF {CDR} {CAR; SOME}}}; SOME}};
REDUCE; NIL operation; PAIR}; NIL operation; PAIR};

View File

@ -1,7 +1,5 @@
parameter (list string); parameter (list string);
storage (list string); storage (list string);
code { CAR; NIL string; SWAP; code { CAR; NIL string; SWAP;
LAMBDA (pair string (list string)) ITER {CONS};
(list string) NIL operation; PAIR};
{DUP; CAR; DIP{CDR}; CONS};
REDUCE; NIL operation; PAIR};

View File

@ -8,14 +8,14 @@ code { DUP;
IF { PUSH bool False} # End the loop 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 nat 1; SWAP; SUB; ABS; # Subtract 1. The ABS is to make it back into a nat
PUSH string "init"; # Storage type 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 tez "5.00"; # Strating balance
PUSH bool False; DUP; # Not spendable or delegatable PUSH bool False; DUP; # Not spendable or delegatable
NONE key_hash; NONE key_hash;
PUSH key_hash "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"; 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 } } ; # emit the operation
SWAP ; DIP { SWAP ; DIP { CONS } } ; # add to the list SWAP ; DIP { SWAP ; DIP { CONS } } ; # add to the list
PUSH bool True}}; # Continue the loop PUSH bool True}}; # Continue the loop