From e3179bd7c7eeacf461a9c3fc365581a45c5a0035 Mon Sep 17 00:00:00 2001
From: galfour <gabriel.alfour@gmail.com>
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)