diff --git a/src/ikarus.boot b/src/ikarus.boot index cb1cebb..a1dd0b4 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/ikarus.strings.ss b/src/ikarus.strings.ss index 7fbfe85..0b65e8b 100644 --- a/src/ikarus.strings.ss +++ b/src/ikarus.strings.ss @@ -2,7 +2,7 @@ (library (ikarus strings) (export string-length string-ref string-set! make-string string->list string=? string-append substring string list->string uuid - string-copy string-for-each) + string-copy string-for-each string-fill!) (import (ikarus system $strings) (ikarus system $fx) @@ -11,7 +11,8 @@ (ikarus system $pairs) (except (ikarus) string-length string-ref string-set! make-string string->list string=? string-append substring string - list->string uuid string-copy string-for-each)) + list->string uuid string-copy string-for-each + string-fill!)) (define string-length @@ -62,7 +63,7 @@ [(n) (unless (and (fixnum? n) (fx>= n 0)) (error 'make-string "~s is not a valid length" n)) - ($make-string n)] + (fill! ($make-string n) 0 n (integer->char 0))] [(n c) (unless (and (fixnum? n) (fx>= n 0)) (error 'make-string "~s is not a valid length" n)) @@ -300,6 +301,16 @@ (f i ($cdr v*)))))) (f p v0 v1 v* ($fxadd1 i) n)])))]))) + (define (string-fill! v fill) + (unless (string? v) + (error 'string-fill! "~s is not a vector" v)) + (unless (char? fill) + (error 'string-fill! "~s is not a character" fill)) + (let f ([v v] [i 0] [n ($string-length v)] [fill fill]) + (unless ($fx= i n) + ($string-set! v i fill) + (f v ($fxadd1 i) n fill)))) + (define uuid (lambda () (let ([s ($make-bytevector 16)]) diff --git a/src/ikarus.vectors.ss b/src/ikarus.vectors.ss index 34b42e8..343fcc8 100644 --- a/src/ikarus.vectors.ss +++ b/src/ikarus.vectors.ss @@ -1,11 +1,13 @@ (library (ikarus vectors) (export make-vector vector vector-length vector-ref vector-set! - vector->list list->vector vector-map vector-for-each) + vector->list list->vector vector-map vector-for-each + vector-fill!) (import (except (ikarus) make-vector vector vector-length vector-ref vector-set! - vector->list list->vector vector-map vector-for-each) + vector->list list->vector vector-map vector-for-each + vector-fill!) (ikarus system $fx) (ikarus system $pairs) (ikarus system $vectors)) @@ -252,4 +254,13 @@ (cons ($vector-ref ($car v*) i) (f i ($cdr v*)))))) (f p v0 v1 v* ($fxadd1 i) n)])))]))) + + (define (vector-fill! v fill) + (unless (vector? v) + (error 'vector-fill! "~s is not a vector" v)) + (let f ([v v] [i 0] [n ($vector-length v)] [fill fill]) + (unless ($fx= i n) + ($vector-set! v i fill) + (f v ($fxadd1 i) n fill)))) + ) diff --git a/src/makefile.ss b/src/makefile.ss index 38a9a72..93e28f6 100755 --- a/src/makefile.ss +++ b/src/makefile.ss @@ -342,6 +342,7 @@ [make-string i r] [string-ref i r] [string-set! i r] + [string-fill! i r] [string-length i r] [string=? i r] [string-ci=? i unicode] @@ -358,6 +359,7 @@ [make-vector i r] [vector-ref i r] [vector-set! i r] + [vector-fill! i r] [vector? i r] [vector-length i r] [list->vector i r] diff --git a/src/todo-r6rs.ss b/src/todo-r6rs.ss index 4d16007..7d139d4 100755 --- a/src/todo-r6rs.ss +++ b/src/todo-r6rs.ss @@ -224,7 +224,7 @@ [values C ba se] [vector C ba se] [vector->list C ba se] - [vector-fill! S ba se] + [vector-fill! C ba se] [vector-for-each C ba] [vector-length C ba se] [vector-map C ba] @@ -524,7 +524,7 @@ [set-cdr! C mp se] ;;; [string-set! C ms se] - [string-fill! S ms se] + [string-fill! C ms se] ;;; [command-line C pr] [exit C pr]