balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

contract are now typecheck (at least in the CLI)

Browse Source
This commit is contained in:
Lesenechal Remi 2019-12-04 13:34:15 +01:00
parent 0cae4302cd
commit 46623ceb77
5 changed files with 30 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
src/bin/cli.ml
View File

@ -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 =

15
src/main/compile/of_mini_c.ml
View File

@ -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

5
src/main/compile/wrapper.ml
View File

@ -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))

8
src/main/run/of_michelson.ml
View File

@ -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

5
vendors/ligo-utils/proto-alpha-utils/x_memory_proto_alpha.ml vendored
View File

@ -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