Merge branch 'feature/flag-for-michelson-typecheking' into 'dev'

add a flag to disable michelson typechecking in compile-contract

See merge request ligolang/ligo!500
This commit is contained in:
Rémi Lesenechal 2020-03-16 12:41:29 +00:00
commit 222bc3cb5c
3 changed files with 29 additions and 15 deletions

View File

@ -94,6 +94,13 @@ let source =
info ~docv ~doc ["source"] in info ~docv ~doc ["source"] in
value @@ opt (some string) None info 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 predecessor_timestamp =
let open Arg in let open Arg in
let info = let info =
@ -131,17 +138,17 @@ module Uncompile = Ligo.Uncompile
module Run = Ligo.Run.Of_michelson module Run = Ligo.Run.Of_michelson
let compile_file = 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 @@ toplevel ~display_format @@
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,_ = Compile.Of_simplified.compile (Contract entry_point) simplified 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 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 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 ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) contract
in in
let term = 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 cmdname = "compile-contract" in
let doc = "Subcommand: Compile a contract." in let doc = "Subcommand: Compile a contract." in
(Term.ret term , Term.info ~doc cmdname) (Term.ret term , Term.info ~doc cmdname)

View File

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

View File

@ -32,8 +32,8 @@ module Errors = struct
error title_type_check_msg message error title_type_check_msg message
end end
let build_contract : Compiler.compiled_expression -> Michelson.michelson result = let build_contract : ?disable_typecheck:bool -> Compiler.compiled_expression -> Michelson.michelson result =
fun compiled -> 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 ((Ex_ty _param_ty),(Ex_ty _storage_ty)) = Self_michelson.fetch_contract_inputs compiled.expr_ty in
let%bind param_michelson = let%bind param_michelson =
Trace.trace_tzresult_lwt (simple_error "Could not unparse parameter") @@ Trace.trace_tzresult_lwt (simple_error "Could not unparse parameter") @@
@ -42,6 +42,9 @@ let build_contract : Compiler.compiled_expression -> Michelson.michelson result
Trace.trace_tzresult_lwt (simple_error "Could not unparse storage") @@ Trace.trace_tzresult_lwt (simple_error "Could not unparse storage") @@
Proto_alpha_utils.Memory_proto_alpha.unparse_ty_michelson _storage_ty in Proto_alpha_utils.Memory_proto_alpha.unparse_ty_michelson _storage_ty in
let contract = Michelson.contract param_michelson storage_michelson compiled.expr in let contract = Michelson.contract param_michelson storage_michelson compiled.expr in
if disable_typecheck then
ok contract
else
let%bind res = let%bind res =
Trace.trace_tzresult_lwt (simple_error "Could not typecheck the code") @@ Trace.trace_tzresult_lwt (simple_error "Could not typecheck the code") @@
Proto_alpha_utils.Memory_proto_alpha.typecheck_contract contract in Proto_alpha_utils.Memory_proto_alpha.typecheck_contract contract in