From e3179bd7c7eeacf461a9c3fc365581a45c5a0035 Mon Sep 17 00:00:00 2001 From: galfour Date: Thu, 19 Sep 2019 12:59:07 +0200 Subject: [PATCH] tests pass again --- src/main/compile/dune | 1 + src/main/compile/helpers.ml | 8 ++++++-- src/main/run/of_mini_c.ml | 6 ++++++ src/passes/3-self_ast_simplified/helpers.ml | 11 +++++++++++ .../self_ast_simplified.ml | 3 ++- src/passes/6-transpiler/transpiler.ml | 4 ++-- src/stages/mini_c/PP.ml | 2 +- src/stages/mini_c/combinators.ml | 4 ++++ src/stages/mini_c/misc.ml | 17 ++++++++++++++++- src/stages/mini_c/types.ml | 2 +- src/test/compiler_tests.ml | 2 +- src/test/contracts/annotation.ligo | 4 +--- src/test/integration_tests.ml | 10 +++++++--- 13 files changed, 59 insertions(+), 15 deletions(-) diff --git a/src/main/compile/dune b/src/main/compile/dune index bd1ac2d33..e8520e473 100644 --- a/src/main/compile/dune +++ b/src/main/compile/dune @@ -7,6 +7,7 @@ parser simplify ast_simplified + self_ast_simplified typer ast_typed transpiler diff --git a/src/main/compile/helpers.ml b/src/main/compile/helpers.ml index 5e47665a4..054c9e00d 100644 --- a/src/main/compile/helpers.ml +++ b/src/main/compile/helpers.ml @@ -62,11 +62,15 @@ let parsify = fun (syntax : v_syntax) source_filename -> | Pascaligo -> ok parsify_pascaligo | Cameligo -> ok parsify_ligodity in - parsify source_filename + let%bind parsified = parsify source_filename in + let%bind applied = Self_ast_simplified.convert_annotation_program parsified in + ok applied let parsify_expression = fun syntax source -> let%bind parsify = match syntax with | Pascaligo -> ok parsify_expression_pascaligo | Cameligo -> ok parsify_expression_ligodity in - parsify source + let%bind parsified = parsify source in + let%bind applied = Self_ast_simplified.convert_annotation_expression parsified in + ok applied diff --git a/src/main/run/of_mini_c.ml b/src/main/run/of_mini_c.ml index 0fecd02bb..dbe02bf08 100644 --- a/src/main/run/of_mini_c.ml +++ b/src/main/run/of_mini_c.ml @@ -35,6 +35,12 @@ let run_function ?options expression input ty = let%bind ex_ty_value = Of_michelson.run ?options code input in Compile.Of_mini_c.uncompile_value ex_ty_value +let run_function_value ?options expression input ty = + let%bind code = Compile.Of_mini_c.compile_function expression in + let%bind input = Compile.Of_mini_c.compile_value input ty in + let%bind ex_ty_value = Of_michelson.run ~is_input_value:true ?options code input in + Compile.Of_mini_c.uncompile_value ex_ty_value + let run_function_entry ?options program entry input = let%bind code = Compile.Of_mini_c.compile_function_entry program entry in let%bind input_michelson = diff --git a/src/passes/3-self_ast_simplified/helpers.ml b/src/passes/3-self_ast_simplified/helpers.ml index 8b41248eb..61aa8fcb2 100644 --- a/src/passes/3-self_ast_simplified/helpers.ml +++ b/src/passes/3-self_ast_simplified/helpers.ml @@ -125,3 +125,14 @@ and map_cases : mapper -> matching_expr -> matching_expr result = fun f m -> let%bind lst' = bind_map_list aux lst in ok @@ Match_variant lst' ) + +and map_program : mapper -> program -> program result = fun m p -> + let aux = fun (x : declaration) -> + match x with + | Declaration_constant (t , o , e) -> ( + let%bind e' = map_expression m e in + ok (Declaration_constant (t , o , e')) + ) + | Declaration_type _ -> ok x + in + bind_map_list (bind_map_location aux) p diff --git a/src/passes/3-self_ast_simplified/self_ast_simplified.ml b/src/passes/3-self_ast_simplified/self_ast_simplified.ml index 48ec6fc50..6aafa38a4 100644 --- a/src/passes/3-self_ast_simplified/self_ast_simplified.ml +++ b/src/passes/3-self_ast_simplified/self_ast_simplified.ml @@ -1 +1,2 @@ -let convert_annotation = Helpers.map_expression Tezos_type_annotation.peephole_expression +let convert_annotation_expression = Helpers.map_expression Tezos_type_annotation.peephole_expression +let convert_annotation_program = Helpers.map_program Tezos_type_annotation.peephole_expression diff --git a/src/passes/6-transpiler/transpiler.ml b/src/passes/6-transpiler/transpiler.ml index df99e3b4b..8e65cfdb7 100644 --- a/src/passes/6-transpiler/transpiler.ml +++ b/src/passes/6-transpiler/transpiler.ml @@ -547,9 +547,9 @@ let transpile_declaration env (d:AST.declaration) : toplevel_statement result = let transpile_program (lst : AST.program) : program result = let aux (prev:(toplevel_statement list * Environment.t) result) cur = - let%bind (tl, env) = prev in + let%bind (hds, env) = prev in let%bind ((_, env') as cur') = transpile_declaration env cur in - ok (cur' :: tl, env'.post_environment) + ok (hds @ [ cur' ], env'.post_environment) in let%bind (statements, _) = List.fold_left aux (ok ([], Environment.empty)) (temp_unwrap_loc_list lst) in ok statements diff --git a/src/stages/mini_c/PP.ml b/src/stages/mini_c/PP.ml index f2527d27b..3bb230627 100644 --- a/src/stages/mini_c/PP.ml +++ b/src/stages/mini_c/PP.ml @@ -69,7 +69,7 @@ and value_assoc ppf : (value * value) -> unit = fun (a, b) -> and expression' ppf (e:expression') = match e with | E_skip -> fprintf ppf "skip" - | E_closure x -> function_ ppf x + | E_closure x -> fprintf ppf "C(%a)" function_ x | E_variable v -> fprintf ppf "V(%s)" v | E_application(a, b) -> fprintf ppf "(%a)@(%a)" expression a expression b | E_constant(p, lst) -> fprintf ppf "%s %a" p (pp_print_list ~pp_sep:space_sep expression) lst diff --git a/src/stages/mini_c/combinators.ml b/src/stages/mini_c/combinators.ml index e9090a9d8..f19536e8f 100644 --- a/src/stages/mini_c/combinators.ml +++ b/src/stages/mini_c/combinators.ml @@ -81,6 +81,10 @@ let get_t_function tv = match tv with | T_function ty -> ok ty | _ -> simple_fail "not a function" +let get_t_closure tv = match tv with + | T_deep_closure ty -> ok ty + | _ -> simple_fail "not a function" + let get_t_option (v:type_value) = match v with | T_option t -> ok t | _ -> simple_fail "not an option" diff --git a/src/stages/mini_c/misc.ml b/src/stages/mini_c/misc.ml index 7fa6a9779..21e049e38 100644 --- a/src/stages/mini_c/misc.ml +++ b/src/stages/mini_c/misc.ml @@ -87,7 +87,22 @@ let aggregate_entry (lst : program) (name : string) (to_functionalize : bool) : let e' = { entry_expression with content = E_literal (D_function l') } in ok e' ) + | (E_closure l , false) -> ( + let l' = { l with body = wrapper l.body } in + let%bind t' = + let%bind (_ , input_ty , output_ty) = get_t_closure entry_expression.type_value in + ok (t_function input_ty output_ty) + in + let e' = { + content = E_literal (D_function l') ; + type_value = t' ; + } in + ok e' + ) | (_ , true) -> ( ok @@ functionalize @@ wrapper entry_expression ) - | _ -> fail @@ Errors.not_functional_main name + | _ -> ( + Format.printf "Not functional: %a\n" PP.expression entry_expression ; + fail @@ Errors.not_functional_main name + ) diff --git a/src/stages/mini_c/types.ml b/src/stages/mini_c/types.ml index d3b6bcf36..26801d227 100644 --- a/src/stages/mini_c/types.ml +++ b/src/stages/mini_c/types.ml @@ -12,7 +12,7 @@ type type_value = | T_pair of (type_value * type_value) | T_or of type_value * type_value | T_function of (type_value * type_value) - | T_deep_closure of environment * type_value * type_value + | T_deep_closure of (environment * type_value * type_value) | T_base of type_base | T_map of (type_value * type_value) | T_list of type_value diff --git a/src/test/compiler_tests.ml b/src/test/compiler_tests.ml index dd18c53f2..a93fb2ee7 100644 --- a/src/test/compiler_tests.ml +++ b/src/test/compiler_tests.ml @@ -5,7 +5,7 @@ open Test_helpers let run_entry_int e (n:int) : int result = let param : value = D_int n in - let%bind result = Run.Of_mini_c.run_function e param t_int in + let%bind result = Run.Of_mini_c.run_function_value e param t_int in match result with | D_int n -> ok n | _ -> simple_fail "result is not an int" diff --git a/src/test/contracts/annotation.ligo b/src/test/contracts/annotation.ligo index 1cae3ffe9..1eaef7b0c 100644 --- a/src/test/contracts/annotation.ligo +++ b/src/test/contracts/annotation.ligo @@ -1,5 +1,3 @@ const lst : list(int) = list [] ; -const address : address = "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" ; - -const address_2 : address = ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" : address) ; +const address : address = ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" : address) ; diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index f2dcd21c1..e5b097981 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -28,9 +28,6 @@ let annotation () : unit result = let%bind () = expect_eq_evaluate program "address" (e_address "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx") in - let%bind () = - expect_eq_evaluate program "address_2" (e_address "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx") - in ok () let complex_function () : unit result = @@ -99,14 +96,21 @@ let higher_order () : unit result = let shared_function () : unit result = let%bind program = type_file "./contracts/function-shared.ligo" in + Format.printf "inc\n" ; let%bind () = let make_expect = fun n -> (n + 1) in expect_eq_n_int program "inc" make_expect in + Format.printf "double inc?\n" ; + let%bind () = + expect_eq program "double_inc" (e_int 0) (e_int 2) + in + Format.printf "double incd!\n" ; let%bind () = let make_expect = fun n -> (n + 2) in expect_eq_n_int program "double_inc" make_expect in + Format.printf "foo\n" ; let%bind () = let make_expect = fun n -> (2 * n + 3) in expect_eq program "foo" (e_int 0) (e_int @@ make_expect 0)