Hello, Manuel,
Text manipulation tasks requiring the appending of many strings, for example a
templating system, can be painfully slow using Bigloo's string procedures.
Could we get something similar to the attached string-builder module added to
the Bigloo standard library or possibly the Text api. It is similar to the
StringBuilder classes found in Java and .Net. It supports the following api
make-string-builder #!optional init-capacity create a string-builder with an
initial capacity of init-capacity or +minimum-string-builder-capacity+ if not
provided
string-builder #!rest strs create a string-builder containing the
concatentation of all the strings in strs
string-builder-length sb return the length of the string maintained by sb
string-builder-capacity sb return the capacity of the string-builder sb
string-builder-ensure-capacity! capacity make sure capacity of the
string-builder is at leaset capacity
string-builder-reset! sb make the string managed by sb the empty string
string-builder-ref sb index return the charater at index or throw an error
if index is invalid
string-builder-set! sb index ch set the value at index to ch or throw an if
index is invalid
string-builder-append! sb #!rest strs append all of the strings in strs to
the string managed by sb
string-builder-append-char! sb #!rest chars append all of the characters in
chars to the string managed by sb
string-builder->string sb
return a copy of the string managed by string-builder
string-builder->substring sb start #!optional (end #f) return the substring
of the string managed by sb starting at start and ending at end. If end is #f,
end is the end of the string managed by sb.
The modules contains some tests that can be run if you have the btest libary
and compile the module with: bigloo -library btests string-buffer.scmand run
the result.
btest can be found at donaldsonjw/btest.
|
|
|
| | |
|
|
|
| |
donaldsonjw/btest
btest - A Simple Testing Library for Bigloo
|
|
|
Best Regards,Joseph Donaldson
(module string-builder
(export
(class %string-builder
str
length)
(string-builder #!rest strs)
(string-builder->string builder::%string-builder)
(make-string-builder #!optional (init-capacity +minimum-string-builder-capacity+))
+minimum-string-builder-capacity+
(string-builder-set! builder::%string-builder index ch)
(string-builder-ref builder::%string-builder index)
(string-builder-capacity builder::%string-builder)
(string-builder-length builder::%string-builder)
(string-builder-append! builder::%string-builder #!rest strs)
(string-builder-ensure-capacity! builder::%string-builder capacity)
(string-builder-reset! builder::%string-builder)))
(define +minimum-string-builder-capacity+ 16)
(define (string-builder? obj)
(isa? obj %string-builder))
(define (make-string-builder #!optional (init-capacity +minimum-string-builder-capacity+))
(if (>= init-capacity 0)
(instantiate::%string-builder (str (make-string (if (< init-capacity +minimum-string-builder-capacity+)
+minimum-string-builder-capacity+
init-capacity)))
(length 0))
(error "make-string-builder" "initialize capacity must be positive" init-capacity)))
(define (fold proc seed lst)
(if (pair? lst)
(fold proc (proc seed (car lst)) (cdr lst))
seed))
(define (strs-length strs)
(fold (lambda (s v) (+ s (string-length v))) 0
strs))
(define (string-builder #!rest strs)
(if (every string? strs)
(let* ((len (strs-length strs))
(builder (make-string-builder len)))
(apply string-builder-append! (cons builder strs))
builder)
(error "string-builder" "all arguments must be strs" strs)))
(define (string-builder-expand! builder::%string-builder at-least-n)
(let* ((new-size (let loop ((ns (* 2 (string-length (-> builder str)))))
(if (>= ns at-least-n)
ns
(loop (* 2 ns)))))
(new-str (make-string new-size)))
(blit-string! (-> builder str) 0 new-str 0 (-> builder length))
(set! (-> builder str) new-str)))
(define (string-builder-ensure-capacity! builder::%string-builder capacity)
(if (> capacity 0)
(begin
(when (< (string-builder-capacity builder)
capacity)
(string-builder-expand! builder capacity))
(string-builder-capacity builder))
(error "string-builder-ensure-capacity!" "capacity must be positive" capacity)))
(define (string-builder-reset! builder::%string-builder)
(set! (-> builder length) 0))
(define (string-builder-append! builder::%string-builder #!rest strs)
(if (every string? strs)
(let ((len (strs-length strs)))
(when (>= (+ (-> builder length) len)
(string-length (-> builder str)))
(string-builder-expand! builder (+ (-> builder length) len)))
(do ((str strs (cdr str))
(blen (-> builder length) (+ blen (string-length (car str)))))
((null? str))
(blit-string! (car str) 0 (-> builder str) blen (string-length (car str))))
(set! (-> builder length) (+ (-> builder length) len)))
(error "string-builder-append!" "invalid arguments" strs)))
(define (string-builder-append-char! builder::%string-builder #!rest chars)
(if (every char? chars)
(let ((len (length chars)))
(when (>= (+ (-> builder length) len)
(string-length (-> builder str)))
(string-builder-expand! builder (+ (-> builder length) len)))
(do ((ch chars (cdr ch))
(blen (-> builder length) (+ blen 1)))
((null? ch))
(string-set! (-> builder str) blen (car ch)))
(set! (-> builder length) (+ (-> builder length) len)))
(error "string-builder-append-char!" "invalid arguments" chars)))
(define (string-builder-ref builder::%string-builder index)
(if (and (>= index 0)
(< index (-> builder length)))
(string-ref (-> builder str) index)
(error "string-builder-ref" "index out of bounds" index)))
(define (string-builder-set! builder::%string-builder index ch)
(if (and (>= index 0)
(< index (-> builder length))
(char? ch))
(string-set! (-> builder str) index ch)
(error "string-builder-set!" "invalid arguments" (list index ch))))
(define (string-builder-capacity builder::%string-builder)
(string-length (-> builder str)))
(define (string-builder-length builder::%string-builder)
(-> builder length))
(define (string-builder->string builder::%string-builder)
(substring (-> builder str) 0 (-> builder length)))
(define (string-builder->substring builder::%string-builder start #!optional (end #f))
(if (and (>= start 0)
(< start (-> builder length))
(or (not end)
(and (>= end 0)
(<= end (-> builder length)))))
(substring (-> builder str) start (if end end (-> builder length)))
(error "string-builder->substring" "invalid arguments" (list start end))))
(cond-expand
(btest
(define-test-suite +string-builder-test-suite+
(test "string-builder? works"
(assert-true (string-builder? (make-string-builder)))
(assert-true (string-builder? (string-builder)))
(assert-false (string-builder? "sdfds")))
(test "make-string-builder with no args works"
(let ((sb (make-string-builder)))
(assert-true (string-builder? sb))
(assert-equal? (string-builder-capacity sb) 16)))
(test "make-string-builder with an initial capacity works"
(let ((sb (make-string-builder 32)))
(assert-true (string-builder? sb))
(assert-equal? (string-builder-capacity sb) 32)))
(test "make-string-builder with invalid capacity throws an error"
(assert-exception-thrown (make-string-builder -1) &error))
(test "string-builder with initial strings works"
(let ((sb (string-builder "dog" "cat" "horse")))
(assert= (string-builder-length sb) 11)
(assert-equal? (string-builder->string sb) "dogcathorse")))
(test "string-builder-capacity works"
(let ((sb (make-string-builder)))
(string-builder-append! sb "wrenwrenwrenwren+2")
(assert= (string-builder-capacity sb) 32)))
(test "string-builder-ensure-capacity! works"
(let ((sb (make-string-builder)))
(string-builder-ensure-capacity! sb 32)
(assert= (string-builder-capacity sb) 32)))
(test "string-builder-length works"
(let ((sb (string-builder "dog" "cat" "horse" "pig")))
(assert= (string-builder-length sb) 14)
(assert= (string-length (string-builder->string sb)) 14)))
(test "string-builder-append! works"
(let ((sb (make-string-builder)))
(string-builder-append! sb "dog" "cat" "dog" "cat" "dog" "cat" "dog" "cat")
(assert-equal? (string-builder-length sb) 24)
(assert-equal? (string-builder->string sb) "dogcatdogcatdogcatdogcat")))
(test "string-builder-append! works with no str arguments"
(let ((sb (make-string-builder)))
(string-builder-append! sb)
(assert= (string-builder-length sb) 0)))
(test "string-builder-append-char! works"
(let ((sb (make-string-builder)))
(string-builder-append-char! sb #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m #\n
#\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z)
(assert-equal? (string-builder-length sb) 26)
(assert-equal? (string-builder->string sb) "abcdefghijklmnopqrstuvwxyz")
(assert= (string-builder-capacity sb) 32)))
(test "string-builder-append-char! works with no char arguments"
(let ((sb (make-string-builder)))
(string-builder-append-char! sb)
(assert= (string-builder-length sb) 0)))
(test "string-builder-ref works"
(let ((sb (string-builder "some" "text" "to" "test" "with")))
(assert-equal? (string-builder-ref sb 3) #\e)
(assert-equal? (string-builder-ref sb 9) #\o)
(assert-exception-thrown (string-builder-ref sb 36) &error)))
(test "string-builder-set! works"
(let ((sb (string-builder "some" "text" "to" "test" "with")))
(string-builder-set! sb 3 #\5)
(assert-equal? (string-builder-ref sb 3) #\5)
(string-builder-set! sb 9 #\6)
(assert-equal? (string-builder-ref sb 9) #\6)
(assert-exception-thrown (string-builder-set! sb 36 #\r) &error)))
(test "string-builder->string works"
(let ((sb (string-builder "a" "test" "string")))
(assert-equal? (string-builder->string sb) "ateststring")))
(test "string-builder->substring works"
(let ((sb (string-builder "a" "test" "string")))
(assert-equal? (string-builder->substring sb 0)
"ateststring")
(assert-equal? (string-builder->substring sb 2 6)
"ests")
(assert-equal? (string-builder->substring sb 0 1)
"a")
(assert-exception-thrown (string-builder->substring sb 0 25)
&error)))
(test "string-builder-reset! works"
(let ((sb (string-builder "a" "test" "string")))
(assert-equal? (string-builder->string sb) "ateststring")
(string-builder-reset! sb)
(assert-equal? (string-builder->string sb) ""))))
(let ((tr (make-terminal-test-runner +string-builder-test-suite+)))
(test-runner-execute tr #t))))
;(print (string-builder->string (string-builder "dog" "cat" "horse" "pig" "goat")))
; (let ((sb (make-string-builder 0)))
; (do ((i 0 (+ i 1)))
; ((= i 100000) #f)
; (string-builder-append! sb "dogdogdogdog")))
;(print (string-builder-string sb)))
; (do ((i 0 (+ i 1))
; (res "" (string-append res "dogdogdogdog")))
; ((= i 100000) #f))
; (print res))
