bug#40584: R7RS string-for-each does not work two or more strings on its argument

[Taylan Kammer]

Attached is a simple patch to use Mark's implementation
within the current (scheme base) module.

- Taylan
From dda2aaaf0e9064f11d89a83f55340ba0c0115bca Mon Sep 17 00:00:00 2001
From: Taylan Kammer 
Date: Wed, 12 May 2021 22:36:26 +0200
Subject: [PATCH] Fix (scheme base) string-for-each.

* module/scheme/base.scm (r7:string-for-each): New procedure.

Fixes .
---
 module/scheme/base.scm | 26 --
 1 file changed, 24 insertions(+), 2 deletions(-)

diff --git a/module/scheme/base.scm b/module/scheme/base.scm
index 20e280467..58d5acc74 100644
--- a/module/scheme/base.scm
+++ b/module/scheme/base.scm
@@ -51,6 +51,7 @@
 open-output-bytevector get-output-bytevector
 peek-u8 read-u8 read-bytevector read-bytevector!
 read-string read-line
+(r7:string-for-each . string-for-each)
 write-u8 write-bytevector write-string flush-output-port
 (r7:string-map . string-map)
 bytevector bytevector-append
@@ -108,7 +109,7 @@
real? remainder reverse round set!
set-car! set-cdr! string string->list string->number
string->symbol string-append
-   string-copy string-copy! string-fill! string-for-each
+   string-copy string-copy! string-fill!
string-length string-ref string-set! string<=? string=? string>? string? substring symbol->string
symbol? syntax-error syntax-rules truncate
@@ -403,7 +404,28 @@
 (define (r7:string-map proc s . s*)
   (if (null? s*)
   (string-map proc s)
-  (list->string (apply map proc (string->list s) (map string->list s*)
+  (list->string (apply map proc (string->list s) (map string->list
+  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
 
 (define (bytevector . lis)
   (u8-list->bytevector lis))
-- 
2.30.2

bug#40584: R7RS string-for-each does not work two or more strings on its argument

[OKUMURA Yuki]

Hi,

Actually it's my own bug but let me report here: (scheme base) lacks
implementation for string-for-each thus following code does not work;

(import (scheme base))

(string-for-each
  (lambda (e f) 'ok)
  "01234"
  "slas")

Please note that we already have incompatible string-for-each for
SRFI-13 and R6RS.
(It seems current (scheme base) uses SRFI-13 one)
R7RS for-each (and map) procedures allow different length of
collection as arguments.

Checked on 2b4e45ca1b89a942200b7b9f46060dddc44d2876