selection of environment can be done both ways

src/compiler/compiler_environment.ml

@@ -87,7 +87,7 @@ let add : environment -> (string * type_value) -> michelson result = fun e (_s ,
 
   ok code
 
-let select : environment -> string list -> michelson result = fun e lst ->
+let select ?(rev = false) : environment -> string list -> michelson result = fun e lst ->
   let module L = Logger.Stateful() in
   let e_lst =
     let e_lst = Environment.to_list e in
@@ -96,7 +96,11 @@ let select : environment -> string list -> michelson result = fun e lst ->
       match List.mem s selector with
       | true -> List.remove_element s selector , true
       | false -> selector , false in
-    let e_lst' = List.fold_map_right aux lst e_lst in
+    let e_lst' =
+      if rev
+      then List.fold_map aux lst e_lst
+      else List.fold_map_right aux lst e_lst
+    in
     let e_lst'' = List.combine e_lst e_lst' in
     e_lst'' in
   let code =
@@ -145,7 +149,7 @@ let clear : environment -> (michelson * environment) result = fun e ->
     trace_option (simple_error "try to clear empty env") @@
     List.nth_opt lst 0 in
   let%bind code = select e [ first_name ] in
-  let e' = Environment.select [ first_name ] e in
+  let e' = Environment.select ~rev:true [ first_name ] e in
   ok (code , e')
 
 let pack : environment -> michelson result = fun e ->

src/compiler/compiler_program.ml

@@ -106,11 +106,14 @@ and translate_expression ?(first=false) (expr:expression) (env:environment) : (m
   let return ?prepend_env ?end_env code =
     let%bind env' =
       match (prepend_env , end_env) with
-      | (Some _ , Some _) -> simple_fail ("two args to return at " ^ __LOC__)
+      | (Some _ , Some _) ->
-      | None , None -> ok @@ Environment.add ("_tmp_expression" , ty) env
+         simple_fail ("two args to return at " ^ __LOC__)
+      | None , None ->
+         ok @@ Environment.add ("_tmp_expression" , ty) env
       | Some prepend_env , None ->
         ok @@ Environment.add ("_tmp_expression" , ty) prepend_env
-      | None , Some end_env -> ok end_env in
+      | None , Some end_env ->
+         ok end_env in
     let%bind (Stack.Ex_stack_ty input_stack_ty) = Compiler_type.Ty.environment env in
     let%bind output_type = Compiler_type.type_ ty in
     let%bind (Stack.Ex_stack_ty output_stack_ty) = Compiler_type.Ty.environment env' in
@@ -152,6 +155,11 @@ and translate_expression ?(first=false) (expr:expression) (env:environment) : (m
         unpack ;
         i_skip ;
       ]
+      (* return ~end_env:load_env @@ seq [
+       *   expr' ;
+       *   dip clear ;
+       *   unpack ;
+       * ] *)
   | E_environment_select sub_env ->
       let%bind code = Compiler_environment.select_env env sub_env in
       return ~prepend_env:sub_env @@ seq [
@@ -161,6 +169,8 @@ and translate_expression ?(first=false) (expr:expression) (env:environment) : (m
   | E_environment_return expr -> (
       let%bind (expr' , env) = translate_expression expr env in
       let%bind (code , cleared_env) = Compiler_environment.clear env in
+      Format.printf "pre env %a\n" PP.environment env ;
+      Format.printf "post clean env %a\n" PP.environment cleared_env ;
       return ~end_env:cleared_env @@ seq [
         expr' ;
         code ;
@@ -221,7 +231,7 @@ and translate_expression ?(first=false) (expr:expression) (env:environment) : (m
   | E_variable x ->
     let%bind code = Compiler_environment.get env x in
     return code
-  | E_sequence (a , b) ->
+  | E_sequence (a , b) -> (
     let%bind (a' , env_a) = translate_expression a env in
     let%bind env_a' = Compiler_environment.pop env_a in
     let%bind (b' , env_b) = translate_expression b env_a' in
@@ -230,6 +240,13 @@ and translate_expression ?(first=false) (expr:expression) (env:environment) : (m
       i_drop ;
       b' ;
     ]
+    (* let%bind (a' , env_a) = translate_expression a env in
+     * let%bind (b' , env_b) = translate_expression b env_a in
+     * return ~end_env:env_b @@ seq [
+     *   a' ;
+     *   b' ;
+     * ] *)
+  )
   | E_constant(str, lst) ->
       let module L = Logger.Stateful() in
       let%bind lst' =
@@ -313,9 +330,9 @@ and translate_expression ?(first=false) (expr:expression) (env:environment) : (m
   | E_if_left (c, (l_ntv , l), (r_ntv , r)) -> (
       let%bind (c' , _env') = translate_expression c env in
       let l_env = Environment.add l_ntv env in
-      let%bind (l' , _) = translate_expression l l_env in
+      let%bind (l' , _l_env') = translate_expression l l_env in
       let r_env = Environment.add r_ntv env in
-      let%bind (r' , _) = translate_expression r r_env in
+      let%bind (r' , _r_env') = translate_expression r r_env in
       let%bind restrict_l = Compiler_environment.select_env l_env env in
       let%bind restrict_r = Compiler_environment.select_env r_env env in
       let%bind code = ok (seq [
@@ -406,7 +423,7 @@ and translate_expression ?(first=false) (expr:expression) (env:environment) : (m
 
 and translate_quote_body ({result ; binder ; input} as f:anon_function) : michelson result =
   let env = Environment.(add (binder , input) empty) in
-  let%bind (expr , _) = translate_expression result env in
+  let%bind (expr , env') = translate_expression result env in
   let code = seq [
       i_comment "function result" ;
       expr ;
@@ -419,10 +436,13 @@ and translate_quote_body ({result ; binder ; input} as f:anon_function) : michel
     let output_stack_ty = Stack.(output_ty @: nil) in
     let error_message () =
       Format.asprintf
-        "\ncode : %a\ninput : %a\noutput : %a\n"
+        "\nCode : %a\nMichelson code : %a\ninput : %a\noutput : %a\nstart env : %a\nend env : %a\n"
+        PP.expression result
         Michelson.pp code
         PP.type_ f.input
         PP.type_ f.output
+        PP.environment env
+        PP.environment env'
     in
     let%bind _ =
       Trace.trace_tzresult_lwt (

src/compiler/compiler_type.ml

@@ -10,12 +10,14 @@ module Contract_types = Meta_michelson.Types
 module Ty = struct
 
   let not_comparable name () = error (thunk "not a comparable type") (fun () -> name) ()
+  let not_compilable_type name () = error (thunk "not a compilable type") (fun () -> name) ()
 
   let comparable_type_base : type_base -> ex_comparable_ty result = fun tb ->
     let open Contract_types in
     let return x = ok @@ Ex_comparable_ty x in
     match tb with
     | Base_unit -> fail (not_comparable "unit")
+    | Base_void -> fail (not_comparable "void")
     | Base_bool -> fail (not_comparable "bool")
     | Base_nat -> return nat_k
     | Base_tez -> return tez_k
@@ -44,6 +46,7 @@ module Ty = struct
     let return x = ok @@ Ex_ty x in
     match b with
     | Base_unit -> return unit
+    | Base_void -> fail (not_compilable_type "void")
     | Base_bool -> return bool
     | Base_int -> return int
     | Base_nat -> return nat
@@ -118,6 +121,7 @@ end
 let base_type : type_base -> O.michelson result =
   function
   | Base_unit -> ok @@ O.prim T_unit
+  | Base_void -> fail (Ty.not_compilable_type "void")
   | Base_bool -> ok @@ O.prim T_bool
   | Base_int -> ok @@ O.prim T_int
   | Base_nat -> ok @@ O.prim T_nat

src/mini_c/PP.ml

@@ -10,6 +10,7 @@ let lr = fun ppf -> function `Left -> fprintf ppf "L" | `Right -> fprintf ppf "R
 
 let type_base ppf : type_base -> _ = function
   | Base_unit -> fprintf ppf "unit"
+  | Base_void -> fprintf ppf "void"
   | Base_bool -> fprintf ppf "bool"
   | Base_int -> fprintf ppf "int"
   | Base_nat -> fprintf ppf "nat"
@@ -48,7 +49,7 @@ let rec value ppf : value -> unit = function
   | D_nat n -> fprintf ppf "+%d" n
   | D_timestamp n -> fprintf ppf "+%d" n
   | D_tez n -> fprintf ppf "%dtz" n
-  | D_unit -> fprintf ppf " "
+  | D_unit -> fprintf ppf "unit"
   | D_string s -> fprintf ppf "\"%s\"" s
   | D_bytes _ -> fprintf ppf "[bytes]"
   | D_pair (a, b) -> fprintf ppf "(%a), (%a)" value a value b
@@ -68,12 +69,12 @@ and expression' ppf (e:expression') = match e with
   | E_environment_capture s -> fprintf ppf "capture(%a)" (list_sep string (const " ; ")) s
   | E_environment_load (expr , env) -> fprintf ppf "load %a in %a" expression expr environment env
   | E_environment_select env -> fprintf ppf "select %a" environment env
-  | E_environment_return expr -> fprintf ppf "return %a" expression expr
+  | E_environment_return expr -> fprintf ppf "return (%a)" expression expr
   | E_skip -> fprintf ppf "skip"
-  | E_variable v -> fprintf ppf "%s" v
+  | 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
-  | E_literal v -> fprintf ppf "%a" value v
+  | E_literal v -> fprintf ppf "L(%a)" value v
   | E_make_empty_map _ -> fprintf ppf "map[]"
   | E_make_empty_list _ -> fprintf ppf "list[]"
   | E_make_empty_set _ -> fprintf ppf "set[]"
@@ -82,8 +83,7 @@ and expression' ppf (e:expression') = match e with
   | E_if_none (c, n, ((name, _) , s)) -> fprintf ppf "%a ?? %a : %s -> %a" expression c expression n name expression s
   | E_if_left (c, ((name_l, _) , l), ((name_r, _) , r)) ->
       fprintf ppf "%a ?? %s -> %a : %s -> %a" expression c name_l expression l name_r expression r
-  | E_sequence (a , b) -> fprintf ppf "%a ; %a" expression a expression b
+  | E_sequence (a , b) -> fprintf ppf "%a ;; %a" expression a expression b
-  (* | E_sequence_drop (a , b) -> fprintf ppf "%a ;- %a" expression a expression b *)
   | E_let_in ((name , _) , expr , body) ->
       fprintf ppf "let %s = %a in ( %a )" name expression expr expression body
   | E_assignment (r , path , e) ->

src/mini_c/environment.ml

@@ -32,14 +32,18 @@ module Environment (* : ENVIRONMENT *) = struct
   let get_names : t -> string list = List.map fst
   let remove : int -> t -> t = List.remove
 
-  let select : string list -> t -> t = fun lst env ->
+  let select ?(rev = false) : string list -> t -> t = fun lst env ->
     let e_lst =
       let e_lst = to_list env in
       let aux selector (s , _) =
         match List.mem s selector with
         | true -> List.remove_element s selector , true
         | false -> selector , false in
-      let e_lst' = List.fold_map_right aux lst e_lst in
+      let e_lst' =
+        if rev
+        then List.fold_map aux lst e_lst
+        else List.fold_map_right aux lst e_lst
+      in
       let e_lst'' = List.combine e_lst e_lst' in
       e_lst'' in
     of_list

src/mini_c/types.ml

@@ -1,7 +1,7 @@
 type type_name = string
 
 type type_base =
-  | Base_unit
+  | Base_unit | Base_void
   | Base_bool
   | Base_int | Base_nat | Base_tez
   | Base_timestamp

src/transpiler/transpiler.ml

@@ -539,7 +539,7 @@ and translate_lambda env l =
         let%bind output = translate_type output_type in
         let tv = Combinators.t_function input output in
         let content = D_function {binder;input;output;result=result'} in
-        ok @@ Combinators.Expression.make_tpl (E_literal content, tv)
+        ok @@ Combinators.Expression.make_tpl (E_literal content , tv)
       )
     | _ -> (
         translate_lambda_deep env l