add a flag to disable michelson typechecking in compile-contract

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)

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.

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,6 +42,9 @@ 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
+  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