mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-07-08 21:47:33 +02:00
Making string-fold/for-each/map n-ary.
This commit is contained in:
parent
ed4907e19a
commit
fa7a567458
1 changed files with 34 additions and 15 deletions
|
@ -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)
|
||||||
(let ((end (string-cursor-end str)))
|
(if (null? los)
|
||||||
(let lp ((i (string-cursor-start str)) (acc knil))
|
(let ((end (string-cursor-end str)))
|
||||||
(if (string-cursor>=? i end)
|
(let lp ((i (string-cursor-start str)) (acc knil))
|
||||||
acc
|
(if (string-cursor>=? i end)
|
||||||
(lp (string-cursor-next str i)
|
acc
|
||||||
(kons (string-cursor-ref str i) acc))))))
|
(lp (string-cursor-next str i)
|
||||||
|
(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)))
|
||||||
|
|
Loading…
Add table
Reference in a new issue