more operators in the pipeline

src/ast_simplified/combinators.ml

@@ -166,3 +166,13 @@ let extract_list : expression -> (expression list) result = fun e ->
   match Location.unwrap e with
   | E_list lst -> ok lst
   | _ -> fail @@ bad_kind "list" e.location
+
+let extract_record : expression -> (string * expression) list result = fun e ->
+  match Location.unwrap e with
+  | E_record lst -> ok @@ SMap.to_kv_list lst
+  | _ -> fail @@ bad_kind "record" e.location
+
+let extract_map : expression -> (expression * expression) list result = fun e ->
+  match Location.unwrap e with
+  | E_map lst -> ok lst
+  | _ -> fail @@ bad_kind "map" e.location

src/ast_simplified/misc.ml

@@ -166,6 +166,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
   | (E_look_up _, _) | (E_matching _, _) | (E_failwith _, _) | (E_sequence _, _)
   | (E_loop _, _) | (E_assign _, _) | (E_skip, _) -> simple_fail "comparing not a value"
 
+let is_value_eq (a , b) = to_bool @@ assert_value_eq (a , b)
 
 (* module Rename = struct
  *   open Trace

src/compiler/compiler_program.ml

@@ -86,6 +86,9 @@ let rec translate_value (v:value) : michelson result = match v with
   | 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'
   | D_operation _ ->
       simple_fail "can't compile an operation"
 

src/compiler/uncompiler.ml

@@ -77,6 +77,18 @@ let rec translate_value (Ex_typed_value (ty, value)) : value result =
         bind_map_list aux lst'
       in
       ok @@ D_list lst''
+  | (Set_t (ty, _)), (module S) -> (
+      let lst = S.OPS.elements S.boxed in
+      let lst' =
+        let aux acc cur = cur :: acc in
+        let lst = List.fold_left aux lst [] in
+        List.rev lst in
+      let%bind lst'' =
+        let aux = fun t -> translate_value (Ex_typed_value (ty_of_comparable_ty ty, t)) in
+        bind_map_list aux lst'
+      in
+      ok @@ D_set lst''
+    )
   | (Operation_t _) , op ->
       ok @@ D_operation op
   | ty, v ->

src/contracts/vote.mligo

@@ -34,9 +34,9 @@ let init (init_params : init_action) (_ : storage) =
 
 let vote (parameter : string) (storage : storage) =
   let now = Current.time in
-  let _ = assert (now >= storage.beginning_time && storage.finish_time < now) in
+  (* let _ = assert (now >= storage.beginning_time && storage.finish_time > now) in *)
   let addr = Current.source in
-  let _ = assert (not Set.mem addr storage.voters) in
+  (* let _ = assert (not Set.mem addr storage.voters) in *)
   let x = Map.find parameter storage.candidates in
   (
     ([] : operation list),

src/mini_c/PP.ml

@@ -59,6 +59,7 @@ let rec value ppf : value -> unit = function
   | D_some s -> fprintf ppf "Some (%a)" value s
   | D_map m -> fprintf ppf "Map[%a]" (list_sep_d value_assoc) m
   | D_list lst -> fprintf ppf "List[%a]" (list_sep_d value) lst
+  | D_set lst -> fprintf ppf "Set[%a]" (list_sep_d value) lst
 
 and value_assoc ppf : (value * value) -> unit = fun (a, b) ->
   fprintf ppf "%a -> %a" value a value b

src/mini_c/combinators.ml

@@ -37,6 +37,10 @@ let get_nat (v:value) = match v with
   | D_nat n -> ok n
   | _ -> simple_fail "not a nat"
 
+let get_timestamp (v:value) = match v with
+  | D_timestamp n -> ok n
+  | _ -> simple_fail "not a timestamp"
+
 let get_string (v:value) = match v with
   | D_string s -> ok s
   | _ -> simple_fail "not a string"
@@ -62,6 +66,10 @@ let get_list (v:value) = match v with
   | D_list lst -> ok lst
   | _ -> simple_fail "not a list"
 
+let get_set (v:value) = match v with
+  | D_set lst -> ok lst
+  | _ -> simple_fail "not a set"
+
 let get_t_option (v:type_value) = match v with
   | T_option t -> ok t
   | _ -> simple_fail "not an option"

src/mini_c/types.ml

@@ -48,6 +48,7 @@ type value =
   | D_none
   | D_map of (value * value) list
   | D_list of value list
+  | D_set of value list
   (* | `Macro of anon_macro ... The future. *)
   | D_function of anon_function
   | D_operation of Memory_proto_alpha.Alpha_context.packed_internal_operation

src/operators/operators.ml

@@ -509,10 +509,12 @@ module Compiler = struct
     ("UPDATE" , simple_ternary @@ prim I_UPDATE) ;
     ("SOME" , simple_unary @@ prim I_SOME) ;
     ("MAP_GET_FORCE" , simple_binary @@ seq [prim I_GET ; i_assert_some_msg (i_push_string "GET_FORCE")]) ;
+    ("MAP_FIND" , simple_binary @@ seq [prim I_GET ; i_assert_some_msg (i_push_string "MAP FIND")]) ;
     ("MAP_GET" , simple_binary @@ prim I_GET) ;
     ("SIZE" , simple_unary @@ prim I_SIZE) ;
     ("FAILWITH" , simple_unary @@ prim I_FAILWITH) ;
-    ("ASSERT" , simple_binary @@ i_if (seq [i_failwith]) (seq [i_drop ; i_push_unit])) ;
+    ("ASSERT_INFERRED" , simple_binary @@ i_if (seq [i_failwith]) (seq [i_drop ; i_push_unit])) ;
+    ("ASSERT" , simple_unary @@ i_if (seq [i_push_unit ; i_failwith]) (seq [i_push_unit])) ;
     ("INT" , simple_unary @@ prim I_INT) ;
     ("ABS" , simple_unary @@ prim I_ABS) ;
     ("CONS" , simple_binary @@ prim I_CONS) ;
@@ -525,6 +527,8 @@ module Compiler = struct
     ("SENDER" , simple_constant @@ prim I_SENDER) ;
     ("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]) ;
     ("SLICE" , simple_ternary @@ prim I_SLICE) ;
     ("SHA256" , simple_unary @@ prim I_SHA256) ;
     ("SHA512" , simple_unary @@ prim I_SHA512) ;

src/test/vote_tests.ml

@@ -14,16 +14,40 @@ let get_program =
 
 open Ast_simplified
 
-let dummy_storage = ez_e_record [
-    ("title" , e_string "dummy") ;
-    ("candidates" , e_typed_map [] t_string t_int) ;
+let init_storage name = ez_e_record [
+    ("title" , e_string name) ;
+    ("candidates" , e_map [
+        (e_string "Yes" , e_int 0) ;
+        (e_string "No" , e_int 0) ;
+      ]) ;
     ("voters" , e_typed_set [] t_address) ;
     ("beginning_time" , e_timestamp 0) ;
-    ("finish_time" , e_timestamp 0) ;
+    ("finish_time" , e_timestamp 1000000000) ;
   ]
 
+let init title beginning_time finish_time =
+  let init_action = ez_e_record [
+      ("title" , e_string title) ;
+      ("beginning_time" , e_timestamp beginning_time) ;
+      ("finish_time" , e_timestamp finish_time) ;
+    ] in
+  e_constructor "Init" init_action
+
+let vote str =
+  let vote = e_string str in
+  e_constructor "Vote" vote
+
 let init_vote () =
-  let%bind _program = get_program () in
+  let%bind program = get_program () in
+  let%bind result = Ligo.Run.run_simplityped program "main" (e_pair (vote "Yes") (init_storage "basic")) in
+  let%bind (_ , storage) = extract_pair result in
+  let%bind storage' = extract_record storage in
+  let votes = List.assoc "candidates" storage' in
+  let%bind votes' = extract_map votes in
+  let%bind (_ , yess) =
+    trace_option (simple_error "") @@
+    List.find_opt (fun (k , _) -> Ast_simplified.Misc.is_value_eq (k , e_string "Yes")) votes' in
+  let%bind () = Ast_simplified.Misc.assert_value_eq (yess , e_int 1) in
   ok ()
 
 let main = test_suite "Vote" [

src/transpiler/transpiler.ml

@@ -105,6 +105,9 @@ let rec translate_type (t:AST.type_value) : type_value result =
   | T_constant ("list", [t]) ->
       let%bind t' = translate_type t in
       ok (T_list t')
+  | T_constant ("set", [t]) ->
+      let%bind t' = translate_type t in
+      ok (T_set t')
   | T_constant ("option", [o]) ->
       let%bind o' = translate_type o in
       ok (T_option o')
@@ -674,6 +677,12 @@ let rec untranspile (v : value) (t : AST.type_value) : AST.annotated_expression
         get_nat v in      
       return (E_literal (Literal_nat n))
     )
+  | T_constant ("timestamp", []) -> (
+      let%bind n =
+        trace_strong (wrong_mini_c_value "timestamp" v) @@
+        get_timestamp v in      
+      return (E_literal (Literal_timestamp n))
+    )
   | T_constant ("tez", []) -> (
       let%bind n =
         trace_strong (wrong_mini_c_value "tez" v) @@
@@ -723,6 +732,15 @@ let rec untranspile (v : value) (t : AST.type_value) : AST.annotated_expression
         bind_map_list aux lst in
       return (E_list lst')
     )
+  | T_constant ("set", [ty]) -> (
+      let%bind lst =
+        trace_strong (wrong_mini_c_value "set" v) @@
+        get_set v in
+      let%bind lst' =
+        let aux = fun e -> untranspile e ty in
+        bind_map_list aux lst in
+      return (E_set lst')
+    )
   | T_constant ("contract" , [_ty]) ->
     fail @@ bad_untranspile "contract" v
   | T_constant ("operation" , []) -> (

src/typer/typer.ml

@@ -638,7 +638,7 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a
                             ae.location)
             @@ assert_t_unit (get_type_annotation mf') in
           let mt' = make_a_e
-              (E_constant ("ASSERT" , [ex' ; fw']))
+              (E_constant ("ASSERT_INFERRED" , [ex' ; fw']))
               (t_unit ())
               e
           in