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

Michelson: cleanup iterator opcodes

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
docs/whitedoc/michelson.rst
View File

@ -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 ; <tl> } : S => { x ; hd ; <tl> } : 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 : <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.
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 ; <tl> } : S => opt_y : S
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
iff COMPARE / x : k : [] => 0 : []
> 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 : opt_y : { Elt k v ; <tl> } : S => { Elt k v ; <tl'> } : S
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
iff COMPARE / x : k : [] => 0 : []
> 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
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
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
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.
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 / {} : 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.
The body sequence has access to the stack.
@ -1210,19 +1162,6 @@ Operations on lists
where MAP body / { <rest> } : S => { <rest'> } : 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.
::
@ -2439,9 +2378,7 @@ XII - Full grammar
| IF_CONS { <instruction> ... } { <instruction> ... }
| EMPTY_SET <type>
| EMPTY_MAP <comparable type> <type>
| MAP
| MAP { <instruction> ... }
| REDUCE
| ITER { <instruction> ... }
| MEM
| GET

3
src/bin_client/test/contracts/add1_list.tz
View File

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

17
src/bin_client/test/contracts/append.tz
View File

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

4
src/bin_client/test/contracts/concat_hello.tz
View File

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

4
src/bin_client/test/contracts/concat_list.tz
View File

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

10
src/bin_client/test/contracts/contains_all.tz
View File

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

17
src/bin_client/test/contracts/create_add1_lists.tz
View File

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

8
src/bin_client/test/contracts/create_contract.tz
View File

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

18
src/bin_client/test/contracts/create_contract_literal.tz
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 } };

41
src/bin_client/test/contracts/insertion_sort.tz
View File

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

2
src/bin_client/test/contracts/list_id_map.tz
View File

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

12
src/bin_client/test/contracts/max_in_list.tz
View File

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

19
src/bin_client/test/contracts/reduce_map.tz
View File

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

6
src/bin_client/test/contracts/reverse.tz
View File

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

8
src/bin_client/test/contracts/spawn_identities.tz
View File

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

15
src/bin_client/test/contracts/subset.tz
View File

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

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

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

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

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

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

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

117
src/proto_alpha/lib_protocol/src/script_interpreter.ml
View File

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

91
src/proto_alpha/lib_protocol/src/script_ir_translator.ml
View File

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

35
src/proto_alpha/lib_protocol/src/script_typed_ir.ml
View File

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

3
src/proto_alpha/lib_protocol/test/contracts/add1_list.tz
View File

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

4
src/proto_alpha/lib_protocol/test/contracts/concat_hello.tz
View File

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

4
src/proto_alpha/lib_protocol/test/contracts/concat_list.tz
View File

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

10
src/proto_alpha/lib_protocol/test/contracts/contains_all.tz
View File

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

17
src/proto_alpha/lib_protocol/test/contracts/create_add1_lists.tz
View File

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

8
src/proto_alpha/lib_protocol/test/contracts/create_contract.tz
View File

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

18
src/proto_alpha/lib_protocol/test/contracts/create_contract_literal.tz
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 } };

2
src/proto_alpha/lib_protocol/test/contracts/list_id_map.tz
View File

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

12
src/proto_alpha/lib_protocol/test/contracts/max_in_list.tz
View File

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

6
src/proto_alpha/lib_protocol/test/contracts/reverse.tz
View File

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

8
src/proto_alpha/lib_protocol/test/contracts/spawn_identities.tz
View File

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