compile_parameter and compile_storage CLI commands now gets their input checked
This commit is contained in:
parent
a8fdbbfd84
commit
ea343760b2
@ -150,11 +150,6 @@ let measure_contract =
|
|||||||
let compile_parameter =
|
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 @@
|
toplevel ~display_format @@
|
||||||
(*
|
|
||||||
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 simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in
|
||||||
let%bind typed_prg,state = Compile.Of_simplified.compile simplified 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 mini_c_prg = Compile.Of_typed.compile typed_prg in
|
||||||
@ -169,6 +164,7 @@ let compile_parameter =
|
|||||||
let%bind (typed_param,_) = Compile.Of_simplified.compile_expression ~env ~state simplified_param 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 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 mini_c_param in
|
let%bind compiled_param = Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg mini_c_param in
|
||||||
|
let%bind () = Compile.Of_mini_c.assert_equal_michelson_type Check_parameter michelson_prg compiled_param in
|
||||||
let%bind value = Run.evaluate_expression compiled_param.expr compiled_param.expr_ty 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
|
ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value
|
||||||
in
|
in
|
||||||
@ -210,11 +206,6 @@ let interpret =
|
|||||||
let compile_storage =
|
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 @@
|
toplevel ~display_format @@
|
||||||
(*
|
|
||||||
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 simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in
|
||||||
let%bind typed_prg,state = Compile.Of_simplified.compile simplified 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 mini_c_prg = Compile.Of_typed.compile typed_prg in
|
||||||
@ -229,6 +220,7 @@ let compile_storage =
|
|||||||
let%bind (typed_param,_) = Compile.Of_simplified.compile_expression ~env ~state simplified_param 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 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.compile_expression mini_c_param in
|
||||||
|
let%bind () = Compile.Of_mini_c.assert_equal_michelson_type Check_storage michelson_prg compiled_param in
|
||||||
let%bind value = Run.evaluate_expression compiled_param.expr compiled_param.expr_ty 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
|
ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value
|
||||||
in
|
in
|
||||||
|
@ -47,3 +47,17 @@ let build_contract : Compiler.compiled_expression -> Michelson.michelson result
|
|||||||
Trace.trace_tzresult_lwt (simple_error "Invalid contract: Contract did not typecheck") @@
|
Trace.trace_tzresult_lwt (simple_error "Invalid contract: Contract did not typecheck") @@
|
||||||
Proto_alpha_utils.Memory_proto_alpha.typecheck_contract contract in
|
Proto_alpha_utils.Memory_proto_alpha.typecheck_contract contract in
|
||||||
ok contract
|
ok contract
|
||||||
|
|
||||||
|
type check_type = Check_parameter | Check_storage
|
||||||
|
let assert_equal_michelson_type : check_type -> Compiler.compiled_expression -> Compiler.compiled_expression -> unit result =
|
||||||
|
fun c compiled_prg compiled_param ->
|
||||||
|
let%bind (Ex_ty expected_ty) =
|
||||||
|
let%bind (c_param_ty,c_storage_ty) = Self_michelson.fetch_contract_inputs compiled_prg.expr_ty in
|
||||||
|
match c with
|
||||||
|
| Check_parameter -> ok c_param_ty
|
||||||
|
| Check_storage -> ok c_storage_ty in
|
||||||
|
let (Ex_ty actual_ty) = compiled_param.expr_ty in
|
||||||
|
let%bind _ =
|
||||||
|
Trace.trace_tzresult (simple_error "Passed parameter does not match the contract type") @@
|
||||||
|
Proto_alpha_utils.Memory_proto_alpha.assert_equal_michelson_type expected_ty actual_ty in
|
||||||
|
ok ()
|
@ -1105,6 +1105,10 @@ let typecheck_contract contract =
|
|||||||
Script_ir_translator.typecheck_code dummy_environment.tezos_context contract' >>=??
|
Script_ir_translator.typecheck_code dummy_environment.tezos_context contract' >>=??
|
||||||
fun _ -> return ()
|
fun _ -> return ()
|
||||||
|
|
||||||
|
let assert_equal_michelson_type ty1 ty2 =
|
||||||
|
(* alpha_wrap (Script_ir_translator.ty_eq tezos_context a b) >>? fun (Eq, _) -> *)
|
||||||
|
alpha_wrap (Script_ir_translator.ty_eq dummy_environment.tezos_context ty1 ty2)
|
||||||
|
|
||||||
type 'a interpret_res =
|
type 'a interpret_res =
|
||||||
| Succeed of 'a stack
|
| Succeed of 'a stack
|
||||||
| Fail of Script_repr.expr
|
| Fail of Script_repr.expr
|
||||||
|
Loading…
Reference in New Issue
Block a user