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 =