* moved make-string to ikarus.strings

This commit is contained in:
Abdulaziz Ghuloum 2007-05-05 03:49:51 -04:00
parent 3dde7f6c1a
commit 0675feac5c
3 changed files with 31 additions and 25 deletions

Binary file not shown.

View File

@ -70,27 +70,6 @@
(error 'vector-length "~s is not a vector" x))
($vector-length x)))
(let ()
(define fill!
(lambda (s i n c)
(cond
[($fx= i n) s]
[else
($string-set! s i c)
(fill! s ($fx+ i 1) n c)])))
(define make-string
(case-lambda
[(n)
(unless (and (fixnum? n) (fx>= n 0))
(error 'make-string "~s is not a valid length" n))
($make-string n)]
[(n c)
(unless (and (fixnum? n) (fx>= n 0))
(error 'make-string "~s is not a valid length" n))
(unless (char? c)
(error 'make-string "~s is not a character" c))
(fill! ($make-string n) 0 n c)]))
(primitive-set! 'make-string make-string))
(primitive-set! 'string-length

View File

@ -1,9 +1,11 @@
(library (ikarus strings)
(export string-ref)
(export string-ref make-string)
(import
(except (ikarus) string-ref)
(only (scheme) $string-ref $fx<= $fx< $string-length))
(except (ikarus) string-ref make-string)
(only (scheme) $string-ref $fx+ $fx= $fx<= $fx< $string-length
$make-string $string-set!))
(define (string-ref s i)
(unless (string? s)
(error 'string-ref "~s is not a string" s))
@ -12,4 +14,29 @@
(unless (and ($fx< i ($string-length s))
($fx<= 0 i))
(error 'string-ref "index ~s is out of range for ~s" i s))
($string-ref s i)))
($string-ref s i))
(define make-string
(let ()
(define fill!
(lambda (s i n c)
(cond
[($fx= i n) s]
[else
($string-set! s i c)
(fill! s ($fx+ i 1) n c)])))
(define make-string
(case-lambda
[(n)
(unless (and (fixnum? n) (fx>= n 0))
(error 'make-string "~s is not a valid length" n))
($make-string n)]
[(n c)
(unless (and (fixnum? n) (fx>= n 0))
(error 'make-string "~s is not a valid length" n))
(unless (char? c)
(error 'make-string "~s is not a character" c))
(fill! ($make-string n) 0 n c)]))
make-string))
)