From e3ddf82f1ed8abbca9de770cfabda0fd03d95084 Mon Sep 17 00:00:00 2001 From: Leah Neukirchen Date: Mon, 2 Jan 2023 19:31:49 +0100 Subject: add repeat --- mew.scm | 17 ++++++++++++++++- mew.svnwiki | 4 ++++ tests/test.mew | 11 +++++++++++ 3 files changed, 31 insertions(+), 1 deletion(-) diff --git a/mew.scm b/mew.scm index f170273..7de52f0 100644 --- a/mew.scm +++ b/mew.scm @@ -17,7 +17,7 @@ negate nth-accumulator odometer one-of op op* per pop! prn proj push! puts - rand range rep + rand range rep repeat sample scan scan-right sing? search seq set set-at sgn shuffle shuffle! str slurp tally-accumulator tbl time @@ -46,6 +46,7 @@ (chicken random) (chicken repl) (chicken syntax) + utf8-srfi-13 srfi-17 (rename (srfi-69) (hash-table-keys keys) @@ -1280,6 +1281,20 @@ (list knil) lists)) + (define (repeat o n) + (cond ((list? o) (concatenate (make-list n o))) + ((vector? o) (let* ((l (vector-length o)) + (size (* l n)) + (v (make-vector size))) + (let loop ((i 0)) + (when (< i size) + (vector-set! v i (vector-ref o (mod i l))) + (loop (+ i 1)))) + v)) + ((string? o) (string-concatenate (repeat (list o) n))) + ((char? o) (make-string n o)) + (#t (error "no repeat defined")))) + (let ((old-repl-prompt (repl-prompt))) (repl-prompt (lambda () (let ((old-prompt (old-repl-prompt))) diff --git a/mew.svnwiki b/mew.svnwiki index 92ed78d..dce8f34 100644 --- a/mew.svnwiki +++ b/mew.svnwiki @@ -422,6 +422,10 @@ in the sequence {{}}, starting no earlier than {{>}} (default: 0). Returns false if the sequence cannot be found. +(repeat ) + +Repeat the list/vector/string/char {{}} {{}} times. + == Generators and Accumulators diff --git a/tests/test.mew b/tests/test.mew index d2eacbd..96f0764 100644 --- a/tests/test.mew +++ b/tests/test.mew @@ -718,3 +718,14 @@ (test 42 (imp #t #t #t 42)) (test 42 (imp 39 40 41 42)) (test #t (imp 39 #f 41 42))) + +(test-group "repeat" + (test '(1 2 3 1 2 3 1 2 3 1 2 3) (repeat '(1 2 3) 4)) + (test #(1 2 3 1 2 3 1 2 3 1 2 3) (repeat #(1 2 3) 4)) + (test "123123123123" (repeat "123" 4)) + (test "xxxx" (repeat #\x 4)) + + (test '() (repeat '(1 2 3) 0)) + (test #() (repeat #(1 2 3) 0)) + (test "" (repeat "123" 0)) + (test "" (repeat #\x 0))) -- cgit 1.4.1