diff --git a/d-.scm b/d-.scm index 387c2d8..b82b505 100644 --- a/d-.scm +++ b/d-.scm @@ -1,15 +1,19 @@ (define-module (d-) #:use-module (srfi srfi-1) + #:use-module (language tree-il) #:export (~> ~>> + as~> if-not when-not if-let for partial argmin - generator)) + iterate + generator + macro-expand)) (define-syntax ~> (syntax-rules () @@ -23,6 +27,13 @@ [(~>> v (fn args ...) more ...) (~>> (fn args ... 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 ...) (if (not pred) body ...)) @@ -56,6 +67,11 @@ #f 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 (define (make-generator f) (define tag (make-prompt-tag)) @@ -76,3 +92,6 @@ #'(make-generator (lambda (yield) expr ...)))]))) + +;; Why wasn't this included? +(define macro-expand (compose tree-il->scheme macroexpand)) diff --git a/test.scm b/test.scm index 9884747..8df0b51 100644 --- a/test.scm +++ b/test.scm @@ -18,6 +18,14 @@ (define value (~>> 1 (/ 2) (/ 2))) (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 "test" (assert-equal 'a (if-not #f 'a 'b)))) @@ -51,6 +59,11 @@ (define-test "test" (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 "test" (define number-generator