diff --git a/src/ligo/ast_simplified.ml b/src/ligo/ast_simplified.ml index 4fe0d0559..bd3454395 100644 --- a/src/ligo/ast_simplified.ml +++ b/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 = diff --git a/src/ligo/ast_typed.ml b/src/ligo/ast_typed.ml index bdd3ea3f4..ab53237b5 100644 --- a/src/ligo/ast_typed.ml +++ b/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 diff --git a/src/ligo/contracts/boolean_operators.ligo b/src/ligo/contracts/boolean_operators.ligo new file mode 100644 index 000000000..38b94ba02 --- /dev/null +++ b/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 diff --git a/src/ligo/contracts/multiple-parameters.ligo b/src/ligo/contracts/multiple-parameters.ligo new file mode 100644 index 000000000..a0d1ef386 --- /dev/null +++ b/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) diff --git a/src/ligo/ligo-helpers/trace.ml b/src/ligo/ligo-helpers/trace.ml index 54c1b2a6f..c1de7450a 100644 --- a/src/ligo/ligo-helpers/trace.ml +++ 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) diff --git a/src/ligo/ligo.ml b/src/ligo/ligo.ml index b716d4457..bc81c7c57 100644 --- a/src/ligo/ligo.ml +++ b/src/ligo/ligo.ml @@ -110,31 +110,35 @@ let type_file ?(debug_simplify = false) ?(debug_typed = false) ) ; ok typed -let easy_run_main_typed - ?(debug_mini_c = false) +let easy_run_typed + ?(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 diff --git a/src/ligo/mini_c.ml b/src/ligo/mini_c.ml index 5e8882473..ee86c46de 100644 --- a/src/ligo/mini_c.ml +++ b/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 diff --git a/src/ligo/test/integration_tests.ml b/src/ligo/test/integration_tests.ml index eae2a9256..f8859daf7 100644 --- a/src/ligo/test/integration_tests.ml +++ b/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 ; diff --git a/src/ligo/typer.ml b/src/ligo/typer.ml index 2f3926a43..e35a333e0 100644 --- a/src/ligo/typer.ml +++ b/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 =