Also perform Ast_typed check

src/bin/cli.ml

@@ -121,7 +121,7 @@ let compile_file =
     let%bind typed,_    = Compile.Of_simplified.compile 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_mini_c.build_contract michelson in
+    let%bind contract   = Compile.Of_michelson.build_contract michelson in
     ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) contract
   in
   let term =
@@ -137,7 +137,7 @@ let measure_contract =
     let%bind typed,_    = Compile.Of_simplified.compile 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_mini_c.build_contract michelson in
+    let%bind contract   = Compile.Of_michelson.build_contract michelson in
     let open Tezos_utils in
     ok @@ Format.asprintf "%d bytes\n" (Michelson.measure contract)
   in
@@ -157,14 +157,15 @@ let compile_parameter =
     let      env             = Ast_typed.program_environment typed_prg in
     let%bind (_contract: Tezos_utils.Michelson.michelson) =
       (* fails if the given entry point is not a valid contract *)
-      Compile.Of_mini_c.build_contract michelson_prg in
+      Compile.Of_michelson.build_contract michelson_prg in
 
     let%bind v_syntax         = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in
     let%bind simplified_param = Compile.Of_source.compile_expression v_syntax expression in
     let%bind (typed_param,_)  = Compile.Of_simplified.compile_expression ~env ~state simplified_param in
     let%bind mini_c_param     = Compile.Of_typed.compile_expression typed_param in
     let%bind compiled_param   = Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg mini_c_param in
-    let%bind ()               = Compile.Of_mini_c.assert_equal_michelson_type Check_parameter michelson_prg compiled_param in
+    let%bind ()               = Compile.Of_typed.assert_equal_contract_type Check_parameter entry_point typed_prg typed_param in
+    let%bind ()               = Compile.Of_michelson.assert_equal_contract_type Check_parameter michelson_prg compiled_param in
     let%bind value            = Run.evaluate_expression compiled_param.expr compiled_param.expr_ty in
     ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value
   in
@@ -213,14 +214,15 @@ let compile_storage =
     let      env             = Ast_typed.program_environment typed_prg in
     let%bind (_contract: Tezos_utils.Michelson.michelson) =
       (* fails if the given entry point is not a valid contract *)
-      Compile.Of_mini_c.build_contract michelson_prg in
+      Compile.Of_michelson.build_contract michelson_prg in
 
     let%bind v_syntax         = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in
     let%bind simplified_param = Compile.Of_source.compile_expression v_syntax expression in
     let%bind (typed_param,_)  = Compile.Of_simplified.compile_expression ~env ~state simplified_param in
     let%bind mini_c_param     = Compile.Of_typed.compile_expression typed_param in
     let%bind compiled_param   = Compile.Of_mini_c.compile_expression mini_c_param in
-    let%bind ()               = Compile.Of_mini_c.assert_equal_michelson_type Check_storage michelson_prg compiled_param in
+    let%bind ()               = Compile.Of_typed.assert_equal_contract_type Check_storage entry_point typed_prg typed_param in
+    let%bind ()               = Compile.Of_michelson.assert_equal_contract_type Check_storage michelson_prg compiled_param in
     let%bind value            = Run.evaluate_expression compiled_param.expr compiled_param.expr_ty in
     ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value
   in
@@ -240,7 +242,7 @@ let dry_run =
     let%bind michelson_prg   = Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg entry_point in
     let%bind (_contract: Tezos_utils.Michelson.michelson) =
       (* fails if the given entry point is not a valid contract *)
-      Compile.Of_mini_c.build_contract michelson_prg in
+      Compile.Of_michelson.build_contract michelson_prg in
 
     let%bind v_syntax          = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in
     let%bind simplified        = Compile.Of_source.compile_contract_input storage input v_syntax in

src/main/compile/of_michelson.ml

@@ -0,0 +1,32 @@
+open Tezos_utils
+open Proto_alpha_utils
+open Trace
+
+let build_contract : Compiler.compiled_expression -> Michelson.michelson result =
+  fun 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 "Invalid contract: Could not unparse parameter") @@
+    Proto_alpha_utils.Memory_proto_alpha.unparse_ty_michelson _param_ty in
+  let%bind storage_michelson =
+    Trace.trace_tzresult_lwt (simple_error "Invalid contract: 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 () = 
+    Trace.trace_tzresult_lwt (simple_error "Invalid contract: Contract did not typecheck") @@
+    Proto_alpha_utils.Memory_proto_alpha.typecheck_contract contract in
+  ok contract
+
+type check_type = Check_parameter | Check_storage
+let assert_equal_contract_type : check_type -> Compiler.compiled_expression -> Compiler.compiled_expression -> unit result =
+  fun c compiled_prg compiled_param ->
+    let%bind (Ex_ty expected_ty) =
+      let%bind (c_param_ty,c_storage_ty) = Self_michelson.fetch_contract_inputs compiled_prg.expr_ty in
+      match c with
+      | Check_parameter -> ok c_param_ty
+      | Check_storage -> ok c_storage_ty in
+    let (Ex_ty actual_ty) = compiled_param.expr_ty in
+    let%bind _ = 
+      Trace.trace_tzresult (simple_error "Passed parameter does not match the contract type") @@
+      Proto_alpha_utils.Memory_proto_alpha.assert_equal_michelson_type expected_ty actual_ty in
+    ok ()

src/main/compile/of_mini_c.ml

@@ -1,5 +1,4 @@
 open Mini_c
-open Tezos_utils
 open Proto_alpha_utils
 open Trace
 
@@ -32,32 +31,3 @@ let aggregate_and_compile_contract = fun program name ->
 
 let aggregate_and_compile_expression = fun program exp ->
   aggregate_and_compile program (ExpressionForm exp)
-
-let build_contract : Compiler.compiled_expression -> Michelson.michelson result =
-  fun 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 "Invalid contract: Could not unparse parameter") @@
-    Proto_alpha_utils.Memory_proto_alpha.unparse_ty_michelson _param_ty in
-  let%bind storage_michelson =
-    Trace.trace_tzresult_lwt (simple_error "Invalid contract: 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 () = 
-    Trace.trace_tzresult_lwt (simple_error "Invalid contract: Contract did not typecheck") @@
-    Proto_alpha_utils.Memory_proto_alpha.typecheck_contract contract in
-  ok contract
-
-type check_type = Check_parameter | Check_storage
-let assert_equal_michelson_type : check_type -> Compiler.compiled_expression -> Compiler.compiled_expression -> unit result =
-  fun c compiled_prg compiled_param ->
-    let%bind (Ex_ty expected_ty) =
-      let%bind (c_param_ty,c_storage_ty) = Self_michelson.fetch_contract_inputs compiled_prg.expr_ty in
-      match c with
-      | Check_parameter -> ok c_param_ty
-      | Check_storage -> ok c_storage_ty in
-    let (Ex_ty actual_ty) = compiled_param.expr_ty in
-    let%bind _ = 
-      Trace.trace_tzresult (simple_error "Passed parameter does not match the contract type") @@
-      Proto_alpha_utils.Memory_proto_alpha.assert_equal_michelson_type expected_ty actual_ty in
-    ok ()

src/main/compile/of_typed.ml

@@ -6,3 +6,19 @@ let compile : Ast_typed.program -> Mini_c.program result = fun p ->
 
 let compile_expression : annotated_expression -> Mini_c.expression result = fun e ->
   Transpiler.transpile_annotated_expression e
+
+type check_type = Check_parameter | Check_storage
+let assert_equal_contract_type : check_type -> string -> Ast_typed.program -> Ast_typed.value -> unit result =
+    fun c entry contract param -> Trace.trace (simple_info "Check argument type against contract type") (
+  let%bind entry_point = Ast_typed.get_entry contract entry in
+  match entry_point.type_annotation.type_value' with
+  | T_arrow (args,_) -> (
+      match args.type_value' with
+      | T_tuple [param_exp;storage_exp] -> (
+          match c with
+          | Check_parameter -> assert_type_value_eq (param_exp,   param.type_annotation)
+          | Check_storage   -> assert_type_value_eq (storage_exp, param.type_annotation)
+      )
+      | _ -> dummy_fail
+  )
+  | _ -> dummy_fail )

src/stages/ast_typed/combinators.ml

@@ -138,7 +138,7 @@ let get_t_pair (t:type_value) : (type_value * type_value) result = match t.type_
 
 let get_t_function (t:type_value) : (type_value * type_value) result = match t.type_value' with
   | T_arrow (a,r) -> ok (a,r)
-  | _ -> simple_fail "not a tuple"
+  | _ -> simple_fail "not a function"
 
 let get_t_sum (t:type_value) : type_value constructor_map result = match t.type_value' with
   | T_sum m -> ok m

src/test/coase_tests.ml

@@ -26,7 +26,7 @@ let compile_main () =
   let%bind michelson_prg   = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in
   let%bind (_contract: Tezos_utils.Michelson.michelson) =
     (* fails if the given entry point is not a valid contract *)
-    Ligo.Compile.Of_mini_c.build_contract michelson_prg in
+    Ligo.Compile.Of_michelson.build_contract michelson_prg in
   ok ()
 
 open Ast_simplified

src/test/multisig_tests.ml

@@ -23,7 +23,7 @@ let compile_main () =
   let%bind michelson_prg   = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in
   let%bind (_contract: Tezos_utils.Michelson.michelson) =
     (* fails if the given entry point is not a valid contract *)
-    Ligo.Compile.Of_mini_c.build_contract michelson_prg in
+    Ligo.Compile.Of_michelson.build_contract michelson_prg in
   ok ()
 
 open Ast_simplified

src/test/multisig_v2_tests.ml

@@ -23,7 +23,7 @@ let compile_main () =
   let%bind michelson_prg   = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in
   let%bind (_contract: Tezos_utils.Michelson.michelson) =
     (* fails if the given entry point is not a valid contract *)
-    Ligo.Compile.Of_mini_c.build_contract michelson_prg in
+    Ligo.Compile.Of_michelson.build_contract michelson_prg in
   ok ()
 
 open Ast_simplified

src/test/replaceable_id_tests.ml

@@ -23,7 +23,7 @@ let compile_main () =
   let%bind michelson_prg   = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in
   let%bind (_contract: Tezos_utils.Michelson.michelson) =
     (* fails if the given entry point is not a valid contract *)
-    Ligo.Compile.Of_mini_c.build_contract michelson_prg in
+    Ligo.Compile.Of_michelson.build_contract michelson_prg in
   ok ()
 open Ast_simplified