Improve printing of effects for functions with simple effects.

Reject contract creation of overloaded types.

svn: r12105

collects/typed-scheme/private/type-contract.ss

@@ -18,6 +18,7 @@
  syntax/struct
  syntax/stx
  mzlib/trace
+ scheme/list
  (only-in scheme/contract -> ->* case-> cons/c flat-rec-contract provide/contract any/c)
  (for-template scheme/base scheme/contract (only-in scheme/class object% is-a?/c subclass?/c)))
 
@@ -40,6 +41,9 @@
              (generate-contract-def e)))
        (syntax->list forms)))
 
+(define (no-duplicates l)
+  (= (length l) (length (remove-duplicates l))))
+
 
 (define (type->contract ty fail)
   (define vars (make-parameter '()))
@@ -97,6 +101,9 @@
                (if rst
                    #'((dom* ...) () #:rest (listof rst*) . ->* . rng*)
                    #'(dom* ...  . -> . rng*))))
+           (unless (no-duplicates (for/list ([t arrs])
+                                    (match t [(arr: dom _ _ _ _ _ _) (length dom)])))
+             (exit (fail)))
 	   (match (map f arrs)
 	     [(list e) e]
 	     [l #`(case-> #,@l)]))]

collects/typed-scheme/private/type-effect-printer.ss

@@ -64,8 +64,10 @@
        (when drest
          (fp "~a ... ~a " (car drest) (cdr drest)))
        (fp "-> ~a" rng)
-       (unless (and (null? thn-eff) (null? els-eff))
+       (match* (thn-eff els-eff)
-         (fp " : ~a ~a" thn-eff els-eff))
+         [((list) (list)) (void)]
+         [((list (Latent-Restrict-Effect: t)) (list (Latent-Remove-Effect: t))) (fp " : ~a" t)]
+         [(_ _) (fp " : ~a ~a" thn-eff els-eff)])
        (fp ")")]))
   (define (tuple? t)
     (match t