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

Michelson: change semantics of CONCAT

Browse Source
This commit is contained in:
Benjamin Canou 2018-06-18 13:24:16 +02:00 committed by Grégoire Henry
parent bd709a44ba
commit c691068209
11 changed files with 36 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
src/bin_client/test/contracts/concat.tz
View File

@ -1,8 +1,7 @@
parameter string;
storage string;
code {DUP; # We're going to need both the storage and parameter
CAR; # Get the parameter
DIP{CDR}; # Get the storage value
SWAP; # Get the order we want (this is optional)
CONCAT; # Concatenate the strings
NIL operation; PAIR} # Match the calling convention
code { DUP;
DIP { CDR ; NIL string ; SWAP ; CONS } ;
CAR ; CONS ;
CONCAT;
NIL operation; PAIR}

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

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

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

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

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

@ -1,5 +1,7 @@
parameter string;
storage string;
code {CAR;
LAMBDA string string {PUSH string "_abc"; SWAP; CONCAT};
LAMBDA string string
{PUSH string "_abc"; NIL string ;
SWAP ; CONS ; SWAP ; CONS ; CONCAT};
SWAP; EXEC; NIL operation; PAIR};

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

@ -1,5 +1,3 @@
parameter (list string);
storage string;
code { CAR; PUSH string ""; SWAP;
ITER { CONCAT };
NIL operation; PAIR}
code { UNPAIR ; SWAP ; CONS ; CONCAT; NIL operation; PAIR}

4
src/bin_client/test/test_contracts.sh
View File

@ -114,8 +114,8 @@ assert_storage $contract_dir/list_map_block.tz '{0}' '{ 1 ; 2 ; 3 ; 0 }' '{ 1 ;
assert_storage $contract_dir/list_iter.tz 0 '{ 10 ; 2 ; 1 }' 20
assert_storage $contract_dir/list_iter.tz 0 '{ 3 ; 6 ; 9 }' 162
assert_storage $contract_dir/list_iter2.tz '"?"' '{ "a" ; "b" ; "c" }' '"cba"'
assert_storage $contract_dir/list_iter2.tz '"?"' '{}' '""'
assert_storage $contract_dir/list_iter2.tz '"abc"' '{ "d" ; "e" ; "f" }' '"abcdef"'
assert_storage $contract_dir/list_iter2.tz '"abc"' '{}' '"abc"'
# Identity on sets

9
src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml
View File

@ -53,8 +53,13 @@ module Cost_of = struct
let zint z =
alloc_bits_cost (Z.numbits z)
let concat s1 s2 =
string (String.length s1 + String.length s2)
let concat cost length ss =
let rec cum acc = function
| [] -> acc
| s :: ss -> cum (cost (length s) +@ acc) ss in
cum free ss
let concat_string ss = concat string String.length ss
(* Cost per cycle of a loop, fold, etc *)
let loop_cycle = step_cost 2

2
src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli
View File

@ -38,7 +38,7 @@ module Cost_of : sig
val cons : Gas.cost
val variant_no_data : Gas.cost
val branch : Gas.cost
val concat : string -> string -> Gas.cost
val concat_string : string list -> Gas.cost
val map_mem :
'a -> ('b, 'c) Script_typed_ir.map -> Gas.cost
val map_to_list :

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

@ -415,8 +415,10 @@ let rec interp
consume_gas_binop descr (Script_timestamp.diff, t1, t2)
Interp_costs.diff_timestamps rest ctxt
(* string operations *)
| Concat, Item (x, Item (y, rest)) ->
consume_gas_binop descr ((^), x, y) Interp_costs.concat rest ctxt
| Concat, Item (ss, rest) ->
Lwt.return (Gas.consume ctxt (Interp_costs.concat_string ss)) >>=? fun ctxt ->
let s = String.concat "" ss in
logged_return (Item (s, rest), ctxt)
(* currency operations *)
| Add_tez, Item (x, Item (y, rest)) ->
Lwt.return (Gas.consume ctxt Interp_costs.int64_op) >>=? fun ctxt ->

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

@ -2111,9 +2111,8 @@ and parse_instr
(Item_t (Int_t tname, rest, annot))
(* string operations *)
| Prim (loc, I_CONCAT, [], annot),
Item_t (String_t tn1, Item_t (String_t tn2, rest, _), _) ->
parse_var_annot loc annot >>=? fun annot ->
Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
Item_t (List_t (String_t tname, _), rest, list_annot) ->
parse_var_annot ~default:list_annot loc annot >>=? fun annot ->
typed ctxt loc Concat
(Item_t (String_t tname, rest, annot))
(* currency operations *)
@ -2611,10 +2610,10 @@ and parse_instr
get_toplevel_type tc_context
(* Primitive parsing errors *)
| 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_CONCAT
| I_MEM | I_UPDATE | I_MAP
| I_GET | I_EXEC | I_FAILWITH | I_SIZE
| I_CONCAT | I_ADD | I_SUB
| I_ADD | I_SUB
| I_MUL | I_EDIV | I_OR | I_AND | I_XOR
| I_NOT
| I_ABS | I_NEG | I_LSL | I_LSR
@ -2643,12 +2642,12 @@ and parse_instr
(* Stack errors *)
| Prim (loc, (I_ADD | I_SUB | I_MUL | I_EDIV
| I_AND | I_OR | I_XOR | I_LSL | I_LSR
| I_CONCAT | I_COMPARE as name), [], _),
| I_COMPARE as name), [], _),
Item_t (ta, Item_t (tb, _, _), _) ->
Lwt.return @@ serialize_ty_for_error ctxt ta >>=? fun (ta, ctxt) ->
Lwt.return @@ serialize_ty_for_error ctxt tb >>=? fun (tb, _ctxt) ->
fail (Undefined_binop (loc, name, ta, tb))
| Prim (loc, (I_NEG | I_ABS | I_NOT
| Prim (loc, (I_NEG | I_ABS | I_NOT | I_CONCAT
| I_EQ | I_NEQ | I_LT | I_GT | I_LE | I_GE as name),
[], _),
Item_t (t, _, _) ->
@ -2683,7 +2682,7 @@ and parse_instr
| I_GET | I_MEM | I_EXEC
| I_CHECK_SIGNATURE | I_ADD | I_SUB | I_MUL
| I_EDIV | I_AND | I_OR | I_XOR
| I_LSL | I_LSR | I_CONCAT as name), _, _),
| I_LSL | I_LSR as name), _, _),
stack ->
serialize_stack_for_error ctxt stack >>=? fun (stack, _ctxt) ->
fail (Bad_stack (loc, name, 2, stack))

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

@ -203,7 +203,7 @@ and ('bef, 'aft) instr =
('key * ('value option * (('key, 'value) big_map * 'rest)), ('key, 'value) big_map * 'rest) instr
(* string operations *)
| Concat :
(string * (string * 'rest), string * 'rest) instr
(string list * 'rest, string * 'rest) instr
(* timestamp operations *)
| Add_seconds_to_timestamp :
(z num * (Script_timestamp.t * 'rest),