Merge branch 'feature/pascaligo-set-patch' into 'dev'

[LIGO-127] Add set patch functionality to PascaLIGO

See merge request ligolang/ligo!127

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

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)
 
+
+

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"])