merge operations syntax for map with big_map
This commit is contained in:
parent
e930dc00c4
commit
1c281ac079
@ -139,12 +139,13 @@ let get_t_record (t:type_value) : type_value SMap.t result = match t.type_value'
|
||||
let get_t_map (t:type_value) : (type_value * type_value) result =
|
||||
match t.type_value' with
|
||||
| T_constant ("map", [k;v]) -> ok (k, v)
|
||||
| _ -> simple_fail "get: not a map"
|
||||
|
||||
let get_t_big_map (t:type_value) : (type_value * type_value) result =
|
||||
match t.type_value' with
|
||||
| T_constant ("big_map", [k;v]) -> ok (k, v)
|
||||
| _ -> simple_fail "get: not a big_map"
|
||||
| _ -> simple_fail "get: not a map or a big_map"
|
||||
|
||||
let get_t_map_not_big_map (t:type_value) : (type_value * type_value) result =
|
||||
match t.type_value' with
|
||||
| T_constant ("map", [k;v]) -> ok (k, v)
|
||||
| _ -> simple_fail "get: not a map"
|
||||
|
||||
let get_t_map_key : type_value -> type_value result = fun t ->
|
||||
let%bind (key , _) = get_t_map t in
|
||||
@ -158,8 +159,7 @@ let assert_t_map = fun t ->
|
||||
let%bind _ = get_t_map t in
|
||||
ok ()
|
||||
|
||||
let is_t_map = Function.compose to_bool get_t_map
|
||||
let is_t_big_map = Function.compose to_bool get_t_big_map
|
||||
let is_t_map_not_big_map = Function.compose to_bool get_t_map_not_big_map
|
||||
|
||||
let assert_t_tez : type_value -> unit result = get_t_tez
|
||||
let assert_t_key = get_t_key
|
||||
|
@ -88,6 +88,7 @@ let get_t_or (t:type_value) = match t with
|
||||
|
||||
let get_t_map (t:type_value) = match t with
|
||||
| T_map kv -> ok kv
|
||||
| T_big_map kv -> ok kv
|
||||
| _ -> simple_fail "not a type map"
|
||||
|
||||
let get_t_list (t:type_value) = match t with
|
||||
|
@ -268,20 +268,20 @@ module Typer = struct
|
||||
ok @@ t_option dst ()
|
||||
|
||||
let map_iter : typer = typer_2 "MAP_ITER" @@ fun m f ->
|
||||
let%bind (k, v) = get_t_map m in
|
||||
let%bind (k, v) = get_t_map_not_big_map m in
|
||||
let%bind (arg , res) = get_t_function f in
|
||||
let%bind () = assert_eq_1 arg (t_pair k v ()) in
|
||||
let%bind () = assert_eq_1 res (t_unit ()) in
|
||||
ok @@ t_unit ()
|
||||
|
||||
let map_map : typer = typer_2 "MAP_MAP" @@ fun m f ->
|
||||
let%bind (k, v) = get_t_map m in
|
||||
let%bind (k, v) = get_t_map_not_big_map m in
|
||||
let%bind (arg , res) = get_t_function f in
|
||||
let%bind () = assert_eq_1 arg (t_pair k v ()) in
|
||||
ok @@ t_map k res ()
|
||||
|
||||
let map_fold : typer = typer_2 "MAP_FOLD" @@ fun f m ->
|
||||
let%bind (k, v) = get_t_map m in
|
||||
let%bind (k, v) = get_t_map_not_big_map m in
|
||||
let%bind (arg_1 , res) = get_t_function f in
|
||||
let%bind (arg_2 , res') = get_t_function res in
|
||||
let%bind (arg_3 , res'') = get_t_function res' in
|
||||
@ -290,39 +290,10 @@ module Typer = struct
|
||||
let%bind () = assert_eq_1 arg_3 res'' in
|
||||
ok @@ res'
|
||||
|
||||
let big_map_remove : typer = typer_2 "BIG_MAP_REMOVE" @@ fun k m ->
|
||||
let%bind (src , _) = get_t_big_map m in
|
||||
let%bind () = assert_type_value_eq (src , k) in
|
||||
ok m
|
||||
|
||||
let big_map_add : typer = typer_3 "BIG_MAP_ADD" @@ fun k v m ->
|
||||
let%bind (src, dst) = get_t_big_map m in
|
||||
let%bind () = assert_type_value_eq (src, k) in
|
||||
let%bind () = assert_type_value_eq (dst, v) in
|
||||
ok m
|
||||
|
||||
let big_map_update : typer = typer_3 "BIG_MAP_UPDATE" @@ fun k v m ->
|
||||
let%bind (src, dst) = get_t_big_map m in
|
||||
let%bind () = assert_type_value_eq (src, k) in
|
||||
let%bind v' = get_t_option v in
|
||||
let%bind () = assert_type_value_eq (dst, v') in
|
||||
ok m
|
||||
|
||||
let big_map_mem : typer = typer_2 "BIG_MAP_MEM" @@ fun k m ->
|
||||
let%bind (src, _dst) = get_t_big_map m in
|
||||
let%bind () = assert_type_value_eq (src, k) in
|
||||
ok @@ t_bool ()
|
||||
|
||||
let big_map_find : typer = typer_2 "BIG_MAP_FIND" @@ fun k m ->
|
||||
let%bind (src, dst) = get_t_big_map m in
|
||||
let%bind () = assert_type_value_eq (src, k) in
|
||||
ok @@ dst
|
||||
|
||||
|
||||
let size = typer_1 "SIZE" @@ fun t ->
|
||||
let%bind () =
|
||||
Assert.assert_true @@
|
||||
(is_t_map t || is_t_list t || is_t_string t || is_t_bytes t || is_t_set t || is_t_big_map t) in
|
||||
(is_t_map_not_big_map t || is_t_list t || is_t_string t || is_t_bytes t || is_t_set t) in
|
||||
ok @@ t_nat ()
|
||||
|
||||
let slice = typer_3 "SLICE" @@ fun i j s ->
|
||||
@ -592,11 +563,6 @@ module Typer = struct
|
||||
map_map ;
|
||||
map_fold ;
|
||||
map_iter ;
|
||||
big_map_remove ;
|
||||
big_map_add ;
|
||||
big_map_update ;
|
||||
big_map_mem ;
|
||||
big_map_find ;
|
||||
set_empty ;
|
||||
set_mem ;
|
||||
set_add ;
|
||||
|
@ -614,7 +614,7 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a
|
||||
return (E_application (f' , arg)) tv
|
||||
| E_look_up dsi ->
|
||||
let%bind (ds, ind) = bind_map_pair (type_expression e) dsi in
|
||||
let%bind (src, dst) = bind_map_or (get_t_map , get_t_big_map) ds.type_annotation in
|
||||
let%bind (src, dst) = get_t_map ds.type_annotation in
|
||||
let%bind _ = O.assert_type_value_eq (ind.type_annotation, src) in
|
||||
return (E_look_up (ds , ind)) (t_option dst ())
|
||||
(* Advanced *)
|
||||
|
Loading…
Reference in New Issue
Block a user