From Newsgroup: comp.lang.scheme
B. Pym wrote:
fireblade wrote:
Any nice way of replacing substrings, i'm currently using below
it works but it's discusting :
(defun substring-replace (new old text )
(let ((res "") (now 0)
(old-length (length old))
(text-length (length text)))
(loop
(if (> (+ now old-length) text-length)
(progn
(if (< now text-length)
(setq res
(concatenate 'string res
(subseq text now))))
(return res))
(if (string= old
(subseq text now (+ now old-length)))
(progn
(setq res
(concatenate 'string res new))
(incf now old-length))
(progn
(setq res
(concatenate 'string res
(subseq text now (1+ now))))
(incf now)))))))
Gauche Scheme
(use srfi-13) ;; String functions.
(define (gsub old new text :optional (start 0) (accum '()))
(let1 p (string-contains text old start)
(if p
(gsub old new text
(+ p (string-length old))
(cons* new (string-copy text start p) accum))
(string-concatenate
(reverse (cons (string-copy text start) accum))))))
If the function "string-contains" isn't available,
this can be used.
(define (string-contains text str :optional (start 0))
(let1 len-str (string-length str)
(do ((i start (+ i 1))
(end (- (string-length text) len-str))
(found #f
(if (string= str (substring text i (+ i len-str)))
i #f)))
((or found (> i end)) found))))
As an exercise, I wrote a version using a record (structure).
(use gauche.record)
(define-record-type ssub #t #t
text old new
(start)
(accum)
(result))
(use srfi-13) ;; String functions.
To access the fields, I used "~", which in Gauche Scheme
is the "universal accessor".
(define (process-ssub ss)
(unless (~ ss 'result)
(let ((text (~ ss 'text))
(old (~ ss 'old)))
(if (>= (~ ss 'start) (string-length text))
(set! (~ ss 'result) (string-concatenate-reverse (~ ss 'accum)))
(let1 found (string-contains text old (~ ss 'start))
(if found
(begin
(push! (~ ss 'accum)
(substring text (~ ss 'start) found))
(push! (~ ss 'accum) (~ ss 'new))
(set! (~ ss 'start) (+ found (string-length old))))
(begin
(push! (~ ss 'accum)
(string-copy text (~ ss 'start)))
(set! (~ ss 'start) +inf.0))))))))
(define (gsub old new text)
(let1 ss (make-ssub text old new 0 '() #f)
(until (~ ss 'result) (process-ssub ss))
(~ ss 'result)))
(gsub "oo" "o" "Too moove the furniture, he droove a truck.")
===>
"To move the furniture, he drove a truck."
--
[T]he problem is that lispniks are as cultish as any other devout group and basically fall down frothing at the mouth if they see [heterodoxy].
--- Kenny Tilton
The good news is, it's not Lisp that sucks, but Common Lisp. --- Paul Graham --- Synchronet 3.21a-Linux NewsLink 1.2