From 0f2fc610ce4bed445e75d0ae4136ae6ae3e6e9a3 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Mon, 28 Apr 2008 21:21:26 +0000 Subject: [PATCH] better err message don't create duplicate imports svn: r9515 --- collects/typed-scheme/private/unit-utils.ss | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/collects/typed-scheme/private/unit-utils.ss b/collects/typed-scheme/private/unit-utils.ss index 7a625a4330..57d77169fd 100644 --- a/collects/typed-scheme/private/unit-utils.ss +++ b/collects/typed-scheme/private/unit-utils.ss @@ -3,7 +3,7 @@ (require scheme/unit (for-syntax scheme/base - (only-in srfi/1/list s:member) + (only-in srfi/1/list s:member s:delete-duplicates) scheme/unit-exptime scheme/match)) @@ -60,8 +60,10 @@ (values imps* exps*)))) (define (duplicates sigs) - (= (length sigs) - (length (s:delete-duplicates sigs sig=?)))) + (for/or ([s sigs] + #:when + (> 1 (length (for/list ([s* sig]) (sig=? s s*))))) + s)) (syntax-case stx (import export) ;; here the exports are specified - they ought to be a subset of the allowable exports @@ -74,9 +76,11 @@ (andmap identifier? (syntax->list #'units)) (let*-values ([(units) (syntax->list #'units)] [(imps exps) (imps/exps-from-units units)]) - (when (duplicates? exps) - (raise-syntax-error #f "multiple units export the same signature" stx)) - (mk imps exps units stx))])) + (cond [(duplicates? exps) + => + (lambda (d) + (raise-syntax-error #f (format "multiple units export the signature ~a" d) stx))] + [else (mk (s:delete-duplicates imps) exps units stx)]))])) ;; Tests