better err message

don't create duplicate imports

svn: r9515
This commit is contained in:
Sam Tobin-Hochstadt 2008-04-28 21:21:26 +00:00
parent 5b19df4bcb
commit 0f2fc610ce

View File

@ -3,7 +3,7 @@
(require scheme/unit (require scheme/unit
(for-syntax (for-syntax
scheme/base scheme/base
(only-in srfi/1/list s:member) (only-in srfi/1/list s:member s:delete-duplicates)
scheme/unit-exptime scheme/unit-exptime
scheme/match)) scheme/match))
@ -60,8 +60,10 @@
(values imps* exps*)))) (values imps* exps*))))
(define (duplicates sigs) (define (duplicates sigs)
(= (length sigs) (for/or ([s sigs]
(length (s:delete-duplicates sigs sig=?)))) #:when
(> 1 (length (for/list ([s* sig]) (sig=? s s*)))))
s))
(syntax-case stx (import export) (syntax-case stx (import export)
;; here the exports are specified - they ought to be a subset of the allowable exports ;; here the exports are specified - they ought to be a subset of the allowable exports
@ -74,9 +76,11 @@
(andmap identifier? (syntax->list #'units)) (andmap identifier? (syntax->list #'units))
(let*-values ([(units) (syntax->list #'units)] (let*-values ([(units) (syntax->list #'units)]
[(imps exps) (imps/exps-from-units units)]) [(imps exps) (imps/exps-from-units units)])
(when (duplicates? exps) (cond [(duplicates? exps)
(raise-syntax-error #f "multiple units export the same signature" stx)) =>
(mk imps exps units stx))])) (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 ;; Tests