diff --git a/src/ast_simplified/combinators.ml b/src/ast_simplified/combinators.ml index 654d55024..690c9dfcb 100644 --- a/src/ast_simplified/combinators.ml +++ b/src/ast_simplified/combinators.ml @@ -49,7 +49,7 @@ let e_record ?loc map : expression = Location.wrap ?loc @@ E_record map let e_tuple ?loc lst : expression = Location.wrap ?loc @@ E_tuple lst 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_update ?loc k v old : expression = Location.wrap ?loc @@ E_constant ("MAP_UPDATE" , [k ; v ; old]) +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_list ?loc lst : expression = Location.wrap ?loc @@ E_list lst let e_pair ?loc a b : expression = Location.wrap ?loc @@ E_tuple [a; b] diff --git a/src/operators/operators.ml b/src/operators/operators.ml index afb5d34af..d8c3d134f 100644 --- a/src/operators/operators.ml +++ b/src/operators/operators.ml @@ -189,12 +189,57 @@ module Typer = struct let%bind () = assert_type_value_eq (src , k) in ok m - let map_update : typer = typer_3 "MAP_UPDATE" @@ fun k v m -> + let map_add : typer = typer_3 "MAP_ADD" @@ fun k v m -> let%bind (src, dst) = get_t_map m in let%bind () = assert_type_value_eq (src, k) in let%bind () = assert_type_value_eq (dst, v) in ok m + let map_update : typer = typer_3 "MAP_UPDATE_TODO" @@ fun k v m -> + let%bind (src, dst) = get_t_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 map_mem : typer = typer_2 "MAP_MEM_TODO" @@ fun k m -> + let%bind (src, _dst) = get_t_map m in + let%bind () = assert_type_value_eq (src, k) in + ok @@ t_bool () + + let map_find : typer = typer_2 "MAP_FIND_TODO" @@ fun k m -> + let%bind (src, dst) = get_t_map m in + let%bind () = assert_type_value_eq (src, k) in + ok @@ t_option dst () + + let map_fold : typer = typer_3 "MAP_FOLD_TODO" @@ fun f m acc -> + let%bind (src, dst) = get_t_map m in + let expected_f_type = t_function (t_tuple [(t_tuple [src ; dst] ()) ; acc] ()) acc () in + let%bind () = assert_type_value_eq (f, expected_f_type) in + ok @@ acc + + let map_map : typer = typer_2 "MAP_MAP_TODO" @@ fun f m -> + let%bind (k, v) = get_t_map m in + let%bind (input_type, result_type) = get_t_function f in + let%bind () = assert_type_value_eq (input_type, t_tuple [k ; v] ()) in + ok @@ t_map k result_type () + + let map_map_fold : typer = typer_3 "MAP_MAP_TODO" @@ fun f m acc -> + let%bind (k, v) = get_t_map m in + let%bind (input_type, result_type) = get_t_function f in + let%bind () = assert_type_value_eq (input_type, t_tuple [t_tuple [k ; v] () ; acc] ()) in + let%bind ttuple = get_t_tuple result_type in + match ttuple with + | [result_acc ; result_dst ] -> + ok @@ t_tuple [ t_map k result_dst () ; result_acc ] () + (* TODO: error message *) + | _ -> fail @@ simple_error "function passed to map should take (k * v) * acc as an argument" + + let map_iter : typer = typer_2 "MAP_MAP_TODO" @@ fun f m -> + let%bind (k, v) = get_t_map m in + let%bind () = assert_type_value_eq (f, t_function (t_tuple [k ; v] ()) (t_unit ()) ()) in + ok @@ t_unit () + let size = typer_1 "SIZE" @@ fun t -> let%bind () = Assert.assert_true @@ @@ -307,7 +352,15 @@ module Typer = struct boolean_operator_2 "OR" ; boolean_operator_2 "AND" ; map_remove ; + map_add ; map_update ; + map_mem ; + map_find ; + map_map_fold ; + map_map ; + map_fold ; + map_iter ; + (* map_size ; (* use size *) *) int ; size ; failwith_ ; @@ -379,7 +432,8 @@ module Compiler = struct ("CALL" , simple_ternary @@ prim I_TRANSFER_TOKENS) ; ("SOURCE" , simple_constant @@ prim I_SOURCE) ; ("SENDER" , simple_constant @@ prim I_SENDER) ; - ( "MAP_UPDATE" , simple_ternary @@ seq [dip (i_some) ; prim I_UPDATE ]) ; + ( "MAP_ADD" , simple_ternary @@ seq [dip (i_some) ; prim I_UPDATE ]) ; + ( "MAP_UPDATE" , simple_ternary @@ prim I_UPDATE) ; ] end diff --git a/src/simplify/pascaligo.ml b/src/simplify/pascaligo.ml index 58b5d6896..53e004688 100644 --- a/src/simplify/pascaligo.ml +++ b/src/simplify/pascaligo.ml @@ -765,7 +765,7 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu | _ -> fail @@ unsupported_deep_map_assign v in let%bind key_expr = simpl_expression v'.index.value.inside in let old_expr = e_variable name.value in - let expr' = e_map_update key_expr value_expr old_expr in + let expr' = e_map_add key_expr value_expr old_expr in return @@ e_assign ~loc name.value [] expr' ) )