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

Michelson: adds SIZE for sets and maps

Browse Source
This commit is contained in:
Milo Davis 2017-08-03 17:21:43 +02:00 committed by Grégoire Henry
parent 13c147016f
commit 62a10de372
8 changed files with 59 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
src/proto/alpha/docs/language.md
View File

@ -768,6 +768,11 @@ constants as is, concatenate them and use them as keys.
:: lambda (pair 'elt * 'b) 'b : set 'elt : 'b : 'S -> 'b : 'S
* `SIZE`:
Get the cardinality of the set.
:: set 'elt : 'S -> nat : 'S
### Operations on maps
* `EMPTY_MAP 'key 'val`:
@ -806,6 +811,11 @@ constants as is, concatenate them and use them as keys.
:: lambda (pair (pair 'key 'val) 'b) 'b : map 'key 'val : 'b : 'S -> 'b : 'S
* `SIZE`:
Get the cardinality of the map.
:: map 'key 'val : 'S -> nat : 'S
### Operations on optional values
* `SOME`:
@ -832,6 +842,7 @@ constants as is, concatenate them and use them as keys.
> IF_NONE ; C / (None) : S => bt ; C / S
> IF_NONE ; C / (Some a) : S => bf ; C / a : S
### Operations on unions
* `LEFT 'b`:

4
src/proto/alpha/script_interpreter.ml
View File

@ -190,6 +190,8 @@ let rec interp
logged_return (Item (set_mem v set, rest), qta - 1, ctxt)
| Set_update, Item (v, Item (presence, Item (set, rest))) ->
logged_return (Item (set_update v presence set, rest), qta - 1, ctxt)
| Set_size, Item (set, rest) ->
logged_return (Item (set_size set, rest), qta - 1, ctxt)
(* maps *)
| Empty_map (t, _), rest ->
logged_return (Item (empty_map t, rest), qta - 1, ctxt)
@ -219,6 +221,8 @@ let rec interp
logged_return (Item (map_get v map, rest), qta - 1, ctxt)
| Map_update, Item (k, Item (v, Item (map, rest))) ->
logged_return (Item (map_update k v map, rest), qta - 1, ctxt)
| Map_size, Item (map, rest) ->
logged_return (Item (map_size map, rest), qta - 1, ctxt)
(* timestamp operations *)
| Add_seconds_to_timestamp, Item (n, Item (t, rest)) ->
begin match Script_int.to_int64 n with

20
src/proto/alpha/script_ir_translator.ml
View File

@ -169,6 +169,11 @@ let set_fold
= fun f (module Box) ->
Box.OPS.fold f Box.boxed
let set_size
: type elt. elt set -> Script_int.n Script_int.num =
fun (module Box) ->
Script_int.(abs (of_int (Box.OPS.cardinal Box.boxed)))
let map_key_ty
: type a b. (a, b) map -> a comparable_ty
= fun (module Box) -> Box.key_ty
@ -217,6 +222,11 @@ let map_fold
= fun f (module Box) ->
Box.OPS.fold f Box.boxed
let map_size
: type key value. (key, value) map -> Script_int.n Script_int.num =
fun (module Box) ->
Script_int.(abs (of_int (Box.OPS.cardinal Box.boxed)))
(* ---- Unparsing (Typed IR -> Untyped epressions) --------------------------*)
let ty_of_comparable_ty
@ -927,6 +937,9 @@ and parse_instr
let ty = ty_of_comparable_ty elt in
check_item_ty ty v loc "UPDATE" 1 3 >>=? fun (Eq _) ->
return (typed loc (Set_update, Item_t (Set_t elt, rest)))
| Prim (loc, "SIZE", []),
Item_t (Set_t _, rest) ->
return (typed loc (Set_size, Item_t (Nat_t, rest)))
(* maps *)
| Prim (loc, "EMPTY_MAP", [ tk ; tv ]),
stack ->
@ -964,6 +977,9 @@ and parse_instr
check_item_ty vk k loc "UPDATE" 1 3 >>=? fun (Eq _) ->
check_item_ty vv v loc "UPDATE" 2 3 >>=? fun (Eq _) ->
return (typed loc (Map_update, Item_t (Map_t (ck, v), rest)))
| Prim (loc, "SIZE", []),
Item_t (Map_t (_, _), rest) ->
return (typed loc (Map_size, Item_t (Nat_t, rest)))
(* control *)
| Seq (loc, []),
stack ->
@ -1275,7 +1291,7 @@ and parse_instr
| Prim (loc, ("DROP" | "DUP" | "SWAP" | "SOME" | "UNIT"
| "PAIR" | "CAR" | "CDR" | "CONS"
| "MEM" | "UPDATE" | "MAP" | "REDUCE"
| "GET" | "EXEC" | "FAIL"
| "GET" | "EXEC" | "FAIL" | "SIZE"
| "CONCAT" | "ADD" | "SUB"
| "MUL" | "EDIV" | "OR" | "AND" | "XOR"
| "NOT"
@ -1343,7 +1359,7 @@ and parse_instr
[ "DROP" ; "DUP" ; "SWAP" ; "SOME" ; "UNIT" ;
"PAIR" ; "CAR" ; "CDR" ; "CONS" ;
"MEM" ; "UPDATE" ; "MAP" ; "REDUCE" ;
"GET" ; "EXEC" ; "FAIL" ;
"GET" ; "EXEC" ; "FAIL" ; "SIZE" ;
"CONCAT" ; "ADD" ; "SUB" ;
"MUL" ; "EDIV" ; "OR" ; "AND" ; "XOR" ;
"NOT" ;

2
src/proto/alpha/script_ir_translator.mli
View File

@ -64,6 +64,7 @@ val set_fold :
'elt Script_typed_ir.set -> 'acc -> 'acc
val set_update : 'a -> bool -> 'a Script_typed_ir.set -> 'a Script_typed_ir.set
val set_mem : 'elt -> 'elt Script_typed_ir.set -> bool
val set_size : 'elt Script_typed_ir.set -> Script_int.n Script_int.num
val empty_map : 'a Script_typed_ir.comparable_ty -> ('a, 'b) Script_typed_ir.map
val map_fold :
@ -74,6 +75,7 @@ val map_update :
val map_mem : 'key -> ('key, 'value) Script_typed_ir.map -> bool
val map_get : 'key -> ('key, 'value) Script_typed_ir.map -> 'value option
val map_key_ty : ('a, 'b) Script_typed_ir.map -> 'a Script_typed_ir.comparable_ty
val map_size : ('a, 'b) Script_typed_ir.map -> Script_int.n Script_int.num
val ty_eq :
'ta Script_typed_ir.ty -> 'tb Script_typed_ir.ty ->

2
src/proto/alpha/script_typed_ir.ml
View File

@ -146,6 +146,7 @@ and ('bef, 'aft) instr =
('elt * ('elt set * 'rest), bool * 'rest) instr
| Set_update :
('elt * (bool * ('elt set * 'rest)), 'elt set * 'rest) instr
| Set_size : ('a set * 'rest, n num * 'rest) instr
(* maps *)
| Empty_map : 'a comparable_ty * 'v ty ->
('rest, ('a, 'v) map * 'rest) instr
@ -160,6 +161,7 @@ and ('bef, 'aft) instr =
('a * (('a, 'v) map * 'rest), 'v option * 'rest) instr
| Map_update :
('a * ('v option * (('a, 'v) map * 'rest)), ('a, 'v) map * 'rest) instr
| Map_size : (('a, 'b) map * 'rest, n num * 'rest) instr
(* string operations *)
| Concat :
(string * (string * 'rest), string * 'rest) instr

4
test/contracts/map_size.tz Normal file
View File

@ -0,0 +1,4 @@
parameter (map string nat);
return nat;
storage unit;
code {CAR; SIZE; UNIT; SWAP; PAIR}

4
test/contracts/set_size.tz Normal file
View File

@ -0,0 +1,4 @@
parameter (set int);
storage unit;
return nat;
code {CAR; SIZE; UNIT; SWAP; PAIR}

14
test/test_contracts.sh
View File

@ -102,6 +102,20 @@ assert_output $CONTRACT_PATH/set_member.tz '(Set)' '"Hi"' 'False'
assert_output $CONTRACT_PATH/set_member.tz '(Set "Hi")' '"Hi"' 'True'
assert_output $CONTRACT_PATH/set_member.tz '(Set "Hello" "World")' '""' 'False'
# Set size
assert_output $CONTRACT_PATH/set_size.tz Unit '(Set)' 0
assert_output $CONTRACT_PATH/set_size.tz Unit '(Set 1)' 1
assert_output $CONTRACT_PATH/set_size.tz Unit '(Set 1 2 3)' 3
assert_output $CONTRACT_PATH/set_size.tz Unit '(Set 1 2 3 4 5 6)' 6
# Map size
assert_output $CONTRACT_PATH/map_size.tz Unit '(Map)' 0
assert_output $CONTRACT_PATH/map_size.tz Unit '(Map (Item "a" 1))' 1
assert_output $CONTRACT_PATH/map_size.tz Unit \
'(Map (Item "a" 1) (Item "b" 2) (Item "c" 3))' 3
assert_output $CONTRACT_PATH/map_size.tz Unit \
'(Map (Item "a" 1) (Item "b" 2) (Item "c" 3) (Item "d" 4) (Item "e" 5) (Item "f" 6))' 6
# Contains all elements -- does the second list contain all of the same elements
# as the first one? I'm ignoring element multiplicity
assert_output $CONTRACT_PATH/contains_all.tz \