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)