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
(case-lambda*
[(f ... 8)
(make-intermediate-procedure
'conjoined
[(x (... ...) 2) (and (f x (... ...)) ...)]
[xs (and (apply f xs) ...)]
#:keyword
[(keys vals . args)
(and (keyword-apply f keys vals args) ...)])]
(begin
(for ([f* (in-list (list f ...))])
(unless (procedure? f*)
(raise-argument-error 'conjoin "procedure?" f*)))
(make-intermediate-procedure
'conjoined
[(x (... ...) 2) (and (f x (... ...)) ...)]
[xs (and (apply f xs) ...)]
#:keyword
[(keys vals . args)
(and (keyword-apply f keys vals args) ...)]))]
[fs
(make-intermediate-procedure
'conjoined
[(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)])]))
(begin
(for ([f* (in-list fs)])
(unless (procedure? f*)
(raise-argument-error 'conjoin "procedure?" f*)))
(make-intermediate-procedure
'conjoined
[(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
(case-lambda*
[(f ... 8)
(make-intermediate-procedure
'disjoined
[(x (... ...) 2) (or (f x (... ...)) ...)]
[xs (or (apply f xs) ...)]
#:keyword
[(keys vals . args)
(or (keyword-apply f keys vals args) ...)])]
(begin
(for ([f* (in-list (list f ...))])
(unless (procedure? f*)
(raise-argument-error 'conjoin "procedure?" f*)))
(make-intermediate-procedure
'disjoined
[(x (... ...) 2) (or (f x (... ...)) ...)]
[xs (or (apply f xs) ...)]
#:keyword
[(keys vals . args)
(or (keyword-apply f keys vals args) ...)]))]
[fs
(make-intermediate-procedure
'disjoined
[(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)])]))
(begin
(for ([f* (in-list fs)])
(unless (procedure? f*)
(raise-argument-error 'conjoin "procedure?" f*)))
(make-intermediate-procedure
'disjoined
[(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)
(syntax-case stx [quote]