Merge branch 'refactoring-unify' into 'dev'
Refactoring unify See merge request ligolang/ligo!236
This commit is contained in:
Rémi Lesenechal
commit
21a6749a81
143
src/bin/cli.ml
143
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_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
|
||||
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_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)
|
||||
in
|
||||
@ -125,12 +133,28 @@ 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 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_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 *)
|
||||
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.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
|
||||
let term =
|
||||
@ -139,16 +163,29 @@ 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 =
|
||||
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
|
||||
(*
|
||||
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 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_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 *)
|
||||
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 =
|
||||
@ -160,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_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 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 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_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
|
||||
|
||||
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 =
|
||||
@ -179,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_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 options = Run.make_dry_run_options {amount ; sender ; source } in
|
||||
let%bind michelson_output = Run.run ~options michelson args_michelson 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_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
|
||||
ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output
|
||||
in
|
||||
let term =
|
||||
@ -198,11 +253,14 @@ 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 contract = Compile.typed_to_michelson_value_as_function 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 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 (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
|
||||
ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output
|
||||
in
|
||||
let term =
|
||||
@ -215,10 +273,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_value_as_function
|
||||
~env:(Ast_typed.Environment.full_empty) ~state:(Typer.Solver.initial_state)
|
||||
expression v_syntax in
|
||||
let%bind value = Run.evaluate_michelson compiled 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 =
|
||||
|
||||
@ -1,44 +1,58 @@
|
||||
open Trace
|
||||
open Mini_c
|
||||
open Tezos_utils
|
||||
open Proto_alpha_utils
|
||||
open Trace
|
||||
|
||||
let compile_expression_as_function : expression -> _ 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 = fun e ->
|
||||
let%bind (input , output) = get_t_function e.type_value in
|
||||
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 in
|
||||
let body = Self_michelson.optimize body in
|
||||
let%bind (input , output) = bind_map_pair Compiler.Type.Ty.type_ (input , output) 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 { input ; output ; body }
|
||||
ok { expr_ty ; expr }
|
||||
|
||||
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_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_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
|
||||
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 compile_contract_entry = 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
|
||||
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 ->
|
||||
let%bind ((Ex_ty _param_ty),(Ex_ty _storage_ty)) = Self_michelson.fetch_lambda_parameters compiled.expr_ty in
|
||||
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 =
|
||||
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
|
||||
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
|
||||
|
||||
@ -1,51 +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 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
|
||||
|
||||
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 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
|
||||
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
|
||||
@ -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_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") @@
|
||||
@ -123,3 +59,72 @@ 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
|
||||
|
||||
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"
|
||||
|
||||
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 = 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 (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_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
|
||||
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
|
||||
let open! Memory_proto_alpha.Protocol.Script_interpreter in
|
||||
let%bind res =
|
||||
Trace.trace_tzresult_lwt (simple_error "error of execution") @@
|
||||
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 ?options exp exp_type in
|
||||
ex_value_ty_to_michelson etv
|
||||
@ -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
|
||||
|
||||
@ -449,49 +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 ;
|
||||
}
|
||||
|
||||
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
|
||||
type compiled_expression = {
|
||||
expr_ty : ex_ty ;
|
||||
expr : michelson ;
|
||||
}
|
||||
@ -9,10 +9,9 @@ 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 ;
|
||||
}
|
||||
|
||||
val get_operator : constant -> type_value -> expression list -> predicate result
|
||||
@ -20,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
|
||||
|
||||
@ -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 ()
|
||||
|
||||
@ -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,
|
||||
|
||||
@ -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) @@
|
||||
@ -148,29 +140,31 @@ 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 f = () -> x + y
|
||||
f(unit)
|
||||
```
|
||||
|
||||
The entry-point can be an expression, which is then functionalized if
|
||||
`to_functionalize` is set to true.
|
||||
if arg_lst is None, it means that the entry point is not an arbitrary expression
|
||||
*)
|
||||
let aggregate_entry (lst : program) (name : string) (to_functionalize : bool) : expression result =
|
||||
let%bind (entry_expression , entry_index) = get_entry lst name in
|
||||
type form_t =
|
||||
| ContractForm of (expression * int)
|
||||
| ExpressionForm of ((expression * int) * expression list)
|
||||
|
||||
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 =
|
||||
@ -179,23 +173,27 @@ 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
|
||||
| (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 _ , (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) -> (
|
||||
ok @@ functionalize @@ wrapper entry_expression
|
||||
)
|
||||
| _ -> (
|
||||
Format.printf "Not functional: %a\n" PP.expression entry_expression ;
|
||||
fail @@ Errors.not_functional_main name
|
||||
)
|
||||
| (_ , _) -> (
|
||||
ok @@ wrapper entry_expression
|
||||
)
|
||||
@ -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 =
|
||||
@ -18,6 +19,16 @@ let get_program =
|
||||
ok program
|
||||
)
|
||||
|
||||
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_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
|
||||
ok ()
|
||||
|
||||
open Ast_simplified
|
||||
|
||||
let card owner =
|
||||
@ -232,6 +243,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 ;
|
||||
|
||||
@ -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
|
||||
@ -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,10 +49,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 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_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
|
||||
let%bind (_ , output_type) = Ast_typed.get_t_function entry_expression.type_annotation in
|
||||
|
||||
@ -4,15 +4,19 @@ 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 =
|
||||
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,6 +188,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 =
|
||||
@ -208,21 +213,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)
|
||||
|
||||
@ -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,9 +17,13 @@ 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 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_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
|
||||
ok ()
|
||||
|
||||
open Ast_simplified
|
||||
|
||||
@ -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,9 +17,13 @@ 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 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_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
|
||||
ok ()
|
||||
|
||||
open Ast_simplified
|
||||
|
||||
@ -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,23 @@ 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 result =
|
||||
let env = Ast_typed.program_environment program 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
|
||||
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)
|
||||
(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 = 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
|
||||
|
||||
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_value_as_function program entry_point in
|
||||
let%bind result = Ligo.Run.Of_michelson.evaluate michelson_value_as_f 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 +118,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 = 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
|
||||
| Ligo.Run.Of_michelson.Failwith_string s -> Assert.assert_equal_string expected_failwith s
|
||||
| _ -> simple_fail "Expected to fail with a string"
|
||||
@ -147,8 +143,11 @@ 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 mini_c = Ligo.Compile.Of_typed.compile program 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
|
||||
|
||||
let expect_eq_evaluate program entry_point expected =
|
||||
let expecter = fun result ->
|
||||
|
||||
@ -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 =
|
||||
|
||||
@ -1096,6 +1096,15 @@ 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
|
||||
|
||||
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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user