Add 'for' iterator and 'if-let' syntax
This commit is contained in:
parent
779bc50a77
commit
56594fd146
30
d-.scm
30
d-.scm
@ -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))))
|
||||||
|
|
||||||
|
13
test.scm
13
test.scm
@ -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))
|
||||||
|
Loading…
Reference in New Issue
Block a user