Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-08 13:37:35 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

Making string-fold/for-each/map n-ary.

Browse source
This commit is contained in:
Alex Shinn 2012-06-23 22:30:35 -07:00
parent ed4907e19a
commit fa7a567458
1 changed files with 34 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

39
lib/chibi/strings.scm
View file

@ -119,13 +119,24 @@
(- (string-mismatch-right suffix str) (- (string-mismatch-right suffix str)
(- (string-cursor-end str) (string-cursor-end suffix))))) (- (string-cursor-end str) (string-cursor-end suffix)))))
(define (string-fold kons knil str) (define (string-fold kons knil str . los)
(if (null? los)
(let ((end (string-cursor-end str))) (let ((end (string-cursor-end str)))
(let lp ((i (string-cursor-start str)) (acc knil)) (let lp ((i (string-cursor-start str)) (acc knil))
(if (string-cursor>=? i end) (if (string-cursor>=? i end)
acc acc
(lp (string-cursor-next str i) (lp (string-cursor-next str i)
(kons (string-cursor-ref str i) acc)))))) (kons (string-cursor-ref str i) acc)))))
(let ((los (cons str los)))
(let lp ((is (map string-cursor-start los))
(acc knil))
(if (any (lambda (str i)
(string-cursor>=? i (string-cursor-end str)))
los is)
acc
(lp (map string-cursor-next los is)
(apply kons (append (map string-cursor-ref los is)
(list acc)))))))))
(define (string-fold-right kons knil str) (define (string-fold-right kons knil str)
(let ((end (string-cursor-end str))) (let ((end (string-cursor-end str)))
@ -138,17 +149,25 @@
(let ((pred (make-char-predicate x))) (let ((pred (make-char-predicate x)))
(string-fold (lambda (ch count) (if (pred ch) (+ count 1) count)) 0 str))) (string-fold (lambda (ch count) (if (pred ch) (+ count 1) count)) 0 str)))
(define (string-for-each proc str) (define (string-for-each proc str . los)
(let ((end (string-cursor-end str))) (if (null? los)
(let lp ((i (string-cursor-start str))) (string-fold (lambda (ch a) (proc ch)) #f str)
(cond ((string-cursor<? i end) (let ((los (cons str los)))
(proc (string-cursor-ref str i)) (let lp ((is (map string-cursor-start los)))
(lp (string-cursor-next str i))))))) (cond
((any (lambda (str i)
(string-cursor>=? i (string-cursor-end str)))
los is))
(else
(apply proc (map string-cursor-ref los is))
(lp (map string-cursor-next los is))))))))
(define (string-map proc str) (define (string-map proc str . los)
(call-with-output-string (call-with-output-string
(lambda (out) (lambda (out)
(string-for-each (lambda (ch) (write-char (proc ch) out)) str)))) (apply string-for-each
(lambda args (write-char (apply proc args) out))
str los))))
(define (make-string-searcher needle) (define (make-string-searcher needle)
(lambda (haystack) (string-contains haystack needle))) (lambda (haystack) (string-contains haystack needle)))