From 1c281ac079e1a4f44cbad8e27d33743e6d46f6a7 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Thu, 5 Sep 2019 13:06:48 +0200 Subject: [PATCH] merge operations syntax for map with big_map --- src/ast_typed/combinators.ml | 14 ++++++------ src/mini_c/combinators.ml | 1 + src/operators/operators.ml | 42 ++++-------------------------------- src/typer/typer.ml | 2 +- 4 files changed, 13 insertions(+), 46 deletions(-) diff --git a/src/ast_typed/combinators.ml b/src/ast_typed/combinators.ml index ec745fabc..f402d253b 100644 --- a/src/ast_typed/combinators.ml +++ b/src/ast_typed/combinators.ml @@ -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 diff --git a/src/mini_c/combinators.ml b/src/mini_c/combinators.ml index f7342987e..5cc9d2ae4 100644 --- a/src/mini_c/combinators.ml +++ b/src/mini_c/combinators.ml @@ -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 diff --git a/src/operators/operators.ml b/src/operators/operators.ml index d08a535eb..3db1919f1 100644 --- a/src/operators/operators.ml +++ b/src/operators/operators.ml @@ -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 ; diff --git a/src/typer/typer.ml b/src/typer/typer.ml index 6262f3971..5c962cc10 100644 --- a/src/typer/typer.ml +++ b/src/typer/typer.ml @@ -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 *)