Better error message for functions that don't have the same arity as

the expected.
Add some tests for errors.

svn: r17551

original commit: eaad64d6120e70e59200fb2cec58f4af5a777ed4

collects/tests/typed-scheme/fail/all-bad-syntax.ss

@@ -0,0 +1,25 @@
+#;
+(exn-pred 1)
+#lang typed-scheme
+
+(require scheme/list)
+
+(define-type-alias (BT a) (U Boolean (node a)))
+(define-struct: (a) node ([key : a] [l : (BT a)] [r : (BT a)]))
+
+(: traverse-4 (All (a i) (BT a) (a ( -> i) ( -> i) -> i) i -> i))
+(define (traverse-4 abt f i)
+  (cond
+    [(boolean? abt) i]
+    [(node? abt) (f (node-key abt)
+                    (lambda () (traverse-4 (node-l abt) f i))
+                    (lambda () (traverse-4 (node-r abt) f i)))]))
+
+(define: (a) (inorder-4 [abt : (BT a)]) : (Listof a)
+  (traverse-4 abt
+              (lambda: ([key : a] [lt : ( -> (Listof a))] [rt : ( -> (Listof a))])
+                (append (lt)
+                        (list key)
+                        (rt)))
+              #;empty))
+(+ 'foo)

collects/tests/typed-scheme/fail/bad-ann.ss

@@ -0,0 +1,14 @@
+#;
+(exn-pred 2)
+#lang typed/scheme
+
+
+(: f : Number  -> Number)
+(define (f a b)
+  (+ a b))
+
+(define: (g [a : Number] [b : Number]) : Number
+  (+ a b))
+
+(f 1 2)
+(g 1 2)

collects/tests/typed-scheme/fail/duplicate-ann.ss

@@ -0,0 +1,19 @@
+#lang scheme/load
+
+(module square typed-scheme
+  
+  ;(provide: [square (Integer -> Integer)])
+  (provide: [square (Integer -> Integer)])
+  ;(: square (Number -> Number))
+  (define: (square [n : Number]) : Number
+    (* n n))
+  )
+
+(module squareclient typed-scheme
+  
+  (require 'square)
+  
+  (square 10)  ;; 100
+  (integer? 10.1)  ;; #f
+  (square 10.1)  ;; 102.009999...
+  )

collects/typed-scheme/typecheck/tc-lambda-unit.ss

@@ -66,7 +66,7 @@
     (define (check-body)
       (with-lexical-env/extend 
        arg-list arg-types
-       (make-lam-result (map list arg-list arg-types) null rest-ty drest 
+       (make-lam-result (for/list ([al arg-list] [at arg-types] [a-ty arg-tys]) (list al at)) null rest-ty drest 
                         (tc-exprs/check (syntax->list body) ret-ty))))
     (when (or (not (= arg-len tys-len))
               (and (or rest-ty drest) (not rest)))