diff --git a/src/main/compile/of_mini_c.ml b/src/main/compile/of_mini_c.ml index 0ee2bb085..bf2b56a64 100644 --- a/src/main/compile/of_mini_c.ml +++ b/src/main/compile/of_mini_c.ml @@ -3,27 +3,31 @@ open Tezos_utils open Proto_alpha_utils open Trace -let compile : expression -> Compiler.compiled_expression result = fun e -> - let%bind body = match e.type_value with - | T_function (input_ty, _) -> - let%bind body = get_function e in - Compiler.Program.translate_function_body body [] input_ty - | _ -> - Compiler.Program.translate_expression e Compiler.Environment.empty in +let compile_function_expression : expression -> Compiler.compiled_expression result = fun e -> + let%bind (input_ty , _) = get_t_function e.type_value in + let%bind body = get_function e in + let%bind body = Compiler.Program.translate_function_body body [] input_ty in let expr = Self_michelson.optimize body in let%bind expr_ty = Compiler.Type.Ty.type_ e.type_value in let open! Compiler.Program in ok { expr_ty ; expr } +let compile_expression : expression -> Compiler.compiled_expression result = fun e -> + let%bind expr = Compiler.Program.translate_expression e Compiler.Environment.empty in + let expr = Self_michelson.optimize expr in + let%bind expr_ty = Compiler.Type.Ty.type_ e.type_value in + let open! Compiler.Program in + ok { expr_ty ; expr } + let aggregate_and_compile_function = fun program name -> let%bind aggregated = aggregate_entry program name false in let aggregated = Self_mini_c.all_expression aggregated in - compile aggregated + compile_function_expression aggregated let aggregate_and_compile_expression = fun program name -> let%bind aggregated = aggregate_entry program name true in let aggregated = Self_mini_c.all_expression aggregated in - compile aggregated + compile_expression aggregated let build_contract : Compiler.compiled_expression -> Michelson.michelson result = fun compiled -> diff --git a/src/main/compile/wrapper.ml b/src/main/compile/wrapper.ml index af2d8dab3..ad00296ce 100644 --- a/src/main/compile/wrapper.ml +++ b/src/main/compile/wrapper.ml @@ -6,7 +6,6 @@ let source_to_typed syntax source_file = let env = Ast_typed.program_environment typed in ok (typed,state,env) -(* fetches entry_point which is a function and transform ir into a fun (..) { let .. in let .. in body } *) let typed_to_michelson_fun (typed: Ast_typed.program) (entry_point:string) : Compiler.compiled_expression result = let%bind mini_c = Of_typed.compile typed in @@ -22,13 +21,13 @@ let source_expression_to_michelson ~env ~state parameter syntax = let%bind simplified = Of_source.compile_expression syntax parameter in let%bind (typed,_) = Of_simplified.compile_expression ~env ~state simplified in let%bind mini_c = Of_typed.compile_expression typed in - Of_mini_c.compile mini_c + Of_mini_c.compile_expression mini_c let source_contract_param_to_michelson ~env ~state (storage,parameter) syntax = let%bind simplified = Of_source.compile_contract_input storage parameter syntax in let%bind typed,_ = Of_simplified.compile_expression ~env ~state simplified in let%bind mini_c = Of_typed.compile_expression typed in - Of_mini_c.compile mini_c + Of_mini_c.compile_expression mini_c (* produce a michelson contract e.g. the following sequence K_param ; K_storage ; K_code. and fails if the produced contract isn't valid *) diff --git a/src/main/run/of_michelson.ml b/src/main/run/of_michelson.ml index ce3506c3e..e619067af 100644 --- a/src/main/run/of_michelson.ml +++ b/src/main/run/of_michelson.ml @@ -72,13 +72,13 @@ let run_function_aux ?options (exp:Michelson.t) (exp_type:ex_ty) (input_michelso Trace.trace_tzresult_lwt (simple_error "error parsing input") @@ Memory_proto_alpha.parse_michelson_data input_michelson input_ty in - let top_level = if is_contract then - Script_ir_translator.Toplevel - { storage_type = output_ty ; param_type = input_ty ; - root_name = None ; legacy_create_contract_literal = false } - else Script_ir_translator.Lambda - and ty_stack_before = Script_typed_ir.Item_t (input_ty, Empty_t, None) - and ty_stack_after = Script_typed_ir.Item_t (output_ty, Empty_t, None) in + let (top_level, ty_stack_before, ty_stack_after) = + (if is_contract then + Script_ir_translator.Toplevel { storage_type = output_ty ; param_type = input_ty ; + root_name = None ; legacy_create_contract_literal = false } + else Script_ir_translator.Lambda) , + Script_typed_ir.Item_t (input_ty, Empty_t, None), + Script_typed_ir.Item_t (output_ty, Empty_t, None) in let exp = Michelson.strip_annots exp in let%bind descr = Trace.trace_tzresult_lwt (simple_error "error parsing program code") @@ diff --git a/src/test/heap_tests.ml b/src/test/heap_tests.ml index 18380f487..dfe1d1ef7 100644 --- a/src/test/heap_tests.ml +++ b/src/test/heap_tests.ml @@ -50,7 +50,7 @@ let dummy n = let run_typed (entry_point:string) (program:Ast_typed.program) (input:Ast_typed.annotated_expression) = let%bind program_mich = Compile.Wrapper.typed_to_michelson_fun program entry_point in let%bind input_mini_c = Compile.Of_typed.compile_expression input in - let%bind input_mich = Compile.Of_mini_c.compile input_mini_c in + let%bind input_mich = Compile.Of_mini_c.compile_expression input_mini_c in let%bind input_eval = Run.Of_michelson.evaluate_expression input_mich.expr input_mich.expr_ty in let%bind res = Run.Of_michelson.run_function program_mich.expr program_mich.expr_ty input_eval false in let%bind output_type = diff --git a/src/test/test_helpers.ml b/src/test/test_helpers.ml index 903bf6946..e28f464ca 100644 --- a/src/test/test_helpers.ml +++ b/src/test/test_helpers.ml @@ -34,14 +34,11 @@ open Ast_simplified let pack_payload (program:Ast_typed.program) (payload:expression) : bytes result = let%bind code = + let env = Ast_typed.program_environment program in let%bind (typed,_) = Compile.Of_simplified.compile_expression - ~env:(Ast_typed.program_environment program) ~state:(Typer.Solver.initial_state) payload in + ~env ~state:(Typer.Solver.initial_state) payload in let%bind mini_c = Compile.Of_typed.compile_expression typed in - let%bind expr = Compiler.Program.translate_expression mini_c Compiler.Environment.empty in - let expr = Self_michelson.optimize expr in - let%bind expr_ty = Compiler.Type.Ty.type_ mini_c.type_value in - let open! Compiler.Program in - ok { expr_ty ; expr } in + Compile.Of_mini_c.compile_expression mini_c in let (Ex_ty payload_ty) = code.expr_ty in let%bind (payload: Tezos_utils.Michelson.michelson) = Ligo.Run.Of_michelson.evaluate_expression code.expr code.expr_ty in @@ -87,7 +84,7 @@ let typed_program_with_simplified_input_to_michelson let env = Ast_typed.program_environment program in let%bind (typed_in,_) = Compile.Of_simplified.compile_expression ~env ~state:(Typer.Solver.initial_state) input in let%bind mini_c_in = Compile.Of_typed.compile_expression typed_in in - let%bind michelson_in = Compile.Of_mini_c.compile mini_c_in in + let%bind michelson_in = Compile.Of_mini_c.compile_expression mini_c_in in let%bind evaluated_in = Ligo.Run.Of_michelson.evaluate_expression michelson_in.expr michelson_in.expr_ty in let%bind michelson_program = Compile.Wrapper.typed_to_michelson_fun program entry_point in ok (michelson_program, evaluated_in)