diff --git a/src/bin/cli.ml b/src/bin/cli.ml index a35e5d91c..ad36e987c 100644 --- a/src/bin/cli.ml +++ b/src/bin/cli.ml @@ -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) diff --git a/src/bin/expect_tests/help_tests.ml b/src/bin/expect_tests/help_tests.ml index f13b5c078..d1028bfab 100644 --- a/src/bin/expect_tests/help_tests.ml +++ b/src/bin/expect_tests/help_tests.ml @@ -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. diff --git a/src/main/compile/of_michelson.ml b/src/main/compile/of_michelson.ml index 3602a495e..93213152a 100644 --- a/src/main/compile/of_michelson.ml +++ b/src/main/compile/of_michelson.ml @@ -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 =