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

Add argument checking to conjoin and disjoin.

Browse Source
This commit is contained in:
Vincent St-Amour 2015-06-12 15:58:36 -05:00
parent 0e6baea9f6
commit 60e7f1b7c7
1 changed files with 44 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

72
racket/collects/racket/function.rkt
View File

@ -96,40 +96,56 @@
(define conjoin (define conjoin
(case-lambda* (case-lambda*
[(f ... 8) [(f ... 8)
(make-intermediate-procedure (begin
'conjoined (for ([f* (in-list (list f ...))])
[(x (... ...) 2) (and (f x (... ...)) ...)] (unless (procedure? f*)
[xs (and (apply f xs) ...)] (raise-argument-error 'conjoin "procedure?" f*)))
#:keyword (make-intermediate-procedure
[(keys vals . args) 'conjoined
(and (keyword-apply f keys vals args) ...)])] [(x (... ...) 2) (and (f x (... ...)) ...)]
[xs (and (apply f xs) ...)]
#:keyword
[(keys vals . args)
(and (keyword-apply f keys vals args) ...)]))]
[fs [fs
(make-intermediate-procedure (begin
'conjoined (for ([f* (in-list fs)])
[(x ... 2) (andmap (lambda (f) (f x ...)) fs)] (unless (procedure? f*)
[xs (andmap (lambda (f) (apply f xs)) fs)] (raise-argument-error 'conjoin "procedure?" f*)))
#:keyword (make-intermediate-procedure
[(keys vals . args) 'conjoined
(andmap (lambda (f) (keyword-apply f keys vals args)) fs)])])) [(x ... 2) (andmap (lambda (f) (f x ...)) fs)]
[xs (andmap (lambda (f) (apply f xs)) fs)]
#:keyword
[(keys vals . args)
(andmap (lambda (f) (keyword-apply f keys vals args)) fs)]))]))
(define disjoin (define disjoin
(case-lambda* (case-lambda*
[(f ... 8) [(f ... 8)
(make-intermediate-procedure (begin
'disjoined (for ([f* (in-list (list f ...))])
[(x (... ...) 2) (or (f x (... ...)) ...)] (unless (procedure? f*)
[xs (or (apply f xs) ...)] (raise-argument-error 'conjoin "procedure?" f*)))
#:keyword (make-intermediate-procedure
[(keys vals . args) 'disjoined
(or (keyword-apply f keys vals args) ...)])] [(x (... ...) 2) (or (f x (... ...)) ...)]
[xs (or (apply f xs) ...)]
#:keyword
[(keys vals . args)
(or (keyword-apply f keys vals args) ...)]))]
[fs [fs
(make-intermediate-procedure (begin
'disjoined (for ([f* (in-list fs)])
[(x ... 2) (ormap (lambda (f) (f x ...)) fs)] (unless (procedure? f*)
[xs (ormap (lambda (f) (apply f xs)) fs)] (raise-argument-error 'conjoin "procedure?" f*)))
#:keyword (make-intermediate-procedure
[(keys vals . args) 'disjoined
(ormap (lambda (f) (keyword-apply f keys vals args)) fs)])])) [(x ... 2) (ormap (lambda (f) (f x ...)) fs)]
[xs (ormap (lambda (f) (apply f xs)) fs)]
#:keyword
[(keys vals . args)
(ormap (lambda (f) (keyword-apply f keys vals args)) fs)]))]))
(define-syntax (make-intermediate-procedure stx) (define-syntax (make-intermediate-procedure stx)
(syntax-case stx [quote] (syntax-case stx [quote]