Added types for mligo map instructions

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]

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

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'
           )
     )