if-not and when-not
This commit is contained in:
parent
f3d47afc5f
commit
d9081bcffb
8
d-.scm
8
d-.scm
@ -3,6 +3,8 @@
|
|||||||
#:export
|
#:export
|
||||||
(~>
|
(~>
|
||||||
~>>
|
~>>
|
||||||
|
if-not
|
||||||
|
when-not
|
||||||
partial
|
partial
|
||||||
argmin))
|
argmin))
|
||||||
|
|
||||||
@ -18,6 +20,12 @@
|
|||||||
[(_ v (fn args ...) more ...) (~> (fn args ... v) more ...)]
|
[(_ v (fn args ...) more ...) (~> (fn args ... v) more ...)]
|
||||||
[(_ v fn more ...) (~> (fn v) more ...)]))
|
[(_ v fn more ...) (~> (fn v) more ...)]))
|
||||||
|
|
||||||
|
(define-syntax-rule (if-not pred body ...)
|
||||||
|
(if (not pred) body ...))
|
||||||
|
|
||||||
|
(define-syntax-rule (when-not pred body ...)
|
||||||
|
(when (not pred) body ...))
|
||||||
|
|
||||||
(define (partial fn . args)
|
(define (partial fn . args)
|
||||||
(lambda x (apply fn (append args x))))
|
(lambda x (apply fn (append args x))))
|
||||||
|
|
||||||
|
9
test.scm
9
test.scm
@ -23,6 +23,15 @@
|
|||||||
(define value (~>> 1 (/ 2) (/ 2)))
|
(define value (~>> 1 (/ 2) (/ 2)))
|
||||||
(assert (= value 1))))
|
(assert (= value 1))))
|
||||||
|
|
||||||
|
(define-test if-not
|
||||||
|
(assert (eq? (if-not #f 'a 'b) 'a)))
|
||||||
|
|
||||||
|
(define-test when-not
|
||||||
|
(positive-case
|
||||||
|
(assert (eq? (when-not #f 'do-some-stuff 'return) 'return)))
|
||||||
|
(negative-case
|
||||||
|
(assert (unspecified? (when-not #t 'do-some-stuff 'return)))))
|
||||||
|
|
||||||
(define-test partial
|
(define-test partial
|
||||||
(test
|
(test
|
||||||
(define value (partial / 2))
|
(define value (partial / 2))
|
||||||
|
Loading…
Reference in New Issue
Block a user