From 0b8c0dad3f5742bb3e261e4232bf3da9efb614c8 Mon Sep 17 00:00:00 2001 From: John David Pressman Date: Mon, 14 Oct 2019 15:48:20 -0700 Subject: [PATCH 1/2] Add failing deep set removal test to contracts --- src/test/contracts/set_arithmetic.ligo | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/test/contracts/set_arithmetic.ligo b/src/test/contracts/set_arithmetic.ligo index f38c1319f..879d13940 100644 --- a/src/test/contracts/set_arithmetic.ligo +++ b/src/test/contracts/set_arithmetic.ligo @@ -17,6 +17,9 @@ function remove_op (const s : set(string)) : set(string) is function remove_syntax (var s : set(string)) : set(string) is begin remove "foobar" from set s; end with s +function remove_deep (var s : set(string) * nat) : set(string) * nat is + begin remove "foobar" from set s.0; end with s + function patch_op (var s: set(string)) : set(string) is begin patch s with set ["foobar"]; end with s From 6f5e88c93c739d6a09050c656ac966411efec088 Mon Sep 17 00:00:00 2001 From: John David Pressman Date: Mon, 14 Oct 2019 16:04:48 -0700 Subject: [PATCH 2/2] Make failing deep set removal test pass --- src/passes/2-simplify/pascaligo.ml | 26 ++++++++++---------------- src/test/integration_tests.ml | 9 +++++++++ 2 files changed, 19 insertions(+), 16 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 18f2d8585..f89f8459e 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -119,16 +119,6 @@ module Errors = struct ] in error ~data title message - let unsupported_deep_set_rm path = - let title () = "set removals" in - let message () = - Format.asprintf "removal of members from embedded sets is not supported yet" in - let data = [ - ("path_loc", - fun () -> Format.asprintf "%a" Location.pp_lift @@ path.Region.region) - ] in - error ~data title message - let unsupported_non_var_pattern p = let title () = "pattern is not a variable" in let message () = @@ -831,7 +821,7 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu | Name v -> ok (v.value , e_variable v.value , []) | Path p -> let (name,p') = simpl_path v.map in - let%bind accessor = simpl_projection p in + let%bind accessor = simpl_projection p in ok @@ (name , accessor , p') in let%bind key' = simpl_expression key in @@ -840,12 +830,16 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu ) | SetRemove r -> ( let (set_rm, loc) = r_split r in - let%bind set = match set_rm.set with - | Name v -> ok v.value - | Path path -> fail @@ unsupported_deep_set_rm path in + let%bind (varname, set, path) = match set_rm.set with + | Name v -> ok (v.value, e_variable v.value, []) + | Path path -> + let(name, p') = simpl_path set_rm.set in + let%bind accessor = simpl_projection path in + ok @@ (name, accessor, p') + in let%bind removed' = simpl_expression set_rm.element in - let expr = e_constant ~loc "SET_REMOVE" [removed' ; e_variable set] in - return_statement @@ e_assign ~loc set [] expr + let expr = e_constant ~loc "SET_REMOVE" [removed' ; set] in + return_statement @@ e_assign ~loc varname path expr ) and simpl_path : Raw.path -> string * Ast_simplified.access_path = fun p -> diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 1daf4c046..89e5ef967 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -245,6 +245,15 @@ let set_arithmetic () : unit result = expect_eq program "remove_syntax" (e_set [e_string "foo" ; e_string "bar" ; e_string "foobar"]) (e_set [e_string "foo" ; e_string "bar"]) in + let%bind () = + expect_eq program "remove_deep" + (e_pair + (e_set [e_string "foo" ; e_string "bar" ; e_string "foobar"]) + (e_nat 42)) + (e_pair + (e_set [e_string "foo" ; e_string "bar"]) + (e_nat 42)) + in let%bind () = expect_eq program "patch_op" (e_set [e_string "foo" ; e_string "bar"])