refactor: mini_c expression built and access through combinators

src/ligo/mini_c/PP.ml

@@ -73,11 +73,13 @@ and expression' ppf (e:expression') = match e with
   | E_make_none _ -> fprintf ppf "none"
   | E_Cond (c, a, b) -> fprintf ppf "%a ? %a : %a" expression c expression a expression b
 
-and expression ppf (e' , _ , _) = expression' ppf e'
+and expression : _ -> expression -> _ = fun ppf e ->
-
+  expression' ppf (Combinators.Expression.get_content e)
-and expression_with_type = fun ppf (e' , t , _) ->
-  fprintf ppf "%a : %a" expression' e' type_ t
 
+and expression_with_type : _ -> expression -> _  = fun ppf e ->
+  fprintf ppf "%a : %a"
+    expression' (Combinators.Expression.get_content e)
+    type_ (Combinators.Expression.get_type e)
 
 and function_ ppf ({binder ; input ; output ; body ; result ; capture_type}:anon_function_content) =
   fprintf ppf "fun[%s] (%s:%a) : %a %a return %a"

src/ligo/mini_c/combinators.ml

@@ -1,6 +1,30 @@
 open Trace
 open Types
 
+module Expression = struct
+  type t' = expression'
+  type t = expression
+
+  let get_content : t -> t' = fun e -> e.content
+  let get_type : t -> type_value = fun e -> e.type_value
+  let get_environment : t -> environment = fun e -> e.environment
+  let is_toplevel : t -> bool = fun e -> e.is_toplevel
+
+  let make = fun ?(itl = false) e' t env -> {
+    content = e' ;
+    type_value = t ;
+    environment = env ;
+    is_toplevel = itl ;
+  }
+
+  let make_tpl = fun ?(itl = false) (e' , t , env) -> {
+    content = e' ;
+    type_value = t ;
+    environment = env ;
+    is_toplevel = itl ;
+  }
+end
+
 let get_bool (v:value) = match v with
   | D_bool b -> ok b
   | _ -> simple_fail "not a bool"
@@ -93,64 +117,16 @@ let quote binder input output body result : anon_function =
 
 let basic_quote i o b : anon_function result =
   let%bind (_, e) = get_last_statement b in
-  let r : expression = (E_variable "output", o, e.post_environment) in
+  let r : expression = Expression.make_tpl (E_variable "output", o, e.post_environment) in
   ok @@ quote "input" i o b r
 
 let basic_int_quote b : anon_function result =
   basic_quote t_int t_int b
 
-let basic_int_quote_env : environment =
+let e_int expr env : expression = Expression.make_tpl (expr, t_int, env)
-  let e = Compiler_environment.empty in
-  Compiler_environment.add ("input", t_int) e
-
-let e_int expr env : expression = (expr, t_int, env)
 let e_var_int name env : expression = e_int (E_variable name) env
 
 let d_unit : value = D_unit
 
 let environment_wrap pre_environment post_environment = { pre_environment ; post_environment }
 let id_environment_wrap e = environment_wrap e e
-
-let statement s' e : statement =
-  match s' with
-  | S_environment_extend -> s', environment_wrap e (Compiler_environment.extend e)
-  | S_environment_restrict -> s', environment_wrap e (Compiler_environment.restrict e)
-  | S_environment_add (name, tv) -> s', environment_wrap e (Compiler_environment.add (name, tv) e)
-  | S_cond _ -> s', id_environment_wrap e
-  | S_if_none _ -> s', id_environment_wrap e
-  | S_while _ -> s', id_environment_wrap e
-  | S_patch _ -> s', id_environment_wrap e
-  | S_declaration (name, (_, t, _)) -> s', environment_wrap e (Compiler_environment.add (name, t) e)
-  | S_assignment (name, (_, t, _)) -> s', environment_wrap e (Compiler_environment.add (name, t) e)
-
-let block (statements:statement list) : block result =
-  match statements with
-  | [] -> simple_fail "no statements in block"
-  | lst ->
-      let first = List.hd lst in
-      let last = List.(nth lst (length lst - 1)) in
-      ok (lst, environment_wrap (snd first).pre_environment (snd last).post_environment)
-
-let append_statement' : block -> statement' -> block = fun b s' ->
-  let b_wrap = snd b in
-  let s = statement s' b_wrap.post_environment in
-  let s_wrap = snd s in
-  let b_wrap' = { b_wrap with post_environment = s_wrap.post_environment } in
-  let b_content = fst b in
-  (b_content @ [s], b_wrap')
-
-let prepend_statement : statement -> block -> block = fun s b ->
-  let s_wrap = snd s in
-  let b_wrap = snd b in
-  let b_wrap' = { b_wrap with pre_environment = s_wrap.pre_environment } in
-  let b_content = fst b in
-  (s :: b_content, b_wrap')
-
-let statements (lst:(environment -> statement) list) e : statement list =
-  let rec aux lst e = match lst with
-    | [] -> []
-    | hd :: tl ->
-        let s = hd e in
-        s :: aux tl (snd s).post_environment
-  in
-  aux lst e

src/ligo/mini_c/combinators_smart.ml

@@ -0,0 +1,51 @@
+open Trace
+open Types
+open Combinators
+
+let basic_int_quote_env : environment =
+  let e = Compiler_environment.empty in
+  Compiler_environment.add ("input", t_int) e
+
+let statement s' env : statement =
+  match s' with
+  | S_environment_extend -> s', environment_wrap env (Compiler_environment.extend env)
+  | S_environment_restrict -> s', environment_wrap env (Compiler_environment.restrict env)
+  | S_environment_add (name, tv) -> s' , environment_wrap env (Compiler_environment.add (name , tv) env)
+  | S_cond _ -> s' , id_environment_wrap env
+  | S_if_none _ -> s' , id_environment_wrap env
+  | S_while _ -> s' , id_environment_wrap env
+  | S_patch _ -> s' , id_environment_wrap env
+  | S_declaration (name , e) -> s', environment_wrap env (Compiler_environment.add (name , (Expression.get_type e)) env)
+  | S_assignment (name , e) -> s', environment_wrap env (Compiler_environment.add (name , (Expression.get_type e)) env)
+
+let block (statements:statement list) : block result =
+  match statements with
+  | [] -> simple_fail "no statements in block"
+  | lst ->
+      let first = List.hd lst in
+      let last = List.(nth lst (length lst - 1)) in
+      ok (lst, environment_wrap (snd first).pre_environment (snd last).post_environment)
+
+let append_statement' : block -> statement' -> block = fun b s' ->
+  let b_wrap = snd b in
+  let s = statement s' b_wrap.post_environment in
+  let s_wrap = snd s in
+  let b_wrap' = { b_wrap with post_environment = s_wrap.post_environment } in
+  let b_content = fst b in
+  (b_content @ [s], b_wrap')
+
+let prepend_statement : statement -> block -> block = fun s b ->
+  let s_wrap = snd s in
+  let b_wrap = snd b in
+  let b_wrap' = { b_wrap with pre_environment = s_wrap.pre_environment } in
+  let b_content = fst b in
+  (s :: b_content, b_wrap')
+
+let statements (lst:(environment -> statement) list) e : statement list =
+  let rec aux lst e = match lst with
+    | [] -> []
+    | hd :: tl ->
+        let s = hd e in
+        s :: aux tl (snd s).post_environment
+  in
+  aux lst e

src/ligo/mini_c/compiler.ml

@@ -55,8 +55,8 @@ let rec get_predicate : string -> expression list -> predicate result = fun s ls
   (* | "CONS" -> ok @@ simple_binary @@ seq [prim I_SWAP ; prim I_CONS] *)
   | "MAP_REMOVE" ->
       let%bind v = match lst with
-        | [ _ ; (_, m, _) ] ->
+        | [ _ ; expr ] ->
-            let%bind (_, v) = Combinators.get_t_map m in
+            let%bind (_, v) = Combinators.(get_t_map (Expression.get_type expr)) in
             ok v
         | _ -> simple_fail "mini_c . MAP_REMOVE" in
       let%bind v_ty = Compiler_type.type_ v in
@@ -113,7 +113,8 @@ and translate_function ({capture;content}:anon_function) : michelson result =
       ok @@ d_pair capture_m body
   | _ -> simple_fail "compiling closure without capture"
 
-and translate_expression ((expr', ty, env) as expr:expression) : michelson result =
+and translate_expression (expr:expression) : michelson result =
+  let (expr' , ty , env) = Combinators.Expression.(get_content expr , get_type expr , get_environment expr) in
   let error_message () = Format.asprintf  "%a" PP.expression expr in
 
   let return code =
@@ -157,8 +158,8 @@ and translate_expression ((expr', ty, env) as expr:expression) : michelson resul
           prim ~children:[t;v] I_PUSH ;
           prim I_PAIR ;
         ]
-    | E_application((_, f_ty, _) as f, arg) -> (
+    | E_application(f, arg) -> (
-        match f_ty with
+        match Combinators.Expression.get_type f with
         | T_function _ -> (
             trace (simple_error "Compiling quote application") @@
             let%bind f = translate_expression f in
@@ -259,22 +260,22 @@ and translate_expression ((expr', ty, env) as expr:expression) : michelson resul
                 i_pair ;
               ] in
             return code
-        | Deep_capture small_env ->
+        | Deep_capture _small_env -> simple_fail "no deep capture expression yet"
-            (* Capture the variable bounds, assemble them. On call, append the input. *)
+            (* (\* Capture the variable bounds, assemble them. On call, append the input. *\)
-            let senv_type = Compiler_environment.Small.to_mini_c_type small_env in
+             * let senv_type = Compiler_environment.Small.to_mini_c_type small_env in
-            let%bind body = translate_closure_body anon senv_type in
+             * let%bind body = translate_closure_body anon senv_type in
-            let%bind capture = Environment.Small.to_mini_c_capture env small_env in
+             * let%bind capture = Environment.Small.to_mini_c_capture env small_env in
-            let%bind capture = translate_expression capture in
+             * let%bind capture = translate_expression capture in
-            let%bind input_type = Compiler_type.type_ anon.input in
+             * let%bind input_type = Compiler_type.type_ anon.input in
-            let%bind output_type = Compiler_type.type_ anon.output in
+             * let%bind output_type = Compiler_type.type_ anon.output in
-            let code = seq [
+             * let code = seq [
-                capture ;
+             *     capture ;
-                i_unpair ;
+             *     i_unpair ;
-                i_lambda input_type output_type body ;
+             *     i_lambda input_type output_type body ;
-                i_piar ;
+             *     i_piar ;
-                i_pair ;
+             *     i_pair ;
-              ] in
+             *   ] in
-            return code
+             * return code *)
         | Shallow_capture env ->
             (* Capture the whole environment. *)
             let env_type = Compiler_environment.to_mini_c_type env in
@@ -330,7 +331,8 @@ and translate_statement ((s', w_env) as s:statement) : michelson result =
         simple_fail "not ready yet"
     (* | S_environment_add (name, tv) ->
      *     Environment.to_michelson_add (name, tv) w_env.pre_environment *)
-    | S_declaration (s, ((_, tv, _) as expr)) ->
+    | S_declaration (s, expr) ->
+        let tv = Combinators.Expression.get_type expr in
         let%bind expr = translate_expression expr in
         let%bind add = Environment.to_michelson_add (s, tv) w_env.pre_environment in
         ok (seq [
@@ -382,7 +384,7 @@ and translate_statement ((s', w_env) as s:statement) : michelson result =
               seq [add ; some'] ;
             ] I_IF_NONE
           ])
-    | S_while ((_, _, _) as expr, block) ->
+    | S_while (expr, block) ->
         let%bind expr = translate_expression expr in
         let%bind block' = translate_regular_block block in
         let%bind restrict_block =
@@ -540,12 +542,12 @@ type compiled_program = {
 }
 
 let translate_program (p:program) (entry:string) : compiled_program result =
-  let is_main ((s, _):toplevel_statement) =
+  let is_main (((name , expr), _):toplevel_statement) =
-    match s with
+    match Combinators.Expression.(get_content expr , get_type expr)with
-    | name , (E_function f, T_function (_, _), _)
+    | (E_function f , T_function _)
       when f.capture_type = No_capture && name = entry ->
         Some f
-    | name , (E_literal (D_function {content ; capture = None}), T_function (_, _), _)
+    | (E_literal (D_function {content ; capture = None}) , T_function _)
       when name = entry ->
         Some content
     | _ ->  None

src/ligo/mini_c/compiler_environment.ml

@@ -117,16 +117,16 @@ module Small = struct
     | Empty -> ok (dip i_drop)
     | Full x -> to_michelson_append' x
 
-  let rec to_mini_c_capture' env : _ -> expression result = function
+  (* let rec to_mini_c_capture' env : _ -> expression result = function
-    | Leaf (n, tv) -> ok (E_variable n, tv, env)
+   *   | Leaf (n, tv) -> ok (E_variable n, tv, env)
-    | Node {a;b} ->
+   *   | Node {a;b} ->
-        let%bind ((_, ty_a, _) as a) = to_mini_c_capture' env a in
+   *       let%bind ((_, ty_a, _) as a) = to_mini_c_capture' env a in
-        let%bind ((_, ty_b, _) as b) = to_mini_c_capture' env b in
+   *       let%bind ((_, ty_b, _) as b) = to_mini_c_capture' env b in
-        ok (E_constant ("PAIR", [a;b]), (T_pair(ty_a, ty_b) : type_value), env)
+   *       ok (E_constant ("PAIR", [a;b]), (T_pair(ty_a, ty_b) : type_value), env)
-
+   *
-  let to_mini_c_capture env = function
+   * let to_mini_c_capture env = function
-    | Empty -> simple_fail "to_mini_c_capture"
+   *   | Empty -> simple_fail "to_mini_c_capture"
-    | Full x -> to_mini_c_capture' env x
+   *   | Full x -> to_mini_c_capture' env x *)
 
   let rec to_mini_c_type' : _ -> type_value = function
     | Leaf (_, t) -> t
@@ -183,9 +183,9 @@ let rec to_mini_c_type = function
   | [hd] -> Small.to_mini_c_type hd
   | Append_tree.Empty :: tl -> to_mini_c_type tl
   | hd :: tl -> T_pair(Small.to_mini_c_type hd, to_mini_c_type tl)
-let to_mini_c_capture = function
+(* let to_mini_c_capture = function
-  | [a] -> Small.to_mini_c_capture a
+ *   | [a] -> Small.to_mini_c_capture a
-  | _ -> raise (Failure "Schema.Big.to_mini_c_capture")
+ *   | _ -> raise (Failure "Schema.Big.to_mini_c_capture") *)
 
 type path = [`Left | `Right] list
 let pp_path : _ -> path -> unit =

src/ligo/mini_c/dune

@@ -8,5 +8,5 @@
   (preprocess
     (pps ppx_let)
   )
-  (flags (:standard -w +1..62-4-9-44-40-42-48@39@33 -open Tezos_utils ))
+  (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Tezos_utils ))
 )

src/ligo/mini_c/mini_c.ml

@@ -1,7 +1,10 @@
 include Types
 
 module PP = PP
-module Combinators = Combinators
+module Combinators = struct
+  include Combinators
+  include Combinators_smart
+end
 module Environment = Compiler_environment
 module Compiler_type = Compiler_type
 module Compiler = Compiler

src/ligo/mini_c/run.ml

@@ -51,8 +51,8 @@ let run (program:program) (input:value) : value result =
   let%bind (result : value) = Uncompiler.translate_value ex_ty_value in
   ok result
 
-let expression_to_value ((e', _, _) as e:expression) : value result =
+let expression_to_value (e:expression) : value result =
-  match e' with
+  match (Combinators.Expression.get_content e) with
   | E_literal v -> ok v
   | _ -> fail
       @@ error (thunk "not a value")

src/ligo/mini_c/types.ml

@@ -65,7 +65,12 @@ and expression' =
   | E_make_none of type_value
   | E_Cond of expression * expression * expression
 
-and expression = expression' * type_value * environment (* Environment in which the expressions are evaluated *)
+and expression = {
+  content : expression' ;
+  type_value : type_value ;
+  environment : environment ;  (* Environment in which the expressions are evaluated *)
+  is_toplevel : bool ;
+}
 
 and assignment = var_name * expression
 

src/ligo/transpiler.ml

@@ -118,8 +118,8 @@ and translate_instruction (env:Environment.t) (i:AST.instruction) : statement li
   let return ?(env' = env) x : statement list result = ok ([x, environment_wrap env env']) in
   match i with
   | I_declaration {name;annotated_expression} ->
-      let%bind (_, t, _) as expression = translate_annotated_expression env annotated_expression in
+      let%bind expression = translate_annotated_expression env annotated_expression in
-      let env' = Environment.add (name, t) env in
+      let env' = Environment.add (name, (Combinators.Expression.get_type expression)) env in
       return ~env' (S_declaration (name, expression))
   | I_assignment {name;annotated_expression} ->
       let%bind expression = translate_annotated_expression env annotated_expression in
@@ -179,62 +179,67 @@ and translate_instruction (env:Environment.t) (i:AST.instruction) : statement li
   | I_skip -> ok []
   | I_fail _ -> simple_fail "todo : fail"
 
+and translate_literal : AST.literal -> value = fun l -> match l with
+  | Literal_bool b -> D_bool b
+  | Literal_int n -> D_int n
+  | Literal_nat n -> D_nat n
+  | Literal_bytes s -> D_bytes s
+  | Literal_string s -> D_string s
+  | Literal_unit -> D_unit
+
 and translate_annotated_expression (env:Environment.t) (ae:AST.annotated_expression) : expression result =
   let%bind tv = translate_type ae.type_annotation in
-  let return (expr, tv) = ok (expr, tv, env) in
+  let return ?(tv = tv) expr = ok @@ Combinators.Expression.make_tpl (expr, tv, env) in
   let f = translate_annotated_expression env in
   match ae.expression with
-  | E_literal (Literal_bool b) -> ok (E_literal (D_bool b), tv, env)
+  | E_literal l -> return @@ E_literal (translate_literal l)
-  | E_literal (Literal_int n) -> ok (E_literal (D_int n), tv, env)
-  | E_literal (Literal_nat n) -> ok (E_literal (D_nat n), tv, env)
-  | E_literal (Literal_bytes s) -> ok (E_literal (D_bytes s), tv, env)
-  | E_literal (Literal_string s) -> ok (E_literal (D_string s), tv, env)
-  | E_literal Literal_unit -> ok (E_literal D_unit, tv, env)
   | E_variable name ->
       let%bind tv =
         trace_option (simple_error "transpiler: variable not in env") @@
         Environment.get_opt env name in
-      ok (E_variable name, tv, env)
+      return ~tv @@ E_variable name
   | E_application (a, b) ->
       let%bind a = translate_annotated_expression env a in
       let%bind b = translate_annotated_expression env b in
-      ok (E_application (a, b), tv, env)
+      return @@ E_application (a, b)
   | E_constructor (m, param) ->
-      let%bind (param'_expr, param'_tv, _) = translate_annotated_expression env ae in
+      let%bind param' = translate_annotated_expression env ae in
+      let (param'_expr , param'_tv) = Combinators.Expression.(get_content param' , get_type param') in
       let%bind map_tv = get_t_sum ae.type_annotation in
       let node_tv = Append_tree.of_list @@ kv_list_of_map map_tv in
-      let%bind ae' =
+      let leaf (k, tv) : (expression' option * type_value) result =
-        let leaf (k, tv) : (expression' option * type_value) result =
+        if k = m then (
-          if k = m then (
+          let%bind _ =
-            let%bind _ =
+            trace (simple_error "constructor parameter doesn't have expected type (shouldn't happen here)")
-              trace (simple_error "constructor parameter doesn't have expected type (shouldn't happen here)")
+            @@ AST.assert_type_value_eq (tv, param.type_annotation) in
-              @@ AST.assert_type_value_eq (tv, param.type_annotation) in
+          ok (Some (param'_expr), param'_tv)
-            ok (Some (param'_expr), param'_tv)
+        ) else (
-          ) else (
+          let%bind tv = translate_type tv in
-            let%bind tv = translate_type tv in
+          ok (None, tv)
-            ok (None, tv)
+        ) in
-          ) in
+      let node a b : (expression' option * type_value) result =
-        let node a b : (expression' option * type_value) result =
+        let%bind a = a in
-          let%bind a = a in
+        let%bind b = b in
-          let%bind b = b in
+        match (a, b) with
-          match (a, b) with
+        | (None, a), (None, b) -> ok (None, T_or (a, b))
-          | (None, a), (None, b) -> ok (None, T_or (a, b))
+        | (Some _, _), (Some _, _) -> simple_fail "several identical constructors in the same variant (shouldn't happen here)"
-          | (Some _, _), (Some _, _) -> simple_fail "several identical constructors in the same variant (shouldn't happen here)"
+        | (Some v, a), (None, b) -> ok (Some (E_constant ("LEFT", [Combinators.Expression.make_tpl (v, a, env)])), T_or (a, b))
-          | (Some v, a), (None, b) -> ok (Some (E_constant ("LEFT", [v, a, env])), T_or (a, b))
+        | (None, a), (Some v, b) -> ok (Some (E_constant ("RIGHT", [Combinators.Expression.make_tpl (v, b, env)])), T_or (a, b))
-          | (None, a), (Some v, b) -> ok (Some (E_constant ("RIGHT", [v, b, env])), T_or (a, b))
+      in
-        in
+      let%bind (ae_opt, tv) = Append_tree.fold_ne leaf node node_tv in
-        let%bind (ae_opt, tv) = Append_tree.fold_ne leaf node node_tv in
+      let%bind ae =
-        let%bind ae =
+        trace_option (simple_error "constructor doesn't exist in claimed type (shouldn't happen here)")
-          trace_option (simple_error "constructor doesn't exist in claimed type (shouldn't happen here)")
+          ae_opt in
-            ae_opt in
+      return ~tv ae
-        ok (ae, tv, env) in
-      ok ae'
   | E_tuple lst ->
       let node = Append_tree.of_list lst in
       let aux (a:expression result) (b:expression result) : expression result =
-        let%bind (_, a_ty, _) as a = a in
+        let%bind a = a in
-        let%bind (_, b_ty, _) as b = b in
+        let%bind b = b in
-        ok (E_constant ("PAIR", [a; b]), T_pair(a_ty, b_ty), env)
+        let a_ty = Combinators.Expression.get_type a in
+        let b_ty = Combinators.Expression.get_type b in
+        let tv = T_pair (a_ty , b_ty) in
+        return ~tv @@ E_constant ("PAIR", [a; b])
       in
       Append_tree.fold_ne (translate_annotated_expression env) aux node
   | E_tuple_accessor (tpl, ind) ->
@@ -246,22 +251,31 @@ and translate_annotated_expression (env:Environment.t) (ae:AST.annotated_express
         let c = match lr with
           | `Left -> "CAR"
           | `Right -> "CDR" in
-        E_constant (c, [pred]), ty, env in
+        Combinators.Expression.make_tpl (E_constant (c, [pred]) , ty , env) in
       let%bind tpl' = translate_annotated_expression env tpl in
       let expr = List.fold_left aux tpl' path in
       ok expr
   | E_record m ->
       let node = Append_tree.of_list @@ list_of_map m in
       let aux a b : expression result =
-        let%bind (_, a_ty, _) as a = a in
+        let%bind a = a in
-        let%bind (_, b_ty, _) as b = b in
+        let%bind b = b in
-        ok (E_constant ("PAIR", [a; b]), T_pair(a_ty, b_ty), env)
+        let a_ty = Combinators.Expression.get_type a in
+        let b_ty = Combinators.Expression.get_type b in
+        let tv = T_pair (a_ty , b_ty) in
+        return ~tv @@ E_constant ("PAIR", [a; b])
       in
       Append_tree.fold_ne (translate_annotated_expression env) aux node
   | E_record_accessor (record, property) ->
       let%bind translation = translate_annotated_expression env record in
       let%bind record_type_map =
-        trace (simple_error (Format.asprintf "Accessing field of %a, that has type %a, which isn't a record" AST.PP.annotated_expression record AST.PP.type_value record.type_annotation)) @@
+        let error =
+          let title () =
+            Format.asprintf "Accessing field of %a, that has type %a, which isn't a record"
+              AST.PP.annotated_expression record AST.PP.type_value record.type_annotation in
+          let content () = "" in
+          error title content in
+        trace error @@
         get_t_record record.type_annotation in
       let node_tv = Append_tree.of_list @@ kv_list_of_map record_type_map in
       let leaf (key, _) : expression result =
@@ -272,13 +286,13 @@ and translate_annotated_expression (env:Environment.t) (ae:AST.annotated_express
         ) in
       let node (a:expression result) b : expression result =
         match%bind bind_lr (a, b) with
-        | `Left ((_, t, env) as ex) -> (
+        | `Left expr -> (
-            let%bind (a, _) = get_t_pair t in
+            let%bind (tv, _) = get_t_pair @@ Combinators.Expression.get_type expr in
-            ok (E_constant ("CAR", [ex]), a, env)
+            return ~tv @@ E_constant ("CAR", [expr])
           )
-        | `Right ((_, t, env) as ex) -> (
+        | `Right expr -> (
-            let%bind (_, b) = get_t_pair t in
+            let%bind (_, tv) = get_t_pair @@ Combinators.Expression.get_type expr in
-            ok (E_constant ("CDR", [ex]), b, env)
+            return ~tv @@ E_constant ("CDR", [expr])
           ) in
       let%bind expr =
         trace_strong (simple_error "bad key in record (shouldn't happen here)") @@
@@ -289,16 +303,16 @@ and translate_annotated_expression (env:Environment.t) (ae:AST.annotated_express
         match name, lst with
         | "NONE", [] ->
             let%bind o = Mini_c.Combinators.get_t_option tv in
-            ok (E_make_none o, tv, env)
+            return @@ E_make_none o
-        | _ -> ok (E_constant (name, lst'), tv, env)
+        | _ -> return @@ E_constant (name, lst')
       )
   | E_lambda l -> translate_lambda env l
   | E_list lst ->
       let%bind t = Mini_c.Combinators.get_t_list tv in
       let%bind lst' = bind_map_list (translate_annotated_expression env) lst in
       let aux : expression -> expression -> expression result = fun prev cur ->
-        return (E_constant ("CONS", [cur ; prev]), tv) in
+        return @@ E_constant ("CONS", [cur ; prev]) in
-      let%bind (init : expression) = return (E_empty_list t, tv) in
+      let%bind (init : expression) = return @@ E_empty_list t in
       bind_fold_list aux init lst'
   | E_map m ->
       let%bind (src, dst) = Mini_c.Combinators.get_t_map tv in
@@ -307,19 +321,19 @@ and translate_annotated_expression (env:Environment.t) (ae:AST.annotated_express
         let%bind (k', v') =
           let v' = e_a_some v in
           bind_map_pair (translate_annotated_expression env) (k, v') in
-        return (E_constant ("UPDATE", [k' ; v' ; prev']), tv)
+        return @@ E_constant ("UPDATE", [k' ; v' ; prev'])
       in
-      let init = return (E_empty_map (src, dst), tv) in
+      let init = return @@ E_empty_map (src, dst) in
       List.fold_left aux init m
   | E_look_up dsi ->
       let%bind (ds', i') = bind_map_pair f dsi in
-      return (E_constant ("GET", [i' ; ds']), tv)
+      return @@ E_constant ("GET", [i' ; ds'])
   | E_matching (expr, m) -> (
       let%bind expr' = translate_annotated_expression env expr in
       match m with
       | AST.Match_bool {match_true ; match_false} ->
           let%bind (t, f) = bind_map_pair (translate_annotated_expression env) (match_true, match_false) in
-          return (E_Cond (expr', t, f), tv)
+          return @@ E_Cond (expr', t, f)
       | AST.Match_list _ | AST.Match_option _ | AST.Match_tuple (_, _) ->
           simple_fail "only match bool exprs are translated yet"
     )
@@ -336,7 +350,7 @@ and translate_lambda_shallow : Mini_c.Environment.t -> AST.lambda -> Mini_c.expr
   let%bind output_type' = translate_type output_type in
   let tv = Combinators.t_shallow_closure env input_type' output_type' in
   let content = {binder;input=input_type';output=output_type';body;result;capture_type} in
-  ok (E_function content, tv, env)
+  ok @@ Combinators.Expression.make_tpl (E_function content, tv, env)
 
 and translate_lambda env l =
   let { binder ; input_type ; output_type ; body ; result } : AST.lambda = l in
@@ -359,7 +373,7 @@ and translate_lambda env l =
       let%bind output = translate_type output_type in
       let tv = Combinators.t_function input output in
       let content = {binder;input;output;body=body';result=result';capture_type} in
-      ok (E_literal (D_function {capture=None;content}), tv, env)
+      ok @@ Combinators.Expression.make_tpl (E_literal (D_function {capture=None;content}), tv, env)
     )
   | _ -> (
       trace (simple_error "translate lambda shallow") @@
@@ -369,7 +383,8 @@ and translate_lambda env l =
 let translate_declaration env (d:AST.declaration) : toplevel_statement result =
   match d with
   | Declaration_constant {name;annotated_expression} ->
-      let%bind ((_, tv, _) as expression) = translate_annotated_expression env annotated_expression in
+      let%bind expression = translate_annotated_expression env annotated_expression in
+      let tv = Combinators.Expression.get_type expression in
       let env' = Environment.add (name, tv) env in
       ok @@ ((name, expression), environment_wrap env env')
 
@@ -383,8 +398,8 @@ let translate_program (lst:AST.program) : program result =
   ok statements
 
 let translate_main (l:AST.lambda) (_t:AST.type_value) : anon_function result =
-  let%bind (expr, _, _) = translate_lambda Environment.empty l in
+  let%bind expr = translate_lambda Environment.empty l in
-  match expr with
+  match Combinators.Expression.get_content expr with
   | E_literal (D_function f) -> ok f
   | _ -> simple_fail "main is not a function"