mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Add test for r7rs string-for-each

Browse source 
* test-suite/tests/r7rs.test: As stated.
* module/scheme/base.scm: Reindent and add minimal doc.
This commit is contained in:
Daniel Llorens 2023-09-29 16:49:57 +02:00
parent 3243d96bb5
commit 4daf4664cf
2 changed files with 27 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

37
module/scheme/base.scm
View file

@ -406,24 +406,25 @@
s*)))))
(define r7:string-for-each
(case-lambda
((proc s) (string-for-each proc s))
((proc s1 s2)
(let ((len (min (string-length s1)
(string-length s2))))
(let loop ((i 0))
(when (< i len)
(proc (string-ref s1 i)
(string-ref s2 i))
(loop (+ i 1))))))
((proc . strings)
(let ((len (apply min (map string-length strings))))
(let loop ((i 0))
(when (< i len)
(apply proc (map (lambda (s)
(string-ref s i))
strings))
(loop (+ i 1))))))))
(case-lambda
"Like @code{for-each}, but takes strings instead of lists."
((proc s) (string-for-each proc s))
((proc s1 s2)
(let ((len (min (string-length s1)
(string-length s2))))
(let loop ((i 0))
(when (< i len)
(proc (string-ref s1 i)
(string-ref s2 i))
(loop (+ i 1))))))
((proc . strings)
(let ((len (apply min (map string-length strings))))
(let loop ((i 0))
(when (< i len)
(apply proc (map (lambda (s)
(string-ref s i))
strings))
(loop (+ i 1))))))))
(define (bytevector . lis)
(u8-list->bytevector lis))

8
test-suite/tests/r7rs.test
View file

@ -1773,6 +1773,14 @@
"abcde")
v))
(test '(4 3 2 1)
(let ((v '()))
(string-for-each
(lambda (b c) (set! v (cons (- (char->integer b) (char->integer c)) v)))
"bdfh"
"abcde")
v))
(test '(0 1 4 9 16) (let ((v (make-list 5)))
(vector-for-each
(lambda (i) (list-set! v i (* i i)))