balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Added types for mligo map instructions

Browse Source
This commit is contained in:
Georges Dupéron 2019-06-07 15:16:24 +02:00
parent 4d121602eb
commit b2ec459b08
3 changed files with 58 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/ast_simplified/combinators.ml
View File

@ -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]

58
src/operators/operators.ml
View File

@ -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

2
src/simplify/pascaligo.ml
View File

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