From 2f60c85aa882411811a7085c608c405f8237e747 Mon Sep 17 00:00:00 2001
From: John David Pressman <jd@jdpressman.com>
Date: Wed, 9 Oct 2019 17:08:58 -0700
Subject: [PATCH] Add rough draft of set patch functionality

---
 src/passes/2-simplify/pascaligo.ml | 40 ++++++++++++++++++------------
 1 file changed, 24 insertions(+), 16 deletions(-)

diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml
index 9dc303e3c..0a0e252d5 100644
--- a/src/passes/2-simplify/pascaligo.ml
+++ b/src/passes/2-simplify/pascaligo.ml
@@ -141,7 +141,7 @@ module Errors = struct
     ] in
     error ~data title message
 
-  let unsupported_set_patches patch =
+  (* let unsupported_set_patches patch =
     let title () = "set patches" in
     let message () =
       Format.asprintf "set patches (a.k.a. functional updates) are \
@@ -150,7 +150,7 @@ module Errors = struct
       ("patch_loc",
        fun () -> Format.asprintf "%a" Location.pp_lift @@ patch.Region.region)
     ] in
-    error ~data title message
+    error ~data title message *)
 
   let unsupported_deep_map_rm path =
     let title () = "binding removals" in
@@ -163,18 +163,6 @@ module Errors = struct
     ] 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 () = 
@@ -839,8 +827,28 @@ 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 = patch.value in
+      let (name , access_path) = simpl_path setp.path in
+      let%bind inj = bind_list
+          @@ List.map (fun (x:Raw.expr) ->
+            let%bind e = simpl_expression x
+            in ok e)
+          @@ pseq_to_list setp.set_inj.value.elements in
+      let%bind expr =
+        let aux = fun (v) ->
+          e_assign name access_path (e_constant "SET_ADD" [v ; e_variable name]) in
+        let assigns = List.map aux inj in
+        match assigns with
+        | [] -> fail @@ unsupported_empty_record_patch setp.set_inj
+        | hd :: tl -> (
+            let aux acc cur = e_sequence acc cur in
+            ok @@ List.fold_left aux hd tl
+          )
+      in
+      return_statement @@ expr
+    )
+
   | MapRemove r -> (
       let (v , loc) = r_split r in
       let key = v.key in