diff --git a/src/ligo/ast_simplified.ml b/src/ligo/ast_simplified.ml index 2dd856293..aaf2e7b7b 100644 --- a/src/ligo/ast_simplified.ml +++ b/src/ligo/ast_simplified.ml @@ -166,6 +166,15 @@ module PP = struct fprintf ppf "%s := %a" name annotated_expression ae | Matching (ae, m) -> fprintf ppf "match %a with %a" annotated_expression ae matching m + + let declaration ppf (d:declaration) = match d with + | Type_declaration {type_name ; type_expression = te} -> + fprintf ppf "type %s = %a" type_name type_expression te + | Constant_declaration {name ; annotated_expression = ae} -> + fprintf ppf "const %s = %a" name annotated_expression ae + + let program ppf (p:program) = + fprintf ppf "%a" (list_sep declaration) p end module Simplify = struct diff --git a/src/ligo/contracts/function-complex.ligo b/src/ligo/contracts/function-complex.ligo new file mode 100644 index 000000000..ec34cab7e --- /dev/null +++ b/src/ligo/contracts/function-complex.ligo @@ -0,0 +1,7 @@ +function main (const i : int) : int is + var j : int := 0 ; + var k : int := 1 ; + begin + j := k + i ; + k := i + j ; + end with (k + j) diff --git a/src/ligo/contracts/quote-declaration.ligo b/src/ligo/contracts/quote-declaration.ligo new file mode 100644 index 000000000..4c5547d4c --- /dev/null +++ b/src/ligo/contracts/quote-declaration.ligo @@ -0,0 +1,8 @@ +function foo (const input : int) : int is begin + skip +end with (input + 42) + +function main (const i : int) : int is + begin + skip + end with i + foo (i) diff --git a/src/ligo/contracts/quote-declarations.ligo b/src/ligo/contracts/quote-declarations.ligo new file mode 100644 index 000000000..1b783066d --- /dev/null +++ b/src/ligo/contracts/quote-declarations.ligo @@ -0,0 +1,13 @@ +function foo (const input : int) : int is begin + skip +end with (input + 23) + +function bar (const input : int) : int is begin + skip +end with (input + 51) + + +function main (const i : int) : int is + begin + skip + end with foo (i) + bar (i) diff --git a/src/ligo/ligo-helpers/trace.ml b/src/ligo/ligo-helpers/trace.ml index a38cdb871..54c1b2a6f 100644 --- a/src/ligo/ligo-helpers/trace.ml +++ b/src/ligo/ligo-helpers/trace.ml @@ -167,8 +167,10 @@ module Assert = struct | true -> ok () | false -> simple_fail msg - let assert_equal_int ?(msg="not equal int") a b = - assert_true ~msg (a = b) + 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) 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 6a795e0a3..ea9eb6fd5 100644 --- a/src/ligo/ligo.ml +++ b/src/ligo/ligo.ml @@ -11,7 +11,9 @@ module Transpiler = Transpiler open Ligo_helpers.Trace let parse_file (source:string) : AST_Raw.t result = - let channel = open_in source in + let%bind channel = + generic_try (simple_error "error opening file") @@ + (fun () -> open_in source) in let lexbuf = Lexing.from_channel channel in let Lexer.{read ; _} = Lexer.open_token_stream None in @@ -91,9 +93,14 @@ let transpile_value ?(env:Mini_c.Environment.t = Mini_c.Environment.empty) let untranspile_value (v : Mini_c.value) (e:AST_Typed.type_value) : AST_Typed.annotated_expression result = Transpiler.untranspile v e -let type_file (path:string) : AST_Typed.program result = +let type_file ?(debug_simplify = false) (path:string) : AST_Typed.program result = let%bind raw = parse_file path in - let%bind simpl = simplify raw in + let%bind simpl = + trace (simple_error "simplifying") @@ + simplify raw in + (if debug_simplify then + Format.printf "Simplified : %a\n%!" AST_Simplified.PP.program simpl + ) ; let%bind typed = trace (simple_error "typing") @@ type_ simpl in diff --git a/src/ligo/test/integration_tests.ml b/src/ligo/test/integration_tests.ml index a272e5e45..a1b5be378 100644 --- a/src/ligo/test/integration_tests.ml +++ b/src/ligo/test/integration_tests.ml @@ -25,10 +25,8 @@ let function_ () : unit result = let%bind _ = easy_run_main "./contracts/function.ligo" "2" in ok () -let declarations () : unit result = - let%bind program = type_file "./contracts/declarations.ligo" in - Format.printf "toto\n%!" ; - Printf.printf "toto\n%!" ; +let complex_function () : unit result = + let%bind program = type_file ~debug_simplify:true "./contracts/function-complex.ligo" in let aux n = let open AST_Typed.Combinators in let input = a_int n in @@ -36,15 +34,67 @@ let declarations () : unit result = let%bind result' = trace (simple_error "bad result") @@ get_a_int result in - Assert.assert_equal_int result' (42 + n) + Assert.assert_equal_int (3 * n + 2) result' in let%bind _ = bind_list @@ List.map aux @@ [0 ; 2 ; 42 ; 163 ; -1] in ok () +let declarations () : unit result = + let%bind program = type_file "./contracts/declarations.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 (42 + n) result' + in + let%bind _ = bind_list + @@ List.map aux + @@ [0 ; 2 ; 42 ; 163 ; -1] in + ok () + +let quote_declaration () : unit result = + let%bind program = type_file "./contracts/quote-declaration.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 result' (42 + 2 * n) + in + let%bind _ = bind_list + @@ List.map aux + @@ [0 ; 2 ; 42 ; 163 ; -1] in + ok () + +let quote_declarations () : unit result = + let%bind program = type_file "./contracts/quote-declarations.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 result' (74 + 2 * n) + in + let%bind _ = bind_list + @@ List.map aux + @@ [0 ; 2 ; 42 ; 163 ; -1] in + ok () + + let main = "Integration (End to End)", [ test "basic" basic ; test "function" function_ ; + test "complex function" complex_function ; test "declarations" declarations ; + test "quote declaration" quote_declaration ; + test "quote declarations" quote_declarations ; ] diff --git a/src/ligo/typer.ml b/src/ligo/typer.ml index 5a9c602bc..f2ba95d15 100644 --- a/src/ligo/typer.ml +++ b/src/ligo/typer.ml @@ -60,13 +60,23 @@ module Errors = struct let full = Format.asprintf "%s in %a" n Environment.PP.type_ e in error title full + let unbound_variable (e:environment) (n:string) = + let title = "unbound variable" in + let full = Format.asprintf "%s in %a" n Environment.PP.value e in + error title full + let unrecognized_constant (n:string) = let title = "unrecognized constant" in let full = n in error title full + + let constant_declaration_error (name:string) = + error "typing constant declaration" name + end open Errors + let rec type_program (p:I.program) : O.program result = let aux (e, acc:(environment * O.declaration list)) (d:I.declaration) = let%bind (e', d') = type_declaration e d in @@ -74,7 +84,9 @@ let rec type_program (p:I.program) : O.program result = | None -> ok (e', acc) | Some d' -> ok (e', d' :: acc) in - let%bind (_, lst) = bind_fold_list aux (Environment.empty, []) p in + let%bind (_, lst) = + trace (simple_error "typing program") @@ + bind_fold_list aux (Environment.empty, []) p in ok @@ List.rev lst and type_declaration env : I.declaration -> (environment * O.declaration option) result = function @@ -83,17 +95,23 @@ and type_declaration env : I.declaration -> (environment * O.declaration option) let env' = Environment.add_type env type_name tv in ok (env', None) | Constant_declaration {name;annotated_expression} -> - let%bind ae' = type_annotated_expression env annotated_expression in + let%bind ae' = + trace (constant_declaration_error name) @@ + type_annotated_expression env annotated_expression in let env' = Environment.add env name ae'.type_annotation in ok (env', Some (O.Constant_declaration {name;annotated_expression=ae'})) -and type_block (e:environment) (b:I.block) : O.block result = +and type_block_full (e:environment) (b:I.block) : (O.block * environment) result = let aux (e, acc:(environment * O.instruction list)) (i:I.instruction) = let%bind (e', i') = type_instruction e i in ok (e', i' :: acc) in - let%bind (_, lst) = bind_fold_list aux (e, []) b in - ok @@ List.rev lst + let%bind (e', lst) = bind_fold_list aux (e, []) b in + ok @@ (List.rev lst, e') + +and type_block (e:environment) (b:I.block) : O.block result = + let%bind (block, _) = type_block_full e b in + ok block and type_instruction (e:environment) : I.instruction -> (environment * O.instruction) result = function | Skip -> ok (e, O.Skip) @@ -216,7 +234,7 @@ and type_annotated_expression (e:environment) (ae:I.annotated_expression) : O.an (* Basic *) | Variable name -> let%bind tv' = - trace_option (simple_error "var not in env") + trace_option (unbound_variable e name) @@ Environment.get e name in let%bind type_annotation = check tv' in ok O.{expression = Variable name ; type_annotation} @@ -286,8 +304,8 @@ and type_annotated_expression (e:environment) (ae:I.annotated_expression) : O.an let%bind input_type = evaluate_type e input_type in let%bind output_type = evaluate_type e output_type in let e' = Environment.add e binder input_type in - let%bind result = type_annotated_expression e' result in - let%bind body = type_block e' body in + let%bind (body, e'') = type_block_full e' body in + let%bind result = type_annotated_expression e'' result in let%bind type_annotation = check @@ make_t_function (input_type, output_type) in ok O.{expression = Lambda {binder;input_type;output_type;result;body} ; type_annotation} | Constant (name, lst) ->