add map literals in cameligo
This commit is contained in:
parent
ac449d2cb3
commit
b6ee28d704
@ -63,7 +63,7 @@ let parsify = fun (syntax : v_syntax) source_filename ->
|
|||||||
| Cameligo -> ok parsify_ligodity
|
| Cameligo -> ok parsify_ligodity
|
||||||
in
|
in
|
||||||
let%bind parsified = parsify source_filename 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
|
ok applied
|
||||||
|
|
||||||
let parsify_expression = fun syntax source ->
|
let parsify_expression = fun syntax source ->
|
||||||
@ -72,5 +72,5 @@ let parsify_expression = fun syntax source ->
|
|||||||
| Cameligo -> ok parsify_expression_ligodity
|
| Cameligo -> ok parsify_expression_ligodity
|
||||||
in
|
in
|
||||||
let%bind parsified = parsify source 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
|
ok applied
|
||||||
|
35
src/passes/3-self_ast_simplified/literals.ml
Normal file
35
src/passes/3-self_ast_simplified/literals.ml
Normal file
@ -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
|
@ -1,3 +1,23 @@
|
|||||||
let convert_annotation_expression = Helpers.map_expression Tezos_type_annotation.peephole_expression
|
open Trace
|
||||||
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
|
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
|
||||||
|
@ -159,6 +159,8 @@ module Simplify = struct
|
|||||||
("Map.iter" , "MAP_ITER") ;
|
("Map.iter" , "MAP_ITER") ;
|
||||||
("Map.map" , "MAP_MAP") ;
|
("Map.map" , "MAP_MAP") ;
|
||||||
("Map.fold" , "MAP_FOLD") ;
|
("Map.fold" , "MAP_FOLD") ;
|
||||||
|
("Map.empty" , "MAP_EMPTY") ;
|
||||||
|
("Map.literal" , "MAP_LITERAL" ) ;
|
||||||
|
|
||||||
("String.length", "SIZE") ;
|
("String.length", "SIZE") ;
|
||||||
("String.size", "SIZE") ;
|
("String.size", "SIZE") ;
|
||||||
|
@ -162,6 +162,11 @@ let get_e_list = fun t ->
|
|||||||
| E_list lst -> ok lst
|
| E_list lst -> ok lst
|
||||||
| _ -> simple_fail "not a list"
|
| _ -> 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 ->
|
let get_e_failwith = fun e ->
|
||||||
match e.expression with
|
match e.expression with
|
||||||
| E_failwith fw -> ok fw
|
| E_failwith fw -> ok fw
|
||||||
|
5
src/test/contracts/map.mligo
Normal file
5
src/test/contracts/map.mligo
Normal file
@ -0,0 +1,5 @@
|
|||||||
|
type foobar = (int , int) map
|
||||||
|
|
||||||
|
let foobar : foobar = Map.empty
|
||||||
|
|
||||||
|
let foobarz : foobar = Map.literal [ (1 , 10) ; (2 , 20) ]
|
@ -357,6 +357,14 @@ let moption () : unit result =
|
|||||||
in
|
in
|
||||||
ok ()
|
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 map () : unit result =
|
||||||
let%bind program = type_file "./contracts/map.ligo" in
|
let%bind program = type_file "./contracts/map.ligo" in
|
||||||
let ez lst =
|
let ez lst =
|
||||||
@ -766,6 +774,7 @@ let main = test_suite "Integration (End to End)" [
|
|||||||
test "option" option ;
|
test "option" option ;
|
||||||
test "option (mligo)" moption ;
|
test "option (mligo)" moption ;
|
||||||
test "map" map ;
|
test "map" map ;
|
||||||
|
test "map (mligo)" mmap ;
|
||||||
test "big_map" big_map ;
|
test "big_map" big_map ;
|
||||||
test "list" list ;
|
test "list" list ;
|
||||||
test "loop" loop ;
|
test "loop" loop ;
|
||||||
|
Loading…
Reference in New Issue
Block a user