Add 'for' iterator and 'if-let' syntax

This commit is contained in:
Dane Johnson 2024-11-01 18:05:27 -05:00
parent 779bc50a77
commit 56594fd146
2 changed files with 37 additions and 6 deletions

30
d-.scm
View File

@ -5,21 +5,23 @@
~>>
if-not
when-not
if-let
for
partial
argmin
make-generator))
(define-syntax ~>
(syntax-rules ()
[(_ v) v]
[(_ v (fn args ...) more ...) (~> (fn v args ...) more ...)]
[(_ v fn more ...) (~> (fn v) more ...)]))
[(~> v) v]
[(~> v (fn args ...) more ...) (~> (fn v args ...) more ...)]
[(~> v fn more ...) (~> (fn v) more ...)]))
(define-syntax ~>>
(syntax-rules ()
[(_ v) v]
[(_ v (fn args ...) more ...) (~>> (fn args ... v) more ...)]
[(_ v fn more ...) (~>> (fn v) more ...)]))
[(~>> v) v]
[(~>> v (fn args ...) more ...) (~>> (fn args ... v) more ...)]
[(~>> v fn more ...) (~>> (fn v) more ...)]))
(define-syntax-rule (if-not pred body ...)
(if (not pred) body ...))
@ -27,6 +29,22 @@
(define-syntax-rule (when-not pred body ...)
(when (not pred) body ...))
(define-syntax-rule (if-let ([ident test]) expr ...)
(let ([ident test])
(if ident
(begin expr ...)
#f)))
(define-syntax for
(syntax-rules ()
[(for () expr ...) (list (begin expr ...))]
[(for ([ident lst] bindings ...) expr ...)
(let iter ([rest lst])
(if (pair? rest)
(let ([ident (car rest)])
(append (for (bindings ...) expr ...) (iter (cdr rest))))
'()))]))
(define (partial fn . args)
(lambda x (apply fn (append args x))))

View File

@ -32,6 +32,19 @@
(negative-case
(assert (unspecified? (when-not #t 'do-some-stuff 'return)))))
(define-test for
(permutation
(define value (for ([i (iota 2)]
[j (iota 2)])
(cons i j)))
(assert (equal? value '((0 . 0) (0 . 1) (1 . 0) (1 . 1))))))
(define-test if-let
(positive-case
(assert (= (if-let ([v (or #f 1)]) (+ v 1)) 2)))
(negative-case
(assert (not (if-let ([v (and #f 1)]) (+ v 1))))))
(define-test partial
(test
(define value (partial / 2))