From cccbd424a88ab954661cb239eab90fb7a1a83974 Mon Sep 17 00:00:00 2001
From: Tom Jack <tom@tomjack.co>
Date: Wed, 23 Oct 2019 08:30:54 -0500
Subject: [PATCH 1/3] Implement Mini_c.Free_variables

---
 src/stages/mini_c/misc.ml | 97 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 97 insertions(+)

diff --git a/src/stages/mini_c/misc.ml b/src/stages/mini_c/misc.ml
index 60810643c..00f70cd9c 100644
--- a/src/stages/mini_c/misc.ml
+++ b/src/stages/mini_c/misc.ml
@@ -22,6 +22,103 @@ module Errors = struct
 
 end
 
+module Free_variables = struct
+
+  type bindings = string list
+  let mem : string -> bindings -> bool = List.mem
+  let singleton : string -> bindings = fun s -> [ s ]
+  let union : bindings -> bindings -> bindings = (@)
+  let unions : bindings list -> bindings = List.concat
+  let empty : bindings = []
+  let of_list : string list -> bindings = fun x -> x
+
+  let rec expression : bindings -> expression -> bindings = fun b e ->
+    let self = expression b in
+    match e.content with
+    | E_literal v -> value b v
+    | E_closure f -> lambda b f
+    | E_skip -> empty
+    | E_constant (_, xs) -> unions @@ List.map self xs
+    | E_application (f, x) -> unions @@ [ self f ; self x ]
+    | E_variable n -> var_name b n
+    | E_make_empty_map _ -> empty
+    | E_make_empty_list _ -> empty
+    | E_make_empty_set _ -> empty
+    | E_make_none _ -> empty
+    | E_iterator (_, ((v, _), body), expr) ->
+      unions [ expression (union (singleton v) b) body ;
+               self expr ;
+             ]
+    | E_fold (((v, _), body), collection, initial) ->
+      unions [ expression (union (singleton v) b) body ;
+               self collection ;
+               self initial ;
+             ]
+    | E_if_bool (x, bt, bf) -> unions [ self x ; self bt ; self bf ]
+    | E_if_none (x, bn, ((s, _), bs)) ->
+      unions [ self x ;
+               self bn ;
+               expression (union (singleton s) b) bs ;
+             ]
+    | E_if_cons (x, bnil , (((h, _) , (t, _)) , bcons)) ->
+      unions [ self x ;
+               self bnil ;
+               expression (unions [ singleton h ; singleton t ; b ]) bcons ;
+             ]
+    | E_if_left (x, ((l, _), bl), ((r, _), br)) ->
+      unions [ self x ;
+               expression (union (singleton l) b) bl ;
+               expression (union (singleton r) b) br ;
+             ]
+    | E_let_in ((v , _) , expr , body) ->
+      unions [ self expr ;
+               expression (union (singleton v) b) body ;
+             ]
+    | E_sequence (x, y) -> union (self x) (self y)
+    (* we do not consider the assigned variable free... seems strange,
+       but, matches ast_typed, and does not cause any troubles? *)
+    | E_assignment (_, _, e) -> self e
+    | E_while (cond , body) -> union (self cond) (self body)
+
+  and var_name : bindings -> var_name -> bindings = fun b n ->
+    if mem n b
+    then empty
+    else singleton n
+
+  and value : bindings -> value -> bindings = fun b v ->
+    let self = value b in
+    match v with
+    | D_unit
+    | D_bool _
+    | D_nat _
+    | D_timestamp _
+    | D_mutez _
+    | D_int _
+    | D_string _
+    | D_bytes _
+    | D_none
+    | D_operation _
+      -> empty
+    | D_pair (x, y) -> unions [ self x ; self y ]
+    | D_left x
+    | D_right x
+    | D_some x
+      -> self x
+    | D_map kvs
+    | D_big_map kvs
+      -> unions @@ List.map (fun (k, v) -> unions [ self k ; self v ]) kvs
+    | D_list xs
+    | D_set xs
+      -> unions @@ List.map self xs
+    | D_function f ->
+      lambda b f
+
+  and lambda : bindings -> anon_function -> bindings = fun b l ->
+    let b = union (singleton l.binder) b in
+    expression b l.body
+
+end
+
 (*
    Converts `expr` in `fun () -> expr`.
 *)

From e30b7faa9df29023d7ccfebe4fe29eae356a8e16 Mon Sep 17 00:00:00 2001
From: Tom Jack <tom@tomjack.co>
Date: Fri, 25 Oct 2019 01:01:45 -0500
Subject: [PATCH 2/3] Mini_c: Remove T_deep_closure and D_function

---
 src/main/compile/of_mini_c.ml             |  2 +-
 src/passes/6-transpiler/transpiler.ml     | 77 +++--------------------
 src/passes/6-transpiler/transpiler.mli    |  5 +-
 src/passes/7-self_mini_c/helpers.ml       | 18 +-----
 src/passes/8-compiler/compiler_program.ml | 41 ++++++------
 src/passes/8-compiler/compiler_type.ml    | 16 ++---
 src/stages/mini_c/PP.ml                   |  5 --
 src/stages/mini_c/combinators.ml          | 11 +---
 src/stages/mini_c/combinators.mli         |  4 +-
 src/stages/mini_c/misc.ml                 | 13 +---
 src/stages/mini_c/types.ml                |  2 -
 11 files changed, 47 insertions(+), 147 deletions(-)

diff --git a/src/main/compile/of_mini_c.ml b/src/main/compile/of_mini_c.ml
index bc1a2f260..ced31d622 100644
--- a/src/main/compile/of_mini_c.ml
+++ b/src/main/compile/of_mini_c.ml
@@ -25,7 +25,7 @@ let compile_expression_as_function : expression -> _ result = fun e ->
 let compile_function = fun e ->
   let%bind (input , output) = get_t_function e.type_value in
   let%bind body = get_function e in
-  let%bind body = compile_value body (t_function input output) in
+  let%bind body = Compiler.Program.translate_function_body body [] input in
   let body = Self_michelson.optimize body in
   let%bind (input , output) = bind_map_pair Compiler.Type.Ty.type_ (input , output) in
   let open! Compiler.Program in
diff --git a/src/passes/6-transpiler/transpiler.ml b/src/passes/6-transpiler/transpiler.ml
index 1beb15ef2..434f03352 100644
--- a/src/passes/6-transpiler/transpiler.ml
+++ b/src/passes/6-transpiler/transpiler.ml
@@ -228,36 +228,7 @@ let rec transpile_literal : AST.literal -> value = fun l -> match l with
   | Literal_unit -> D_unit
 
 and transpile_environment_element_type : AST.environment_element -> type_value result = fun ele ->
-  match (AST.get_type' ele.type_value , ele.definition) with
-  | (AST.T_function (arg , ret) , ED_declaration (ae , ((_ :: _) as captured_variables)) ) ->
-  begin
-    match ae.expression with
-    | E_lambda _ ->
-      let%bind ret' = transpile_type ret in
-      let%bind arg' = transpile_type arg in
-      let%bind env' = transpile_environment ae.environment in
-      let sub_env = Mini_c.Environment.select captured_variables env' in
-      if sub_env = [] then
-        transpile_type ele.type_value
-      else
-        ok @@ Combinators.t_deep_closure sub_env arg' ret'
-    | _ -> transpile_type ele.type_value
-  end
-  | _ -> transpile_type ele.type_value
-
-and transpile_small_environment : AST.small_environment -> Environment.t result = fun x ->
-  let x' = AST.Environment.Small.get_environment x in
-  let aux prec (name , (ele : AST.environment_element)) =
-    let%bind tv' = transpile_environment_element_type ele in
-    ok @@ Environment.add (name , tv') prec
-  in
-  let%bind result =
-    bind_fold_right_list aux Environment.empty x' in
-  ok result
-
-and transpile_environment : AST.full_environment -> Environment.t result = fun x ->
-  let%bind nlst = bind_map_ne_list transpile_small_environment x in
-  ok @@ Environment.concat @@ List.Ne.to_list nlst
+  transpile_type ele.type_value
 
 and tree_of_sum : AST.type_value -> (type_name * AST.type_value) Append_tree.t result = fun t ->
   let%bind map_tv = get_t_sum t in
@@ -435,11 +406,8 @@ and transpile_annotated_expression (ae:AST.annotated_expression) : expression re
         )
     )
   | E_lambda l ->
-    let%bind env =
-      trace_strong (corner_case ~loc:__LOC__ "environment") @@
-      transpile_environment ae.environment in
     let%bind io = AST.get_t_function ae.type_annotation in
-    transpile_lambda env l io
+    transpile_lambda l io
   | E_list lst -> (
       let%bind t =
         trace_strong (corner_case ~loc:__LOC__ "not a list") @@
@@ -610,40 +578,14 @@ and transpile_annotated_expression (ae:AST.annotated_expression) : expression re
       | AST.Match_tuple _ -> fail @@ unsupported_pattern_matching "tuple" ae.location
     )
 
-and transpile_lambda_deep : Mini_c.Environment.t -> AST.lambda -> _ -> Mini_c.expression result =
-  fun env l (input_type , output_type)->
+and transpile_lambda l (input_type , output_type) =
   let { binder ; body } : AST.lambda = l in
-  (* Deep capture. Capture the relevant part of the environment. *)
-  let%bind c_env =
-    let free_variables = Ast_typed.Free_variables.lambda [] l in
-    let sub_env = Mini_c.Environment.select free_variables env in
-    ok sub_env in
-  let%bind (f_expr' , input_tv , output_tv) =
-    let%bind raw_input = transpile_type input_type in
-    let%bind output = transpile_type output_type in
-    let%bind body = transpile_annotated_expression body in
-    let expr' = E_closure { binder ; body } in
-    ok (expr' , raw_input , output) in
-  let tv = Mini_c.t_deep_closure c_env input_tv output_tv in
-  ok @@ Expression.make_tpl (f_expr' , tv)
-
-and transpile_lambda env l (input_type , output_type) =
-  let { binder ; body } : AST.lambda = l in
-  let fvs = AST.Free_variables.(annotated_expression (singleton binder) body) in
-  let%bind result =
-    match fvs with
-    | [] -> (
-        let%bind result' = transpile_annotated_expression body in
-        let%bind input = transpile_type input_type in
-        let%bind output = transpile_type output_type in
-        let tv = Combinators.t_function input output in
-        let content = D_function { binder ; body = result'} in
-        ok @@ Combinators.Expression.make_tpl (E_literal content , tv)
-      )
-    | _ -> (
-        transpile_lambda_deep env l (input_type , output_type)
-      ) in
-  ok result
+  let%bind result' = transpile_annotated_expression body in
+  let%bind input = transpile_type input_type in
+  let%bind output = transpile_type output_type in
+  let tv = Combinators.t_function input output in
+  let closure = E_closure { binder ; body = result'} in
+  ok @@ Combinators.Expression.make_tpl (closure , tv)
 
 let transpile_declaration env (d:AST.declaration) : toplevel_statement result =
   match d with
@@ -671,7 +613,6 @@ let check_storage f ty loc : (anon_function * _) result =
       | T_pair (a , b) -> (aux (snd a) true) && (aux (snd b) false)
       | T_or (a,b) -> (aux (snd a) false) && (aux (snd b) false)
       | T_function (a,b) -> (aux a false) && (aux b false)
-      | T_deep_closure (_,a,b) -> (aux a false) && (aux b false)
       | T_map (a,b) -> (aux a false) && (aux b false)
       | T_list a -> (aux a false)
       | T_set a -> (aux a false)
diff --git a/src/passes/6-transpiler/transpiler.mli b/src/passes/6-transpiler/transpiler.mli
index 60600ea53..c03fdcb28 100644
--- a/src/passes/6-transpiler/transpiler.mli
+++ b/src/passes/6-transpiler/transpiler.mli
@@ -33,14 +33,11 @@ val tuple_access_to_lr : type_value -> type_value list -> int -> (type_value * [
 val record_access_to_lr : type_value -> type_value AST.type_name_map -> string -> (type_value * [`Left | `Right]) list result 
 val translate_literal : AST.literal -> value
 val transpile_environment_element_type : AST.environment_element -> type_value result
-val transpile_small_environment : AST.small_environment -> Environment.t result
-val transpile_environment : AST.full_environment -> Environment.t result
 val tree_of_sum : AST.type_value -> (type_name * AST.type_value) Append_tree.t result
 *)
 val transpile_annotated_expression : AST.annotated_expression -> expression result
 (*
-val transpile_lambda_deep : Mini_c.Environment.t -> AST.lambda -> Mini_c.expression result
-val transpile_lambda : Environment.t -> AST.lambda -> expression result
+val transpile_lambda : AST.lambda -> expression result
 val transpile_declaration : environment -> AST.declaration -> toplevel_statement result
 *)
 
diff --git a/src/passes/7-self_mini_c/helpers.ml b/src/passes/7-self_mini_c/helpers.ml
index 9904a8083..f3931e6ce 100644
--- a/src/passes/7-self_mini_c/helpers.ml
+++ b/src/passes/7-self_mini_c/helpers.ml
@@ -11,8 +11,6 @@ let rec fold_type_value : ('a -> type_value -> 'a result) -> 'a -> type_value ->
   | T_map (a, b)
   | T_big_map (a, b) ->
      bind_fold_pair self init' (a, b)
-  | T_deep_closure (env, a, b) ->
-     bind_fold_list self init' (List.map snd env @ [a; b])
   | T_list a
   | T_set a
   | T_contract a
@@ -31,11 +29,7 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
   | E_make_empty_set _ -> (
     ok init'
   )
-  | E_literal v -> (
-    match v with
-    | D_function an -> self init' an.body
-    | _ -> ok init'
-  )
+  | E_literal _ -> ok init'
   | E_constant (_, lst) -> (
       let%bind res = bind_fold_list self init' lst in
       ok res
@@ -96,16 +90,8 @@ let rec map_expression : mapper -> expression -> expression result = fun f e ->
   let%bind e' = f e in
   let return content = ok { e' with content } in
   match e'.content with
-  | E_variable _ | E_skip | E_make_none _
+  | E_variable _ | E_literal _ | E_skip | E_make_none _
   | E_make_empty_map (_,_) | E_make_empty_list _ | E_make_empty_set _ as em -> return em
-  | E_literal v -> (
-      let%bind v' = match v with
-      | D_function an ->
-        let%bind body = self an.body in
-        ok @@ D_function { an with body }
-      | _ -> ok v in
-      return @@ E_literal v'
-  )
   | E_constant (name, lst) -> (
       let%bind lst' = bind_map_list self lst in
       return @@ E_constant (name,lst')
diff --git a/src/passes/8-compiler/compiler_program.ml b/src/passes/8-compiler/compiler_program.ml
index 6f033acc6..4916dab73 100644
--- a/src/passes/8-compiler/compiler_program.ml
+++ b/src/passes/8-compiler/compiler_program.ml
@@ -86,11 +86,6 @@ let rec translate_value (v:value) ty : michelson result = match v with
       let%bind b' = translate_value b b_ty in
       ok @@ prim ~children:[b'] D_Right
     )
-  | D_function func -> (
-      match ty with
-      | T_function (in_ty , _) -> translate_function_body func [] in_ty
-      | _ -> simple_fail "expected function type"
-    )
   | D_none -> ok @@ prim D_None
   | D_some s ->
       let%bind s' = translate_value s ty in
@@ -143,19 +138,9 @@ and translate_expression (expr:expression) (env:environment) : michelson result
       return @@ i_push t v
   | E_closure anon -> (
       match ty with
-      | T_deep_closure (small_env , input_ty , output_ty) -> (
-          let selector = List.map fst small_env in
-          let%bind closure_pack_code = Compiler_environment.pack_closure env selector in
-          let%bind lambda_ty = Compiler_type.lambda_closure (small_env , input_ty , output_ty) in
-          let%bind lambda_body_code = translate_function_body anon small_env input_ty in
-          return @@ seq [
-            closure_pack_code ;
-            i_push lambda_ty lambda_body_code ;
-            i_swap ;
-            i_apply ;
-          ]
-        )
-      | _ -> simple_fail "expected closure type"
+      | T_function (input_ty , output_ty) ->
+        translate_function anon env input_ty output_ty
+      | _ -> simple_fail "expected function type"
     )
   | E_application (f , arg) -> (
       trace (simple_error "Compiling quote application") @@
@@ -407,6 +392,24 @@ and translate_function_body ({body ; binder} : anon_function) lst input : michel
 
   ok code
 
+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_body_code = translate_function_body anon small_env input_ty in
+  match fvs with
+  | [] -> ok @@ seq [ i_push lambda_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_swap ;
+      i_apply ;
+    ]
+
+
 type compiled_program = {
   input : ex_ty ;
   output : ex_ty ;
@@ -416,7 +419,7 @@ type compiled_program = {
 let get_main : program -> string -> (anon_function * _) result = fun p entry ->
   let is_main (((name , expr), _):toplevel_statement) =
     match Combinators.Expression.(get_content expr , get_type expr)with
-    | (E_literal (D_function content) , T_function ty)
+    | (E_closure content , T_function ty)
       when name = entry ->
         Some (content , ty)
     | _ ->  None
diff --git a/src/passes/8-compiler/compiler_type.ml b/src/passes/8-compiler/compiler_type.ml
index df0ff7bc6..d87132b08 100644
--- a/src/passes/8-compiler/compiler_type.ml
+++ b/src/passes/8-compiler/compiler_type.ml
@@ -73,7 +73,6 @@ module Ty = struct
   let comparable_type : type_value -> ex_comparable_ty result = fun tv ->
     match tv with
     | T_base b -> comparable_type_base b
-    | T_deep_closure _ -> fail (not_comparable "deep closure")
     | T_function _ -> fail (not_comparable "function")
     | T_or _ -> fail (not_comparable "or")
     | T_pair _ -> fail (not_comparable "pair")
@@ -117,10 +116,6 @@ 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 (_, arg, ret) ->
-        let%bind (Ex_ty arg) = type_ arg in
-        let%bind (Ex_ty ret) = type_ ret in
-        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
@@ -221,10 +216,6 @@ 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 (_ , arg , ret) ->
-      let%bind arg = type_ arg in
-      let%bind ret = type_ ret in
-      ok @@ O.prim ~children:[arg;ret] T_lambda
 
 and annotated : type_value annotated -> O.michelson result =
   function
@@ -242,10 +233,13 @@ and environment = fun env ->
   @@ List.map snd env
 
 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 capture arg) ret
+  match c with
+  | [] -> ok @@ O.t_lambda arg ret
+  | _ :: _ ->
+    let%bind capture = environment_closure c in
+    ok @@ O.t_lambda (O.t_pair capture arg) ret
 
 and environment_closure =
   function
diff --git a/src/stages/mini_c/PP.ml b/src/stages/mini_c/PP.ml
index e904ad01f..b36ae77a0 100644
--- a/src/stages/mini_c/PP.ml
+++ b/src/stages/mini_c/PP.ml
@@ -33,10 +33,6 @@ let rec type_ ppf : type_value -> _ = function
   | T_set(t) -> fprintf ppf "set(%a)" type_ t
   | T_option(o) -> fprintf ppf "option(%a)" type_ o
   | T_contract(t) -> fprintf ppf "contract(%a)" type_ t
-  | T_deep_closure(c, arg, ret) ->
-      fprintf ppf "[%a](%a)->(%a)"
-        environment c
-        type_ arg type_ ret
 
 and annotated ppf : type_value annotated -> _ = function
   | (Some ann, a) -> fprintf ppf "(%a %%%s)" type_ a ann
@@ -63,7 +59,6 @@ let rec value ppf : value -> unit = function
   | D_pair (a, b) -> fprintf ppf "(%a), (%a)" value a value b
   | D_left a -> fprintf ppf "L(%a)" value a
   | D_right b -> fprintf ppf "R(%a)" value b
-  | D_function x -> function_ ppf x
   | D_none -> fprintf ppf "None"
   | D_some s -> fprintf ppf "Some (%a)" value s
   | D_map m -> fprintf ppf "Map[%a]" (list_sep_d value_assoc) m
diff --git a/src/stages/mini_c/combinators.ml b/src/stages/mini_c/combinators.ml
index c716ee367..556682907 100644
--- a/src/stages/mini_c/combinators.ml
+++ b/src/stages/mini_c/combinators.ml
@@ -77,22 +77,18 @@ let get_set (v:value) = match v with
 
 let get_function_with_ty (e : expression) =
   match (e.content , e.type_value) with
-  | E_literal (D_function f) , T_function ty -> ok (f , ty)
+  | E_closure f , T_function ty -> ok (f , ty)
   | _ -> simple_fail "not a function with functional type"
 
 let get_function (e : expression) =
   match (e.content) with
-  | E_literal (D_function f) -> ok (D_function f)
+  | E_closure f -> ok f
   | _ -> simple_fail "not a function"
 
 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"
@@ -169,7 +165,6 @@ let t_unit : type_value = T_base Base_unit
 let t_nat : type_value = T_base Base_nat
 
 let t_function x y : type_value = T_function ( x , y )
-let t_deep_closure x y z : type_value = T_deep_closure ( x , y , z )
 let t_pair x y : type_value = T_pair ( x , y )
 let t_union x y : type_value = T_or ( x , y )
 
@@ -194,7 +189,7 @@ let ez_e_sequence a b : expression = Expression.(make_tpl (E_sequence (make_tpl
 let d_unit : value = D_unit
 
 let basic_quote expr in_ty out_ty : expression result =
-  let expr' = E_literal (D_function (quote "input" expr)) in
+  let expr' = E_closure (quote "input" expr) in
   ok @@ Expression.make_tpl (expr' , t_function in_ty out_ty)
 
 let basic_int_quote expr : expression result =
diff --git a/src/stages/mini_c/combinators.mli b/src/stages/mini_c/combinators.mli
index 7005b2c7e..f686bd522 100644
--- a/src/stages/mini_c/combinators.mli
+++ b/src/stages/mini_c/combinators.mli
@@ -30,9 +30,8 @@ val get_big_map : value -> ( value * value ) list result
 val get_list : value -> value list result
 val get_set : value -> value list result
 val get_function_with_ty : expression -> ( anon_function * ( type_value * type_value) ) result
-val get_function : expression -> value  result
+val get_function : expression -> anon_function result
 val get_t_function : type_value -> ( type_value * type_value ) result
-val get_t_closure : type_value -> ( environment * type_value * type_value ) result
 val get_t_option : type_value -> type_value result
 val get_pair : value -> ( value * value ) result
 val get_t_pair : type_value -> ( type_value * type_value ) result
@@ -57,7 +56,6 @@ val t_int : type_value
 val t_unit : type_value 
 val t_nat : type_value 
 val t_function : type_value -> type_value -> type_value
-val t_deep_closure : environment -> type_value -> type_value -> type_value
 val t_pair : type_value annotated -> type_value annotated -> type_value
 val t_union : type_value annotated -> type_value annotated -> type_value
 (*
diff --git a/src/stages/mini_c/misc.ml b/src/stages/mini_c/misc.ml
index 00f70cd9c..fb6d86449 100644
--- a/src/stages/mini_c/misc.ml
+++ b/src/stages/mini_c/misc.ml
@@ -110,8 +110,6 @@ module Free_variables = struct
     | D_list xs
     | D_set xs
       -> unions @@ List.map self xs
-    | D_function f ->
-      lambda b f
 
   and lambda : bindings -> anon_function -> bindings = fun b l ->
     let b = union (singleton l.binder) b in
@@ -123,7 +121,7 @@ end
    Converts `expr` in `fun () -> expr`.
 *)
 let functionalize (body : expression) : expression =
-  let content = E_literal (D_function { binder = "_" ; body }) in
+  let content = E_closure { binder = "_" ; body } in
   let type_value = t_function t_unit body.type_value in
   { content ; type_value }
 
@@ -179,19 +177,14 @@ let aggregate_entry (lst : program) (name : string) (to_functionalize : bool) :
     fun expr -> List.fold_right' aux expr pre_declarations
   in
   match (entry_expression.content , to_functionalize) with
-  | (E_literal (D_function l) , false) -> (
-      let l' = { l with body = wrapper l.body } in
-      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
+        let%bind (input_ty , output_ty) = get_t_function entry_expression.type_value in
         ok (t_function input_ty output_ty)
       in
       let e' = {
-        content = E_literal (D_function l') ;
+        content = E_closure l' ;
         type_value = t' ;
       } in
       ok e'
diff --git a/src/stages/mini_c/types.ml b/src/stages/mini_c/types.ml
index 2646d3dc9..dd9a40d5b 100644
--- a/src/stages/mini_c/types.ml
+++ b/src/stages/mini_c/types.ml
@@ -14,7 +14,6 @@ type type_value =
   | T_pair of (type_value annotated * type_value annotated)
   | T_or of (type_value annotated * type_value annotated)
   | T_function of (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_big_map of (type_value * type_value)
@@ -54,7 +53,6 @@ type value =
   | D_list of value list
   | D_set of value list
   (* | `Macro of anon_macro ... The future. *)
-  | D_function of anon_function
   | D_operation of Memory_proto_alpha.Protocol.Alpha_context.packed_internal_operation
 
 and selector = var_name list

From c969f306af8ccff83a367f733352ebef68b5eab9 Mon Sep 17 00:00:00 2001
From: Tom Jack <tom@tomjack.co>
Date: Sat, 2 Nov 2019 16:56:05 -0500
Subject: [PATCH 3/3] Eliminate dead lambdas

---
 src/main/compile/dune                   |  1 +
 src/main/compile/of_mini_c.ml           |  3 +++
 src/passes/7-self_mini_c/self_mini_c.ml | 29 +++++++++++++++++++++++++
 3 files changed, 33 insertions(+)
 create mode 100644 src/passes/7-self_mini_c/self_mini_c.ml

diff --git a/src/main/compile/dune b/src/main/compile/dune
index 705ed50b9..865a8ec1a 100644
--- a/src/main/compile/dune
+++ b/src/main/compile/dune
@@ -12,6 +12,7 @@
     ast_typed
     transpiler
     mini_c
+    self_mini_c
     compiler
     self_michelson
   )
diff --git a/src/main/compile/of_mini_c.ml b/src/main/compile/of_mini_c.ml
index ced31d622..9851d2d36 100644
--- a/src/main/compile/of_mini_c.ml
+++ b/src/main/compile/of_mini_c.ml
@@ -33,14 +33,17 @@ let compile_function = fun e ->
 
 let compile_expression_as_function_entry = fun program name ->
   let%bind aggregated = aggregate_entry program name true in
+  let%bind aggregated = Self_mini_c.all_expression aggregated in
   compile_function aggregated
 
 let compile_function_entry = fun program name ->
   let%bind aggregated = aggregate_entry program name false in
+  let%bind aggregated = Self_mini_c.all_expression aggregated in
   compile_function aggregated
 
 let compile_contract_entry = fun program name ->
   let%bind aggregated = aggregate_entry program name false in
+  let%bind aggregated = Self_mini_c.all_expression aggregated in
   let%bind compiled = compile_function aggregated in
   let%bind (param_ty , storage_ty) =
     let%bind fun_ty = get_t_function aggregated.type_value in
diff --git a/src/passes/7-self_mini_c/self_mini_c.ml b/src/passes/7-self_mini_c/self_mini_c.ml
new file mode 100644
index 000000000..96f134c91
--- /dev/null
+++ b/src/passes/7-self_mini_c/self_mini_c.ml
@@ -0,0 +1,29 @@
+open Mini_c
+open Trace
+
+(* Overly conservative for now: ok to treat pure things as impure,
+   must not treat impure things as pure. *)
+let is_pure : expression -> bool = fun e ->
+  match e.content with
+  | E_closure _ -> true
+  | _ -> false
+
+let rec elim_dead_lambdas : expression -> expression result = fun e ->
+  let changed = ref false in (* ugh *)
+  let mapper : Helpers.mapper = fun e ->
+    match e.content with
+    | E_let_in ((x, _), e1, e2) when is_pure e1 ->
+      let fvs = Free_variables.expression [] e2 in
+      if Free_variables.mem x fvs
+      then ok e
+      else
+        (* pure e1 is not used, eliminate! *)
+        (changed := true ; ok e2)
+    | _ -> ok e in
+  let%bind e = Helpers.map_expression mapper e in
+  if !changed
+  then elim_dead_lambdas e
+  else ok e
+
+let all_expression : expression -> expression result =
+  elim_dead_lambdas