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

add a flag to disable michelson typechecking in compile-contract

Browse Source
This commit is contained in:
Lesenechal Remi 2020-03-12 20:16:50 +01:00
parent eecdbcddf7
commit 97a85766d3
3 changed files with 29 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
src/bin/cli.ml
View File

@ -94,6 +94,13 @@ let source =
info ~docv ~doc ["source"] in
value @@ opt (some string) None info
let disable_michelson_typechecking =
let open Arg in
let info =
let doc = "disable Michelson typecking, this might produce ill-typed Michelson code." in
info ~doc ["disable-michelson-typechecking"] in
value @@ flag info
let predecessor_timestamp =
let open Arg in
let info =
@ -131,17 +138,17 @@ module Uncompile = Ligo.Uncompile
module Run = Ligo.Run.Of_michelson
let compile_file =
let f source_file entry_point syntax display_format michelson_format =
let f source_file entry_point syntax display_format disable_typecheck michelson_format =
toplevel ~display_format @@
let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in
let%bind typed,_ = Compile.Of_simplified.compile (Contract entry_point) 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_michelson.build_contract michelson in
let%bind contract = Compile.Of_michelson.build_contract ~disable_typecheck michelson in
ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) contract
in
let term =
Term.(const f $ source_file 0 $ entry_point 1 $ syntax $ display_format $ michelson_code_format) in
Term.(const f $ source_file 0 $ entry_point 1 $ syntax $ display_format $ disable_michelson_typechecking $ michelson_code_format) in
let cmdname = "compile-contract" in
let doc = "Subcommand: Compile a contract." in
(Term.ret term , Term.info ~doc cmdname)

4
src/bin/expect_tests/help_tests.ml
View File

@ -176,6 +176,10 @@ let%expect_test _ =
SOURCE_FILE is the path to the smart contract file.
OPTIONS
--disable-michelson-typechecking
disable Michelson typecking, this might produce ill-typed
Michelson code.
--format=DISPLAY_FORMAT, --display-format=DISPLAY_FORMAT
(absent=human-readable)
DISPLAY_FORMAT is the format that will be used by the CLI.

27
src/main/compile/of_michelson.ml
View File

@ -32,8 +32,8 @@ module Errors = struct
error title_type_check_msg message
end
let build_contract : Compiler.compiled_expression -> Michelson.michelson result =
fun compiled ->
let build_contract : ?disable_typecheck:bool -> Compiler.compiled_expression -> Michelson.michelson result =
fun ?(disable_typecheck= false) compiled ->
let%bind ((Ex_ty _param_ty),(Ex_ty _storage_ty)) = Self_michelson.fetch_contract_inputs compiled.expr_ty in
let%bind param_michelson =
Trace.trace_tzresult_lwt (simple_error "Could not unparse parameter") @@
@ -42,16 +42,19 @@ let build_contract : Compiler.compiled_expression -> Michelson.michelson result
Trace.trace_tzresult_lwt (simple_error "Could not unparse 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 res =
Trace.trace_tzresult_lwt (simple_error "Could not typecheck the code") @@
Proto_alpha_utils.Memory_proto_alpha.typecheck_contract contract in
match res with
| Type_checked -> ok contract
| Err_parameter -> fail @@ Errors.bad_parameter contract ()
| Err_storage -> fail @@ Errors.bad_storage contract ()
| Err_contract -> fail @@ Errors.bad_contract contract ()
| Err_gas -> fail @@ Errors.ran_out_of_gas ()
| Err_unknown -> fail @@ Errors.unknown ()
if disable_typecheck then
ok contract
else
let%bind res =
Trace.trace_tzresult_lwt (simple_error "Could not typecheck the code") @@
Proto_alpha_utils.Memory_proto_alpha.typecheck_contract contract in
match res with
| Type_checked -> ok contract
| Err_parameter -> fail @@ Errors.bad_parameter contract ()
| Err_storage -> fail @@ Errors.bad_storage contract ()
| Err_contract -> fail @@ Errors.bad_contract contract ()
| Err_gas -> fail @@ Errors.ran_out_of_gas ()
| Err_unknown -> fail @@ Errors.unknown ()
type check_type = Check_parameter | Check_storage
let assert_equal_contract_type : check_type -> Compiler.compiled_expression -> Compiler.compiled_expression -> unit result =