diff options
| author | Leah Neukirchen <leah@vuxu.org> | 2022-11-03 20:44:43 +0100 |
|---|---|---|
| committer | Leah Neukirchen <leah@vuxu.org> | 2022-11-03 20:44:43 +0100 |
| commit | 121afda5a559ed39c42060697fe39e736e3383d9 (patch) | |
| tree | 7e8de1f889d18bdc95e5dcaac69fd5dbb054c11e | |
| parent | 94846eb7cf636276d7f177dc54387162d2593812 (diff) | |
| download | mew-121afda5a559ed39c42060697fe39e736e3383d9.tar.gz mew-121afda5a559ed39c42060697fe39e736e3383d9.tar.xz mew-121afda5a559ed39c42060697fe39e736e3383d9.zip | |
reimplement range to allow negative step
| -rw-r--r-- | mew.scm | 15 | ||||
| -rw-r--r-- | mew.svnwiki | 4 | ||||
| -rw-r--r-- | tests/test.mew | 5 |
3 files changed, 19 insertions, 5 deletions
diff --git a/mew.scm b/mew.scm index 4fe649d..78c6558 100644 --- a/mew.scm +++ b/mew.scm @@ -16,7 +16,7 @@ negate one-of op op* per prn puts - rep + range rep sing? set set-at str slurp tally-accumulator tbl time while @@ -52,7 +52,6 @@ (reexport srfi-158) (reexport (rename (srfi-158) - (make-range-generator range) (circular-generator cycle))) (reexport matchable) (reexport @@ -337,6 +336,18 @@ (define (void? x) (eq? x (void))) + (define range + (case-lambda + ((start) (make-range-generator start +inf.0 1)) + ((start end) (make-range-generator start end 1)) + ((start end step) (set! start (- (+ start step) step)) + (let ((cmp (if (>= step 0) < >))) + (lambda () (if (cmp start end) + (let ((v start)) + (set! start (+ start step)) + v) + (eof))))))) + (define (gconcatenate gen) (let ((gen2 #f)) (lambda () diff --git a/mew.svnwiki b/mew.svnwiki index 91f435e..a4916ef 100644 --- a/mew.svnwiki +++ b/mew.svnwiki @@ -309,9 +309,9 @@ Generic generator for list/vector/string/hash-table/generator. Alias for {{circular-generator}}. -<procedure>(range <val>...)</procedure> +<procedure>(range <start> <end>? <step>?)</procedure> -Alias for {{make-range-generator}}. +A variant of {{make-range-generator}} that also allows negative {{step}}. <procedure>(giterate <fun> <val>)</procedure> diff --git a/tests/test.mew b/tests/test.mew index 311db5a..82c793a 100644 --- a/tests/test.mew +++ b/tests/test.mew @@ -28,7 +28,10 @@ (test '() (into '() (range 4 1))) (test '(1 3 5) (into '() (range 1 6 2))) (test '(1 3 5) (into '() (range 1 7 2))) - (test '(2 3 4) (into '() (gtake (range 2) 3)))) + (test '(3 2 1) (into '() (range 3 0 -1))) + (test '(2 3 4) (into '() (gtake (range 2) 3))) + (test '(1 3/2 2 5/2) (into '() (gtake (range 1 +inf.0 1/2) 4))) + (test '(1 1 1 1) (into '() (gtake (range 1 +inf.0 0) 4)))) (test-group "cycle" (test '(1 2 3 1 2 3) (into '() (gtake (cycle 1 2 3) 6))) |