Add iterate and macro-expand
This commit is contained in:
parent
7ba64111ba
commit
e6209fa8a4
21
d-.scm
21
d-.scm
@ -1,15 +1,19 @@
|
|||||||
(define-module (d-)
|
(define-module (d-)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
|
#:use-module (language tree-il)
|
||||||
#:export
|
#:export
|
||||||
(~>
|
(~>
|
||||||
~>>
|
~>>
|
||||||
|
as~>
|
||||||
if-not
|
if-not
|
||||||
when-not
|
when-not
|
||||||
if-let
|
if-let
|
||||||
for
|
for
|
||||||
partial
|
partial
|
||||||
argmin
|
argmin
|
||||||
generator))
|
iterate
|
||||||
|
generator
|
||||||
|
macro-expand))
|
||||||
|
|
||||||
(define-syntax ~>
|
(define-syntax ~>
|
||||||
(syntax-rules ()
|
(syntax-rules ()
|
||||||
@ -23,6 +27,13 @@
|
|||||||
[(~>> 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 as~>
|
||||||
|
(syntax-rules ()
|
||||||
|
[(_ as v) v]
|
||||||
|
[(_ as v (fn args ...) more ...)
|
||||||
|
(let [(as v)]
|
||||||
|
(as~> as (fn args ...) more ...))]))
|
||||||
|
|
||||||
(define-syntax-rule (if-not pred body ...)
|
(define-syntax-rule (if-not pred body ...)
|
||||||
(if (not pred) body ...))
|
(if (not pred) body ...))
|
||||||
|
|
||||||
@ -56,6 +67,11 @@
|
|||||||
#f
|
#f
|
||||||
vals))
|
vals))
|
||||||
|
|
||||||
|
(define (iterate n f v)
|
||||||
|
(if (zero? n)
|
||||||
|
v
|
||||||
|
(iterate (1- n) f (f v))))
|
||||||
|
|
||||||
;; Shamelessly ripped from https://wingolog.org/archives/2013/02/25/on-generators
|
;; Shamelessly ripped from https://wingolog.org/archives/2013/02/25/on-generators
|
||||||
(define (make-generator f)
|
(define (make-generator f)
|
||||||
(define tag (make-prompt-tag))
|
(define tag (make-prompt-tag))
|
||||||
@ -76,3 +92,6 @@
|
|||||||
#'(make-generator
|
#'(make-generator
|
||||||
(lambda (yield)
|
(lambda (yield)
|
||||||
expr ...)))])))
|
expr ...)))])))
|
||||||
|
|
||||||
|
;; Why wasn't this included?
|
||||||
|
(define macro-expand (compose tree-il->scheme macroexpand))
|
||||||
|
13
test.scm
13
test.scm
@ -18,6 +18,14 @@
|
|||||||
(define value (~>> 1 (/ 2) (/ 2)))
|
(define value (~>> 1 (/ 2) (/ 2)))
|
||||||
(assert-equal 1 value)))
|
(assert-equal 1 value)))
|
||||||
|
|
||||||
|
(define-test-suite "as~>"
|
||||||
|
(define-test "switch sides"
|
||||||
|
(define value (as~> % 'apples (cons % '()) (cons 'pears %)))
|
||||||
|
(assert-equal '(pears apples) value))
|
||||||
|
(define-test "middle argument"
|
||||||
|
(define value (as~> % '((apples . pears)) (assoc 'apples % equal?)))
|
||||||
|
(assert-equal '(apples . pears) value)))
|
||||||
|
|
||||||
(define-test-suite "if-not"
|
(define-test-suite "if-not"
|
||||||
(define-test "test"
|
(define-test "test"
|
||||||
(assert-equal 'a (if-not #f 'a 'b))))
|
(assert-equal 'a (if-not #f 'a 'b))))
|
||||||
@ -51,6 +59,11 @@
|
|||||||
(define-test "test"
|
(define-test "test"
|
||||||
(assert-equal '(b . 2) (argmin cdr < '(a . 5) '(b . 2) '(c . 3)))))
|
(assert-equal '(b . 2) (argmin cdr < '(a . 5) '(b . 2) '(c . 3)))))
|
||||||
|
|
||||||
|
(define-test-suite "iterate"
|
||||||
|
(define-test "test"
|
||||||
|
(define value (iterate 2 1+ 3))
|
||||||
|
(assert-equal 5 value)))
|
||||||
|
|
||||||
(define-test-suite "generator"
|
(define-test-suite "generator"
|
||||||
(define-test "test"
|
(define-test "test"
|
||||||
(define number-generator
|
(define number-generator
|
||||||
|
Loading…
Reference in New Issue
Block a user