more tests

src/ligo/ast_simplified.ml

@@ -190,6 +190,7 @@ module Simplify = struct
   let type_constants = [
     ("nat", 0) ;
     ("int", 0) ;
+    ("bool", 0) ;
   ]
 
   let rec simpl_type_expression (t:Raw.type_expr) : type_expression result =

src/ligo/ast_typed.ml

@@ -316,6 +316,7 @@ module Combinators = struct
   let t_tuple lst s : type_value = type_value (Type_tuple lst) s
   let simplify_t_tuple lst s = t_tuple lst (Some s)
   let make_t_tuple lst = t_tuple lst None
+  let make_t_pair a b = make_t_tuple [a ; b]
 
   let t_record m s : type_value = type_value (Type_record m) s
   let make_t_ez_record (lst:(string * type_value) list) : type_value =
@@ -363,11 +364,20 @@ module Combinators = struct
     Record map
 
   let int n : expression = Literal (Int n)
+  let bool b : expression = Literal (Bool b)
+  let pair a b : expression = Constant ("PAIR", [a; b])
 
   let a_int n = annotated_expression (int n) make_t_int
+  let a_bool b = annotated_expression (bool b) make_t_bool
+  let a_pair a b = annotated_expression (pair a b) (make_t_pair a.type_annotation b.type_annotation)
 
   let get_a_int (t:annotated_expression) =
     match t.expression with
     | Literal (Int n) -> ok n
     | _ -> simple_fail "not an int"
+
+  let get_a_bool (t:annotated_expression) =
+    match t.expression with
+    | Literal (Bool b) -> ok b
+    | _ -> simple_fail "not a bool"
 end

src/ligo/contracts/boolean_operators.ligo

@@ -0,0 +1,11 @@
+function or_true (const b : bool) : bool is
+  begin skip end with b or True
+
+function or_false (const b : bool) : bool is
+  begin skip end with b or False
+
+function and_true (const b : bool) : bool is
+  begin skip end with b and True
+
+function and_false (const b : bool) : bool is
+  begin skip end with b and False

src/ligo/contracts/multiple-parameters.ligo

@@ -0,0 +1,2 @@
+function bi(const a : int; const b : int) : int is
+  begin skip end with (a + b)

src/ligo/ligo-helpers/trace.ml

@@ -167,10 +167,18 @@ module Assert = struct
     | true -> ok ()
     | false -> simple_fail msg
 
+  let assert_equal ?msg expected actual =
+    assert_true ?msg (expected = actual)
+
   let assert_equal_int ?msg expected actual =
     let default = Format.asprintf "Not equal int : expected %d, got %d" expected actual in
     let msg = Option.unopt ~default msg in
-    assert_true ~msg (expected = actual)
+    assert_equal ~msg expected actual
+
+  let assert_equal_bool ?msg expected actual =
+    let default = Format.asprintf "Not equal bool : expected %b, got %b" expected actual in
+    let msg = Option.unopt ~default msg in
+    assert_equal ~msg expected actual
 
   let assert_list_size ?(msg="lst doesn't have the right size") lst n =
     assert_true ~msg List.(length lst = n)

src/ligo/ligo.ml

@@ -110,31 +110,35 @@ let type_file ?(debug_simplify = false) ?(debug_typed = false)
   ) ;
   ok typed
 
-let easy_run_main_typed
+let easy_run_typed
-    ?(debug_mini_c = false)
+    ?(debug_mini_c = false) (entry:string)
     (program:AST_Typed.program) (input:AST_Typed.annotated_expression) : AST_Typed.annotated_expression result =
   let%bind mini_c_main =
     trace (simple_error "transpile mini_c main") @@
-    transpile_entry program "main" in
+    transpile_entry program entry in
   (if debug_mini_c then
      Format.(printf "Mini_c : %a\n%!" Mini_c.PP.function_ mini_c_main.content)
   ) ;
 
   let%bind mini_c_value = transpile_value input in
 
-
   let%bind mini_c_result =
     trace (simple_error "run mini_c") @@
     Mini_c.Run.run_entry mini_c_main mini_c_value in
   let%bind typed_result =
     let%bind main_result_type =
-    let%bind typed_main = Ast_typed.get_entry program "main" in
+    let%bind typed_main = Ast_typed.get_entry program entry in
     match (snd typed_main).type_value with
     | Type_function (_, result) -> ok result
     | _ -> simple_fail "main doesn't have fun type" in
     untranspile_value mini_c_result main_result_type in
   ok typed_result
 
+let easy_run_main_typed
+    ?(debug_mini_c = false)
+    (program:AST_Typed.program) (input:AST_Typed.annotated_expression) : AST_Typed.annotated_expression result =
+  easy_run_typed ~debug_mini_c "main" program input
+
 let easy_run_main (path:string) (input:string) : AST_Typed.annotated_expression result =
   let%bind typed = type_file path in
 

src/ligo/mini_c.ml

@@ -624,6 +624,8 @@ module Translate_program = struct
   let rec get_predicate : string -> predicate result = function
     | "ADD_INT" -> ok @@ simple_binary @@ prim I_ADD
     | "NEG" -> ok @@ simple_unary @@ prim I_NEG
+    | "OR" -> ok @@ simple_binary @@ prim I_OR
+    | "AND" -> ok @@ simple_binary @@ prim I_AND
     | "PAIR" -> ok @@ simple_binary @@ prim I_PAIR
     | "EQ" -> ok @@ simple_binary @@ seq [prim I_COMPARE ; prim I_EQ]
     | x -> simple_fail @@ "predicate \"" ^ x ^ "\" doesn't exist"
@@ -942,6 +944,8 @@ module Translate_ir = struct
           trace_option (simple_error "too big to fit an int") @@
           Alpha_context.Script_int.to_int n in
         ok @@ `Nat n
+    | (Bool_t _), b ->
+        ok @@ `Bool b
     | _ -> simple_fail "this value can't be transpiled back yet"
 end
 

src/ligo/test/integration_tests.ml

@@ -26,7 +26,7 @@ let function_ () : unit result =
   ok ()
 
 let complex_function () : unit result =
-  let%bind program = type_file ~debug_simplify:true "./contracts/function-complex.ligo" in
+  let%bind program = type_file "./contracts/function-complex.ligo" in
   let aux n =
     let open AST_Typed.Combinators in
     let input = a_int n in
@@ -41,6 +41,48 @@ let complex_function () : unit result =
     @@ [0 ; 2 ; 42 ; 163 ; -1] in
   ok ()
 
+let multiple_parameters () : unit result  =
+  let%bind program = type_file "./contracts/multiple-parameters.ligo" in
+  let aux n =
+    let open AST_Typed.Combinators in
+    let input = a_int n in
+    let%bind result = easy_run_main_typed program input in
+    let%bind result' =
+      trace (simple_error "bad result") @@
+      get_a_int result in
+    Assert.assert_equal_int (3 * n + 2) result'
+  in
+  let%bind _ = bind_list
+    @@ List.map aux
+    @@ [0 ; 2 ; 42 ; 163 ; -1] in
+  ok ()
+
+let bool_expression () : unit result =
+  let%bind program = type_file "./contracts/boolean_operators.ligo" in
+  let aux (name, f) =
+    let aux b =
+      let open AST_Typed.Combinators in
+      let input = a_bool b in
+      let%bind result = easy_run_typed name program input in
+      let%bind result' =
+        trace (simple_error "bad result") @@
+        get_a_bool result in
+      Assert.assert_equal_bool (f b) result'
+    in
+    let%bind _ = bind_list
+      @@ List.map aux [true;false] in
+    ok ()
+  in
+  let%bind _ = bind_list
+    @@ List.map aux
+    @@ [
+      ("or_true", fun b -> b || true) ;
+      ("or_false", fun b -> b || false) ;
+      ("and_true", fun b -> b && true) ;
+      ("and_false", fun b -> b && false) ;
+    ] in
+  ok ()
+
 let condition () : unit result =
   let%bind program = type_file "./contracts/condition.ligo" in
   let aux n =
@@ -57,7 +99,6 @@ let condition () : unit result =
     @@ [0 ; 2 ; 42 ; 163 ; -1] in
   ok ()
 
-
 let declarations () : unit result =
   let%bind program = type_file "./contracts/declarations.ligo" in
   let aux n =
@@ -109,8 +150,10 @@ let quote_declarations () : unit result =
 
 let main = "Integration (End to End)", [
     test "basic" basic ;
+    test "bool" bool_expression ;
     test "function" function_ ;
     test "complex function" complex_function ;
+    test "multiple parameters" multiple_parameters ;
     test "condition" condition ;
     test "declarations" declarations ;
     test "quote declaration" quote_declaration ;

src/ligo/typer.ml

@@ -335,6 +335,10 @@ and type_constant (name:string) (lst:O.type_value list) : (string * O.type_value
   | "ADD", _ -> simple_fail "bad number of params to add"
   | "EQ", [a ; b] when type_value_eq (a, make_t_int) && type_value_eq (b, make_t_int) -> ok ("EQ", make_t_bool)
   | "EQ", _ -> simple_fail "EQ only defined over int"
+  | "OR", [a ; b] when type_value_eq (a, make_t_bool) && type_value_eq (b, make_t_bool) -> ok ("OR", make_t_bool)
+  | "OR", _ -> simple_fail "OR only defined over bool"
+  | "AND", [a ; b] when type_value_eq (a, make_t_bool) && type_value_eq (b, make_t_bool) -> ok ("AND", make_t_bool)
+  | "AND", _ -> simple_fail "AND only defined over bool"
   | name, _ -> fail @@ unrecognized_constant name
 
 let untype_type_value (t:O.type_value) : (I.type_expression) result =