diff --git a/collects/typed-scheme/private/type-contract.ss b/collects/typed-scheme/private/type-contract.ss index 7f072c0ed7..7cfed89286 100644 --- a/collects/typed-scheme/private/type-contract.ss +++ b/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)]))] diff --git a/collects/typed-scheme/private/type-effect-printer.ss b/collects/typed-scheme/private/type-effect-printer.ss index 6b29c7c6da..c9f49f2529 100644 --- a/collects/typed-scheme/private/type-effect-printer.ss +++ b/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)) - (fp " : ~a ~a" thn-eff els-eff)) + (match* (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