diff --git a/src/bin/cli.ml b/src/bin/cli.ml index 2dc18723e..0524814c7 100644 --- a/src/bin/cli.ml +++ b/src/bin/cli.ml @@ -95,14 +95,18 @@ let michelson_code_format = `Text info module Helpers = Ligo.Compile.Helpers -module Compile = Ligo.Compile.Wrapper +module Compile = Ligo.Compile module Uncompile = Ligo.Uncompile module Run = Ligo.Run.Of_michelson let compile_file = let f source_file entry_point syntax display_format michelson_format = toplevel ~display_format @@ - let%bind (contract,_) = Compile.source_to_michelson_contract (Syntax_name syntax) source_file entry_point in + let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in + let%bind typed,_ = Compile.Of_simplified.compile simplified in + let%bind mini_c = Compile.Of_typed.compile typed in + let%bind michelson = Compile.Of_mini_c.aggregate_and_compile mini_c None entry_point in + let%bind contract = Compile.Of_mini_c.build_contract michelson in ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) contract in let term = @@ -114,7 +118,11 @@ let compile_file = let measure_contract = let f source_file entry_point syntax display_format = toplevel ~display_format @@ - let%bind (contract,_) = Compile.source_to_michelson_contract (Syntax_name syntax) source_file entry_point in + let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in + let%bind typed,_ = Compile.Of_simplified.compile simplified in + let%bind mini_c = Compile.Of_typed.compile typed in + let%bind michelson = Compile.Of_mini_c.aggregate_and_compile mini_c None entry_point in + let%bind contract = Compile.Of_mini_c.build_contract michelson in let open Tezos_utils in ok @@ Format.asprintf "%d bytes\n" (Michelson.measure contract) in @@ -127,15 +135,26 @@ let measure_contract = let compile_parameter = let f source_file entry_point expression syntax display_format michelson_format = toplevel ~display_format @@ - let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in (* TODO: source_to_michelson_contract will fail if the entry_point does not point to a michelson contract but we do not check that the type of the parameter matches the type of the given expression *) - let%bind (_,(_,state,env)) = Compile.source_to_michelson_contract (Syntax_name syntax) source_file entry_point in - let%bind compiled_exp = Compile.source_expression_to_michelson ~env ~state expression v_syntax in - let%bind value = Run.evaluate_expression compiled_exp.expr compiled_exp.expr_ty in + let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in + let%bind typed_prg,state = Compile.Of_simplified.compile simplified in + let%bind mini_c_prg = Compile.Of_typed.compile typed_prg in + let%bind michelson_prg = Compile.Of_mini_c.aggregate_and_compile mini_c_prg None entry_point in + let env = Ast_typed.program_environment typed_prg in + let%bind (_contract: Tezos_utils.Michelson.michelson) = + (* fails if the given entry point is not a valid contract *) + Compile.Of_mini_c.build_contract michelson_prg in + + let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in + let%bind simplified_param = Compile.Of_source.compile_expression v_syntax expression in + let%bind (typed_param,_) = Compile.Of_simplified.compile_expression ~env ~state simplified_param in + let%bind mini_c_param = Compile.Of_typed.compile_expression typed_param in + let%bind compiled_param = Compile.Of_mini_c.compile_expression mini_c_param in + let%bind value = Run.evaluate_expression compiled_param.expr compiled_param.expr_ty in ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value in let term = @@ -147,15 +166,26 @@ let compile_parameter = let compile_storage = let f source_file entry_point expression syntax display_format michelson_format = toplevel ~display_format @@ - let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in (* TODO: source_to_michelson_contract will fail if the entry_point does not point to a michelson contract but we do not check that the type of the storage matches the type of the given expression *) - let%bind (_,(_,state,env)) = Compile.source_to_michelson_contract (Syntax_name syntax) source_file entry_point in - let%bind compiled_exp = Compile.source_expression_to_michelson ~env ~state expression v_syntax in - let%bind value = Run.evaluate_expression compiled_exp.expr compiled_exp.expr_ty in + let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in + let%bind typed_prg,state = Compile.Of_simplified.compile simplified in + let%bind mini_c_prg = Compile.Of_typed.compile typed_prg in + let%bind michelson_prg = Compile.Of_mini_c.aggregate_and_compile mini_c_prg None entry_point in + let env = Ast_typed.program_environment typed_prg in + let%bind (_contract: Tezos_utils.Michelson.michelson) = + (* fails if the given entry point is not a valid contract *) + Compile.Of_mini_c.build_contract michelson_prg in + + let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in + let%bind simplified_param = Compile.Of_source.compile_expression v_syntax expression in + let%bind (typed_param,_) = Compile.Of_simplified.compile_expression ~env ~state simplified_param in + let%bind mini_c_param = Compile.Of_typed.compile_expression typed_param in + let%bind compiled_param = Compile.Of_mini_c.compile_expression mini_c_param in + let%bind value = Run.evaluate_expression compiled_param.expr compiled_param.expr_ty in ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value in let term = @@ -167,14 +197,26 @@ let compile_storage = let dry_run = let f source_file entry_point storage input amount sender source syntax display_format = toplevel ~display_format @@ - let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in - let%bind (_,(typed_program,state,env)) = Compile.source_to_michelson_contract (Syntax_name syntax) source_file entry_point in - let%bind compiled_parameter = Compile.source_contract_param_to_michelson ~env ~state (storage,input) v_syntax in - let%bind michelson = Compile.typed_to_michelson_fun typed_program entry_point in - let%bind args_michelson = Run.evaluate_expression compiled_parameter.expr compiled_parameter.expr_ty in - let%bind options = Run.make_dry_run_options {amount ; sender ; source } in - let%bind michelson_output = Run.run_function ~options michelson.expr michelson.expr_ty args_michelson true in - let%bind simplified_output = Uncompile.uncompile_typed_program_entry_function_result typed_program entry_point michelson_output in + let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in + let%bind typed_prg,state = Compile.Of_simplified.compile simplified in + let env = Ast_typed.program_environment typed_prg in + let%bind mini_c_prg = Compile.Of_typed.compile typed_prg in + let%bind michelson_prg = Compile.Of_mini_c.aggregate_and_compile mini_c_prg None entry_point in + let%bind (_contract: Tezos_utils.Michelson.michelson) = + (* fails if the given entry point is not a valid contract *) + Compile.Of_mini_c.build_contract michelson_prg in + + let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in + let%bind simplified = Compile.Of_source.compile_contract_input storage input v_syntax in + let%bind typed,_ = Compile.Of_simplified.compile_expression ~env ~state simplified in + let%bind mini_c = Compile.Of_typed.compile_expression typed in + let%bind compiled_params = Compile.Of_mini_c.compile_expression mini_c in + let%bind args_michelson = Run.evaluate_expression compiled_params.expr compiled_params.expr_ty in + + let%bind options = Run.make_dry_run_options {amount ; sender ; source } in + let%bind michelson_output = Run.run_contract ~options michelson_prg.expr michelson_prg.expr_ty args_michelson in + + let%bind simplified_output = Uncompile.uncompile_typed_program_entry_function_result typed_prg entry_point michelson_output in ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output in let term = @@ -186,14 +228,20 @@ let dry_run = let run_function = let f source_file entry_point parameter amount sender source syntax display_format = toplevel ~display_format @@ - let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in - let%bind (typed_program,state,env) = Compile.source_to_typed (Syntax_name syntax) source_file in - let%bind compiled_parameter = Compile.source_expression_to_michelson ~env ~state parameter v_syntax in - let%bind michelson = Compile.typed_to_michelson_fun typed_program entry_point in - let%bind args_michelson = Run.evaluate_expression compiled_parameter.expr compiled_parameter.expr_ty in - let%bind options = Run.make_dry_run_options {amount ; sender ; source } in - let%bind michelson_output = Run.run_function ~options michelson.expr michelson.expr_ty args_michelson false in - let%bind simplified_output = Uncompile.uncompile_typed_program_entry_function_result typed_program entry_point michelson_output in + let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in + let%bind simplified_prg = Compile.Of_source.compile source_file (Syntax_name syntax) in + let%bind typed_prg,state = Compile.Of_simplified.compile simplified_prg in + let env = Ast_typed.program_environment typed_prg in + let%bind mini_c_prg = Compile.Of_typed.compile typed_prg in + + let%bind simplified_param = Compile.Of_source.compile_expression v_syntax parameter in + let%bind (typed_param,_) = Compile.Of_simplified.compile_expression ~env ~state simplified_param in + let%bind compiled_param = Compile.Of_typed.compile_expression typed_param in + + let%bind michelson = Compile.Of_mini_c.aggregate_and_compile mini_c_prg (Some [compiled_param]) entry_point in + let%bind options = Run.make_dry_run_options {amount ; sender ; source } in + let%bind michelson_output = Run.run ~options michelson.expr michelson.expr_ty in + let%bind simplified_output = Uncompile.uncompile_typed_program_entry_function_result typed_prg entry_point michelson_output in ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output in let term = @@ -205,11 +253,13 @@ let run_function = let evaluate_value = let f source_file entry_point amount sender source syntax display_format = toplevel ~display_format @@ - let%bind (typed_program,_,_) = Compile.source_to_typed (Syntax_name syntax) source_file in - let%bind compiled = Compile.typed_to_michelson_expression typed_program entry_point in - let%bind options = Run.make_dry_run_options {amount ; sender ; source } in - let%bind michelson_output = Run.run_exp ~options compiled.expr compiled.expr_ty in - let%bind simplified_output = Uncompile.uncompile_typed_program_entry_expression_result typed_program entry_point michelson_output in + let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in + let%bind typed_prg,_ = Compile.Of_simplified.compile simplified in + let%bind mini_c = Compile.Of_typed.compile typed_prg in + let%bind compiled = Compile.Of_mini_c.aggregate_and_compile mini_c (Some []) entry_point in + let%bind options = Run.make_dry_run_options {amount ; sender ; source } in + let%bind michelson_output = Run.run ~options compiled.expr compiled.expr_ty in + let%bind simplified_output = Uncompile.uncompile_typed_program_entry_expression_result typed_prg entry_point michelson_output in ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output in let term = @@ -222,10 +272,13 @@ let compile_expression = let f expression syntax display_format michelson_format = toplevel ~display_format @@ let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (None) in - let%bind compiled = Compile.source_expression_to_michelson - ~env:(Ast_typed.Environment.full_empty) ~state:(Typer.Solver.initial_state) - expression v_syntax in - let%bind value = Run.evaluate_expression compiled.expr compiled.expr_ty in + let env = Ast_typed.Environment.full_empty in + let state = Typer.Solver.initial_state in + let%bind simplified = Compile.Of_source.compile_expression v_syntax expression in + let%bind (typed_exp,_) = Compile.Of_simplified.compile_expression ~env ~state simplified in + let%bind mini_c_exp = Compile.Of_typed.compile_expression typed_exp in + let%bind compiled_exp = Compile.Of_mini_c.compile_expression mini_c_exp in + let%bind value = Run.evaluate_expression compiled_exp.expr compiled_exp.expr_ty in ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value in let term = diff --git a/src/main/compile/of_mini_c.ml b/src/main/compile/of_mini_c.ml index bf2b56a64..debacfa0a 100644 --- a/src/main/compile/of_mini_c.ml +++ b/src/main/compile/of_mini_c.ml @@ -3,7 +3,7 @@ open Tezos_utils open Proto_alpha_utils open Trace -let compile_function_expression : expression -> Compiler.compiled_expression result = fun e -> +let compile_contract : 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 @@ -19,15 +19,12 @@ let compile_expression : expression -> Compiler.compiled_expression result = fun 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 aggregate_and_compile = fun program arg_opt name -> + let%bind aggregated = aggregate_entry program name arg_opt in let aggregated = Self_mini_c.all_expression aggregated in - 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_expression aggregated + match arg_opt with + | Some _ -> compile_expression aggregated + | None -> compile_contract 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 deleted file mode 100644 index ad00296ce..000000000 --- a/src/main/compile/wrapper.ml +++ /dev/null @@ -1,38 +0,0 @@ -open Trace - -let source_to_typed syntax source_file = - let%bind simplified = Of_source.compile source_file syntax in - let%bind typed,state = Of_simplified.compile simplified in - let env = Ast_typed.program_environment typed in - ok (typed,state,env) - -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 - Of_mini_c.aggregate_and_compile_function mini_c entry_point - -(* fetches entry_point and transform it into a let .. in let .. in expression *) -let typed_to_michelson_expression - (typed: Ast_typed.program) (entry_point:string) : Compiler.compiled_expression result = - let%bind mini_c = Of_typed.compile typed in - Of_mini_c.aggregate_and_compile_expression mini_c entry_point - -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_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_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 *) -let source_to_michelson_contract syntax source_file entry_point = - let%bind (typed,state,env) = source_to_typed syntax source_file in - let%bind michelson = typed_to_michelson_fun typed entry_point in - let%bind contract = Of_mini_c.build_contract michelson in - ok (contract, (typed,state,env)) diff --git a/src/main/run/of_michelson.ml b/src/main/run/of_michelson.ml index e619067af..ae2a2ea9f 100644 --- a/src/main/run/of_michelson.ml +++ b/src/main/run/of_michelson.ml @@ -5,7 +5,7 @@ open Memory_proto_alpha.X type options = Memory_proto_alpha.options -type run_function_res = +type run_res = | Success of ex_typed_value | Fail of Memory_proto_alpha.Protocol.Script_repr.expr @@ -65,54 +65,30 @@ let fetch_lambda_types (contract_ty:ex_ty) = | Ex_ty (Lambda_t (in_ty, out_ty, _)) -> ok (Ex_ty in_ty, Ex_ty out_ty) | _ -> simple_fail "failed to fetch lambda types" -let run_function_aux ?options (exp:Michelson.t) (exp_type:ex_ty) (input_michelson:Michelson.t) (is_contract:bool) : run_function_res result = +let run_contract ?options (exp:Michelson.t) (exp_type:ex_ty) (input_michelson:Michelson.t) : ex_typed_value result = let open! Tezos_raw_protocol_005_PsBabyM1 in let%bind (Ex_ty input_ty, Ex_ty output_ty) = fetch_lambda_types exp_type in let%bind input = Trace.trace_tzresult_lwt (simple_error "error parsing input") @@ Memory_proto_alpha.parse_michelson_data input_michelson input_ty 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 top_level = Script_ir_translator.Toplevel + { storage_type = output_ty ; param_type = input_ty ; + root_name = None ; legacy_create_contract_literal = false } in + let ty_stack_before = Script_typed_ir.Item_t (input_ty, Empty_t, None) in + let ty_stack_after = 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") @@ Memory_proto_alpha.parse_michelson ~top_level exp ty_stack_before ty_stack_after in let open! Memory_proto_alpha.Protocol.Script_interpreter in - let%bind res = + let%bind (Item(output, Empty)) = Trace.trace_tzresult_lwt (simple_error "error of execution") @@ - Memory_proto_alpha.failure_interpret ?options descr - (Item(input, Empty)) - in - match res with - | Memory_proto_alpha.Succeed stack -> - let (Item(output, Empty)) = stack in - ok @@ Success (Ex_typed_value (output_ty, output)) - | Memory_proto_alpha.Fail expr -> - ok (Fail expr) + Memory_proto_alpha.interpret ?options descr + (Item(input, Empty)) in + ok (Ex_typed_value (output_ty, output)) -let run_function ?options (exp:Michelson.t) (exp_type:ex_ty) (input_michelson:Michelson.t) (is_contract:bool) : ex_typed_value result = - let%bind expr = run_function_aux ?options exp exp_type input_michelson is_contract in - match expr with - | Success res -> ok res - | _ -> simple_fail "Execution terminated with failwith" - -let run_failwith ?options (exp:Michelson.t) (exp_type:ex_ty) (input_michelson:Michelson.t) (is_contract:bool) : run_failwith_res result = - let%bind expr = run_function_aux ?options exp exp_type input_michelson is_contract in - match expr with - | Fail res -> ( match Tezos_micheline.Micheline.root @@ Memory_proto_alpha.strings_of_prims res with - | Int (_ , i) -> ok (Failwith_int (Z.to_int i)) - | String (_ , s) -> ok (Failwith_string s) - | Bytes (_,b) -> ok (Failwith_bytes b) - | _ -> simple_fail "Unknown failwith type" ) - | _ -> simple_fail "An error of execution was expected" - -let run_exp ?options (exp:Michelson.t) (exp_type:ex_ty) : ex_typed_value result = +let run_expression ?options (exp:Michelson.t) (exp_type:ex_ty) : run_res result = let open! Tezos_raw_protocol_005_PsBabyM1 in let (Ex_ty exp_type') = exp_type in let exp = Michelson.strip_annots exp in @@ -123,11 +99,32 @@ let run_exp ?options (exp:Michelson.t) (exp_type:ex_ty) : ex_typed_value result Trace.trace_tzresult_lwt (simple_error "error parsing program code") @@ Memory_proto_alpha.parse_michelson ~top_level exp ty_stack_before ty_stack_after in let open! Memory_proto_alpha.Protocol.Script_interpreter in - let%bind (Item(output, Empty)) = + let%bind res = Trace.trace_tzresult_lwt (simple_error "error of execution") @@ - Memory_proto_alpha.interpret ?options descr Empty in - ok (Ex_typed_value (exp_type', output)) + Memory_proto_alpha.failure_interpret ?options descr Empty in + match res with + | Memory_proto_alpha.Succeed stack -> + let (Item(output, Empty)) = stack in + ok @@ Success (Ex_typed_value (exp_type', output)) + | Memory_proto_alpha.Fail expr -> + ok (Fail expr) + +let run ?options (exp:Michelson.t) (exp_type:ex_ty) : ex_typed_value result = + let%bind expr = run_expression ?options exp exp_type in + match expr with + | Success res -> ok res + | _ -> simple_fail "Execution terminated with failwith" + +let run_failwith ?options (exp:Michelson.t) (exp_type:ex_ty) : run_failwith_res result = + let%bind expr = run_expression ?options exp exp_type in + match expr with + | Fail res -> ( match Tezos_micheline.Micheline.root @@ Memory_proto_alpha.strings_of_prims res with + | Int (_ , i) -> ok (Failwith_int (Z.to_int i)) + | String (_ , s) -> ok (Failwith_string s) + | Bytes (_,b) -> ok (Failwith_bytes b) + | _ -> simple_fail "Unknown failwith type" ) + | _ -> simple_fail "An error of execution was expected" let evaluate_expression ?options exp exp_type = - let%bind etv = run_exp ?options exp exp_type in + let%bind etv = run ?options exp exp_type in ex_value_ty_to_michelson etv \ No newline at end of file diff --git a/src/stages/mini_c/misc.ml b/src/stages/mini_c/misc.ml index bd704a745..472811e3f 100644 --- a/src/stages/mini_c/misc.ml +++ b/src/stages/mini_c/misc.ml @@ -140,39 +140,25 @@ let get_entry (lst : program) (name : string) : (expression * int) result = in ok (entry_expression , entry_index) - (* - Assume the following code: - ``` - const x = 42 - const y = 120 - const z = 423 - const f = () -> x + y - ``` - It is transformed in: - ``` - const f = () -> - let x = 42 in - let y = 120 in - let z = 423 in - x + y - ``` + Assume the following program: + ``` + const x = 42 + const y = 120 + const f = () -> x + y + ``` + aggregate_entry program "f" (Some [unit]) would return: + ``` + let x = 42 in + let y = 120 in + const y = e -> e + (f ()) + f(unit) + ``` - The entry-point can be an expression. In that case the following code: - ``` - const x = 42 - const y = 120 - const z = 423 - const some_exp = x+y - ``` - Is transformed in: - let x = 42 in - let y = 120 in - let z = 423 in - x+y - ``` + if arg_lst is None, it means that the entry point is not an arbitrary expression *) -let aggregate_entry (lst : program) (name : string) (is_exp : bool) : expression result = + +let aggregate_entry (lst : program) (name : string) (arg_lst : expression list option) : expression result = let%bind (entry_expression , entry_index) = get_entry lst name in let pre_declarations = List.until entry_index lst in let wrapper = @@ -182,23 +168,27 @@ let aggregate_entry (lst : program) (name : string) (is_exp : bool) : expression in fun expr -> List.fold_right' aux expr pre_declarations in - match (entry_expression.content , is_exp) with - | (E_closure l , false) -> ( - let l' = { l with body = wrapper l.body } in - let%bind t' = - 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_closure l' ; - type_value = t' ; - } in - ok e' + match (entry_expression.content , arg_lst) with + | (E_closure _ , Some (hd::tl)) -> ( + let%bind type_value' = match entry_expression.type_value with + | T_function (_,t) -> ok t + | _ -> simple_fail "Trying to aggregate closure which does not have function type" in + let entry_expression' = List.fold_left + (fun acc el -> + let type_value' = match acc.type_value with + | T_function (_,t) -> t + | e -> e in + { + content = E_application (acc,el) ; + type_value = type_value' ; + } + ) + { + content = E_application (entry_expression, hd) ; + type_value = type_value' ; + } tl in + ok @@ wrapper entry_expression' ) - | (_ , true) -> ( + | (_ , None) | (_, Some _) -> ( ok @@ wrapper entry_expression ) - | _ -> ( - Format.printf "Not functional: %a\n" PP.expression entry_expression ; - fail @@ Errors.not_functional_main name - ) diff --git a/src/test/coase_tests.ml b/src/test/coase_tests.ml index 32b21deba..23772d634 100644 --- a/src/test/coase_tests.ml +++ b/src/test/coase_tests.ml @@ -4,7 +4,8 @@ open Trace open Test_helpers let type_file f = - let%bind (typed , state , _env) = Ligo.Compile.Wrapper.source_to_typed (Syntax_name "pascaligo") f in + let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "pascaligo") in + let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in ok @@ (typed,state) let get_program = @@ -19,8 +20,13 @@ let get_program = ) let compile_main () = - let%bind (_ : Tezos_utils.Michelson.michelson * (Ast_typed.program * Typer.Solver.state * Ast_typed.Types.full_environment)) = - Compile.Wrapper.source_to_michelson_contract (Syntax_name "pascaligo") "./contracts/coase.ligo" "main" in + let%bind simplified = Ligo.Compile.Of_source.compile "./contracts/coase.ligo" (Syntax_name "pascaligo") in + let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile simplified in + let%bind mini_c_prg = Ligo.Compile.Of_typed.compile typed_prg in + let%bind michelson_prg = Ligo.Compile.Of_mini_c.aggregate_and_compile mini_c_prg None "main" in + let%bind (_contract: Tezos_utils.Michelson.michelson) = + (* fails if the given entry point is not a valid contract *) + Ligo.Compile.Of_mini_c.build_contract michelson_prg in ok () open Ast_simplified diff --git a/src/test/heap_tests.ml b/src/test/heap_tests.ml index dfe1d1ef7..440d6fe7a 100644 --- a/src/test/heap_tests.ml +++ b/src/test/heap_tests.ml @@ -2,7 +2,8 @@ open Trace open Test_helpers let type_file f = - let%bind (typed , state , _env) = Ligo.Compile.Wrapper.source_to_typed (Syntax_name "pascaligo") f in + let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "pascaligo") in + let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in ok @@ (typed,state) let get_program = @@ -48,11 +49,10 @@ 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_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 mini_c = Compile.Of_typed.compile program in + let%bind program_mich = Compile.Of_mini_c.aggregate_and_compile mini_c (Some [input_mini_c]) entry_point in + let%bind res = Run.Of_michelson.run program_mich.expr program_mich.expr_ty in let%bind output_type = let%bind entry_expression = Ast_typed.get_entry program entry_point in let%bind (_ , output_type) = Ast_typed.get_t_function entry_expression.type_annotation in diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index cd6aae92d..6efe009aa 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -8,11 +8,13 @@ let retype_file f = let () = Typer.Solver.discard_state state in ok typed let mtype_file f = - let%bind (typed , state , _env) = Ligo.Compile.Wrapper.source_to_typed (Syntax_name "cameligo") f in + let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "cameligo") in + let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in let () = Typer.Solver.discard_state state in ok typed let type_file f = - let%bind (typed , state , _env) = Ligo.Compile.Wrapper.source_to_typed (Syntax_name "pascaligo") f in + let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "pascaligo") in + let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in let () = Typer.Solver.discard_state state in ok typed @@ -184,26 +186,6 @@ let higher_order () : unit result = let%bind _ = expect_eq_n_int program "foobar3" make_expect in let%bind _ = expect_eq_n_int program "foobar4" make_expect in let%bind _ = expect_eq_n_int program "foobar5" make_expect in - - - let%bind (typed_arg,_) = Compile.Of_simplified.compile_expression - ~env:(Ast_typed.Environment.full_empty) ~state:(Typer.Solver.initial_state) (e_int 1) in - let%bind mini_c_arg = Compile.Of_typed.compile_expression typed_arg in - let%bind compiled_arg = Compile.Of_mini_c.compile_expression mini_c_arg in - let%bind arg_michelson = Ligo.Run.Of_michelson.evaluate_expression compiled_arg.expr compiled_arg.expr_ty in - - let%bind michelson = Compile.Wrapper.typed_to_michelson_fun program "foobar6" in - let%bind _michelson_output1 = Ligo.Run.Of_michelson.run_function michelson.expr michelson.expr_ty arg_michelson false in (* foobar6(1) = f *) - - let%bind _michelson_output1 = Ligo.Run.Of_michelson.ex_value_ty_to_michelson _michelson_output1 in - let%bind expr_ty = Compiler.Type.Ty.type_ (T_function (Mini_c.t_int,Mini_c.t_int)) in - let%bind _michelson_output2 = Ligo.Run.Of_michelson.run_function _michelson_output1 expr_ty arg_michelson false in (* f(1) = 1*) - - let%bind mini_c_un = Compiler.Uncompiler.translate_value _michelson_output2 in - let%bind typed_un = Transpiler.untranspile mini_c_un (Ast_typed.t_int ()) in - let%bind _simplified_output = Typer.untype_expression typed_un in - let%bind () = Ast_simplified.Misc.assert_value_eq (_simplified_output , e_int 1) in - ok () let higher_order_mligo () : unit result = @@ -228,21 +210,17 @@ let higher_order_religo () : unit result = let shared_function () : unit result = let%bind program = type_file "./contracts/function-shared.ligo" in - Format.printf "inc\n" ; let%bind () = let make_expect = fun n -> (n + 1) in expect_eq_n_int program "inc" make_expect in - Format.printf "double inc?\n" ; let%bind () = expect_eq program "double_inc" (e_int 0) (e_int 2) in - Format.printf "double incd!\n" ; let%bind () = let make_expect = fun n -> (n + 2) in expect_eq_n_int program "double_inc" make_expect in - Format.printf "foo\n" ; let%bind () = let make_expect = fun n -> (2 * n + 3) in expect_eq program "foo" (e_int 0) (e_int @@ make_expect 0) diff --git a/src/test/multisig_tests.ml b/src/test/multisig_tests.ml index b90b56ed2..220b48fae 100644 --- a/src/test/multisig_tests.ml +++ b/src/test/multisig_tests.ml @@ -2,7 +2,8 @@ open Trace open Test_helpers let type_file f = - let%bind (typed , state , _env) = Ligo.Compile.Wrapper.source_to_typed (Syntax_name "pascaligo") f in + let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "pascaligo") in + let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in ok @@ (typed,state) let get_program = @@ -16,8 +17,13 @@ let get_program = ) let compile_main () = - let%bind (_ : Tezos_utils.Michelson.michelson * (Ast_typed.program * Typer.Solver.state * Ast_typed.Types.full_environment)) = - Compile.Wrapper.source_to_michelson_contract (Syntax_name "pascaligo") "./contracts/multisig.ligo" "main" in + let%bind simplified = Ligo.Compile.Of_source.compile "./contracts/multisig.ligo" (Syntax_name "pascaligo") in + let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile simplified in + let%bind mini_c_prg = Ligo.Compile.Of_typed.compile typed_prg in + let%bind michelson_prg = Ligo.Compile.Of_mini_c.aggregate_and_compile mini_c_prg None "main" in + let%bind (_contract: Tezos_utils.Michelson.michelson) = + (* fails if the given entry point is not a valid contract *) + Ligo.Compile.Of_mini_c.build_contract michelson_prg in ok () open Ast_simplified diff --git a/src/test/multisig_v2_tests.ml b/src/test/multisig_v2_tests.ml index 4ddbb7b61..080669bfb 100644 --- a/src/test/multisig_v2_tests.ml +++ b/src/test/multisig_v2_tests.ml @@ -2,7 +2,8 @@ open Trace open Test_helpers let type_file f = - let%bind (typed , state , _env) = Ligo.Compile.Wrapper.source_to_typed (Syntax_name "pascaligo") f in + let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "pascaligo") in + let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in ok @@ (typed,state) let get_program = @@ -16,8 +17,13 @@ let get_program = ) let compile_main () = - let%bind (_ : Tezos_utils.Michelson.michelson * (Ast_typed.program * Typer.Solver.state * Ast_typed.Types.full_environment)) = - Compile.Wrapper.source_to_michelson_contract (Syntax_name "pascaligo") "./contracts/multisig-v2.ligo" "main" in + let%bind simplified = Ligo.Compile.Of_source.compile "./contracts/multisig-v2.ligo" (Syntax_name "pascaligo") in + let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile simplified in + let%bind mini_c_prg = Ligo.Compile.Of_typed.compile typed_prg in + let%bind michelson_prg = Ligo.Compile.Of_mini_c.aggregate_and_compile mini_c_prg None "main" in + let%bind (_contract: Tezos_utils.Michelson.michelson) = + (* fails if the given entry point is not a valid contract *) + Ligo.Compile.Of_mini_c.build_contract michelson_prg in ok () open Ast_simplified diff --git a/src/test/test_helpers.ml b/src/test/test_helpers.ml index e28f464ca..7e2651892 100644 --- a/src/test/test_helpers.ml +++ b/src/test/test_helpers.ml @@ -84,17 +84,21 @@ 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 + (* might be useless *) 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 + + let%bind mini_c_prg = Compile.Of_typed.compile program in + let%bind michelson_program = Compile.Of_mini_c.aggregate_and_compile mini_c_prg (Some [mini_c_in]) entry_point in ok (michelson_program, evaluated_in) let run_typed_program_with_simplified_input ?options (program: Ast_typed.program) (entry_point: string) (input: Ast_simplified.expression) : Ast_simplified.expression result = - let%bind (michelson_program, evaluated_in) = typed_program_with_simplified_input_to_michelson program entry_point input in - let%bind michelson_output = Ligo.Run.Of_michelson.run_function - ?options michelson_program.expr michelson_program.expr_ty evaluated_in false in + let%bind (michelson_program, _evaluated_in) = typed_program_with_simplified_input_to_michelson program entry_point input in + (* let%bind michelson_output = Ligo.Run.Of_michelson.run_contract + ?options michelson_program.expr michelson_program.expr_ty _evaluated_in false in *) + let%bind michelson_output = Ligo.Run.Of_michelson.run ?options michelson_program.expr michelson_program.expr_ty in Uncompile.uncompile_typed_program_entry_function_result program entry_point michelson_output let expect ?options program entry_point input expecter = @@ -120,9 +124,9 @@ let expect_fail ?options program entry_point input = run_typed_program_with_simplified_input ?options program entry_point input let expect_string_failwith ?options program entry_point input expected_failwith = - let%bind (michelson_program, evaluated_in) = typed_program_with_simplified_input_to_michelson program entry_point input in + let%bind (michelson_program, _evaluated_in) = typed_program_with_simplified_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 evaluated_in false in + ?options michelson_program.expr michelson_program.expr_ty in match err with | Ligo.Run.Of_michelson.Failwith_string s -> Assert.assert_equal_string expected_failwith s | _ -> simple_fail "Expected to fail with a string" @@ -145,8 +149,9 @@ let expect_evaluate program entry_point expecter = let content () = Format.asprintf "Entry_point: %s" entry_point in error title content in trace error @@ - let%bind michelson_value_as_f = Compile.Wrapper.typed_to_michelson_expression program entry_point in - let%bind res_michelson = Ligo.Run.Of_michelson.run_exp michelson_value_as_f.expr michelson_value_as_f.expr_ty in + let%bind mini_c = Ligo.Compile.Of_typed.compile program in + let%bind michelson_value = Ligo.Compile.Of_mini_c.aggregate_and_compile mini_c (Some []) entry_point in + let%bind res_michelson = Ligo.Run.Of_michelson.run michelson_value.expr michelson_value.expr_ty in let%bind res_simpl = Uncompile.uncompile_typed_program_entry_expression_result program entry_point res_michelson in expecter res_simpl diff --git a/src/test/vote_tests.ml b/src/test/vote_tests.ml index b7c4ab798..35cb3ad1f 100644 --- a/src/test/vote_tests.ml +++ b/src/test/vote_tests.ml @@ -2,7 +2,8 @@ open Trace open Test_helpers let type_file f = - let%bind (typed , state , _env) = Ligo.Compile.Wrapper.source_to_typed (Syntax_name "cameligo") f in + let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "cameligo") in + let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in ok @@ (typed,state) let get_program =