Commit a425b3dc authored by Benjamin Canou's avatar Benjamin Canou Committed by Grégoire Henry

Michelson: cleanup iterator opcodes

parent c57458ea
......@@ -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
......
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
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}
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};
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};
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};
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
......@@ -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 }
......
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 } };
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 }
parameter (list string);
storage (list string);
code {CAR; LAMBDA string string {}; MAP; NIL operation; PAIR}
code {CAR; MAP {}; NIL operation; PAIR}
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,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
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,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
......
......@@ -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
......@@ -227,7 +227,6 @@ module Script : sig
| I_OR
| I_PAIR
| I_PUSH
| I_REDUCE
| I_RIGHT
| I_SIZE
| I_SOME
......
......@@ -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) ;
......
......@@ -77,7 +77,6 @@ type prim =
| I_OR
| I_PAIR
| I_PUSH
| I_REDUCE
| I_RIGHT
| I_SIZE
| I_SOME
......
......@@ -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 ->
......
......@@ -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),