diff --git a/src/ast_simplified/PP.ml b/src/ast_simplified/PP.ml index 07277c664..4ab2bdde8 100644 --- a/src/ast_simplified/PP.ml +++ b/src/ast_simplified/PP.ml @@ -41,6 +41,7 @@ let rec expression ppf (e:expression) = match Location.unwrap e with | E_accessor (ae, p) -> fprintf ppf "%a.%a" expression ae access_path p | E_record m -> fprintf ppf "record[%a]" (smap_sep_d expression) m | E_map m -> fprintf ppf "map[%a]" (list_sep_d assoc_expression) m + | E_big_map m -> fprintf ppf "big_map[%a]" (list_sep_d assoc_expression) m | E_list lst -> fprintf ppf "list[%a]" (list_sep_d expression) lst | E_set lst -> fprintf ppf "set[%a]" (list_sep_d expression) lst | E_look_up (ds, ind) -> fprintf ppf "(%a)[%a]" expression ds expression ind diff --git a/src/ast_simplified/combinators.ml b/src/ast_simplified/combinators.ml index 622e1039c..4680056e5 100644 --- a/src/ast_simplified/combinators.ml +++ b/src/ast_simplified/combinators.ml @@ -43,6 +43,7 @@ let ez_t_sum (lst:(string * type_expression) list) : type_expression = let t_function param result : type_expression = T_function (param, result) let t_map key value = (T_constant ("map", [key ; value])) +let t_big_map key value = (T_constant ("big_map", [key ; value])) let t_set key = (T_constant ("set", [key])) let make_name (s : string) : name = s @@ -66,6 +67,7 @@ let e_some ?loc s : expression = Location.wrap ?loc @@ E_constant ("SOME", [s]) let e_none ?loc () : expression = Location.wrap ?loc @@ E_constant ("NONE", []) let e_map_add ?loc k v old : expression = Location.wrap ?loc @@ E_constant ("MAP_ADD" , [k ; v ; old]) let e_map ?loc lst : expression = Location.wrap ?loc @@ E_map lst +let e_big_map ?loc lst : expression = Location.wrap ?loc @@ E_big_map lst let e_set ?loc lst : expression = Location.wrap ?loc @@ E_set lst let e_list ?loc lst : expression = Location.wrap ?loc @@ E_list lst let e_pair ?loc a b : expression = Location.wrap ?loc @@ E_tuple [a; b] @@ -106,6 +108,7 @@ let e_typed_list ?loc lst t = e_annotation ?loc (e_list lst) (t_list t) let e_typed_map ?loc lst k v = e_annotation ?loc (e_map lst) (t_map k v) +let e_typed_big_map ?loc lst k v = e_annotation ?loc (e_big_map lst) (t_big_map k v) let e_typed_set ?loc lst k = e_annotation ?loc (e_set lst) (t_set k) diff --git a/src/ast_simplified/misc.ml b/src/ast_simplified/misc.ml index e1582b073..5dd52417b 100644 --- a/src/ast_simplified/misc.ml +++ b/src/ast_simplified/misc.ml @@ -120,7 +120,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result = | E_record _, _ -> simple_fail "comparing record with other stuff" - | E_map lsta, E_map lstb -> ( + | (E_map lsta, E_map lstb | E_big_map lsta, E_big_map lstb) -> ( let%bind lst = generic_try (simple_error "maps of different lengths") (fun () -> let lsta' = List.sort compare lsta in @@ -133,7 +133,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result = let%bind _all = bind_map_list aux lst in ok () ) - | E_map _, _ -> + | (E_map _ | E_big_map _), _ -> simple_fail "comparing map with other stuff" | E_list lsta, E_list lstb -> ( diff --git a/src/ast_simplified/types.ml b/src/ast_simplified/types.ml index 88b93beda..1e8104a79 100644 --- a/src/ast_simplified/types.ml +++ b/src/ast_simplified/types.ml @@ -59,6 +59,7 @@ and expression' = | E_accessor of (expr * access_path) (* Data Structures *) | E_map of (expr * expr) list + | E_big_map of (expr * expr) list | E_list of expr list | E_set of expr list | E_look_up of (expr * expr) diff --git a/src/ast_typed/PP.ml b/src/ast_typed/PP.ml index 3e8edf30c..141cc768a 100644 --- a/src/ast_typed/PP.ml +++ b/src/ast_typed/PP.ml @@ -42,6 +42,7 @@ and expression ppf (e:expression) : unit = | E_tuple lst -> fprintf ppf "tuple[@; @[%a@]@;]" (list_sep annotated_expression (tag ",@;")) lst | E_record m -> fprintf ppf "record[%a]" (smap_sep_d annotated_expression) m | E_map m -> fprintf ppf "map[@; @[%a@]@;]" (list_sep assoc_annotated_expression (tag ",@;")) m + | E_big_map m -> fprintf ppf "big_map[@; @[%a@]@;]" (list_sep assoc_annotated_expression (tag ",@;")) m | E_list m -> fprintf ppf "list[@; @[%a@]@;]" (list_sep annotated_expression (tag ",@;")) m | E_set m -> fprintf ppf "set[@; @[%a@]@;]" (list_sep annotated_expression (tag ",@;")) m | E_look_up (ds, i) -> fprintf ppf "(%a)[%a]" annotated_expression ds annotated_expression i diff --git a/src/ast_typed/combinators.ml b/src/ast_typed/combinators.ml index f402d253b..78aa8a4a6 100644 --- a/src/ast_typed/combinators.ml +++ b/src/ast_typed/combinators.ml @@ -41,6 +41,7 @@ let ez_t_record lst ?s () : type_value = t_record m ?s () let t_map key value ?s () = make_t (T_constant ("map", [key ; value])) s +let t_big_map key value ?s () = make_t (T_constant ("big_map", [key ; value])) s let t_sum m ?s () : type_value = make_t (T_sum m) s let make_t_ez_sum (lst:(string * type_value) list) : type_value = diff --git a/src/ast_typed/misc.ml b/src/ast_typed/misc.ml index 091531789..8ea8c1bba 100644 --- a/src/ast_typed/misc.ml +++ b/src/ast_typed/misc.ml @@ -156,7 +156,7 @@ module Free_variables = struct | E_tuple_accessor (a, _) -> self a | E_list lst -> unions @@ List.map self lst | E_set lst -> unions @@ List.map self lst - | E_map m -> unions @@ List.map self @@ List.concat @@ List.map (fun (a, b) -> [ a ; b ]) m + | (E_map m | E_big_map m) -> unions @@ List.map self @@ List.concat @@ List.map (fun (a, b) -> [ a ; b ]) m | E_look_up (a , b) -> unions @@ List.map self [ a ; b ] | E_matching (a , cs) -> union (self a) (matching_expression b cs) | E_failwith a -> self a @@ -422,7 +422,7 @@ let rec assert_value_eq (a, b: (value*value)) : unit result = | E_record _, _ -> fail @@ (different_values_because_different_types "record vs. non-record" a b) - | E_map lsta, E_map lstb -> ( + | (E_map lsta, E_map lstb | E_big_map lsta, E_big_map lstb) -> ( let%bind lst = generic_try (different_size_values "maps of different lengths" a b) (fun () -> let lsta' = List.sort compare lsta in @@ -435,7 +435,7 @@ let rec assert_value_eq (a, b: (value*value)) : unit result = let%bind _all = bind_map_list aux lst in ok () ) - | E_map _, _ -> + | (E_map _ | E_big_map _), _ -> fail @@ different_values_because_different_types "map vs. non-map" a b | E_list lsta, E_list lstb -> ( diff --git a/src/ast_typed/misc_smart.ml b/src/ast_typed/misc_smart.ml index 0d0e8cd02..8ff87c9f6 100644 --- a/src/ast_typed/misc_smart.ml +++ b/src/ast_typed/misc_smart.ml @@ -80,7 +80,7 @@ module Captured_variables = struct | E_set lst -> let%bind lst' = bind_map_list self lst in ok @@ unions lst' - | E_map m -> + | (E_map m | E_big_map m) -> let%bind lst' = bind_map_list self @@ List.concat @@ List.map (fun (a, b) -> [ a ; b ]) m in ok @@ unions lst' | E_look_up (a , b) -> diff --git a/src/ast_typed/types.ml b/src/ast_typed/types.ml index cf8c40fec..a56843eca 100644 --- a/src/ast_typed/types.ml +++ b/src/ast_typed/types.ml @@ -99,6 +99,7 @@ and expression = | E_record_accessor of (ae * string) (* Data Structures *) | E_map of (ae * ae) list + | E_big_map of (ae * ae) list | E_list of ae list | E_set of ae list | E_look_up of (ae * ae) diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index dccd6470a..c08a18d55 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -397,7 +397,7 @@ let big_map () : unit result = let ez lst = let open Ast_simplified.Combinators in let lst' = List.map (fun (x, y) -> e_int x, e_int y) lst in - e_pair (e_typed_map lst' t_int t_int) (e_unit ()) + e_pair (e_typed_big_map lst' t_int t_int) (e_unit ()) in let%bind () = let make_input = fun n -> ez [(23, n) ; (42, 4)] in diff --git a/src/transpiler/transpiler.ml b/src/transpiler/transpiler.ml index 7f63fc378..ff80c19c8 100644 --- a/src/transpiler/transpiler.ml +++ b/src/transpiler/transpiler.ml @@ -434,7 +434,7 @@ and translate_annotated_expression (ae:AST.annotated_expression) : expression re let%bind (init : expression) = return @@ E_make_empty_set t in bind_fold_list aux init lst' ) - | E_map m -> ( + | (E_map m | E_big_map m) -> ( let%bind (src, dst) = trace_strong (corner_case ~loc:__LOC__ "not a map") @@ Mini_c.Combinators.get_t_map tv in @@ -802,6 +802,18 @@ let rec untranspile (v : value) (t : AST.type_value) : AST.annotated_expression bind_map_list aux lst in return (E_map lst') ) + | T_constant ("big_map", [k_ty;v_ty]) -> ( + let%bind lst = + trace_strong (wrong_mini_c_value "map" v) @@ + get_map v in + let%bind lst' = + let aux = fun (k, v) -> + let%bind k' = untranspile k k_ty in + let%bind v' = untranspile v v_ty in + ok (k', v') in + bind_map_list aux lst in + return (E_big_map lst') + ) | T_constant ("list", [ty]) -> ( let%bind lst = trace_strong (wrong_mini_c_value "list" v) @@ diff --git a/src/typer/typer.ml b/src/typer/typer.ml index 5c962cc10..c95ec44fb 100644 --- a/src/typer/typer.ml +++ b/src/typer/typer.ml @@ -556,6 +556,36 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a ok (t_map key_type value_type ()) in return (E_map lst') tv + | E_big_map lst -> + let%bind lst' = bind_map_list (bind_map_pair (type_expression e)) lst in + let%bind tv = + let aux opt c = + match opt with + | None -> ok (Some c) + | Some c' -> + let%bind _eq = Ast_typed.assert_type_value_eq (c, c') in + ok (Some c') in + let%bind key_type = + let%bind sub = + bind_fold_list aux None + @@ List.map get_type_annotation + @@ List.map fst lst' in + let%bind annot = bind_map_option get_t_map_key tv_opt in + trace (simple_info "empty map expression without a type annotation") @@ + O.merge_annotation annot sub (needs_annotation ae "this map literal") + in + let%bind value_type = + let%bind sub = + bind_fold_list aux None + @@ List.map get_type_annotation + @@ List.map snd lst' in + let%bind annot = bind_map_option get_t_map_value tv_opt in + trace (simple_info "empty map expression without a type annotation") @@ + O.merge_annotation annot sub (needs_annotation ae "this map literal") + in + ok (t_big_map key_type value_type ()) + in + return (E_big_map lst') tv | E_lambda { binder ; input_type ; @@ -826,6 +856,9 @@ let rec untype_expression (e:O.annotated_expression) : (I.expression) result = | E_map m -> let%bind m' = bind_map_list (bind_map_pair untype_expression) m in return (e_map m') + | E_big_map m -> + let%bind m' = bind_map_list (bind_map_pair untype_expression) m in + return (e_big_map m') | E_list lst -> let%bind lst' = bind_map_list untype_expression lst in return (e_list lst')