diff --git a/src/main/compile/helpers.ml b/src/main/compile/helpers.ml index 054c9e00d..663c989e7 100644 --- a/src/main/compile/helpers.ml +++ b/src/main/compile/helpers.ml @@ -63,7 +63,7 @@ let parsify = fun (syntax : v_syntax) source_filename -> | Cameligo -> ok parsify_ligodity in let%bind parsified = parsify source_filename in - let%bind applied = Self_ast_simplified.convert_annotation_program parsified in + let%bind applied = Self_ast_simplified.all_program parsified in ok applied let parsify_expression = fun syntax source -> @@ -72,5 +72,5 @@ let parsify_expression = fun syntax source -> | Cameligo -> ok parsify_expression_ligodity in let%bind parsified = parsify source in - let%bind applied = Self_ast_simplified.convert_annotation_expression parsified in + let%bind applied = Self_ast_simplified.all_expression parsified in ok applied diff --git a/src/passes/3-self_ast_simplified/literals.ml b/src/passes/3-self_ast_simplified/literals.ml new file mode 100644 index 000000000..4584f1eb5 --- /dev/null +++ b/src/passes/3-self_ast_simplified/literals.ml @@ -0,0 +1,35 @@ +open Ast_simplified +open Trace + +let peephole_expression : expression -> expression result = fun e -> + let return expression = ok { e with expression } in + match e.expression with + | E_constant ("MAP_LITERAL" , lst) -> ( + let%bind elt = + trace_option (simple_error "map literal expects a single parameter") @@ + List.to_singleton lst + in + let%bind lst = + trace (simple_error "map literal expects a list as parameter") @@ + get_e_list elt.expression + in + let aux = fun (e : expression) -> + trace (simple_error "map literal expects a list of pairs as parameter") @@ + let%bind tpl = get_e_tuple e.expression in + let%bind (a , b) = + trace_option (simple_error "of pairs") @@ + List.to_pair tpl + in + ok (a , b) + in + let%bind pairs = bind_map_list aux lst in + return @@ E_map pairs + ) + | E_constant ("MAP_EMPTY" , lst) -> ( + let%bind () = + trace_strong (simple_error "MAP_EMPTY expects no parameter") @@ + Assert.assert_list_empty lst + in + return @@ E_map [] + ) + | e -> return e diff --git a/src/passes/3-self_ast_simplified/self_ast_simplified.ml b/src/passes/3-self_ast_simplified/self_ast_simplified.ml index b3ebb08db..aa18b4a8c 100644 --- a/src/passes/3-self_ast_simplified/self_ast_simplified.ml +++ b/src/passes/3-self_ast_simplified/self_ast_simplified.ml @@ -1,3 +1,23 @@ -let convert_annotation_expression = Helpers.map_expression Tezos_type_annotation.peephole_expression -let convert_annotation_program = Helpers.map_program Tezos_type_annotation.peephole_expression -let convert_none_variant_to_const = Helpers.map_program None_variant.peephole_expression +open Trace + +let all = [ + Tezos_type_annotation.peephole_expression ; + None_variant.peephole_expression ; + Literals.peephole_expression ; +] + +let rec bind_chain : ('a -> 'a result) list -> 'a -> 'a result = fun fs x -> + match fs with + | [] -> ok x + | hd :: tl -> ( + let aux : 'a -> 'a result = fun x -> bind (bind_chain tl) (hd x) in + bind aux (ok x) + ) + +let all_program = + let all_p = List.map Helpers.map_program all in + bind_chain all_p + +let all_expression = + let all_p = List.map Helpers.map_expression all in + bind_chain all_p diff --git a/src/passes/operators/operators.ml b/src/passes/operators/operators.ml index 2dc5ef7d6..00d580a87 100644 --- a/src/passes/operators/operators.ml +++ b/src/passes/operators/operators.ml @@ -159,6 +159,8 @@ module Simplify = struct ("Map.iter" , "MAP_ITER") ; ("Map.map" , "MAP_MAP") ; ("Map.fold" , "MAP_FOLD") ; + ("Map.empty" , "MAP_EMPTY") ; + ("Map.literal" , "MAP_LITERAL" ) ; ("String.length", "SIZE") ; ("String.size", "SIZE") ; diff --git a/src/stages/ast_simplified/combinators.ml b/src/stages/ast_simplified/combinators.ml index 6260229ad..99f0f3af5 100644 --- a/src/stages/ast_simplified/combinators.ml +++ b/src/stages/ast_simplified/combinators.ml @@ -162,6 +162,11 @@ let get_e_list = fun t -> | E_list lst -> ok lst | _ -> simple_fail "not a list" +let get_e_tuple = fun t -> + match t with + | E_tuple lst -> ok lst + | _ -> simple_fail "not a tuple" + let get_e_failwith = fun e -> match e.expression with | E_failwith fw -> ok fw diff --git a/src/test/contracts/map.mligo b/src/test/contracts/map.mligo new file mode 100644 index 000000000..7317dc6b8 --- /dev/null +++ b/src/test/contracts/map.mligo @@ -0,0 +1,5 @@ +type foobar = (int , int) map + +let foobar : foobar = Map.empty + +let foobarz : foobar = Map.literal [ (1 , 10) ; (2 , 20) ] diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 1b6f96ce7..93aac4e01 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -357,6 +357,14 @@ let moption () : unit result = in ok () +let mmap () : unit result = + let%bind program = mtype_file "./contracts/map.mligo" in + let%bind () = expect_eq_evaluate program "foobar" + (e_annotation (e_map []) (t_map t_int t_int)) in + let%bind () = expect_eq_evaluate program "foobarz" + (e_annotation (e_map [(e_int 1 , e_int 10) ; (e_int 2 , e_int 20)]) (t_map t_int t_int)) in + ok () + let map () : unit result = let%bind program = type_file "./contracts/map.ligo" in let ez lst = @@ -766,6 +774,7 @@ let main = test_suite "Integration (End to End)" [ test "option" option ; test "option (mligo)" moption ; test "map" map ; + test "map (mligo)" mmap ; test "big_map" big_map ; test "list" list ; test "loop" loop ;