suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

aaaah!

Browse Source 
svn: r9519
This commit is contained in:
Sam Tobin-Hochstadt 2008-04-28 21:21:28 +00:00
parent 72effc076d
commit 032a4eb7b9
1 changed files with 12 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/typed-scheme/private/unit-utils.ss
View File

@ -59,11 +59,17 @@
[imps* (map datum->sig-elem (filter (lambda (imp) (not (sig-in-sigs? imp exps))) imps))]) [imps* (map datum->sig-elem (filter (lambda (imp) (not (sig-in-sigs? imp exps))) imps))])
(values imps* exps*)))) (values imps* exps*))))
<<<<<<< HEAD:collects/typed-scheme/private/unit-utils.ss
(define (duplicates? sigs) (define (duplicates? sigs)
(for/or ([s sigs] (for/or ([s sigs]
#:when #:when
(> 1 (length (for/list ([s* sigs]) (free-identifier=? s s*))))) (> 1 (length (for/list ([s* sigs]) (free-identifier=? s s*)))))
s)) s))
=======
(define (duplicates sigs)
(= (length sigs)
(length (s:delete-duplicates sigs sig=?))))
>>>>>>> check for dups:collects/typed-scheme/private/unit-utils.ss
(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
@ -76,12 +82,18 @@
(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)])
<<<<<<< HEAD:collects/typed-scheme/private/unit-utils.ss
(cond [(duplicates? exps) (cond [(duplicates? exps)
=> =>
(lambda (d) (lambda (d)
(raise-syntax-error #f (format "multiple units export the signature ~a" d) stx))] (raise-syntax-error #f (format "multiple units export the signature ~a" d) stx))]
[else [else
(mk (delete-duplicates imps) exps units stx)]))])) (mk (delete-duplicates imps) exps units stx)]))]))
=======
(when (duplicates? exps)
(raise-syntax-error #f "multiple units export the same signature" stx))
(mk imps exps units stx))]))
>>>>>>> check for dups:collects/typed-scheme/private/unit-utils.ss
;; Tests ;; Tests