diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 095ab6ac5..92f8c14aa 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -130,28 +130,6 @@ module Errors = struct ] in error ~data title message - let unsupported_set_patches patch = - let title () = "set patches" in - let message () = - Format.asprintf "set patches (a.k.a. functional updates) are \ - not supported yet" in - let data = [ - ("patch_loc", - fun () -> Format.asprintf "%a" Location.pp_lift @@ patch.Region.region) - ] in - error ~data title message - - (* let unsupported_set_removal remove = - let title () = "set removals" in - let message () = - Format.asprintf "removal of elements in a set is not \ - supported yet" in - let data = [ - ("removal_loc", - fun () -> Format.asprintf "%a" Location.pp_lift @@ remove.Region.region) - ] in - error ~data title message *) - let unsupported_deep_set_rm path = let title () = "set removals" in let message () = @@ -819,8 +797,24 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu ) | MapPatch patch -> fail @@ unsupported_map_patches patch - | SetPatch patch -> - fail @@ unsupported_set_patches patch + | SetPatch patch -> ( + let (setp, loc) = r_split patch in + let (name , access_path) = simpl_path setp.path in + let%bind inj = + bind_list @@ + List.map simpl_expression @@ + pseq_to_list setp.set_inj.value.elements in + let expr = + match inj with + | [] -> e_skip ~loc () + | _ :: _ -> + let assigns = List.fold_left + (fun s hd -> e_constant "SET_ADD" [hd ; s]) + (e_accessor ~loc (e_variable name) access_path) inj in + e_assign ~loc name access_path assigns in + return_statement @@ expr + ) + | MapRemove r -> ( let (v , loc) = r_split r in let key = v.key in diff --git a/src/test/contracts/set_arithmetic.ligo b/src/test/contracts/set_arithmetic.ligo index 81f9b0d6c..f38c1319f 100644 --- a/src/test/contracts/set_arithmetic.ligo +++ b/src/test/contracts/set_arithmetic.ligo @@ -17,6 +17,17 @@ 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 patch_op (var s: set(string)) : set(string) is + begin patch s with set ["foobar"]; end with s + +function patch_op_deep (var s: set(string)*nat) : set(string)*nat is + begin patch s.0 with set ["foobar"]; end with s + +function patch_op_empty (var s: set(string)) : set(string) is + begin patch s with set []; end with s + function mem_op (const s : set(string)) : bool is begin skip end with set_mem("foobar" , s) + + diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 94f0755a6..38c0869a5 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -245,6 +245,22 @@ 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 "patch_op" + (e_set [e_string "foo" ; e_string "bar"]) + (e_set [e_string "foo" ; e_string "bar"; e_string "foobar"]) in + let%bind () = + expect_eq program "patch_op_deep" + (e_pair + (e_set [e_string "foo" ; e_string "bar"]) + (e_nat 42)) + (e_pair + (e_set [e_string "foo" ; e_string "bar" ; e_string "foobar"]) + (e_nat 42)) in + let%bind () = + expect_eq program "patch_op_empty" + (e_set [e_string "foo" ; e_string "bar"]) + (e_set [e_string "foo" ; e_string "bar"]) in let%bind () = expect_eq program "mem_op" (e_set [e_string "foo" ; e_string "bar" ; e_string "foobar"])