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 if-not
when-not when-not
if-let
for
partial partial
argmin argmin
make-generator)) make-generator))
(define-syntax ~> (define-syntax ~>
(syntax-rules () (syntax-rules ()
[(_ v) v] [(~> v) v]
[(_ v (fn args ...) more ...) (~> (fn v args ...) more ...)] [(~> v (fn args ...) more ...) (~> (fn v args ...) more ...)]
[(_ v fn more ...) (~> (fn v) more ...)])) [(~> v fn more ...) (~> (fn v) more ...)]))
(define-syntax ~>> (define-syntax ~>>
(syntax-rules () (syntax-rules ()
[(_ v) v] [(~>> v) v]
[(_ 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 ...) (define-syntax-rule (if-not pred body ...)
(if (not pred) body ...)) (if (not pred) body ...))
@ -27,6 +29,22 @@
(define-syntax-rule (when-not pred body ...) (define-syntax-rule (when-not pred body ...)
(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) (define (partial fn . args)
(lambda x (apply fn (append args x)))) (lambda x (apply fn (append args x))))

View File

@ -32,6 +32,19 @@
(negative-case (negative-case
(assert (unspecified? (when-not #t 'do-some-stuff 'return))))) (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 (define-test partial
(test (test
(define value (partial / 2)) (define value (partial / 2))