use apply for closures

src/main/run/of_michelson.ml

@@ -10,16 +10,16 @@ let run ?options (* ?(is_input_value = false) *) (program:compiled_program) (inp
   let Compiler.Program.{input;output;body} : compiled_program = program in
   let (Ex_ty input_ty) = input in
   let (Ex_ty output_ty) = output in
-  (* let%bind input_ty_mich =
+  let%bind input_ty_mich =
-   *   Trace.trace_tzresult_lwt (simple_error "error unparsing input ty") @@
+    Trace.trace_tzresult_lwt (simple_error "error unparsing input ty") @@
-   *   Memory_proto_alpha.unparse_michelson_ty input_ty in
+    Memory_proto_alpha.unparse_michelson_ty input_ty in
-   * let%bind output_ty_mich =
+  let%bind output_ty_mich =
-   *   Trace.trace_tzresult_lwt (simple_error "error unparsing output ty") @@
+    Trace.trace_tzresult_lwt (simple_error "error unparsing output ty") @@
-   *   Memory_proto_alpha.unparse_michelson_ty output_ty in
+    Memory_proto_alpha.unparse_michelson_ty output_ty in
-   * Format.printf "code: %a\n" Michelson.pp program.body ;
+  Format.printf "code: %a\n" Michelson.pp program.body ;
-   * Format.printf "input_ty: %a\n" Michelson.pp input_ty_mich ;
+  Format.printf "input_ty: %a\n" Michelson.pp input_ty_mich ;
-   * Format.printf "output_ty: %a\n" Michelson.pp output_ty_mich ;
+  Format.printf "output_ty: %a\n" Michelson.pp output_ty_mich ;
-   * Format.printf "input: %a\n" Michelson.pp input_michelson ; *)
+  Format.printf "input: %a\n" Michelson.pp input_michelson ;
   let%bind input =
     Trace.trace_tzresult_lwt (simple_error "error parsing input") @@
     Memory_proto_alpha.parse_michelson_data input_michelson input_ty

src/passes/8-compiler/compiler_environment.ml

@@ -88,5 +88,12 @@ let pack_closure : environment -> selector -> michelson result = fun e lst ->
   ok code
 
 let unpack_closure : environment -> michelson result = fun e ->
-  let aux = fun code _ -> seq [ i_unpair ; dip code ] in
+  match e with
-  ok (List.fold_right' aux (seq []) e)
+  | [] -> ok @@ seq []
+  | _ :: tl -> (
+      let aux = fun code _ -> seq [ i_unpair ; dip code ] in
+      let unpairs = (List.fold_right' aux (seq []) tl) in
+      ok @@ seq [ i_unpiar ; dip unpairs ]
+    )
+  (* let aux = fun code _ -> seq [ i_unpair ; dip code ] in
+   * ok (List.fold_right' aux (seq []) e) *)

src/passes/8-compiler/compiler_program.ml

@@ -151,33 +151,21 @@ and translate_expression (expr:expression) (env:environment) : michelson result
           return @@ seq [
             closure_pack_code ;
             i_push lambda_ty lambda_body_code ;
-            i_pair ;
+            i_swap ;
+            i_apply ;
           ]
         )
       | _ -> simple_fail "expected closure type"
     )
   | E_application (f , arg) -> (
-      match Combinators.Expression.get_type f with
+      trace (simple_error "Compiling quote application") @@
-      | T_function _ -> (
+      let%bind f = translate_expression f env in
-          trace (simple_error "Compiling quote application") @@
+      let%bind arg = translate_expression arg env in
-          let%bind f = translate_expression f env in
+      return @@ seq [
-          let%bind arg = translate_expression arg env in
+        arg ;
-          return @@ seq [
+        dip f ;
-            arg ;
+        prim I_EXEC ;
-            dip f ;
+      ]
-            prim I_EXEC ;
-          ]
-        )
-      | T_deep_closure (_ , _ , _) -> (
-          let%bind f_code = translate_expression f env in
-          let%bind arg_code = translate_expression arg env in
-          return @@ seq [
-            arg_code ;
-            dip (seq [ f_code ; i_unpair ; i_swap ]) ; i_pair ;
-            prim I_EXEC ;
-          ]
-        )
-      | _ -> simple_fail "E_applicationing something not appliable"
     )
   | E_variable x ->
     let%bind code = Compiler_environment.get env x in

src/passes/8-compiler/compiler_type.ml

@@ -115,11 +115,10 @@ module Ty = struct
         let%bind (Ex_ty arg) = type_ arg in
         let%bind (Ex_ty ret) = type_ ret in
         ok @@ Ex_ty (lambda arg ret)
-    | T_deep_closure (c, arg, ret) ->
+    | T_deep_closure (_, arg, ret) ->
-        let%bind (Ex_ty capture) = environment_representation c in
         let%bind (Ex_ty arg) = type_ arg in
         let%bind (Ex_ty ret) = type_ ret in
-        ok @@ Ex_ty (pair (lambda (pair arg capture) ret) capture)
+        ok @@ Ex_ty (lambda arg ret)
     | T_map (k, v) ->
         let%bind (Ex_comparable_ty k') = comparable_type k in
         let%bind (Ex_ty v') = type_ v in
@@ -219,10 +218,10 @@ let rec type_ : type_value -> O.michelson result =
       let%bind arg = type_ arg in
       let%bind ret = type_ ret in
       ok @@ O.prim ~children:[arg;ret] T_lambda
-  | T_deep_closure (c , arg , ret) ->
+  | T_deep_closure (_ , arg , ret) ->
-      let%bind capture = environment_closure c in
+      let%bind arg = type_ arg in
-      let%bind lambda = lambda_closure (c , arg , ret) in
+      let%bind ret = type_ ret in
-      ok @@ O.t_pair lambda capture
+      ok @@ O.prim ~children:[arg;ret] T_lambda
 
 and annotated : type_value annotated -> O.michelson result =
   function
@@ -243,7 +242,7 @@ and lambda_closure = fun (c , arg , ret) ->
   let%bind capture = environment_closure c in
   let%bind arg = type_ arg in
   let%bind ret = type_ ret in
-  ok @@ O.t_lambda (O.t_pair arg capture) ret
+  ok @@ O.t_lambda (O.t_pair capture arg) ret
 
 and environment_closure =
   function

vendors/ligo-utils/tezos-utils/x_michelson.ml

@@ -45,6 +45,8 @@ let i_push ty code = prim ~children:[ty;code] I_PUSH
 let i_push_unit = i_push t_unit d_unit
 let i_push_string str = i_push t_string (string str)
 
+let i_apply = prim I_APPLY
+
 let i_comment s : michelson = seq [ i_push_string s ; prim I_DROP ]
 
 let i_none ty = prim ~children:[ty] I_NONE