if-not and when-not

This commit is contained in:
Dane Johnson 2024-10-25 15:48:01 -05:00
parent f3d47afc5f
commit d9081bcffb
2 changed files with 17 additions and 0 deletions

8
d-.scm
View File

@ -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))))

View File

@ -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))