more tests

This commit is contained in:
Galfour 2019-03-27 06:30:05 +00:00
parent 5507482b2d
commit 7716f78139
9 changed files with 95 additions and 8 deletions

View File

@ -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 =

View File

@ -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

View File

@ -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

View File

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

View File

@ -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)

View File

@ -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

View File

@ -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

View File

@ -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 ;

View File

@ -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 =