From 0199f3e448cc559b0beb59d116f92e2a9ee2faac Mon Sep 17 00:00:00 2001
From: galfour <gabriel.alfour@gmail.com>
Date: Thu, 14 May 2020 14:27:28 +0200
Subject: [PATCH] produce I_LAMBDA instead of I_PUSH directly for functions

---
 src/passes/12-compiler/compiler_program.ml |  7 ++++---
 src/passes/12-compiler/compiler_type.ml    | 10 ++++++++--
 src/passes/12-compiler/compiler_type.mli   |  2 ++
 3 files changed, 14 insertions(+), 5 deletions(-)

diff --git a/src/passes/12-compiler/compiler_program.ml b/src/passes/12-compiler/compiler_program.ml
index 1d3764a4c..c8459ed83 100644
--- a/src/passes/12-compiler/compiler_program.ml
+++ b/src/passes/12-compiler/compiler_program.ml
@@ -504,16 +504,17 @@ and translate_function_body ({body ; binder} : anon_function) lst input : michel
 and translate_function anon env input_ty output_ty : michelson result =
   let fvs = Mini_c.Free_variables.lambda [] anon in
   let small_env = Mini_c.Environment.select fvs env in
-  let%bind lambda_ty = Compiler_type.lambda_closure (small_env , input_ty , output_ty) in
+  let%bind (_lambda_ty , input_ty' , output_ty') =
+    Compiler_type.lambda_closure_with_ty (small_env , input_ty , output_ty) in
   let%bind lambda_body_code = translate_function_body anon small_env input_ty in
   match fvs with
-  | [] -> ok @@ seq [ i_push lambda_ty lambda_body_code ]
+  | [] -> ok @@ seq [ i_lambda input_ty' output_ty' lambda_body_code ]
   | _ :: _ ->
     let selector = List.map fst small_env in
     let%bind closure_pack_code = Compiler_environment.pack_closure env selector in
     ok @@ seq [
       closure_pack_code ;
-      i_push lambda_ty lambda_body_code ;
+      i_lambda input_ty' output_ty' lambda_body_code ;
       i_swap ;
       i_apply ;
     ]
diff --git a/src/passes/12-compiler/compiler_type.ml b/src/passes/12-compiler/compiler_type.ml
index 31be45fcc..9329afab0 100644
--- a/src/passes/12-compiler/compiler_type.ml
+++ b/src/passes/12-compiler/compiler_type.ml
@@ -265,13 +265,19 @@ and environment = fun env ->
   @@ List.map snd env
 
 and lambda_closure = fun (c , arg , ret) ->
+  let%bind (lambda , _arg' , _ret') =
+    lambda_closure_with_ty (c , arg , ret) in
+  ok lambda
+
+and lambda_closure_with_ty = fun (c , arg , ret) ->
   let%bind arg = type_ arg in
   let%bind ret = type_ ret in
   match c with
-  | [] -> ok @@ O.t_lambda arg ret
+  | [] -> ok @@ (O.t_lambda arg ret , arg , ret)
   | _ :: _ ->
     let%bind capture = environment_closure c in
-    ok @@ O.t_lambda (O.t_pair capture arg) ret
+    let arg' = O.t_pair capture arg in
+    ok @@ (O.t_lambda arg' ret , arg' , ret)
 
 and environment_closure =
   function
diff --git a/src/passes/12-compiler/compiler_type.mli b/src/passes/12-compiler/compiler_type.mli
index eb2bd747a..1c6186c50 100644
--- a/src/passes/12-compiler/compiler_type.mli
+++ b/src/passes/12-compiler/compiler_type.mli
@@ -87,6 +87,8 @@ val environment_element : string * type_expression -> (int, O.prim) Tezos_michel
 
 val environment : ( 'a * type_expression ) list -> O.t list result
 val lambda_closure : environment * type_expression  * type_expression -> (int, O.prim) Tezos_micheline.Micheline.node result
+val lambda_closure_with_ty : environment * type_expression  * type_expression ->
+                     (O.michelson * O.michelson * O.michelson) result
 
 val environment_closure : environment -> (int , O.prim ) Tezos_micheline.Micheline.node result
 (*