contract are now typecheck (at least in the CLI)

src/bin/cli.ml

@@ -102,7 +102,7 @@ module Run = Ligo.Run.Of_michelson
 let compile_file =
   let f source_file entry_point syntax display_format michelson_format =
     toplevel ~display_format @@
-    let%bind contract = Compile.source_to_michelson_contract (Syntax_name syntax) source_file entry_point in
+    let%bind (contract,_) = Compile.source_to_michelson_contract (Syntax_name syntax) source_file entry_point in
     ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) contract
   in
   let term =
@@ -114,7 +114,7 @@ let compile_file =
 let measure_contract =
   let f source_file entry_point syntax display_format  =
     toplevel ~display_format @@
-    let%bind contract = Compile.source_to_michelson_contract (Syntax_name syntax) source_file entry_point in
+    let%bind (contract,_) = Compile.source_to_michelson_contract (Syntax_name syntax) source_file entry_point in
     let open Tezos_utils in
     ok @@ Format.asprintf "%d bytes\n" (Michelson.measure contract)
   in
@@ -139,9 +139,6 @@ let compile_parameter =
   let doc = "Subcommand: compile parameters to a michelson expression. The resulting michelson expression can be passed as an argument in a transaction which calls a contract." in
   (term , Term.info ~doc cmdname)
 
-(*-------------------------------------------------------------------------------------------------------------------------------------
-TODO: This function does not typecheck anything, add the typecheck against the given entrypoint. For now: does the same as compile_parameter
--------------------------------------------------------------------------------------------------------------------------------------- *)
 let compile_storage =
   let f source_file _entry_point expression syntax display_format michelson_format =
     toplevel ~display_format @@
@@ -161,7 +158,7 @@ let dry_run =
   let f source_file entry_point storage input amount sender source syntax display_format =
     toplevel ~display_format @@
     let%bind v_syntax                      = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in
-    let%bind (typed_program,state,env) = Compile.source_to_typed (Syntax_name syntax) source_file in
+    let%bind (_,(typed_program,state,env)) = Compile.source_to_michelson_contract (Syntax_name syntax) source_file entry_point in
     let%bind compiled_param                = Compile.source_contract_input_to_michelson_value_as_function ~env ~state (storage,input) v_syntax in
     let%bind michelson                     = Compile.typed_to_michelson_contract_as_exp typed_program entry_point in
     let%bind args_michelson                = Run.evaluate_michelson compiled_param in

src/main/compile/of_mini_c.ml

@@ -50,11 +50,14 @@ let compile_contract_as_exp = fun program name ->
 let build_contract : Compiler.compiled_expression -> Michelson.michelson result =
   fun compiled ->
   let%bind ((Ex_ty _param_ty),(Ex_ty _storage_ty)) = Self_michelson.fetch_lambda_parameters compiled.expr_ty in
-  (*TODO : bind pair trace_tzresult_lwt ? *)
+  let%bind param_michelson =
-  let%bind (param_michelson : Tezos_raw_protocol_005_PsBabyM1.Alpha_context.Script.node) = 
+    Trace.trace_tzresult_lwt (simple_error "Could not unparse contract lambda's parameter") @@
-    Trace.trace_tzresult_lwt (simple_error "TODO") @@
     Proto_alpha_utils.Memory_proto_alpha.unparse_ty_michelson _param_ty in
-  let%bind (storage_michelson : Tezos_raw_protocol_005_PsBabyM1.Alpha_context.Script.node) = 
+  let%bind storage_michelson =
-    Trace.trace_tzresult_lwt (simple_error "TODO") @@
+    Trace.trace_tzresult_lwt (simple_error "Could not unparse contract lambda's storage") @@
     Proto_alpha_utils.Memory_proto_alpha.unparse_ty_michelson _storage_ty in
-  ok @@ Michelson.contract param_michelson storage_michelson compiled.expr
+  let contract = Michelson.contract param_michelson storage_michelson compiled.expr in
+  let%bind () = 
+    Trace.trace_tzresult_lwt (simple_error "Invalid contract") @@
+    Proto_alpha_utils.Memory_proto_alpha.typecheck_contract contract in
+  ok contract

src/main/compile/wrapper.ml

@@ -49,6 +49,7 @@ let typed_to_michelson_contract_as_exp
 
 (* produce a michelson contract e.g. the following sequence K_param ; K_storage ; K_code *)
 let source_to_michelson_contract syntax source_file entry_point =
-  let%bind (typed,_,_) = source_to_typed syntax source_file in
+  let%bind (typed,state,env) = source_to_typed syntax source_file in
   let%bind michelson = typed_to_michelson_contract_as_exp typed entry_point in
-  Of_mini_c.build_contract michelson
+  let%bind contract = Of_mini_c.build_contract michelson in
+  ok (contract, (typed,state,env))

src/main/run/of_michelson.ml

@@ -147,18 +147,16 @@ let f = fun x -> let (Ex x') = x in x' (* la ca sort *)
       ('b ty * field_annot option * var_annot option) *
       type_annot option *
       bool -> ('a, 'b) pair ty *)
-let fetch_contract_args (contract_ty:ex_ty) =
+let fetch_lambda_types (contract_ty:ex_ty) =
   match contract_ty with
-  | Ex_ty (Contract_t (in_ty,_)) -> ok (Ex_ty in_ty, Ex_ty in_ty)
   | Ex_ty (Lambda_t (in_ty, out_ty, _)) -> ok (Ex_ty in_ty, Ex_ty out_ty)
-  | _ ->
+  | _ -> simple_fail "failed to fetch lambda types"
-    simple_fail "mock"
 
 (* type run_res = Failwith of failwith_res | Success of ex_typed_value
 let run_bis ?options (exp:Michelson.t) (input_michelson:Michelson.t) (is_contract:bool) : run_res result = *)
 let run_contract ?options (exp:Michelson.t) (exp_type:ex_ty) (input_michelson:Michelson.t) (is_contract:bool) : ex_typed_value result =
   let open! Tezos_raw_protocol_005_PsBabyM1 in
-  let%bind (Ex_ty input_ty, Ex_ty output_ty) = fetch_contract_args exp_type in
+  let%bind (Ex_ty input_ty, Ex_ty output_ty) = fetch_lambda_types exp_type in
   let%bind input =
     Trace.trace_tzresult_lwt (simple_error "error parsing input") @@
     Memory_proto_alpha.parse_michelson_data input_michelson input_ty

vendors/ligo-utils/proto-alpha-utils/x_memory_proto_alpha.ml

@@ -1100,6 +1100,11 @@ let unparse_ty_michelson ty =
   Script_ir_translator.unparse_ty dummy_environment.tezos_context ty >>=??
   fun (n,_) -> return n
 
+let typecheck_contract contract =
+  let contract' = Tezos_micheline.Micheline.strip_locations contract in
+  Script_ir_translator.typecheck_code dummy_environment.tezos_context contract' >>=??
+  fun _ -> return ()
+
 type 'a interpret_res =
   | Succeed of 'a stack
   | Fail of Script_repr.expr