diff --git a/src/passes/4-typer-old/typer.ml b/src/passes/4-typer-old/typer.ml index cc9280531..daaa684bf 100644 --- a/src/passes/4-typer-old/typer.ml +++ b/src/passes/4-typer-old/typer.ml @@ -432,18 +432,29 @@ and type_expression' : environment -> ?tv_opt:O.type_value -> I.expression -> O. let%bind tv = generic_try (bad_tuple_index index ae' prev.type_annotation ae.location) @@ (fun () -> List.nth tpl_tv index) in - return (E_tuple_accessor (prev , index)) tv + let location = ae.location in + ok @@ make_a_e ~location (E_tuple_accessor(prev , index)) tv e ) | Access_record property -> ( let%bind r_tv = get_t_record prev.type_annotation in let%bind tv = generic_try (bad_record_access property ae' prev.type_annotation ae.location) @@ (fun () -> SMap.find property r_tv) in - return (E_record_accessor (prev , property)) tv + let location = ae.location in + ok @@ make_a_e ~location (E_record_accessor (prev , property)) tv e ) in + let%bind ae = trace (simple_info "accessing") @@ - bind_fold_list aux e' path + bind_fold_list aux e' path in + (* check type annotation of the final accessed element *) + let%bind () = + match tv_opt with + | None -> ok () + | Some tv' -> O.assert_type_value_eq (tv' , ae.type_annotation) in + ok(ae) + + (* Sum *) | E_constructor (c, expr) -> let%bind (c_tv, sum_tv) = diff --git a/src/stages/ast_simplified/types.ml b/src/stages/ast_simplified/types.ml index f066b3be2..43302e44d 100644 --- a/src/stages/ast_simplified/types.ml +++ b/src/stages/ast_simplified/types.ml @@ -56,6 +56,7 @@ and expression' = | E_constructor of (name * expr) (* For user defined constructors *) (* E_record *) | E_record of expr_map + (* TODO: Change it to (expr * access) *) | E_accessor of (expr * access_path) (* Data Structures *) | E_map of (expr * expr) list diff --git a/src/test/contracts/deep_access.ligo b/src/test/contracts/deep_access.ligo new file mode 100644 index 000000000..bacbf3467 --- /dev/null +++ b/src/test/contracts/deep_access.ligo @@ -0,0 +1,22 @@ +//Test deep_access in PascalLigo +type pii is (int*int) +type ppi is record x:pii; y:pii end +type ppp is (ppi*ppi) + +function main (const toto : unit) : int is +var a : ppp := +( +record +x = (0,1); +y = (10,11); +end +, +record +x = (100,101); +y = (110,111); +end +) +begin + a.0.x.0 := 2; + const b:int = a.0.x.0; +end with b diff --git a/src/test/contracts/simple_access.ligo b/src/test/contracts/simple_access.ligo new file mode 100644 index 000000000..6cfa85a1e --- /dev/null +++ b/src/test/contracts/simple_access.ligo @@ -0,0 +1,21 @@ +//Test simple_access in PascalLigo +type tpi is (int*int) +type rpi is record +x : int; +y : int; +end +type mpi is map(string,int) + +function main (const toto : tpi) : int is + var a : tpi := toto; + var b : rpi := record x = 0; y=1 ; end; + var m : mpi := map "y" -> 1; end; + begin + a.0 := 2; + b.x := a.0; + m["x"] := b.x; + end with + case m["x"] of + | Some (s) -> s + | None -> 42 + end diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 77bcc74a9..1c7eb60ae 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -1162,6 +1162,17 @@ let balance_constant_mligo () : unit result = let input = e_tuple [e_unit () ; e_mutez 0] in let expected = e_tuple [e_list []; e_mutez 4000000000000] in expect_eq program "main" input expected +let simple_access_ligo () : unit result = + let%bind program = type_file "./contracts/simple_access.ligo" in + let make_input = e_tuple [e_int 0; e_int 1] in + let make_expected = e_int 2 in + expect_eq program "main" make_input make_expected + +let deep_access_ligo () : unit result = + let%bind program = type_file "./contracts/deep_access.ligo" in + let make_input = e_unit () in + let make_expected = e_int 2 in + expect_eq program "main" make_input make_expected let main = test_suite "Integration (End to End)" [ test "type alias" type_alias ; @@ -1245,4 +1256,6 @@ let main = test_suite "Integration (End to End)" [ test "website2 (mligo)" website2_mligo ; test "balance constant" balance_constant ; test "balance constant (mligo)" balance_constant_mligo ; + test "simple_access (ligo)" simple_access_ligo; + test "deep_access (ligo)" deep_access_ligo; ]