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

Made #:forbid-anything be the counterpart of #:allow-anything

Browse Source 
svn: r1140
This commit is contained in:
Eli Barzilay 2005-10-24 11:05:34 +00:00
parent 4130a38299
commit 0b1034dcf8
1 changed files with 12 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/mzlib/kw.ss
View File

@ -96,19 +96,25 @@
;; helpers for process-vars ;; helpers for process-vars
(define ((process-mode modes rests) processed-spec) (define ((process-mode modes rests) processed-spec)
(let ([allow (memq (cadr processed-spec) modes)] (let ([allow (memq (cadr processed-spec) modes)]
[forbid (memq (caddr processed-spec) modes)]) [forbid (memq (caddr processed-spec) modes)]
[allow-any (memq #:allow-anything modes)]
[forbid-any (memq #:forbid-anything modes)])
(cond (cond
[(and allow forbid) [(and allow forbid)
(serror #f "contradicting #:...-~a keywords" (car processed-spec))] (serror #f "contradicting #:...-~a keywords" (car processed-spec))]
[(and forbid (memq #:allow-anything modes)) [(and forbid allow-any)
(serror #f "~a contradicts #:allow-anything" (caddr processed-spec))] (serror #f "~a contradicts #:allow-anything" (caddr processed-spec))]
[(and allow forbid-any)
(serror #f "~a contradicts #:forbid-anything" (cadr processed-spec))]
[(ormap (lambda (k) (assq k rests)) (cadddr processed-spec)) [(ormap (lambda (k) (assq k rests)) (cadddr processed-spec))
=> ; forced? => ; forced?
(lambda (r) (lambda (r)
(when forbid (serror #f "cannot ~s with ~s" (car forbid) (car r))) (when (or forbid forbid-any)
(serror #f "cannot ~s with ~s"
(car (or forbid forbid-any)) (car r)))
#t)] #t)]
[allow #t] [(or allow allow-any) #t]
[forbid #f] [(or forbid forbid-any) #f]
[else (ormap (lambda (k) (and (assq k rests) #t)) ; suggested? [else (ormap (lambda (k) (and (assq k rests) #t)) ; suggested?
(car (cddddr processed-spec)))]))) (car (cddddr processed-spec)))])))
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------