add set tests

src/compiler/compiler_program.ml

@@ -26,6 +26,11 @@ let get_predicate : string -> type_value -> expression list -> predicate result
           let%bind m_ty = Compiler_type.type_ ty' in
           ok @@ simple_unary @@ prim ~children:[m_ty] I_NIL
         )
+      | "SET_EMPTY" -> (
+          let%bind ty' = Mini_c.get_t_set ty in
+          let%bind m_ty = Compiler_type.type_ ty' in
+          ok @@ simple_constant @@ prim ~children:[m_ty] I_EMPTY_SET
+        )
       | "UNPACK" -> (
           let%bind ty' = Mini_c.get_t_option ty in
           let%bind m_ty = Compiler_type.type_ ty' in
@@ -86,14 +91,16 @@ let rec translate_value (v:value) : michelson result = match v with
       ok @@ prim ~children:[s'] D_Some
   | D_map lst ->
       let%bind lst' = bind_map_list (bind_map_pair translate_value) lst in
+      let sorted = List.sort (fun (x , _) (y , _) -> compare x y) lst' in
       let aux (a, b) = prim ~children:[a;b] D_Elt in
-      ok @@ seq @@ List.map aux lst'
+      ok @@ seq @@ List.map aux sorted
   | D_list lst ->
       let%bind lst' = bind_map_list translate_value lst in
       ok @@ seq lst'
   | D_set lst ->
       let%bind lst' = bind_map_list translate_value lst in
-      ok @@ seq lst'
+      let sorted = List.sort compare lst' in
+      ok @@ seq sorted
   | D_operation _ ->
       simple_fail "can't compile an operation"
 

src/contracts/set_arithmetic.ligo

@@ -0,0 +1,15 @@
+const s_e : set(string) = (set_empty : set(string))
+
+const s_fb : set(string) = set [
+      "foo" ;
+      "bar" ;
+]
+
+function add_op (const s : set(string)) : set(string) is
+  begin skip end with set_add("foobar" , s)
+
+function remove_op (const s : set(string)) : set(string) is
+  begin skip end with set_remove("foobar" , s)
+
+function mem_op (const s : set(string)) : bool is
+  begin skip end with set_mem("foobar" , s)

src/main/run_mini_c.ml

@@ -32,8 +32,14 @@ let run_entry ?(debug_michelson = false) ?options (entry:anon_function) (input:v
       error title content in
     trace error @@
     translate_entry entry in
-  if debug_michelson then Format.printf "Program: %a\n" Michelson.pp compiled.body ;
   let%bind input_michelson = translate_value input in
+  if debug_michelson then (
+    Format.printf "Program: %a\n" Michelson.pp compiled.body ;
+    Format.printf "Expression: %a\n" PP.expression entry.result ;
+    Format.printf "Input: %a\n" PP.value input ;
+    Format.printf "Input Type: %a\n" PP.type_ entry.input ;
+    Format.printf "Compiled Input: %a\n" Michelson.pp input_michelson ;
+  ) ;
   let%bind ex_ty_value = run_aux ?options compiled input_michelson in
   let%bind (result : value) = Compiler.Uncompiler.translate_value ex_ty_value in
   ok result

src/operators/operators.ml

@@ -74,6 +74,11 @@ module Simplify = struct
       ("bitwise_xor" , "XOR") ;
       ("string_concat" , "CONCAT") ;
       ("string_slice" , "SLICE") ;
+      ("set_empty" , "SET_EMPTY") ;
+      ("set_mem" , "SET_MEM") ;
+      ("set_add" , "SET_ADD") ;
+      ("set_remove" , "SET_REMOVE") ;
+      ("set_iter" , "SET_ITER") ;
     ]
 
     let type_constants = type_constants
@@ -194,6 +199,11 @@ module Typer = struct
     | None -> simple_fail "untyped NONE"
     | Some t -> ok t
 
+  let set_empty = typer_0 "SET_EMPTY" @@ fun tv_opt ->
+    match tv_opt with
+    | None -> simple_fail "untyped SET_EMPTY"
+    | Some t -> ok t
+
   let sub = typer_2 "SUB" @@ fun a b ->
     if (eq_2 (a , b) (t_int ()))
     then ok @@ t_int () else
@@ -571,6 +581,7 @@ module Typer = struct
       map_map ;
       map_fold ;
       map_iter ;
+      set_empty ;
       set_mem ;
       set_add ;
       set_remove ;
@@ -658,10 +669,11 @@ module Compiler = struct
     ("CALL" , simple_ternary @@ prim I_TRANSFER_TOKENS) ;
     ("SOURCE" , simple_constant @@ prim I_SOURCE) ;
     ("SENDER" , simple_constant @@ prim I_SENDER) ;
-    ("MAP_ADD" , simple_ternary @@ seq [dip (i_some) ; prim I_UPDATE ]) ;
+    ("MAP_ADD" , simple_ternary @@ seq [dip (i_some) ; prim I_UPDATE]) ;
     ("MAP_UPDATE" , simple_ternary @@ prim I_UPDATE) ;
     ("SET_MEM" , simple_binary @@ prim I_MEM) ;
     ("SET_ADD" , simple_binary @@ seq [dip (i_push (prim T_bool) (prim D_True)) ; prim I_UPDATE]) ;
+    ("SET_REMOVE" , simple_binary @@ seq [dip (i_push (prim T_bool) (prim D_False)) ; prim I_UPDATE]) ;
     ("SLICE" , simple_ternary @@ seq [prim I_SLICE ; i_assert_some_msg (i_push_string "SLICE")]) ;
     ("SHA256" , simple_unary @@ prim I_SHA256) ;
     ("SHA512" , simple_unary @@ prim I_SHA512) ;

src/simplify/pascaligo.ml

@@ -484,7 +484,7 @@ let rec simpl_expression (t:Raw.expr) : expr result =
       fail @@ unsupported_string_catenation e
   | ELogic l -> simpl_logic_expression l
   | EList l -> simpl_list_expression l
-  | ESet _ -> fail @@ unsupported_set_expr t
+  | ESet s -> simpl_set_expression s
   | ECase c -> (
       let (c , loc) = r_split c in
       let%bind e = simpl_expression c.expr in
@@ -571,6 +571,21 @@ and simpl_list_expression (t:Raw.list_expr) : expression result =
       return @@ e_list ~loc []
     )
 
+and simpl_set_expression (t:Raw.set_expr) : expression result =
+  match t with
+  | SetMem x -> (
+    let (x' , loc) = r_split x in
+    let%bind set' = simpl_expression x'.set in
+    let%bind element' = simpl_expression x'.element in
+    ok @@ e_constant ~loc "SET_MEM" [ element' ; set' ]
+  )
+  | SetInj x -> (
+    let (x' , loc) = r_split x in
+    let elements = pseq_to_list x'.elements in
+    let%bind elements' = bind_map_list simpl_expression elements in
+    ok @@ e_set ~loc elements'
+  )
+
 and simpl_binop (name:string) (t:_ Raw.bin_op Region.reg) : expression result =
   let return x = ok x in
   let (t , loc) = r_split t in

src/test/integration_tests.ml

@@ -159,6 +159,34 @@ let string_arithmetic () : unit result =
   let%bind () = expect_fail program "slice_op" (e_string "ba") in
   ok ()
 
+let set_arithmetic () : unit result =
+  let%bind program = type_file "./contracts/set_arithmetic.ligo" in
+  let%bind () =
+    expect_eq program "add_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 "add_op"
+      (e_set [e_string "foo" ; e_string "bar" ; e_string "foobar"])
+      (e_set [e_string "foo" ; e_string "bar" ; e_string "foobar"]) in
+  let%bind () =
+    expect_eq program "remove_op"
+      (e_set [e_string "foo" ; e_string "bar"])
+      (e_set [e_string "foo" ; e_string "bar"]) in
+  let%bind () =
+    expect_eq program "remove_op"
+      (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 "mem_op"
+      (e_set [e_string "foo" ; e_string "bar" ; e_string "foobar"])
+      (e_bool true) in
+  let%bind () =
+    expect_eq program "mem_op"
+      (e_set [e_string "foo" ; e_string "bar"])
+      (e_bool false) in
+  ok ()
+
 let unit_expression () : unit result =
   let%bind program = type_file "./contracts/unit.ligo" in
   expect_eq_evaluate program "u" (e_unit ())
@@ -368,8 +396,7 @@ let loop () : unit result =
     let make_expected = fun n -> e_nat (n * (n + 1) / 2) in
     expect_eq_n_pos_mid program "sum" make_input make_expected
   in
-  ok()
+  ok ()
-
 
 let matching () : unit result =
   let%bind program = type_file "./contracts/match.ligo" in
@@ -590,6 +617,7 @@ let main = test_suite "Integration (End to End)" [
     test "arithmetic" arithmetic ;
     test "bitiwse_arithmetic" bitwise_arithmetic ;
     test "string_arithmetic" string_arithmetic ;
+    test "set_arithmetic" set_arithmetic ;
     test "unit" unit_expression ;
     test "string" string_expression ;
     test "option" option ;

src/test/test_helpers.ml

@@ -32,7 +32,13 @@ let rec error_pp out (e : error) =
     | `Null -> ""
     | `List lst -> Format.asprintf "@[<v2>%a@]" PP_helpers.(list_sep error_pp (tag "@,")) lst
     | _ -> " " ^ (J.to_string infos) ^ "\n" in
-  Format.fprintf out "%s%s%s.\n%s%s" title error_code message data infos
+  let children =
+    let children = e |> member "children" in
+    match children with
+    | `Null -> ""
+    | `List lst -> Format.asprintf "@[<v2>%a@]" PP_helpers.(list_sep error_pp (tag "@,")) lst
+    | _ -> " " ^ (J.to_string children) ^ "\n" in
+  Format.fprintf out "%s%s%s.\n%s%s%s" title error_code message data infos children
 
 
 let test name f =

src/transpiler/transpiler.ml

@@ -372,7 +372,7 @@ and translate_annotated_expression (ae:AST.annotated_expression) : expression re
         Mini_c.Combinators.get_t_set tv in
       let%bind lst' = bind_map_list (translate_annotated_expression) lst in
       let aux : expression -> expression -> expression result = fun prev cur ->
-        return @@ E_constant ("CONS", [cur ; prev]) in
+        return @@ E_constant ("SET_ADD", [cur ; prev]) in
       let%bind (init : expression) = return @@ E_make_empty_set t in
       bind_fold_list aux init lst'
     )

vendors/ligo-utils/proto-alpha-utils/trace.ml

@@ -26,10 +26,12 @@ let trace_tzresult err =
 let trace_tzresult_r err_thunk_may_fail =
   function
   | Result.Ok x -> ok x
-  | Error _errs ->
+  | Error errs ->
-      (* let tz_errs = List.map of_tz_error errs in *)
+      let tz_errs = List.map of_tz_error errs in
       match err_thunk_may_fail () with
-      | Simple_utils.Trace.Ok (err, annotations) -> ignore annotations; Error (err)
+      | Simple_utils.Trace.Ok (err, annotations) ->
+         ignore annotations ;
+         Error (fun () -> patch_children tz_errs (err ()))
       | Error errors_while_generating_error ->
           (* TODO: the complexity could be O(n*n) in the worst case,
              this should use some catenable lists. *)