mes: Add string-fold, string-fold-right.
[mes.git] / module / srfi / srfi-13.mes
index 6621b54c59735f2f18374e2e8ede32ae96c135c0..4e77bd0ef61a5c940b06a1be0994bce2bad7538f 100644 (file)
 (define substring/shared substring)
 
 (define string-null? (compose null? string->list))
+
+(define (string-fold cons' nil' s . rest)
+  (let* ((start (and (pair? rest) (car rest)))
+         (end (and start (pair? (cdr rest)) (cadr rest))))
+    (if start (error "string-fold: not supported: start=" start))
+    (if end (error "string-fold: not supported: end=" end))
+    (let loop ((lst (string->list s)) (prev nil'))
+      (if (null? lst) prev
+          (loop (cdr lst) (cons' (car lst) prev))))))
+
+(define (string-fold-right cons' nil' s . rest)
+  (let* ((start (and (pair? rest) (car rest)))
+         (end (and start (pair? (cdr rest)) (cadr rest))))
+    (if start (error "string-fold-right: not supported: start=" start))
+    (if end (error "string-fold-right: not supported: end=" end))
+    (let loop ((lst (reverse (string->list s))) (prev nil'))
+      (if (null? lst) prev
+          (loop (cdr lst) (cons' (car lst) prev))))))