rewrite test suite to compare value from ast_imperative instead of ast_core; includes uncompiler fo stage 4 and 6

src/main/uncompile/dune

@@ -4,6 +4,8 @@
   (libraries
     simple-utils
     compiler
+    imperative_to_sugar
+    sugar_to_core
     typer_new
     typer
     ast_typed

src/main/uncompile/uncompile.ml

@@ -10,7 +10,8 @@ let uncompile_value func_or_expr program entry ex_ty_value =
       ok output_type in
   let%bind mini_c = Compiler.Uncompiler.translate_value ex_ty_value in
   let%bind typed = Transpiler.untranspile mini_c output_type in
-  Typer.untype_expression typed
+  let%bind core  = Typer.untype_expression typed in
+  ok @@ core
 
 let uncompile_typed_program_entry_expression_result program entry ex_ty_value =
   uncompile_value Expression program entry ex_ty_value

src/passes/4-imperative_to_sugar/imperative_to_sugar.ml

@@ -184,3 +184,172 @@ let compile_declaration : I.declaration Location.wrap -> _ =
 let compile_program : I.program -> O.program result =
   fun p ->
   bind_map_list compile_declaration p
+
+(* uncompiling *)
+let rec uncompile_type_expression : O.type_expression -> I.type_expression result =
+  fun te ->
+  let return te = ok @@ I.make_t te in
+  match te.type_content with
+    | O.T_sum sum -> 
+      let sum = I.CMap.to_kv_list sum in
+      let%bind sum = 
+        bind_map_list (fun (k,v) ->
+          let%bind v = uncompile_type_expression v in
+          ok @@ (k,v)
+        ) sum
+      in
+      return @@ I.T_sum (O.CMap.of_list sum)
+    | O.T_record record -> 
+      let record = I.LMap.to_kv_list record in
+      let%bind record = 
+        bind_map_list (fun (k,v) ->
+          let%bind v = uncompile_type_expression v in
+          ok @@ (k,v)
+        ) record
+      in
+      return @@ I.T_record (O.LMap.of_list record)
+    | O.T_arrow {type1;type2} ->
+      let%bind type1 = uncompile_type_expression type1 in
+      let%bind type2 = uncompile_type_expression type2 in
+      return @@ T_arrow {type1;type2}
+    | O.T_variable type_variable -> return @@ T_variable type_variable 
+    | O.T_constant type_constant -> return @@ T_constant type_constant
+    | O.T_operator type_operator ->
+      let%bind type_operator = uncompile_type_operator type_operator in
+      return @@ T_operator type_operator
+
+and uncompile_type_operator : O.type_operator -> I.type_operator result =
+  fun t_o ->
+  match t_o with
+    | TC_contract c -> 
+      let%bind c = uncompile_type_expression c in
+      ok @@ I.TC_contract c
+    | TC_option o ->
+      let%bind o = uncompile_type_expression o in
+      ok @@ I.TC_option o
+    | TC_list l ->
+      let%bind l = uncompile_type_expression l in
+      ok @@ I.TC_list l
+    | TC_set s ->
+      let%bind s = uncompile_type_expression s in
+      ok @@ I.TC_set s
+    | TC_map (k,v) ->
+      let%bind (k,v) = bind_map_pair uncompile_type_expression (k,v) in
+      ok @@ I.TC_map (k,v)
+    | TC_big_map (k,v) ->
+      let%bind (k,v) = bind_map_pair uncompile_type_expression (k,v) in
+      ok @@ I.TC_big_map (k,v)
+    | TC_arrow (i,o) ->
+      let%bind (i,o) = bind_map_pair uncompile_type_expression (i,o) in
+      ok @@ I.TC_arrow (i,o)
+
+let rec uncompile_expression : O.expression -> I.expression result =
+  fun e ->
+  let return expr = ok @@ I.make_expr ~loc:e.location expr in
+  match e.expression_content with 
+    O.E_literal lit -> return @@ I.E_literal lit
+  | O.E_constant {cons_name;arguments} -> 
+    let%bind arguments = bind_map_list uncompile_expression arguments in
+    return @@ I.E_constant {cons_name;arguments}
+  | O.E_variable name     -> return @@ I.E_variable name
+  | O.E_application {expr1;expr2} -> 
+    let%bind expr1 = uncompile_expression expr1 in
+    let%bind expr2 = uncompile_expression expr2 in
+    return @@ I.E_application {expr1; expr2}
+  | O.E_lambda lambda ->
+    let%bind lambda = uncompile_lambda lambda in
+    return @@ I.E_lambda lambda
+  | O.E_recursive {fun_name;fun_type;lambda} ->
+    let%bind fun_type = uncompile_type_expression fun_type in
+    let%bind lambda = uncompile_lambda lambda in
+    return @@ I.E_recursive {fun_name;fun_type;lambda}
+  | O.E_let_in {let_binder;inline;rhs;let_result} ->
+    let (binder,ty_opt) = let_binder in
+    let%bind ty_opt = bind_map_option uncompile_type_expression ty_opt in
+    let%bind rhs = uncompile_expression rhs in
+    let%bind let_result = uncompile_expression let_result in
+    return @@ I.E_let_in {let_binder=(binder,ty_opt);mut=false;inline;rhs;let_result}
+  | O.E_skip -> return @@ I.E_skip
+  | O.E_constructor {constructor;element} ->
+    let%bind element = uncompile_expression element in
+    return @@ I.E_constructor {constructor;element}
+  | O.E_matching {matchee; cases} ->
+    let%bind matchee = uncompile_expression matchee in
+    let%bind cases   = uncompile_matching cases in
+    return @@ I.E_matching {matchee;cases}
+  | O.E_record record ->
+    let record = I.LMap.to_kv_list record in
+    let%bind record = 
+      bind_map_list (fun (k,v) ->
+        let%bind v = uncompile_expression v in
+        ok @@ (k,v)
+      ) record
+    in
+    return @@ I.E_record (O.LMap.of_list record)
+  | O.E_record_accessor {expr;label} ->
+    let%bind expr = uncompile_expression expr in
+    return @@ I.E_record_accessor {expr;label}
+  | O.E_record_update {record;path;update} ->
+    let%bind record = uncompile_expression record in
+    let%bind update = uncompile_expression update in
+    return @@ I.E_record_update {record;path;update}
+  | O.E_map map ->
+    let%bind map = bind_map_list (
+      bind_map_pair uncompile_expression
+    ) map
+    in
+    return @@ I.E_map map
+  | O.E_big_map big_map ->
+    let%bind big_map = bind_map_list (
+      bind_map_pair uncompile_expression
+    ) big_map
+    in
+    return @@ I.E_big_map big_map
+  | O.E_list lst ->
+    let%bind lst = bind_map_list uncompile_expression lst in
+    return @@ I.E_list lst
+  | O.E_set set ->
+    let%bind set = bind_map_list uncompile_expression set in
+    return @@ I.E_set set 
+  | O.E_look_up look_up ->
+    let%bind look_up = bind_map_pair uncompile_expression look_up in
+    return @@ I.E_look_up look_up
+  | O.E_ascription {anno_expr; type_annotation} ->
+    let%bind anno_expr = uncompile_expression anno_expr in
+    let%bind type_annotation = uncompile_type_expression type_annotation in
+    return @@ I.E_ascription {anno_expr; type_annotation}
+
+and uncompile_lambda : O.lambda -> I.lambda result =
+  fun {binder;input_type;output_type;result}->
+    let%bind input_type = bind_map_option uncompile_type_expression input_type in
+    let%bind output_type = bind_map_option uncompile_type_expression output_type in
+    let%bind result = uncompile_expression result in
+    ok @@ I.{binder;input_type;output_type;result}
+and uncompile_matching : O.matching_expr -> I.matching_expr result =
+  fun m -> 
+  match m with 
+    | O.Match_bool {match_true;match_false} ->
+      let%bind match_true = uncompile_expression match_true in
+      let%bind match_false = uncompile_expression match_false in
+      ok @@ I.Match_bool {match_true;match_false}
+    | O.Match_list {match_nil;match_cons} ->
+      let%bind match_nil = uncompile_expression match_nil in
+      let (hd,tl,expr,tv) = match_cons in
+      let%bind expr = uncompile_expression expr in
+      ok @@ I.Match_list {match_nil; match_cons=(hd,tl,expr,tv)}
+    | O.Match_option {match_none;match_some} ->
+      let%bind match_none = uncompile_expression match_none in
+      let (n,expr,tv) = match_some in
+      let%bind expr = uncompile_expression expr in
+      ok @@ I.Match_option {match_none; match_some=(n,expr,tv)}
+    | O.Match_tuple ((lst,expr), tv) ->
+      let%bind expr = uncompile_expression expr in
+      ok @@ O.Match_tuple ((lst,expr), tv)
+    | O.Match_variant (lst,tv) ->
+      let%bind lst = bind_map_list (
+        fun ((c,n),expr) ->
+          let%bind expr = uncompile_expression expr in
+          ok @@ ((c,n),expr)
+      ) lst 
+      in
+      ok @@ I.Match_variant (lst,tv)

src/passes/6-sugar_to_core/sugar_to_core.ml

@@ -185,3 +185,172 @@ let compile_declaration : I.declaration Location.wrap -> _ =
 let compile_program : I.program -> O.program result =
   fun p ->
   bind_map_list compile_declaration p
+
+(* uncompiling *)
+let rec uncompile_type_expression : O.type_expression -> I.type_expression result =
+  fun te ->
+  let return te = ok @@ I.make_t te in
+  match te.type_content with
+    | O.T_sum sum -> 
+      let sum = I.CMap.to_kv_list sum in
+      let%bind sum = 
+        bind_map_list (fun (k,v) ->
+          let%bind v = uncompile_type_expression v in
+          ok @@ (k,v)
+        ) sum
+      in
+      return @@ I.T_sum (O.CMap.of_list sum)
+    | O.T_record record -> 
+      let record = I.LMap.to_kv_list record in
+      let%bind record = 
+        bind_map_list (fun (k,v) ->
+          let%bind v = uncompile_type_expression v in
+          ok @@ (k,v)
+        ) record
+      in
+      return @@ I.T_record (O.LMap.of_list record)
+    | O.T_arrow {type1;type2} ->
+      let%bind type1 = uncompile_type_expression type1 in
+      let%bind type2 = uncompile_type_expression type2 in
+      return @@ T_arrow {type1;type2}
+    | O.T_variable type_variable -> return @@ T_variable type_variable 
+    | O.T_constant type_constant -> return @@ T_constant type_constant
+    | O.T_operator type_operator ->
+      let%bind type_operator = uncompile_type_operator type_operator in
+      return @@ T_operator type_operator
+
+and uncompile_type_operator : O.type_operator -> I.type_operator result =
+  fun t_o ->
+  match t_o with
+    | TC_contract c -> 
+      let%bind c = uncompile_type_expression c in
+      ok @@ I.TC_contract c
+    | TC_option o ->
+      let%bind o = uncompile_type_expression o in
+      ok @@ I.TC_option o
+    | TC_list l ->
+      let%bind l = uncompile_type_expression l in
+      ok @@ I.TC_list l
+    | TC_set s ->
+      let%bind s = uncompile_type_expression s in
+      ok @@ I.TC_set s
+    | TC_map (k,v) ->
+      let%bind (k,v) = bind_map_pair uncompile_type_expression (k,v) in
+      ok @@ I.TC_map (k,v)
+    | TC_big_map (k,v) ->
+      let%bind (k,v) = bind_map_pair uncompile_type_expression (k,v) in
+      ok @@ I.TC_big_map (k,v)
+    | TC_arrow (i,o) ->
+      let%bind (i,o) = bind_map_pair uncompile_type_expression (i,o) in
+      ok @@ I.TC_arrow (i,o)
+
+let rec uncompile_expression : O.expression -> I.expression result =
+  fun e ->
+  let return expr = ok @@ I.make_expr ~loc:e.location expr in
+  match e.expression_content with 
+    O.E_literal lit -> return @@ I.E_literal lit
+  | O.E_constant {cons_name;arguments} -> 
+    let%bind arguments = bind_map_list uncompile_expression arguments in
+    return @@ I.E_constant {cons_name;arguments}
+  | O.E_variable name     -> return @@ I.E_variable name
+  | O.E_application {expr1;expr2} -> 
+    let%bind expr1 = uncompile_expression expr1 in
+    let%bind expr2 = uncompile_expression expr2 in
+    return @@ I.E_application {expr1; expr2}
+  | O.E_lambda lambda ->
+    let%bind lambda = uncompile_lambda lambda in
+    return @@ I.E_lambda lambda
+  | O.E_recursive {fun_name;fun_type;lambda} ->
+    let%bind fun_type = uncompile_type_expression fun_type in
+    let%bind lambda = uncompile_lambda lambda in
+    return @@ I.E_recursive {fun_name;fun_type;lambda}
+  | O.E_let_in {let_binder;inline;rhs;let_result} ->
+    let (binder,ty_opt) = let_binder in
+    let%bind ty_opt = bind_map_option uncompile_type_expression ty_opt in
+    let%bind rhs = uncompile_expression rhs in
+    let%bind let_result = uncompile_expression let_result in
+    return @@ I.E_let_in {let_binder=(binder,ty_opt);inline;rhs;let_result}
+  | O.E_skip -> return @@ I.E_skip
+  | O.E_constructor {constructor;element} ->
+    let%bind element = uncompile_expression element in
+    return @@ I.E_constructor {constructor;element}
+  | O.E_matching {matchee; cases} ->
+    let%bind matchee = uncompile_expression matchee in
+    let%bind cases   = uncompile_matching cases in
+    return @@ I.E_matching {matchee;cases}
+  | O.E_record record ->
+    let record = I.LMap.to_kv_list record in
+    let%bind record = 
+      bind_map_list (fun (k,v) ->
+        let%bind v = uncompile_expression v in
+        ok @@ (k,v)
+      ) record
+    in
+    return @@ I.E_record (O.LMap.of_list record)
+  | O.E_record_accessor {expr;label} ->
+    let%bind expr = uncompile_expression expr in
+    return @@ I.E_record_accessor {expr;label}
+  | O.E_record_update {record;path;update} ->
+    let%bind record = uncompile_expression record in
+    let%bind update = uncompile_expression update in
+    return @@ I.E_record_update {record;path;update}
+  | O.E_map map ->
+    let%bind map = bind_map_list (
+      bind_map_pair uncompile_expression
+    ) map
+    in
+    return @@ I.E_map map
+  | O.E_big_map big_map ->
+    let%bind big_map = bind_map_list (
+      bind_map_pair uncompile_expression
+    ) big_map
+    in
+    return @@ I.E_big_map big_map
+  | O.E_list lst ->
+    let%bind lst = bind_map_list uncompile_expression lst in
+    return @@ I.E_list lst
+  | O.E_set set ->
+    let%bind set = bind_map_list uncompile_expression set in
+    return @@ I.E_set set 
+  | O.E_look_up look_up ->
+    let%bind look_up = bind_map_pair uncompile_expression look_up in
+    return @@ I.E_look_up look_up
+  | O.E_ascription {anno_expr; type_annotation} ->
+    let%bind anno_expr = uncompile_expression anno_expr in
+    let%bind type_annotation = uncompile_type_expression type_annotation in
+    return @@ I.E_ascription {anno_expr; type_annotation}
+
+and uncompile_lambda : O.lambda -> I.lambda result =
+  fun {binder;input_type;output_type;result}->
+    let%bind input_type = bind_map_option uncompile_type_expression input_type in
+    let%bind output_type = bind_map_option uncompile_type_expression output_type in
+    let%bind result = uncompile_expression result in
+    ok @@ I.{binder;input_type;output_type;result}
+and uncompile_matching : O.matching_expr -> I.matching_expr result =
+  fun m -> 
+  match m with 
+    | O.Match_bool {match_true;match_false} ->
+      let%bind match_true = uncompile_expression match_true in
+      let%bind match_false = uncompile_expression match_false in
+      ok @@ I.Match_bool {match_true;match_false}
+    | O.Match_list {match_nil;match_cons} ->
+      let%bind match_nil = uncompile_expression match_nil in
+      let (hd,tl,expr,tv) = match_cons in
+      let%bind expr = uncompile_expression expr in
+      ok @@ I.Match_list {match_nil; match_cons=(hd,tl,expr,tv)}
+    | O.Match_option {match_none;match_some} ->
+      let%bind match_none = uncompile_expression match_none in
+      let (n,expr,tv) = match_some in
+      let%bind expr = uncompile_expression expr in
+      ok @@ I.Match_option {match_none; match_some=(n,expr,tv)}
+    | O.Match_tuple ((lst,expr), tv) ->
+      let%bind expr = uncompile_expression expr in
+      ok @@ O.Match_tuple ((lst,expr), tv)
+    | O.Match_variant (lst,tv) ->
+      let%bind lst = bind_map_list (
+        fun ((c,n),expr) ->
+          let%bind expr = uncompile_expression expr in
+          ok @@ ((c,n),expr)
+      ) lst 
+      in
+      ok @@ I.Match_variant (lst,tv)

src/test/coase_tests.ml

@@ -27,7 +27,7 @@ let compile_main () =
     Ligo.Compile.Of_michelson.build_contract michelson_prg in
   ok ()
 
-open Ast_core
+open Ast_imperative
 
 let card owner =
   e_record_ez [
@@ -220,14 +220,15 @@ let sell () =
       let storage = basic 100 1000 cards (2 * n) in
       e_pair sell_action storage
     in
-    let make_expecter : int -> expression -> unit result = fun n result ->
-      let%bind (ops , storage) = get_e_pair result.expression_content in
+    let make_expecter : int -> Ast_core.expression -> unit result = fun n result ->
+      let%bind (ops , storage) = Ast_core.get_e_pair result.expression_content in
       let%bind () =
-        let%bind lst = get_e_list ops.expression_content in
+        let%bind lst = Ast_core.get_e_list ops.expression_content in
         Assert.assert_list_size lst 1 in
       let expected_storage =
         let cards = List.hds @@ cards_ez first_owner n in
         basic 99 1000 cards (2 * n) in
+      let%bind expected_storage = Test_helpers.expression_to_core expected_storage in
       Ast_core.Misc.assert_value_eq (expected_storage , storage)
     in
     let%bind () =

src/test/hash_lock_tests.ml

@@ -1,6 +1,6 @@
 open Trace
 open Test_helpers
-open Ast_core
+open Ast_imperative
 
 let type_file f =
   let%bind typed,state = Ligo.Compile.Utils.type_file f "cameligo" (Contract "main") in

src/test/id_tests.ml

@@ -1,6 +1,6 @@
 open Trace
 open Test_helpers
-open Ast_core
+open Ast_imperative
 
 
 let mtype_file f =

src/test/integration_tests.ml

@@ -1,7 +1,7 @@
 open Trace
 open Test_helpers
 
-open Ast_core.Combinators
+open Ast_imperative.Combinators
 
 let retype_file f =
   let%bind typed,state = Ligo.Compile.Utils.type_file f "reasonligo" Env in
@@ -424,9 +424,9 @@ let bytes_arithmetic () : unit result =
   let%bind () = expect_eq program "slice_op" tata at in
   let%bind () = expect_fail program "slice_op" foo in
   let%bind () = expect_fail program "slice_op" ba in
-  let%bind b1 = Test_helpers.run_typed_program_with_core_input program "hasherman" foo in
-  let%bind () = expect_eq program "hasherman" foo b1 in
-  let%bind b3 = Test_helpers.run_typed_program_with_core_input program "hasherman" foototo in
+  let%bind b1 = Test_helpers.run_typed_program_with_imperative_input program "hasherman" foo in
+  let%bind () = expect_eq_core program "hasherman" foo b1 in
+  let%bind b3 = Test_helpers.run_typed_program_with_imperative_input program "hasherman" foototo in
   let%bind () = Assert.assert_fail @@ Ast_core.Misc.assert_value_eq (b3 , b1) in
   ok ()
 
@@ -434,13 +434,13 @@ let crypto () : unit result =
   let%bind program = type_file "./contracts/crypto.ligo" in
   let%bind foo = e_bytes_hex "0f00" in
   let%bind foototo = e_bytes_hex "0f007070" in
-  let%bind b1 = Test_helpers.run_typed_program_with_core_input program "hasherman512" foo in
-  let%bind () = expect_eq program "hasherman512" foo b1 in
-  let%bind b2 = Test_helpers.run_typed_program_with_core_input program "hasherman512" foototo in
+  let%bind b1 = Test_helpers.run_typed_program_with_imperative_input program "hasherman512" foo in
+  let%bind () = expect_eq_core program "hasherman512" foo b1 in
+  let%bind b2 = Test_helpers.run_typed_program_with_imperative_input program "hasherman512" foototo in
   let%bind () = Assert.assert_fail @@ Ast_core.Misc.assert_value_eq (b2 , b1) in
-  let%bind b4 = Test_helpers.run_typed_program_with_core_input program "hasherman_blake" foo in
-  let%bind () = expect_eq program "hasherman_blake" foo b4 in
-  let%bind b5 = Test_helpers.run_typed_program_with_core_input program "hasherman_blake" foototo in
+  let%bind b4 = Test_helpers.run_typed_program_with_imperative_input program "hasherman_blake" foo in
+  let%bind () = expect_eq_core program "hasherman_blake" foo b4 in
+  let%bind b5 = Test_helpers.run_typed_program_with_imperative_input program "hasherman_blake" foototo in
   let%bind () = Assert.assert_fail @@ Ast_core.Misc.assert_value_eq (b5 , b4) in
   ok ()
 
@@ -448,13 +448,13 @@ let crypto_mligo () : unit result =
   let%bind program = mtype_file "./contracts/crypto.mligo" in
   let%bind foo = e_bytes_hex "0f00" in
   let%bind foototo = e_bytes_hex "0f007070" in
-  let%bind b1 = Test_helpers.run_typed_program_with_core_input program "hasherman512" foo in
-  let%bind () = expect_eq program "hasherman512" foo b1 in
-  let%bind b2 = Test_helpers.run_typed_program_with_core_input program "hasherman512" foototo in
+  let%bind b1 = Test_helpers.run_typed_program_with_imperative_input program "hasherman512" foo in
+  let%bind () = expect_eq_core program "hasherman512" foo b1 in
+  let%bind b2 = Test_helpers.run_typed_program_with_imperative_input program "hasherman512" foototo in
   let%bind () = Assert.assert_fail @@ Ast_core.Misc.assert_value_eq (b2 , b1) in
-  let%bind b4 = Test_helpers.run_typed_program_with_core_input program "hasherman_blake" foo in
-  let%bind () = expect_eq program "hasherman_blake" foo b4 in
-  let%bind b5 = Test_helpers.run_typed_program_with_core_input program "hasherman_blake" foototo in
+  let%bind b4 = Test_helpers.run_typed_program_with_imperative_input program "hasherman_blake" foo in
+  let%bind () = expect_eq_core program "hasherman_blake" foo b4 in
+  let%bind b5 = Test_helpers.run_typed_program_with_imperative_input program "hasherman_blake" foototo in
   let%bind () = Assert.assert_fail @@ Ast_core.Misc.assert_value_eq (b5 , b4) in
   ok ()
 
@@ -462,13 +462,13 @@ let crypto_religo () : unit result =
   let%bind program = retype_file "./contracts/crypto.religo" in
   let%bind foo = e_bytes_hex "0f00" in
   let%bind foototo = e_bytes_hex "0f007070" in
-  let%bind b1 = Test_helpers.run_typed_program_with_core_input program "hasherman512" foo in
-  let%bind () = expect_eq program "hasherman512" foo b1 in
-  let%bind b2 = Test_helpers.run_typed_program_with_core_input program "hasherman512" foototo in
+  let%bind b1 = Test_helpers.run_typed_program_with_imperative_input program "hasherman512" foo in
+  let%bind () = expect_eq_core program "hasherman512" foo b1 in
+  let%bind b2 = Test_helpers.run_typed_program_with_imperative_input program "hasherman512" foototo in
   let%bind () = Assert.assert_fail @@ Ast_core.Misc.assert_value_eq (b2 , b1) in
-  let%bind b4 = Test_helpers.run_typed_program_with_core_input program "hasherman_blake" foo in
-  let%bind () = expect_eq program "hasherman_blake" foo b4 in
-  let%bind b5 = Test_helpers.run_typed_program_with_core_input program "hasherman_blake" foototo in
+  let%bind b4 = Test_helpers.run_typed_program_with_imperative_input program "hasherman_blake" foo in
+  let%bind () = expect_eq_core program "hasherman_blake" foo b4 in
+  let%bind b5 = Test_helpers.run_typed_program_with_imperative_input program "hasherman_blake" foototo in
   let%bind () = Assert.assert_fail @@ Ast_core.Misc.assert_value_eq (b5 , b4) in
   ok ()
 
@@ -486,9 +486,9 @@ let bytes_arithmetic_mligo () : unit result =
   let%bind () = expect_eq program "slice_op" tata at in
   let%bind () = expect_fail program "slice_op" foo in
   let%bind () = expect_fail program "slice_op" ba in
-  let%bind b1 = Test_helpers.run_typed_program_with_core_input program "hasherman" foo in
-  let%bind () = expect_eq program "hasherman" foo b1 in
-  let%bind b3 = Test_helpers.run_typed_program_with_core_input program "hasherman" foototo in
+  let%bind b1 = Test_helpers.run_typed_program_with_imperative_input program "hasherman" foo in
+  let%bind () = expect_eq_core program "hasherman" foo b1 in
+  let%bind b3 = Test_helpers.run_typed_program_with_imperative_input program "hasherman" foototo in
   let%bind () = Assert.assert_fail @@ Ast_core.Misc.assert_value_eq (b3 , b1) in
   ok ()
 
@@ -506,9 +506,9 @@ let bytes_arithmetic_religo () : unit result =
   let%bind () = expect_eq program "slice_op" tata at in
   let%bind () = expect_fail program "slice_op" foo in
   let%bind () = expect_fail program "slice_op" ba in
-  let%bind b1 = Test_helpers.run_typed_program_with_core_input program"hasherman" foo in
-  let%bind () = expect_eq program "hasherman" foo b1 in
-  let%bind b3 = Test_helpers.run_typed_program_with_core_input program "hasherman" foototo in
+  let%bind b1 = Test_helpers.run_typed_program_with_imperative_input program"hasherman" foo in
+  let%bind () = expect_eq_core program "hasherman" foo b1 in
+  let%bind b3 = Test_helpers.run_typed_program_with_imperative_input program "hasherman" foototo in
   let%bind () = Assert.assert_fail @@ Ast_core.Misc.assert_value_eq (b3 , b1) in
   ok ()
 
@@ -974,7 +974,6 @@ let reoption () : unit result =
 let map_ type_f path : unit result =
   let%bind program = type_f path in
   let ez lst =
-    let open Ast_core.Combinators in
     let lst' = List.map (fun (x, y) -> e_int x, e_int y) lst in
     e_typed_map lst' t_int t_int
   in
@@ -1063,7 +1062,6 @@ let map_ type_f path : unit result =
 let big_map_ type_f path : unit result =
   let%bind program = type_f path in
   let ez lst =
-    let open Ast_core.Combinators in
     let lst' = List.map (fun (x, y) -> e_int x, e_int y) lst in
     (e_typed_big_map lst' t_int t_int)
   in
@@ -1276,7 +1274,6 @@ let loop () : unit result =
     expect_eq program "inner_capture_in_conditional_block"  input expected in
   let%bind () =
     let ez lst =
-      let open Ast_core.Combinators in
       let lst' = List.map (fun (x, y) -> e_string x, e_int y) lst in
         e_typed_map lst' t_string t_int
     in
@@ -2032,11 +2029,11 @@ let get_contract_ligo () : unit result =
   let%bind () =
     let make_input = fun _n -> e_unit () in
     let make_expected : int -> Ast_core.expression -> unit result = fun _n result ->
-      let%bind (ops , storage) = get_e_pair result.expression_content in
+      let%bind (ops , storage) = Ast_core.get_e_pair result.expression_content in
       let%bind () =
-        let%bind lst = get_e_list ops.expression_content in
+        let%bind lst = Ast_core.get_e_list ops.expression_content in
         Assert.assert_list_size lst 1 in
-      let expected_storage = e_unit () in
+      let expected_storage = Ast_core.e_unit () in
       Ast_core.Misc.assert_value_eq (expected_storage , storage)
       in
     let%bind () =

src/test/multisig_tests.ml

@@ -28,7 +28,7 @@ let compile_main f s () =
     Ligo.Compile.Of_michelson.build_contract michelson_prg in
   ok ()
 
-open Ast_core
+open Ast_imperative
 
 let init_storage threshold counter pkeys =
   let keys = List.map

src/test/multisig_v2_tests.ml

@@ -24,7 +24,7 @@ let compile_main () =
     Ligo.Compile.Of_michelson.build_contract michelson_prg in
   ok ()
 
-open Ast_core
+open Ast_imperative
 
 let empty_op_list = 
   (e_typed_list [] t_operation)
@@ -33,7 +33,7 @@ let empty_message = e_lambda (Var.of_name "arguments")
   empty_op_list
 let empty_message2 = e_lambda (Var.of_name "arguments")
   (Some t_bytes) (Some (t_list t_operation))
- ( e_let_in ((Var.of_name "foo"),Some t_unit) false (e_unit ()) empty_op_list)
+ ( e_let_in ((Var.of_name "foo"),Some t_unit) false false (e_unit ()) empty_op_list)
 
 let send_param msg = e_constructor "Send" msg
 let withdraw_param = e_constructor "Withdraw" empty_message

src/test/pledge_tests.ml

@@ -1,7 +1,6 @@
 open Trace
 open Test_helpers
-open Ast_core
-
+open Ast_imperative
 
 let retype_file f =
   let%bind typed,state = Ligo.Compile.Utils.type_file f "reasonligo" Env in

src/test/replaceable_id_tests.ml

@@ -23,7 +23,8 @@ let compile_main () =
     (* fails if the given entry point is not a valid contract *)
     Ligo.Compile.Of_michelson.build_contract michelson_prg in
   ok ()
-open Ast_core
+
+open Ast_imperative
 
 let empty_op_list = 
   (e_typed_list [] t_operation)

src/test/test_helpers.ml

@@ -29,15 +29,21 @@ let test name f =
 
 let test_suite name lst = Test_suite (name , lst)
 
+let expression_to_core expression =
+  let%bind sugar = Compile.Of_imperative.compile_expression expression in
+  let%bind core  = Compile.Of_sugar.compile_expression sugar in
+  ok @@ core
 
-open Ast_core
+open Ast_imperative
 
 let pack_payload (program:Ast_typed.program) (payload:expression) : bytes result =
   let%bind code =
     let env = Ast_typed.program_environment program in
 
+    let%bind sugar     = Compile.Of_imperative.compile_expression payload in
+    let%bind core      = Compile.Of_sugar.compile_expression sugar in
     let%bind (typed,_) = Compile.Of_core.compile_expression
-        ~env ~state:(Typer.Solver.initial_state) payload in
+        ~env ~state:(Typer.Solver.initial_state) core in
     let%bind mini_c = Compile.Of_typed.compile_expression typed in
     Compile.Of_mini_c.compile_expression mini_c in
   let (Ex_ty payload_ty) = code.expr_ty in
@@ -77,24 +83,26 @@ let sha_256_hash pl =
   let open Proto_alpha_utils.Memory_proto_alpha.Alpha_environment in
   Raw_hashes.sha256 pl
 
-open Ast_core.Combinators
+open Ast_imperative.Combinators
 
-let typed_program_with_core_input_to_michelson
+let typed_program_with_imperative_input_to_michelson
     (program: Ast_typed.program) (entry_point: string)
-    (input: Ast_core.expression) : Compiler.compiled_expression result =
+    (input: Ast_imperative.expression) : Compiler.compiled_expression result =
   Printexc.record_backtrace true;
   let env = Ast_typed.program_environment program in
   let state = Typer.Solver.initial_state in
-  let%bind app              = Compile.Of_core.apply entry_point input in
+  let%bind sugar            = Compile.Of_imperative.compile_expression input in
+  let%bind core             = Compile.Of_sugar.compile_expression sugar in
+  let%bind app              = Compile.Of_core.apply entry_point core in
   let%bind (typed_app,_)    = Compile.Of_core.compile_expression ~env ~state app in
   let%bind compiled_applied = Compile.Of_typed.compile_expression typed_app in
   let%bind mini_c_prg       = Compile.Of_typed.compile program in
   Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg compiled_applied
 
-let run_typed_program_with_core_input ?options
+let run_typed_program_with_imperative_input ?options
     (program: Ast_typed.program) (entry_point: string)
-    (input: Ast_core.expression) : Ast_core.expression result =
-  let%bind michelson_program = typed_program_with_core_input_to_michelson program entry_point input in
+    (input: Ast_imperative.expression) : Ast_core.expression result =
+  let%bind michelson_program = typed_program_with_imperative_input_to_michelson program entry_point input in
   let%bind michelson_output  = Ligo.Run.Of_michelson.run_no_failwith ?options michelson_program.expr michelson_program.expr_ty in
   Uncompile.uncompile_typed_program_entry_function_result program entry_point michelson_output
  
@@ -106,7 +114,7 @@ let expect ?options program entry_point input expecter =
       error title content
     in
     trace run_error @@
-    run_typed_program_with_core_input ?options program entry_point input in
+    run_typed_program_with_imperative_input ?options program entry_point input in
   expecter result
 
 let expect_fail ?options program entry_point input =
@@ -117,10 +125,10 @@ let expect_fail ?options program entry_point input =
   in
   trace run_error @@
   Assert.assert_fail @@
-  run_typed_program_with_core_input ?options program entry_point input
+  run_typed_program_with_imperative_input ?options program entry_point input
 
 let expect_string_failwith ?options program entry_point input expected_failwith =
-  let%bind michelson_program = typed_program_with_core_input_to_michelson program entry_point input in
+  let%bind michelson_program = typed_program_with_imperative_input_to_michelson program entry_point input in
   let%bind err = Ligo.Run.Of_michelson.run_failwith
     ?options michelson_program.expr michelson_program.expr_ty in
   match err with
@@ -128,6 +136,19 @@ let expect_string_failwith ?options program entry_point input expected_failwith
     | _ -> simple_fail "Expected to fail with a string"
 
 let expect_eq ?options program entry_point input expected =
+  let%bind expected = expression_to_core expected in
+  let expecter = fun result ->
+    let expect_error =
+      let title () = "expect result" in
+      let content () = Format.asprintf "Expected %a, got %a"
+          Ast_core.PP.expression expected
+          Ast_core.PP.expression result in
+      error title content in
+    trace expect_error @@
+    Ast_core.Misc.assert_value_eq (expected,result) in
+  expect ?options program entry_point input expecter
+
+let expect_eq_core ?options program entry_point input expected =
   let expecter = fun result ->
     let expect_error =
       let title () = "expect result" in
@@ -153,6 +174,7 @@ let expect_evaluate program entry_point expecter =
   expecter res_simpl
 
 let expect_eq_evaluate program entry_point expected =
+  let%bind expected  = expression_to_core expected in
   let expecter = fun result ->
     Ast_core.Misc.assert_value_eq (expected , result) in
   expect_evaluate program entry_point expecter
@@ -237,7 +259,6 @@ let expect_eq_n_int a b c =
   expect_eq_n a b e_int (fun n -> e_int (c n))
 
 let expect_eq_b_bool a b c =
-  let open Ast_core.Combinators in
   expect_eq_b a b (fun bool -> e_bool (c bool))
 
 

src/test/time_lock_repeat_tests.ml

@@ -1,6 +1,6 @@
 open Trace
 open Test_helpers
-open Ast_core
+open Ast_imperative
 
 let type_file f =
   let%bind typed,state = Ligo.Compile.Utils.type_file f "cameligo" (Contract "main") in

src/test/time_lock_tests.ml

@@ -24,7 +24,8 @@ let compile_main () =
     Ligo.Compile.Of_michelson.build_contract michelson_prg in
   ok ()
 
-open Ast_core
+open Ast_imperative
+
 let empty_op_list =
   (e_typed_list [] t_operation)
 let empty_message = e_lambda (Var.of_name "arguments")

src/test/vote_tests.ml

@@ -15,7 +15,7 @@ let get_program =
         ok (program , state)
       )
 
-open Ast_core
+open Ast_imperative
 
 let init_storage name = e_record_ez [
     ("title" , e_string name) ;
@@ -38,14 +38,14 @@ let yea = e_constructor "Vote" (e_constructor "Yea" (e_unit ()))
 let init_vote () =
   let%bind (program , _) = get_program () in
   let%bind result =
-    Test_helpers.run_typed_program_with_core_input
+    Test_helpers.run_typed_program_with_imperative_input
       program "main" (e_pair yea (init_storage "basic")) in
-  let%bind (_, storage) = extract_pair result in
-  let%bind storage' = extract_record storage in
+  let%bind (_, storage) = Ast_core.extract_pair result in
+  let%bind storage' = Ast_core.extract_record storage in
 (*  let votes = List.assoc (Label "voters") storage' in
   let%bind votes' = extract_map votes in *)
   let yea = List.assoc (Label "yea") storage' in
-  let%bind () = Ast_core.Misc.assert_value_eq (yea, e_nat 1) in
+  let%bind () = Ast_core.Misc.assert_value_eq (yea, Ast_core.e_nat 1) in
   ok ()
 
 let main = test_suite "Vote" [