From 385961503fc7fa8f5c4c3f57f1633e13c7cae887 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Wed, 4 Dec 2019 02:05:24 +0100 Subject: [PATCH 01/15] add unparse_ty to ligo-utils (thanks alpha monad) --- vendors/ligo-utils/proto-alpha-utils/x_memory_proto_alpha.ml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/vendors/ligo-utils/proto-alpha-utils/x_memory_proto_alpha.ml b/vendors/ligo-utils/proto-alpha-utils/x_memory_proto_alpha.ml index 541a926cc..c60baea92 100644 --- a/vendors/ligo-utils/proto-alpha-utils/x_memory_proto_alpha.ml +++ b/vendors/ligo-utils/proto-alpha-utils/x_memory_proto_alpha.ml @@ -1096,6 +1096,10 @@ let interpret ?(options = default_options) (instr:('a, 'b) descr) (bef:'a stack) Script_interpreter.step tezos_context step_constants instr bef >>=?? fun (stack, _) -> return stack +let unparse_ty_michelson ty = + Script_ir_translator.unparse_ty dummy_environment.tezos_context ty >>=?? + fun (n,_) -> return n + type 'a interpret_res = | Succeed of 'a stack | Fail of Script_repr.expr From 8edeb273213f084af55b7816fd38abd917a860c0 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Wed, 4 Dec 2019 02:06:41 +0100 Subject: [PATCH 02/15] add a function to fetch (param,storage) in a contract's lambda --- src/passes/9-self_michelson/helpers.ml | 12 ++++++++++++ src/passes/9-self_michelson/self_michelson.ml | 1 + 2 files changed, 13 insertions(+) diff --git a/src/passes/9-self_michelson/helpers.ml b/src/passes/9-self_michelson/helpers.ml index 4ce8670c1..feca5a151 100644 --- a/src/passes/9-self_michelson/helpers.ml +++ b/src/passes/9-self_michelson/helpers.ml @@ -17,3 +17,15 @@ let rec map_expression : mapper -> michelson -> michelson result = fun f e -> ok @@ Seq (l , lst') ) | x -> ok x + +open Memory_proto_alpha.Protocol.Script_ir_translator +(* fetches lambda first and second parameter (parameter,storage) *) +let fetch_lambda_parameters : ex_ty -> (ex_ty * ex_ty) result = + let error () = simple_fail "failed to fetch lambda parameters" in + function + | Ex_ty (Lambda_t (in_ty, _, _)) -> ( + match in_ty with + | Pair_t ((param_ty,_,_),(storage_ty,_,_),_,_) -> + ok (Ex_ty param_ty, Ex_ty storage_ty) + |_ -> error () ) + | _ -> error () diff --git a/src/passes/9-self_michelson/self_michelson.ml b/src/passes/9-self_michelson/self_michelson.ml index 711bf64f2..12b8073aa 100644 --- a/src/passes/9-self_michelson/self_michelson.ml +++ b/src/passes/9-self_michelson/self_michelson.ml @@ -8,6 +8,7 @@ open Tezos_micheline.Micheline open Tezos_utils.Michelson +include Helpers (* `arity p` should be `Some n` only if p is (always) an instruction which removes n items from the stack and uses them to push 1 item, From 0cae4302cd447bcf8086ccd46b3526a701f6b01f Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Wed, 4 Dec 2019 02:07:39 +0100 Subject: [PATCH 03/15] WIP: introduce compiled_expression and unify dry-run and compile-contract --- src/bin/cli.ml | 4 +- src/main/compile/of_mini_c.ml | 42 +++++++---- src/main/compile/wrapper.ml | 21 +++--- src/main/run/of_michelson.ml | 83 ++++++++++++++++++++++ src/passes/8-compiler/compiler_program.ml | 5 ++ src/passes/8-compiler/compiler_program.mli | 5 ++ 6 files changed, 136 insertions(+), 24 deletions(-) diff --git a/src/bin/cli.ml b/src/bin/cli.ml index e0f49bf1b..e3f2ff2ec 100644 --- a/src/bin/cli.ml +++ b/src/bin/cli.ml @@ -163,10 +163,10 @@ let dry_run = 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_param = Compile.source_contract_input_to_michelson_value_as_function ~env ~state (storage,input) v_syntax in - let%bind michelson = Compile.typed_to_michelson_program typed_program entry_point in + let%bind michelson = Compile.typed_to_michelson_contract_as_exp typed_program entry_point in let%bind args_michelson = Run.evaluate_michelson compiled_param in let%bind options = Run.make_dry_run_options {amount ; sender ; source } in - let%bind michelson_output = Run.run ~options michelson args_michelson in + let%bind michelson_output = Run.run_contract ~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 ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output in diff --git a/src/main/compile/of_mini_c.ml b/src/main/compile/of_mini_c.ml index 23a4d4993..239a960d7 100644 --- a/src/main/compile/of_mini_c.ml +++ b/src/main/compile/of_mini_c.ml @@ -1,8 +1,9 @@ -open Trace open Mini_c open Tezos_utils +open Proto_alpha_utils +open Trace -let compile_expression_as_function : expression -> _ result = fun e -> +let compile_expression_as_function : expression -> Compiler.compiled_program result = fun e -> let (input , output) = t_unit , e.type_value in let%bind body = Compiler.Program.translate_expression e Compiler.Environment.empty in let body = Self_michelson.optimize body in @@ -11,7 +12,7 @@ let compile_expression_as_function : expression -> _ result = fun e -> let open! Compiler.Program in ok { input ; output ; body } -let compile_function = fun e -> +let compile_function : expression -> Compiler.compiled_program result = fun e -> let%bind (input , output) = get_t_function e.type_value in let%bind body = get_function e in let%bind body = Compiler.Program.translate_function_body body [] input in @@ -30,15 +31,30 @@ let compile_function_entry = fun program name -> let aggregated = Self_mini_c.all_expression aggregated in compile_function aggregated -let compile_contract_entry = fun program name -> +(* new *) + +let compile_contract : expression -> Compiler.compiled_expression result = fun e -> + let%bind (input , _) = get_t_function e.type_value in + let%bind body = get_function e in + let%bind body = Compiler.Program.translate_function_body body [] input 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_contract_as_exp = fun program name -> let%bind aggregated = aggregate_entry program name false in let aggregated = Self_mini_c.all_expression aggregated in - let%bind compiled = compile_function aggregated in - let%bind (param_ty , storage_ty) = - let%bind fun_ty = get_t_function aggregated.type_value in - Mini_c.get_t_pair (fst fun_ty) - in - let%bind param_michelson = Compiler.Type.type_ param_ty in - let%bind storage_michelson = Compiler.Type.type_ storage_ty in - let contract = Michelson.contract param_michelson storage_michelson compiled.body in - ok contract + compile_contract aggregated + +let build_contract : Compiler.compiled_expression -> Michelson.michelson result = + fun compiled -> + let%bind ((Ex_ty _param_ty),(Ex_ty _storage_ty)) = Self_michelson.fetch_lambda_parameters compiled.expr_ty in + (*TODO : bind pair trace_tzresult_lwt ? *) + let%bind (param_michelson : Tezos_raw_protocol_005_PsBabyM1.Alpha_context.Script.node) = + Trace.trace_tzresult_lwt (simple_error "TODO") @@ + Proto_alpha_utils.Memory_proto_alpha.unparse_ty_michelson _param_ty in + let%bind (storage_michelson : Tezos_raw_protocol_005_PsBabyM1.Alpha_context.Script.node) = + Trace.trace_tzresult_lwt (simple_error "TODO") @@ + Proto_alpha_utils.Memory_proto_alpha.unparse_ty_michelson _storage_ty in + ok @@ Michelson.contract param_michelson storage_michelson compiled.expr diff --git a/src/main/compile/wrapper.ml b/src/main/compile/wrapper.ml index f3577b4e4..a38af4b46 100644 --- a/src/main/compile/wrapper.ml +++ b/src/main/compile/wrapper.ml @@ -31,15 +31,6 @@ let simplified_to_compiled_program let%bind (typed,_) = Of_simplified.compile_expression ~env ~state exp in typed_expression_to_michelson_value_as_function typed -let typed_to_michelson_contract - (typed: Ast_typed.program) (entry_point:string) : Michelson.michelson result = - let%bind mini_c = Of_typed.compile typed in - Of_mini_c.compile_contract_entry mini_c entry_point - -let source_to_michelson_contract syntax source_file entry_point = - let%bind (typed,_,_) = source_to_typed syntax source_file in - typed_to_michelson_contract typed entry_point - let source_expression_to_michelson_value_as_function ~env ~state parameter syntax = let%bind typed = source_to_typed_expression ~env ~state parameter syntax in let%bind mini_c = Of_typed.compile_expression typed in @@ -49,3 +40,15 @@ let source_contract_input_to_michelson_value_as_function ~env ~state (storage,pa let%bind simplified = Of_source.compile_contract_input storage parameter syntax in let%bind typed,_ = Of_simplified.compile_expression ~env ~state simplified in typed_expression_to_michelson_value_as_function typed + +(* new *) +let typed_to_michelson_contract_as_exp + (typed: Ast_typed.program) (entry_point:string) : Compiler.compiled_expression result = + let%bind mini_c = Of_typed.compile typed in + Of_mini_c.compile_contract_as_exp mini_c entry_point + +(* produce a michelson contract e.g. the following sequence K_param ; K_storage ; K_code *) +let source_to_michelson_contract syntax source_file entry_point = + let%bind (typed,_,_) = source_to_typed syntax source_file in + let%bind michelson = typed_to_michelson_contract_as_exp typed entry_point in + Of_mini_c.build_contract michelson diff --git a/src/main/run/of_michelson.ml b/src/main/run/of_michelson.ml index 2d4e5a66b..14618d8ba 100644 --- a/src/main/run/of_michelson.ml +++ b/src/main/run/of_michelson.ml @@ -123,3 +123,86 @@ let pack_payload (payload:Michelson.t) ty = Trace.trace_tzresult_lwt (simple_error "error packing message") @@ Memory_proto_alpha.pack ty payload in ok @@ data + + +(* +type ex_option = +Ex_option : 'a option -> ex_option + +let f : ex_option -> _ = fun exo -> + let (Ex_option x) = exo in + match x with + | None -> 0 + | Some x' -> 1 (*x' varialbe de tpy existentiel*) + (* Some x' : j'essaie defenir x', et je le sors pas de la function, donc c bon*) +*) + +(* +type ex = Ex : 'a -> ex +let f = fun x -> let (Ex x') = x in x' (* la ca sort *) +*) + + (* | Pair_t : + ('a ty * field_annot option * var_annot option) * + ('b ty * field_annot option * var_annot option) * + type_annot option * + bool -> ('a, 'b) pair ty *) +let fetch_contract_args (contract_ty:ex_ty) = + match contract_ty with + | Ex_ty (Contract_t (in_ty,_)) -> ok (Ex_ty in_ty, Ex_ty in_ty) + | Ex_ty (Lambda_t (in_ty, out_ty, _)) -> ok (Ex_ty in_ty, Ex_ty out_ty) + | _ -> + simple_fail "mock" + +(* type run_res = Failwith of failwith_res | Success of ex_typed_value +let run_bis ?options (exp:Michelson.t) (input_michelson:Michelson.t) (is_contract:bool) : run_res result = *) +let run_contract ?options (exp:Michelson.t) (exp_type:ex_ty) (input_michelson:Michelson.t) (is_contract:bool) : ex_typed_value result = + let open! Tezos_raw_protocol_005_PsBabyM1 in + let%bind (Ex_ty input_ty, Ex_ty output_ty) = fetch_contract_args 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 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 (Item(output, Empty)) = + Trace.trace_tzresult_lwt (simple_error "error of execution") @@ + Memory_proto_alpha.interpret ?options descr + (Item(input, Empty)) + in + ok (Ex_typed_value (output_ty, output)) + + (* +let run_exp ?options (exp:Michelson.t) (*add the type*) : ex_typed_value result = + let%bind exp_type = + Trace.trace_tzresult_lwt (simple_error "error getting expression type") @@ + Memory_proto_alpha.parse_michelson_ty exp in + let open! Tezos_raw_protocol_005_PsBabyM1 in + let (Ex_ty exp_type') = exp_type in + let%bind ((top_level : tc_context), ty_stack_before, ty_stack_after) = + ok @@ ( + Script_ir_translator.Lambda, + Script_typed_ir.Empty_t, + Script_typed_ir.Item_t (exp_type', 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 (Item(output, Empty)) = + Trace.trace_tzresult_lwt (simple_error "error of execution") @@ + Memory_proto_alpha.interpret ?options descr Empty in + (* TODO stack type : unit::empty *) + ok (Ex_typed_value (exp_type', output)) + *) \ No newline at end of file diff --git a/src/passes/8-compiler/compiler_program.ml b/src/passes/8-compiler/compiler_program.ml index 6ceca0380..55c5a88f1 100644 --- a/src/passes/8-compiler/compiler_program.ml +++ b/src/passes/8-compiler/compiler_program.ml @@ -456,6 +456,11 @@ type compiled_program = { body : michelson ; } +type compiled_expression = { + expr_ty : ex_ty ; + expr : michelson ; +} + let get_main : program -> string -> (anon_function * _) result = fun p entry -> let is_main ((( name , expr), _):toplevel_statement) = match Combinators.Expression.(get_content expr , get_type expr)with diff --git a/src/passes/8-compiler/compiler_program.mli b/src/passes/8-compiler/compiler_program.mli index ffd3c0666..700c17e46 100644 --- a/src/passes/8-compiler/compiler_program.mli +++ b/src/passes/8-compiler/compiler_program.mli @@ -15,6 +15,11 @@ type compiled_program = { body : michelson ; } +type compiled_expression = { + expr_ty : ex_ty ; + expr : michelson ; +} + val get_operator : constant -> type_value -> expression list -> predicate result val translate_expression : expression -> environment -> michelson result val translate_function_body : anon_function -> environment_element list -> type_value -> michelson result From 46623ceb7720c328efbfef2975630e4cc1cb9a0d Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Wed, 4 Dec 2019 13:34:15 +0100 Subject: [PATCH 04/15] contract are now typecheck (at least in the CLI) --- src/bin/cli.ml | 23 ++++++++----------- src/main/compile/of_mini_c.ml | 15 +++++++----- src/main/compile/wrapper.ml | 5 ++-- src/main/run/of_michelson.ml | 8 +++---- .../proto-alpha-utils/x_memory_proto_alpha.ml | 5 ++++ 5 files changed, 30 insertions(+), 26 deletions(-) diff --git a/src/bin/cli.ml b/src/bin/cli.ml index e3f2ff2ec..aeaa723c2 100644 --- a/src/bin/cli.ml +++ b/src/bin/cli.ml @@ -102,7 +102,7 @@ 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 (contract,_) = Compile.source_to_michelson_contract (Syntax_name syntax) source_file entry_point in ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) contract in let term = @@ -114,7 +114,7 @@ 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 (contract,_) = Compile.source_to_michelson_contract (Syntax_name syntax) source_file entry_point in let open Tezos_utils in ok @@ Format.asprintf "%d bytes\n" (Michelson.measure contract) in @@ -139,9 +139,6 @@ let compile_parameter = let doc = "Subcommand: compile parameters to a michelson expression. The resulting michelson expression can be passed as an argument in a transaction which calls a contract." in (term , Term.info ~doc cmdname) -(*------------------------------------------------------------------------------------------------------------------------------------- -TODO: This function does not typecheck anything, add the typecheck against the given entrypoint. For now: does the same as compile_parameter --------------------------------------------------------------------------------------------------------------------------------------- *) let compile_storage = let f source_file _entry_point expression syntax display_format michelson_format = toplevel ~display_format @@ @@ -160,14 +157,14 @@ 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_typed (Syntax_name syntax) source_file in - let%bind compiled_param = Compile.source_contract_input_to_michelson_value_as_function ~env ~state (storage,input) v_syntax in - let%bind michelson = Compile.typed_to_michelson_contract_as_exp typed_program entry_point in - let%bind args_michelson = Run.evaluate_michelson compiled_param in - let%bind options = Run.make_dry_run_options {amount ; sender ; source } in - let%bind michelson_output = Run.run_contract ~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 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_param = Compile.source_contract_input_to_michelson_value_as_function ~env ~state (storage,input) v_syntax in + let%bind michelson = Compile.typed_to_michelson_contract_as_exp typed_program entry_point in + let%bind args_michelson = Run.evaluate_michelson compiled_param in + let%bind options = Run.make_dry_run_options {amount ; sender ; source } in + let%bind michelson_output = Run.run_contract ~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 ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output in let term = diff --git a/src/main/compile/of_mini_c.ml b/src/main/compile/of_mini_c.ml index 239a960d7..eb28a2f04 100644 --- a/src/main/compile/of_mini_c.ml +++ b/src/main/compile/of_mini_c.ml @@ -50,11 +50,14 @@ let compile_contract_as_exp = fun program name -> let build_contract : Compiler.compiled_expression -> Michelson.michelson result = fun compiled -> let%bind ((Ex_ty _param_ty),(Ex_ty _storage_ty)) = Self_michelson.fetch_lambda_parameters compiled.expr_ty in - (*TODO : bind pair trace_tzresult_lwt ? *) - let%bind (param_michelson : Tezos_raw_protocol_005_PsBabyM1.Alpha_context.Script.node) = - Trace.trace_tzresult_lwt (simple_error "TODO") @@ + let%bind param_michelson = + Trace.trace_tzresult_lwt (simple_error "Could not unparse contract lambda's parameter") @@ Proto_alpha_utils.Memory_proto_alpha.unparse_ty_michelson _param_ty in - let%bind (storage_michelson : Tezos_raw_protocol_005_PsBabyM1.Alpha_context.Script.node) = - Trace.trace_tzresult_lwt (simple_error "TODO") @@ + let%bind storage_michelson = + Trace.trace_tzresult_lwt (simple_error "Could not unparse contract lambda's storage") @@ Proto_alpha_utils.Memory_proto_alpha.unparse_ty_michelson _storage_ty in - ok @@ Michelson.contract param_michelson storage_michelson compiled.expr + let contract = Michelson.contract param_michelson storage_michelson compiled.expr in + let%bind () = + Trace.trace_tzresult_lwt (simple_error "Invalid contract") @@ + Proto_alpha_utils.Memory_proto_alpha.typecheck_contract contract in + ok contract diff --git a/src/main/compile/wrapper.ml b/src/main/compile/wrapper.ml index a38af4b46..f8579e5e1 100644 --- a/src/main/compile/wrapper.ml +++ b/src/main/compile/wrapper.ml @@ -49,6 +49,7 @@ let typed_to_michelson_contract_as_exp (* produce a michelson contract e.g. the following sequence K_param ; K_storage ; K_code *) let source_to_michelson_contract syntax source_file entry_point = - let%bind (typed,_,_) = source_to_typed syntax source_file in + let%bind (typed,state,env) = source_to_typed syntax source_file in let%bind michelson = typed_to_michelson_contract_as_exp typed entry_point in - Of_mini_c.build_contract michelson + 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 14618d8ba..5f7cc6590 100644 --- a/src/main/run/of_michelson.ml +++ b/src/main/run/of_michelson.ml @@ -147,18 +147,16 @@ let f = fun x -> let (Ex x') = x in x' (* la ca sort *) ('b ty * field_annot option * var_annot option) * type_annot option * bool -> ('a, 'b) pair ty *) -let fetch_contract_args (contract_ty:ex_ty) = +let fetch_lambda_types (contract_ty:ex_ty) = match contract_ty with - | Ex_ty (Contract_t (in_ty,_)) -> ok (Ex_ty in_ty, Ex_ty in_ty) | Ex_ty (Lambda_t (in_ty, out_ty, _)) -> ok (Ex_ty in_ty, Ex_ty out_ty) - | _ -> - simple_fail "mock" + | _ -> simple_fail "failed to fetch lambda types" (* type run_res = Failwith of failwith_res | Success of ex_typed_value let run_bis ?options (exp:Michelson.t) (input_michelson:Michelson.t) (is_contract:bool) : run_res result = *) let run_contract ?options (exp:Michelson.t) (exp_type:ex_ty) (input_michelson:Michelson.t) (is_contract:bool) : ex_typed_value result = let open! Tezos_raw_protocol_005_PsBabyM1 in - let%bind (Ex_ty input_ty, Ex_ty output_ty) = fetch_contract_args exp_type 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 diff --git a/vendors/ligo-utils/proto-alpha-utils/x_memory_proto_alpha.ml b/vendors/ligo-utils/proto-alpha-utils/x_memory_proto_alpha.ml index c60baea92..99887c721 100644 --- a/vendors/ligo-utils/proto-alpha-utils/x_memory_proto_alpha.ml +++ b/vendors/ligo-utils/proto-alpha-utils/x_memory_proto_alpha.ml @@ -1100,6 +1100,11 @@ let unparse_ty_michelson ty = Script_ir_translator.unparse_ty dummy_environment.tezos_context ty >>=?? fun (n,_) -> return n +let typecheck_contract contract = + let contract' = Tezos_micheline.Micheline.strip_locations contract in + Script_ir_translator.typecheck_code dummy_environment.tezos_context contract' >>=?? + fun _ -> return () + type 'a interpret_res = | Succeed of 'a stack | Fail of Script_repr.expr From d1f6c37f62b6ddef799f48b0c7a769cc8bc3f892 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Thu, 5 Dec 2019 17:44:56 +0100 Subject: [PATCH 05/15] CLI clean --- src/bin/cli.ml | 52 +++++++++++++++++++++-------------- src/main/compile/of_mini_c.ml | 23 ++++++++++++---- src/main/compile/wrapper.ml | 27 +++++++++++++++--- src/main/run/of_michelson.ml | 52 ++++++++--------------------------- src/stages/mini_c/misc.ml | 23 ++++++++++++---- src/test/multisig_tests.ml | 5 ++-- src/test/multisig_v2_tests.ml | 4 +-- src/test/test_helpers.ml | 4 +-- 8 files changed, 106 insertions(+), 84 deletions(-) diff --git a/src/bin/cli.ml b/src/bin/cli.ml index aeaa723c2..2dc18723e 100644 --- a/src/bin/cli.ml +++ b/src/bin/cli.ml @@ -125,12 +125,17 @@ let measure_contract = (term , Term.info ~doc cmdname) let compile_parameter = - let f source_file _entry_point expression syntax display_format michelson_format = + 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 - let%bind (_,state,env) = Compile.source_to_typed (Syntax_name syntax) source_file in - let%bind compiled_exp = Compile.source_expression_to_michelson_value_as_function ~env ~state expression v_syntax in - let%bind value = Run.evaluate_michelson compiled_exp 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 ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value in let term = @@ -140,12 +145,17 @@ let compile_parameter = (term , Term.info ~doc cmdname) let compile_storage = - let f source_file _entry_point expression syntax display_format michelson_format = + 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 - let%bind (_,state,env) = Compile.source_to_typed (Syntax_name syntax) source_file in - let%bind compiled = Compile.source_expression_to_michelson_value_as_function ~env ~state expression v_syntax in - let%bind value = Run.evaluate_michelson compiled in + 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 ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value in let term = @@ -159,11 +169,11 @@ let dry_run = 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_param = Compile.source_contract_input_to_michelson_value_as_function ~env ~state (storage,input) v_syntax in - let%bind michelson = Compile.typed_to_michelson_contract_as_exp typed_program entry_point in - let%bind args_michelson = Run.evaluate_michelson compiled_param 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_contract ~options michelson.expr michelson.expr_ty args_michelson true 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 ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output in @@ -178,11 +188,11 @@ let run_function = 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_value_as_function ~env ~state parameter v_syntax in - let%bind michelson = Compile.typed_to_michelson_program typed_program entry_point in - let%bind args_michelson = Run.evaluate_michelson compiled_parameter 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 ~options michelson args_michelson 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 ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output in @@ -196,9 +206,9 @@ 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 contract = Compile.typed_to_michelson_value_as_function typed_program entry_point 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.evaluate ~options contract 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 ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output in @@ -212,10 +222,10 @@ 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_value_as_function + 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_michelson compiled in + let%bind value = Run.evaluate_expression compiled.expr compiled.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 eb28a2f04..3e36432b5 100644 --- a/src/main/compile/of_mini_c.ml +++ b/src/main/compile/of_mini_c.ml @@ -33,19 +33,32 @@ let compile_function_entry = fun program name -> (* new *) -let compile_contract : expression -> Compiler.compiled_expression result = fun e -> - let%bind (input , _) = get_t_function e.type_value in +(*TODO rename to compile_function ; see if can be merge with compile expression ? do the same match as in get_t_function and done. ? *) +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 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_contract_as_exp = fun program name -> +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_contract 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_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 f8579e5e1..f3e7c8fe6 100644 --- a/src/main/compile/wrapper.ml +++ b/src/main/compile/wrapper.ml @@ -1,5 +1,6 @@ open Trace +(* will keep *) 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 @@ -10,6 +11,7 @@ let source_to_typed_expression ~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 ok typed +(* will keep *) let typed_to_michelson_program (typed: Ast_typed.program) (entry_point:string) : Compiler.compiled_program result = @@ -42,14 +44,31 @@ let source_contract_input_to_michelson_value_as_function ~env ~state (storage,pa typed_expression_to_michelson_value_as_function typed (* new *) -let typed_to_michelson_contract_as_exp +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.compile_contract_as_exp mini_c entry_point + Of_mini_c.aggregate_and_compile_function mini_c entry_point -(* produce a michelson contract e.g. the following sequence K_param ; K_storage ; K_code *) +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 typed = source_to_typed_expression ~env ~state parameter syntax 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_contract_as_exp typed entry_point 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 5f7cc6590..23af1aab4 100644 --- a/src/main/run/of_michelson.ml +++ b/src/main/run/of_michelson.ml @@ -124,37 +124,14 @@ let pack_payload (payload:Michelson.t) ty = Memory_proto_alpha.pack ty payload in ok @@ data - -(* -type ex_option = -Ex_option : 'a option -> ex_option - -let f : ex_option -> _ = fun exo -> - let (Ex_option x) = exo in - match x with - | None -> 0 - | Some x' -> 1 (*x' varialbe de tpy existentiel*) - (* Some x' : j'essaie defenir x', et je le sors pas de la function, donc c bon*) -*) - -(* -type ex = Ex : 'a -> ex -let f = fun x -> let (Ex x') = x in x' (* la ca sort *) -*) - - (* | Pair_t : - ('a ty * field_annot option * var_annot option) * - ('b ty * field_annot option * var_annot option) * - type_annot option * - bool -> ('a, 'b) pair ty *) +(* new *) let fetch_lambda_types (contract_ty:ex_ty) = match contract_ty with | Ex_ty (Lambda_t (in_ty, out_ty, _)) -> ok (Ex_ty in_ty, Ex_ty out_ty) | _ -> simple_fail "failed to fetch lambda types" -(* type run_res = Failwith of failwith_res | Success of ex_typed_value -let run_bis ?options (exp:Michelson.t) (input_michelson:Michelson.t) (is_contract:bool) : run_res result = *) -let run_contract ?options (exp:Michelson.t) (exp_type:ex_ty) (input_michelson:Michelson.t) (is_contract:bool) : ex_typed_value result = +(* type run_res = Failwith of failwith_res | Success of ex_typed_value *) +let run_function ?options (exp:Michelson.t) (exp_type:ex_ty) (input_michelson:Michelson.t) (is_contract:bool) : 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 = @@ -179,21 +156,14 @@ let run_contract ?options (exp:Michelson.t) (exp_type:ex_ty) (input_michelson:Mi (Item(input, Empty)) in ok (Ex_typed_value (output_ty, output)) - - (* -let run_exp ?options (exp:Michelson.t) (*add the type*) : ex_typed_value result = - let%bind exp_type = - Trace.trace_tzresult_lwt (simple_error "error getting expression type") @@ - Memory_proto_alpha.parse_michelson_ty exp in + +let run_exp ?options (exp:Michelson.t) (exp_type:ex_ty) : ex_typed_value result = let open! Tezos_raw_protocol_005_PsBabyM1 in let (Ex_ty exp_type') = exp_type in - let%bind ((top_level : tc_context), ty_stack_before, ty_stack_after) = - ok @@ ( - Script_ir_translator.Lambda, - Script_typed_ir.Empty_t, - Script_typed_ir.Item_t (exp_type', Empty_t, None) ) - in let exp = Michelson.strip_annots exp in + let top_level = Script_ir_translator.Lambda + and ty_stack_before = Script_typed_ir.Empty_t + and ty_stack_after = Script_typed_ir.Item_t (exp_type', Empty_t, None) 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 @@ -201,6 +171,8 @@ let run_exp ?options (exp:Michelson.t) (*add the type*) : ex_typed_value result let%bind (Item(output, Empty)) = Trace.trace_tzresult_lwt (simple_error "error of execution") @@ Memory_proto_alpha.interpret ?options descr Empty in - (* TODO stack type : unit::empty *) ok (Ex_typed_value (exp_type', output)) - *) \ No newline at end of file + +let evaluate_expression ?options exp exp_type = + let%bind etv = run_exp ?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 d0b366727..a665fff5f 100644 --- a/src/stages/mini_c/misc.ml +++ b/src/stages/mini_c/misc.ml @@ -122,11 +122,11 @@ end (* Converts `expr` in `fun () -> expr`. -*) let functionalize (body : expression) : expression = let content = E_closure { binder = Var.fresh () ; body } in let type_value = t_function t_unit body.type_value in { content ; type_value } +*) let get_entry (lst : program) (name : string) : (expression * int) result = let%bind entry_expression = @@ -166,10 +166,21 @@ let get_entry (lst : program) (name : string) : (expression * int) result = x + y ``` - The entry-point can be an expression, which is then functionalized if - `to_functionalize` is set to true. + 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 + ``` *) -let aggregate_entry (lst : program) (name : string) (to_functionalize : bool) : expression result = +let aggregate_entry (lst : program) (name : string) (is_exp : bool) : expression result = let%bind (entry_expression , entry_index) = get_entry lst name in let pre_declarations = List.until entry_index lst in let wrapper = @@ -179,7 +190,7 @@ let aggregate_entry (lst : program) (name : string) (to_functionalize : bool) : in fun expr -> List.fold_right' aux expr pre_declarations in - match (entry_expression.content , to_functionalize) with + match (entry_expression.content , is_exp) with | (E_closure l , false) -> ( let l' = { l with body = wrapper l.body } in let%bind t' = @@ -193,7 +204,7 @@ let aggregate_entry (lst : program) (name : string) (to_functionalize : bool) : ok e' ) | (_ , true) -> ( - ok @@ functionalize @@ wrapper entry_expression + ok @@ wrapper entry_expression ) | _ -> ( Format.printf "Not functional: %a\n" PP.expression entry_expression ; diff --git a/src/test/multisig_tests.ml b/src/test/multisig_tests.ml index 6df02b512..b97e0f161 100644 --- a/src/test/multisig_tests.ml +++ b/src/test/multisig_tests.ml @@ -16,9 +16,8 @@ let get_program = ) let compile_main () = - let%bind program,_ = get_program () in - let%bind michelson = Compile.Wrapper.typed_to_michelson_value_as_function program "main" in - let%bind _ex_ty_value = Ligo.Run.Of_michelson.evaluate michelson in + let%bind _ = Compile.Wrapper.source_to_michelson_contract + (Syntax_name "pascaligo") "./contracts/multisig.ligo" "main" in ok () open Ast_simplified diff --git a/src/test/multisig_v2_tests.ml b/src/test/multisig_v2_tests.ml index bbfe3a81b..c0f39f181 100644 --- a/src/test/multisig_v2_tests.ml +++ b/src/test/multisig_v2_tests.ml @@ -16,9 +16,7 @@ let get_program = ) let compile_main () = - let%bind program,_ = get_program () in - let%bind michelson = Compile.Wrapper.typed_to_michelson_value_as_function program "main" in - let%bind _ex_ty_value = Ligo.Run.Of_michelson.evaluate michelson in + let%bind _ = Compile.Wrapper.source_to_michelson_contract (Syntax_name "pascaligo") "./contracts/multisig-v2.ligo" "main" in ok () open Ast_simplified diff --git a/src/test/test_helpers.ml b/src/test/test_helpers.ml index 39e9365e8..c5b2ef77d 100644 --- a/src/test/test_helpers.ml +++ b/src/test/test_helpers.ml @@ -97,8 +97,8 @@ let expect_fail_typed_program_with_simplified_input ?options let run_typed_value_as_function (program: Ast_typed.program) (entry_point:string) : Ast_simplified.expression result = - let%bind michelson_value_as_f = Compile.Wrapper.typed_to_michelson_value_as_function program entry_point in - let%bind result = Ligo.Run.Of_michelson.evaluate michelson_value_as_f in + let%bind michelson_value_as_f = Compile.Wrapper.typed_to_michelson_expression program entry_point in + let%bind result = Ligo.Run.Of_michelson.run_exp michelson_value_as_f.expr michelson_value_as_f.expr_ty in Uncompile.uncompile_typed_program_entry_expression_result program entry_point result let expect ?options program entry_point input expecter = From 26f26171e61dd94708c4f8ebfdc6a6d8f3abe6a4 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Fri, 6 Dec 2019 14:21:49 +0100 Subject: [PATCH 06/15] Tests clean --- src/main/compile/of_mini_c.ml | 44 +++----- src/main/compile/wrapper.ml | 34 +----- src/main/run/of_michelson.ml | 115 +++++++-------------- src/passes/8-compiler/compiler_program.ml | 49 +-------- src/passes/8-compiler/compiler_program.mli | 13 --- src/test/heap_tests.ml | 9 +- src/test/test_helpers.ml | 54 +++++----- 7 files changed, 82 insertions(+), 236 deletions(-) diff --git a/src/main/compile/of_mini_c.ml b/src/main/compile/of_mini_c.ml index 3e36432b5..3b86631ed 100644 --- a/src/main/compile/of_mini_c.ml +++ b/src/main/compile/of_mini_c.ml @@ -3,37 +3,6 @@ open Tezos_utils open Proto_alpha_utils open Trace -let compile_expression_as_function : expression -> Compiler.compiled_program result = fun e -> - let (input , output) = t_unit , e.type_value in - let%bind body = Compiler.Program.translate_expression e Compiler.Environment.empty in - let body = Self_michelson.optimize body in - let body = Michelson.(seq [ i_drop ; body ]) in - let%bind (input , output) = bind_map_pair Compiler.Type.Ty.type_ (input , output) in - let open! Compiler.Program in - ok { input ; output ; body } - -let compile_function : expression -> Compiler.compiled_program result = fun e -> - let%bind (input , output) = get_t_function e.type_value in - let%bind body = get_function e in - let%bind body = Compiler.Program.translate_function_body body [] input in - let body = Self_michelson.optimize body in - let%bind (input , output) = bind_map_pair Compiler.Type.Ty.type_ (input , output) in - let open! Compiler.Program in - ok { input ; output ; body } - -let compile_expression_as_function_entry = fun program name -> - let%bind aggregated = aggregate_entry program name true in - let aggregated = Self_mini_c.all_expression aggregated in - compile_function aggregated - -let compile_function_entry = fun program name -> - let%bind aggregated = aggregate_entry program name false in - let aggregated = Self_mini_c.all_expression aggregated in - compile_function aggregated - -(* new *) - -(*TODO rename to compile_function ; see if can be merge with compile expression ? do the same match as in get_t_function and done. ? *) 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 @@ -50,6 +19,19 @@ let compile_expression : expression -> Compiler.compiled_expression result = fun let open! Compiler.Program in ok { expr_ty ; expr } +(* let compile_function_expression_merged : 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 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 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 diff --git a/src/main/compile/wrapper.ml b/src/main/compile/wrapper.ml index f3e7c8fe6..1c25e883b 100644 --- a/src/main/compile/wrapper.ml +++ b/src/main/compile/wrapper.ml @@ -1,6 +1,5 @@ open Trace -(* will keep *) 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 @@ -11,44 +10,13 @@ let source_to_typed_expression ~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 ok typed -(* will keep *) -let typed_to_michelson_program - (typed: Ast_typed.program) (entry_point:string) : Compiler.compiled_program result = - let%bind mini_c = Of_typed.compile typed in - Of_mini_c.compile_function_entry mini_c entry_point - -let typed_to_michelson_value_as_function - (typed: Ast_typed.program) (entry_point:string) : Compiler.compiled_program result = - let%bind mini_c = Of_typed.compile typed in - Of_mini_c.compile_expression_as_function_entry mini_c entry_point - -let typed_expression_to_michelson_value_as_function - (typed: Ast_typed.annotated_expression) : Compiler.compiled_program result = - let%bind mini_c = Of_typed.compile_expression typed in - Of_mini_c.compile_expression_as_function mini_c - -let simplified_to_compiled_program - ~env ~state (exp: Ast_simplified.expression) : Compiler.compiled_program result = - let%bind (typed,_) = Of_simplified.compile_expression ~env ~state exp in - typed_expression_to_michelson_value_as_function typed - -let source_expression_to_michelson_value_as_function ~env ~state parameter syntax = - let%bind typed = source_to_typed_expression ~env ~state parameter syntax in - let%bind mini_c = Of_typed.compile_expression typed in - Of_mini_c.compile_expression_as_function mini_c - -let source_contract_input_to_michelson_value_as_function ~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 - typed_expression_to_michelson_value_as_function typed - -(* new *) 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 diff --git a/src/main/run/of_michelson.ml b/src/main/run/of_michelson.ml index 23af1aab4..e619067af 100644 --- a/src/main/run/of_michelson.ml +++ b/src/main/run/of_michelson.ml @@ -1,11 +1,19 @@ open Proto_alpha_utils open Trace -open Compiler.Program open Memory_proto_alpha.Protocol.Script_ir_translator open Memory_proto_alpha.X type options = Memory_proto_alpha.options +type run_function_res = + | Success of ex_typed_value + | Fail of Memory_proto_alpha.Protocol.Script_repr.expr + +type run_failwith_res = + | Failwith_int of int + | Failwith_string of string + | Failwith_bytes of bytes + type dry_run_options = { amount : string ; sender : string option ; @@ -38,83 +46,11 @@ let make_dry_run_options (opts : dry_run_options) : options result = ok (Some source) in ok @@ make_options ~amount ?source:sender ?payer:source () -let run ?options (* ?(is_input_value = false) *) (program:compiled_program) (input_michelson:Michelson.t) : ex_typed_value result = - let Compiler.Program.{input;output;body} : compiled_program = program in - let (Ex_ty input_ty) = input in - let (Ex_ty output_ty) = output in - (* let%bind input_ty_mich = - Trace.trace_tzresult_lwt (simple_error "error unparsing input ty") @@ - Memory_proto_alpha.unparse_michelson_ty input_ty in - let%bind output_ty_mich = - Trace.trace_tzresult_lwt (simple_error "error unparsing output ty") @@ - Memory_proto_alpha.unparse_michelson_ty output_ty in - Format.printf "code: %a\n" Michelson.pp program.body ; - Format.printf "input_ty: %a\n" Michelson.pp input_ty_mich ; - Format.printf "output_ty: %a\n" Michelson.pp output_ty_mich ; - Format.printf "input: %a\n" Michelson.pp input_michelson ; *) - let%bind input = - Trace.trace_tzresult_lwt (simple_error "error parsing input") @@ - Memory_proto_alpha.parse_michelson_data input_michelson input_ty - in - let body = Michelson.strip_annots body in - let open! Memory_proto_alpha.Protocol.Script_ir_translator in - let top_level = Toplevel { storage_type = output_ty ; param_type = input_ty ; - root_name = None ; legacy_create_contract_literal = false } in - let%bind descr = - Trace.trace_tzresult_lwt (simple_error "error parsing program code") @@ - Memory_proto_alpha.parse_michelson ~top_level body - (Item_t (input_ty, Empty_t, None)) (Item_t (output_ty, Empty_t, None)) in - let open! Memory_proto_alpha.Protocol.Script_interpreter in - let%bind (Item(output, Empty)) = - Trace.trace_tzresult_lwt (simple_error "error of execution") @@ - Memory_proto_alpha.interpret ?options descr (Item(input, Empty)) in - ok (Ex_typed_value (output_ty, output)) - -type failwith_res = - | Failwith_int of int - | Failwith_string of string - | Failwith_bytes of bytes - -let get_exec_error_aux ?options (program:compiled_program) (input_michelson:Michelson.t) : Memory_proto_alpha.Protocol.Script_repr.expr result = - let Compiler.Program.{input;output;body} : compiled_program = program in - let (Ex_ty input_ty) = input in - let (Ex_ty output_ty) = output 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 body = Michelson.strip_annots body in - let%bind descr = - Trace.trace_tzresult_lwt (simple_error "error parsing program code") @@ - Memory_proto_alpha.parse_michelson body - (Item_t (input_ty, Empty_t, None)) (Item_t (output_ty, Empty_t, None)) in - let%bind err = - Trace.trace_tzresult_lwt (simple_error "unexpected error of execution") @@ - Memory_proto_alpha.failure_interpret ?options descr (Item(input, Empty)) in - match err with - | Memory_proto_alpha.Succeed _ -> simple_fail "an error of execution was expected" - | Memory_proto_alpha.Fail expr -> - ok expr - -let get_exec_error ?options (program:compiled_program) (input_michelson:Michelson.t) : failwith_res result = - let%bind expr = get_exec_error_aux ?options program input_michelson in - match Tezos_micheline.Micheline.root @@ Memory_proto_alpha.strings_of_prims expr 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" - -let evaluate ?options program = run ?options program Michelson.d_unit - let ex_value_ty_to_michelson (v : ex_typed_value) : Michelson.t result = let (Ex_typed_value (value , ty)) = v in Trace.trace_tzresult_lwt (simple_error "error unparsing michelson result") @@ Memory_proto_alpha.unparse_michelson_data value ty -let evaluate_michelson ?options program = - let%bind etv = evaluate ?options program in - ex_value_ty_to_michelson etv - let pack_payload (payload:Michelson.t) ty = let%bind payload = Trace.trace_tzresult_lwt (simple_error "error parsing message") @@ @@ -124,14 +60,12 @@ let pack_payload (payload:Michelson.t) ty = Memory_proto_alpha.pack ty payload in ok @@ data -(* new *) let fetch_lambda_types (contract_ty:ex_ty) = match contract_ty with | Ex_ty (Lambda_t (in_ty, out_ty, _)) -> ok (Ex_ty in_ty, Ex_ty out_ty) | _ -> simple_fail "failed to fetch lambda types" -(* type run_res = Failwith of failwith_res | Success of ex_typed_value *) -let run_function ?options (exp:Michelson.t) (exp_type:ex_ty) (input_michelson:Michelson.t) (is_contract:bool) : ex_typed_value result = +let run_function_aux ?options (exp:Michelson.t) (exp_type:ex_ty) (input_michelson:Michelson.t) (is_contract:bool) : run_function_res 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 = @@ -150,12 +84,33 @@ let run_function ?options (exp:Michelson.t) (exp_type:ex_ty) (input_michelson:Mi 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 + Memory_proto_alpha.failure_interpret ?options descr (Item(input, Empty)) - in - ok (Ex_typed_value (output_ty, output)) + 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) + +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 open! Tezos_raw_protocol_005_PsBabyM1 in diff --git a/src/passes/8-compiler/compiler_program.ml b/src/passes/8-compiler/compiler_program.ml index 55c5a88f1..1c370b50a 100644 --- a/src/passes/8-compiler/compiler_program.ml +++ b/src/passes/8-compiler/compiler_program.ml @@ -449,54 +449,7 @@ and translate_function anon env input_ty output_ty : michelson result = i_apply ; ] - -type compiled_program = { - input : ex_ty ; - output : ex_ty ; - body : michelson ; -} - type compiled_expression = { expr_ty : ex_ty ; expr : michelson ; -} - -let get_main : program -> string -> (anon_function * _) result = fun p entry -> - let is_main ((( name , expr), _):toplevel_statement) = - match Combinators.Expression.(get_content expr , get_type expr)with - | (E_closure content , T_function ty) - when Var.equal name (Var.of_name entry) -> - Some (content , ty) - | _ -> None - in - let%bind main = - trace_option (simple_error "no functional entry") @@ - List.find_map is_main p - in - ok main - -let translate_program (p:program) (entry:string) : compiled_program result = - let%bind (main , (input , output)) = get_main p entry in - let%bind body = translate_function_body main [] input in - let%bind input = Compiler_type.Ty.type_ input in - let%bind output = Compiler_type.Ty.type_ output in - ok ({input;output;body}:compiled_program) - -let translate_entry (p:anon_function) ty : compiled_program result = - let (input , output) = ty in - let%bind body = - trace (simple_error "compile entry body") @@ - translate_function_body p [] input in - let%bind input = Compiler_type.Ty.type_ input in - let%bind output = Compiler_type.Ty.type_ output in - ok ({input;output;body}:compiled_program) - -let translate_contract : anon_function -> _ -> michelson result = fun f ty -> - let%bind compiled_program = - trace_strong (corner_case ~loc:__LOC__ "compiling") @@ - translate_entry f ty in - let%bind (param_ty , storage_ty) = Combinators.get_t_pair (fst ty) in - let%bind param_michelson = Compiler_type.type_ param_ty in - let%bind storage_michelson = Compiler_type.type_ storage_ty in - let contract = Michelson.contract param_michelson storage_michelson compiled_program.body in - ok contract +} \ No newline at end of file diff --git a/src/passes/8-compiler/compiler_program.mli b/src/passes/8-compiler/compiler_program.mli index 700c17e46..5573c3d9b 100644 --- a/src/passes/8-compiler/compiler_program.mli +++ b/src/passes/8-compiler/compiler_program.mli @@ -9,12 +9,6 @@ open Operators.Compiler module Contract_types = Meta_michelson.Types module Stack = Meta_michelson.Stack *) -type compiled_program = { - input : ex_ty ; - output : ex_ty ; - body : michelson ; -} - type compiled_expression = { expr_ty : ex_ty ; expr : michelson ; @@ -25,13 +19,6 @@ val translate_expression : expression -> environment -> michelson result val translate_function_body : anon_function -> environment_element list -> type_value -> michelson result val translate_value : value -> type_value -> michelson result -val translate_program : program -> string -> compiled_program result - - -val translate_contract : anon_function -> (type_value * type_value ) -> michelson result - -val translate_entry : anon_function -> type_value * type_value -> compiled_program result - (* open Operators.Compiler diff --git a/src/test/heap_tests.ml b/src/test/heap_tests.ml index 4d4223a32..dfe1d1ef7 100644 --- a/src/test/heap_tests.ml +++ b/src/test/heap_tests.ml @@ -48,10 +48,11 @@ 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_program program entry_point in - let%bind input_mich = Compile.Wrapper.typed_expression_to_michelson_value_as_function input in - let%bind input_eval = Run.Of_michelson.evaluate_michelson input_mich in - let%bind res = Run.Of_michelson.run program_mich input_eval in + 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 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/test_helpers.ml b/src/test/test_helpers.ml index c5b2ef77d..e28f464ca 100644 --- a/src/test/test_helpers.ml +++ b/src/test/test_helpers.ml @@ -35,11 +35,13 @@ 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 - Compile.Wrapper.simplified_to_compiled_program - ~env ~state:(Typer.Solver.initial_state) payload in - let Compiler.Program.{input=_;output=(Ex_ty payload_ty);body=_} = code in + let%bind (typed,_) = Compile.Of_simplified.compile_expression + ~env ~state:(Typer.Solver.initial_state) payload 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 let%bind (payload: Tezos_utils.Michelson.michelson) = - Ligo.Run.Of_michelson.evaluate_michelson code in + Ligo.Run.Of_michelson.evaluate_expression code.expr code.expr_ty in Ligo.Run.Of_michelson.pack_payload payload payload_ty let sign_message (program:Ast_typed.program) (payload : expression) sk : string result = @@ -76,31 +78,25 @@ let sha_256_hash pl = open Ast_simplified.Combinators +let typed_program_with_simplified_input_to_michelson + (program: Ast_typed.program) (entry_point: string) + (input: Ast_simplified.expression) : (Compiler.compiled_expression * Tezos_utils.Michelson.michelson) result = + 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_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) + let run_typed_program_with_simplified_input ?options (program: Ast_typed.program) (entry_point: string) (input: Ast_simplified.expression) : Ast_simplified.expression result = - let env = Ast_typed.program_environment program in - let%bind michelson_exp = Compile.Wrapper.simplified_to_compiled_program ~env ~state:(Typer.Solver.initial_state) input in - let%bind evaluated_exp = Ligo.Run.Of_michelson.evaluate_michelson michelson_exp in - let%bind michelson_program = Compile.Wrapper.typed_to_michelson_program program entry_point in - let%bind michelson_output = Ligo.Run.Of_michelson.run ?options michelson_program evaluated_exp 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_function + ?options michelson_program.expr michelson_program.expr_ty evaluated_in false in Uncompile.uncompile_typed_program_entry_function_result program entry_point michelson_output -let expect_fail_typed_program_with_simplified_input ?options - (program: Ast_typed.program) (entry_point: string) - (input: Ast_simplified.expression) : Ligo.Run.Of_michelson.failwith_res Simple_utils__Trace.result = - let env = Ast_typed.program_environment program in - let%bind michelson_exp = Compile.Wrapper.simplified_to_compiled_program ~env ~state:(Typer.Solver.initial_state) input in - let%bind evaluated_exp = Ligo.Run.Of_michelson.evaluate_michelson michelson_exp in - let%bind michelson_program = Compile.Wrapper.typed_to_michelson_program program entry_point in - Ligo.Run.Of_michelson.get_exec_error ?options michelson_program evaluated_exp - -let run_typed_value_as_function - (program: Ast_typed.program) (entry_point:string) : Ast_simplified.expression result = - let%bind michelson_value_as_f = Compile.Wrapper.typed_to_michelson_expression program entry_point in - let%bind result = Ligo.Run.Of_michelson.run_exp michelson_value_as_f.expr michelson_value_as_f.expr_ty in - Uncompile.uncompile_typed_program_entry_expression_result program entry_point result - let expect ?options program entry_point input expecter = let%bind result = let run_error = @@ -124,7 +120,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 err = expect_fail_typed_program_with_simplified_input ?options 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 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" @@ -147,8 +145,10 @@ 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 result = run_typed_value_as_function program entry_point in - expecter result + 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 res_simpl = Uncompile.uncompile_typed_program_entry_expression_result program entry_point res_michelson in + expecter res_simpl let expect_eq_evaluate program entry_point expected = let expecter = fun result -> From 6ed2f2b3ae1f0b20acc80516f38af16598363ab2 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Fri, 6 Dec 2019 15:10:37 +0100 Subject: [PATCH 07/15] unify a little more --- src/main/compile/of_mini_c.ml | 27 +++++---------------------- src/main/compile/wrapper.ml | 13 +++++-------- src/main/run/of_michelson.ml | 14 +++++++------- src/test/coase_tests.ml | 6 ++++++ src/test/heap_tests.ml | 2 +- src/test/test_helpers.ml | 11 +++++++---- 6 files changed, 31 insertions(+), 42 deletions(-) diff --git a/src/main/compile/of_mini_c.ml b/src/main/compile/of_mini_c.ml index 3b86631ed..0ee2bb085 100644 --- a/src/main/compile/of_mini_c.ml +++ b/src/main/compile/of_mini_c.ml @@ -3,44 +3,27 @@ open Tezos_utils open Proto_alpha_utils open Trace -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 compile_function_expression_merged : expression -> Compiler.compiled_expression result = fun e -> +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 + Compiler.Program.translate_expression e Compiler.Environment.empty 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 } *) + 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_function_expression aggregated + compile 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 + compile 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 1c25e883b..af2d8dab3 100644 --- a/src/main/compile/wrapper.ml +++ b/src/main/compile/wrapper.ml @@ -6,11 +6,7 @@ let source_to_typed syntax source_file = let env = Ast_typed.program_environment typed in ok (typed,state,env) -let source_to_typed_expression ~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 - ok typed - +(* 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 @@ -23,15 +19,16 @@ let typed_to_michelson_expression Of_mini_c.aggregate_and_compile_expression mini_c entry_point let source_expression_to_michelson ~env ~state parameter syntax = - let%bind typed = source_to_typed_expression ~env ~state parameter syntax in + 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 + Of_mini_c.compile 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 + Of_mini_c.compile 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 e619067af..ce3506c3e 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, 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 = 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 exp = Michelson.strip_annots exp in let%bind descr = Trace.trace_tzresult_lwt (simple_error "error parsing program code") @@ diff --git a/src/test/coase_tests.ml b/src/test/coase_tests.ml index 6f89be6b7..a133fe792 100644 --- a/src/test/coase_tests.ml +++ b/src/test/coase_tests.ml @@ -18,6 +18,11 @@ let get_program = ok program ) +let compile_main () = + let%bind _ = Compile.Wrapper.source_to_michelson_contract + (Syntax_name "pascaligo") "./contracts/coase.ligo" "main" in + ok () + open Ast_simplified let card owner = @@ -232,6 +237,7 @@ let sell () = let main = test_suite "Coase (End to End)" [ + test "compile" compile_main ; test "buy" buy ; test "dispatch buy" dispatch_buy ; test "transfer" transfer ; diff --git a/src/test/heap_tests.ml b/src/test/heap_tests.ml index dfe1d1ef7..18380f487 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_expression input_mini_c in + let%bind input_mich = Compile.Of_mini_c.compile 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 e28f464ca..903bf6946 100644 --- a/src/test/test_helpers.ml +++ b/src/test/test_helpers.ml @@ -34,11 +34,14 @@ 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 ~state:(Typer.Solver.initial_state) payload in + ~env:(Ast_typed.program_environment program) ~state:(Typer.Solver.initial_state) payload in let%bind mini_c = Compile.Of_typed.compile_expression typed in - Compile.Of_mini_c.compile_expression mini_c 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 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 @@ -84,7 +87,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_expression mini_c_in in + let%bind michelson_in = Compile.Of_mini_c.compile 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) From 255b9a6e00436f533180e8354008d57011dbd882 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Fri, 6 Dec 2019 18:37:45 +0100 Subject: [PATCH 08/15] type compile_main function in contracts tests --- src/test/coase_tests.ml | 4 ++-- src/test/multisig_tests.ml | 4 ++-- src/test/multisig_v2_tests.ml | 3 ++- 3 files changed, 6 insertions(+), 5 deletions(-) diff --git a/src/test/coase_tests.ml b/src/test/coase_tests.ml index a133fe792..32b21deba 100644 --- a/src/test/coase_tests.ml +++ b/src/test/coase_tests.ml @@ -19,8 +19,8 @@ let get_program = ) let compile_main () = - let%bind _ = Compile.Wrapper.source_to_michelson_contract - (Syntax_name "pascaligo") "./contracts/coase.ligo" "main" in + 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 ok () open Ast_simplified diff --git a/src/test/multisig_tests.ml b/src/test/multisig_tests.ml index b97e0f161..b90b56ed2 100644 --- a/src/test/multisig_tests.ml +++ b/src/test/multisig_tests.ml @@ -16,8 +16,8 @@ let get_program = ) let compile_main () = - let%bind _ = Compile.Wrapper.source_to_michelson_contract - (Syntax_name "pascaligo") "./contracts/multisig.ligo" "main" in + 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 ok () open Ast_simplified diff --git a/src/test/multisig_v2_tests.ml b/src/test/multisig_v2_tests.ml index c0f39f181..4ddbb7b61 100644 --- a/src/test/multisig_v2_tests.ml +++ b/src/test/multisig_v2_tests.ml @@ -16,7 +16,8 @@ let get_program = ) let compile_main () = - let%bind _ = Compile.Wrapper.source_to_michelson_contract (Syntax_name "pascaligo") "./contracts/multisig-v2.ligo" "main" in + 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 ok () open Ast_simplified From 85cffdfc5228491c856f83319e94de9f9f4e94f4 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Fri, 6 Dec 2019 18:38:40 +0100 Subject: [PATCH 09/15] remove comented function --- src/passes/6-transpiler/transpiler.mli | 1 - src/stages/mini_c/misc.ml | 8 -------- 2 files changed, 9 deletions(-) diff --git a/src/passes/6-transpiler/transpiler.mli b/src/passes/6-transpiler/transpiler.mli index c03fdcb28..bebd4aa94 100644 --- a/src/passes/6-transpiler/transpiler.mli +++ b/src/passes/6-transpiler/transpiler.mli @@ -48,7 +48,6 @@ val translate_main : AST.lambda -> Location.t ->( anon_function * ( type_value * (* From an expression [expr], build the expression [fun () -> expr] *) val translate_entry : AST.program -> string -> ( anon_function * ( type_value * type_value )) result -val functionalize : AST.annotated_expression -> AST.lambda * AST.type_value *) val extract_constructor : value -> ( string * AST.type_value ) Append_tree.t' -> (string * value * AST.type_value) result val extract_tuple : value -> AST.type_value Append_tree.t' -> (value * AST.type_value) list result diff --git a/src/stages/mini_c/misc.ml b/src/stages/mini_c/misc.ml index a665fff5f..bd704a745 100644 --- a/src/stages/mini_c/misc.ml +++ b/src/stages/mini_c/misc.ml @@ -120,14 +120,6 @@ module Free_variables = struct end -(* - Converts `expr` in `fun () -> expr`. -let functionalize (body : expression) : expression = - let content = E_closure { binder = Var.fresh () ; body } in - let type_value = t_function t_unit body.type_value in - { content ; type_value } -*) - let get_entry (lst : program) (name : string) : (expression * int) result = let%bind entry_expression = trace_option (Errors.missing_entry_point name) @@ From 974fa6432be4ace9c96da381d4139227fb8eff3c Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Fri, 6 Dec 2019 18:45:22 +0100 Subject: [PATCH 10/15] Revert "unify a little more" --- src/main/compile/of_mini_c.ml | 22 +++++++++++++--------- src/main/compile/wrapper.ml | 5 ++--- src/main/run/of_michelson.ml | 14 +++++++------- src/test/heap_tests.ml | 2 +- src/test/test_helpers.ml | 11 ++++------- 5 files changed, 27 insertions(+), 27 deletions(-) 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) From bbf6b7b8605a98a86eed9bc1db76dafc32230b87 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Fri, 6 Dec 2019 19:42:41 +0100 Subject: [PATCH 11/15] =?UTF-8?q?ss=C3=A9ssaoupa=3F?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/test/contracts/high-order.ligo | 2 ++ src/test/integration_tests.ml | 20 ++++++++++++++++++++ 2 files changed, 22 insertions(+) diff --git a/src/test/contracts/high-order.ligo b/src/test/contracts/high-order.ligo index 107cbd9ff..5540d6f99 100644 --- a/src/test/contracts/high-order.ligo +++ b/src/test/contracts/high-order.ligo @@ -48,3 +48,5 @@ function foobar5 (const i : int) : int is function goo (const i : int) : int is foo(i); } with higher3(i,foo,goo) + +function foobar6 (const i : int) : (int->int) is f \ No newline at end of file diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 201c0ebd3..cd6aae92d 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -184,6 +184,26 @@ 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 = From 16fc55482d464869ab58045def870cbc5ab6a2c7 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Mon, 9 Dec 2019 19:51:10 +0100 Subject: [PATCH 12/15] Remove wrapper. Flatten everything for now. Now have a run function for contracts and a run function for everything else. Run function for contract is only used in CLI dry-run --- src/bin/cli.ml | 125 ++++++++++++++++++++++++---------- src/main/compile/of_mini_c.ml | 15 ++-- src/main/compile/wrapper.ml | 38 ----------- src/main/run/of_michelson.ml | 77 ++++++++++----------- src/stages/mini_c/misc.ml | 84 ++++++++++------------- src/test/coase_tests.ml | 12 +++- src/test/heap_tests.ml | 10 +-- src/test/integration_tests.ml | 30 ++------ src/test/multisig_tests.ml | 12 +++- src/test/multisig_v2_tests.ml | 12 +++- src/test/test_helpers.ml | 21 +++--- src/test/vote_tests.ml | 3 +- 12 files changed, 220 insertions(+), 219 deletions(-) delete mode 100644 src/main/compile/wrapper.ml 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 = From 1c346ead2886801217b59368ddcad56e2bbd8e83 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Mon, 9 Dec 2019 20:09:38 +0100 Subject: [PATCH 13/15] remove useless code in test helper --- src/stages/mini_c/misc.ml | 2 +- src/test/integration_tests.ml | 1 + src/test/test_helpers.ml | 20 +++++++------------- 3 files changed, 9 insertions(+), 14 deletions(-) diff --git a/src/stages/mini_c/misc.ml b/src/stages/mini_c/misc.ml index 472811e3f..bc1a2769e 100644 --- a/src/stages/mini_c/misc.ml +++ b/src/stages/mini_c/misc.ml @@ -151,7 +151,7 @@ let get_entry (lst : program) (name : string) : (expression * int) result = ``` let x = 42 in let y = 120 in - const y = e -> e + (f ()) + const f = () -> x + y f(unit) ``` diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 6efe009aa..7ccab871f 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -186,6 +186,7 @@ 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 _ = applies_expect_eq_n_int program "foobar5" make_expect in *) ok () let higher_order_mligo () : unit result = diff --git a/src/test/test_helpers.ml b/src/test/test_helpers.ml index 7e2651892..e2adf5dc7 100644 --- a/src/test/test_helpers.ml +++ b/src/test/test_helpers.ml @@ -80,24 +80,18 @@ open Ast_simplified.Combinators let typed_program_with_simplified_input_to_michelson (program: Ast_typed.program) (entry_point: string) - (input: Ast_simplified.expression) : (Compiler.compiled_expression * Tezos_utils.Michelson.michelson) result = + (input: Ast_simplified.expression) : Compiler.compiled_expression result = 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 state = Typer.Solver.initial_state in + let%bind (typed_in,_) = Compile.Of_simplified.compile_expression ~env ~state input in + let%bind mini_c_in = Compile.Of_typed.compile_expression typed_in 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) + Compile.Of_mini_c.aggregate_and_compile mini_c_prg (Some [mini_c_in]) entry_point 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_contract - ?options michelson_program.expr michelson_program.expr_ty _evaluated_in false in *) + let%bind michelson_program = typed_program_with_simplified_input_to_michelson program entry_point input 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 @@ -124,7 +118,7 @@ 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 = 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 in match err with From 5ac25bfe21bb4a642590afe5f75df56d3782bd21 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Tue, 10 Dec 2019 15:55:48 +0100 Subject: [PATCH 14/15] easy to interpret expressions. evaluate-value does the job. CLI refactoring might be necessary --- src/bin/cli.ml | 19 ++++++++++--------- src/main/compile/of_mini_c.ml | 28 ++++++++++++++++++++++------ src/stages/mini_c/misc.ml | 15 ++++++++++----- src/test/coase_tests.ml | 2 +- src/test/heap_tests.ml | 3 ++- src/test/multisig_tests.ml | 2 +- src/test/multisig_v2_tests.ml | 2 +- src/test/test_helpers.ml | 6 +++--- 8 files changed, 50 insertions(+), 27 deletions(-) diff --git a/src/bin/cli.ml b/src/bin/cli.ml index 0524814c7..5f5809170 100644 --- a/src/bin/cli.ml +++ b/src/bin/cli.ml @@ -105,7 +105,7 @@ let compile_file = 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 michelson = Compile.Of_mini_c.aggregate_and_compile_contract mini_c 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 @@ -121,7 +121,7 @@ let measure_contract = 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 michelson = Compile.Of_mini_c.aggregate_and_compile_contract mini_c 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) @@ -143,7 +143,7 @@ let compile_parameter = 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%bind michelson_prg = Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg 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 *) @@ -153,7 +153,7 @@ let compile_parameter = 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 compiled_param = Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg (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 @@ -174,7 +174,7 @@ let compile_storage = 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%bind michelson_prg = Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg 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 *) @@ -201,7 +201,7 @@ let dry_run = 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 michelson_prg = Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg 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 @@ -232,13 +232,13 @@ let run_function = 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 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 michelson = Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg (Entry_name entry_point) [compiled_param] 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 @@ -256,7 +256,8 @@ let evaluate_value = 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 (exp,_) = Mini_c.get_entry mini_c entry_point in + let%bind compiled = Compile.Of_mini_c.aggregate_and_compile_expression mini_c (Expression exp) [] 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 diff --git a/src/main/compile/of_mini_c.ml b/src/main/compile/of_mini_c.ml index debacfa0a..b715f55af 100644 --- a/src/main/compile/of_mini_c.ml +++ b/src/main/compile/of_mini_c.ml @@ -19,12 +19,28 @@ let compile_expression : expression -> Compiler.compiled_expression result = fun let open! Compiler.Program in ok { expr_ty ; expr } -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 - match arg_opt with - | Some _ -> compile_expression aggregated - | None -> compile_contract aggregated +let aggregate_and_compile = fun program form -> + let%bind aggregated = aggregate_entry program form in + let aggregated' = Self_mini_c.all_expression aggregated in + match form with + | ContractForm _ -> compile_contract aggregated' + | ExpressionForm _ -> compile_expression aggregated' + +let aggregate_and_compile_contract = fun program name -> + let%bind (exp, idx) = get_entry program name in + aggregate_and_compile program (ContractForm (exp, idx)) + +type compiled_expression_t = + | Expression of expression + | Entry_name of string + +let aggregate_and_compile_expression = fun program exp args -> + match exp with + | Expression exp -> + aggregate_and_compile program (ExpressionForm ((exp,List.length program), args)) + | Entry_name name -> + let%bind (exp, idx) = get_entry program name in + aggregate_and_compile program (ExpressionForm ((exp,idx), args)) let build_contract : Compiler.compiled_expression -> Michelson.michelson result = fun compiled -> diff --git a/src/stages/mini_c/misc.ml b/src/stages/mini_c/misc.ml index bc1a2769e..09619b927 100644 --- a/src/stages/mini_c/misc.ml +++ b/src/stages/mini_c/misc.ml @@ -157,9 +157,14 @@ let get_entry (lst : program) (name : string) : (expression * int) result = if arg_lst is None, it means that the entry point is not an arbitrary expression *) +type form_t = + | ContractForm of (expression * int) + | ExpressionForm of ((expression * int) * expression list) -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 aggregate_entry (lst : program) (form : form_t) : expression result = + let (entry_expression , entry_index, arg_lst) = match form with + | ContractForm (exp,i) -> (exp,i,[]) + | ExpressionForm ((exp,i),argl) -> (exp,i,argl) in let pre_declarations = List.until entry_index lst in let wrapper = let aux prec cur = @@ -169,7 +174,7 @@ let aggregate_entry (lst : program) (name : string) (arg_lst : expression list o fun expr -> List.fold_right' aux expr pre_declarations in match (entry_expression.content , arg_lst) with - | (E_closure _ , Some (hd::tl)) -> ( + | (E_closure _ , (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 @@ -189,6 +194,6 @@ let aggregate_entry (lst : program) (name : string) (arg_lst : expression list o } tl in ok @@ wrapper entry_expression' ) - | (_ , None) | (_, Some _) -> ( + | (_ , _) -> ( ok @@ wrapper entry_expression - ) + ) \ No newline at end of file diff --git a/src/test/coase_tests.ml b/src/test/coase_tests.ml index 23772d634..f2196190d 100644 --- a/src/test/coase_tests.ml +++ b/src/test/coase_tests.ml @@ -23,7 +23,7 @@ let compile_main () = 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 michelson_prg = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "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 diff --git a/src/test/heap_tests.ml b/src/test/heap_tests.ml index 440d6fe7a..a678d1853 100644 --- a/src/test/heap_tests.ml +++ b/src/test/heap_tests.ml @@ -51,7 +51,8 @@ let dummy n = let run_typed (entry_point:string) (program:Ast_typed.program) (input:Ast_typed.annotated_expression) = let%bind input_mini_c = Compile.Of_typed.compile_expression input 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 program_mich = Compile.Of_mini_c.aggregate_and_compile_expression + mini_c (Entry_name entry_point) [input_mini_c] 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 diff --git a/src/test/multisig_tests.ml b/src/test/multisig_tests.ml index 220b48fae..80a17b3d4 100644 --- a/src/test/multisig_tests.ml +++ b/src/test/multisig_tests.ml @@ -20,7 +20,7 @@ let compile_main () = 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 michelson_prg = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "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 diff --git a/src/test/multisig_v2_tests.ml b/src/test/multisig_v2_tests.ml index 080669bfb..81d0ca395 100644 --- a/src/test/multisig_v2_tests.ml +++ b/src/test/multisig_v2_tests.ml @@ -20,7 +20,7 @@ let compile_main () = 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 michelson_prg = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "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 diff --git a/src/test/test_helpers.ml b/src/test/test_helpers.ml index e2adf5dc7..7ea253b01 100644 --- a/src/test/test_helpers.ml +++ b/src/test/test_helpers.ml @@ -85,8 +85,8 @@ let typed_program_with_simplified_input_to_michelson let state = Typer.Solver.initial_state in let%bind (typed_in,_) = Compile.Of_simplified.compile_expression ~env ~state input in let%bind mini_c_in = Compile.Of_typed.compile_expression typed_in in - let%bind mini_c_prg = Compile.Of_typed.compile program in - Compile.Of_mini_c.aggregate_and_compile mini_c_prg (Some [mini_c_in]) entry_point + let%bind mini_c_prg = Compile.Of_typed.compile program in + Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg (Entry_name entry_point) [mini_c_in] let run_typed_program_with_simplified_input ?options (program: Ast_typed.program) (entry_point: string) @@ -144,7 +144,7 @@ let expect_evaluate program entry_point expecter = error title content in trace error @@ 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 michelson_value = Ligo.Compile.Of_mini_c.aggregate_and_compile_expression mini_c (Entry_name 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 From 9d83159e8983c30e42ff673e4dd7db5f7fe3bd21 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Tue, 10 Dec 2019 16:01:26 +0100 Subject: [PATCH 15/15] merge with dev --- src/test/integration_tests.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 7ccab871f..921a6a376 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -4,7 +4,9 @@ open Test_helpers open Ast_simplified.Combinators let retype_file f = - let%bind (typed , state , _env) = Ligo.Compile.Wrapper.source_to_typed (Syntax_name "reasonligo") f in + let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "reasonligo") in + let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in + let () = Typer.Solver.discard_state state in let () = Typer.Solver.discard_state state in ok typed let mtype_file f =