conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* moved substring to ikarus.strings

This commit is contained in:
Abdulaziz Ghuloum 2007-05-05 04:02:27 -04:00
parent 4145850d37
commit 970613559c
3 changed files with 29 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

29
src/ikarus.core.ss
View File

@ -77,35 +77,6 @@
#|procedure:substring
(substring str i j)
Returns a substring of str starting from index i (inclusive)
and ending with index j (exclusive).|#
(let ()
(define fill
(lambda (s d si sj di)
(cond
[($fx= si sj) d]
[else
($string-set! d di ($string-ref s si))
(fill s d ($fxadd1 si) sj ($fxadd1 di))])))
(primitive-set! 'substring
(lambda (s n m)
(unless (string? s)
(error 'substring "~s is not a string" s))
(let ([len ($string-length s)])
(unless (and (fixnum? n)
($fx>= n 0)
($fx< n len))
(error 'substring "~s is not a valid start index for ~s" n s))
(unless (and (fixnum? m)
($fx>= m 0)
($fx<= m len))
(error 'substring "~s is not a valid end index for ~s" m s))
(let ([len ($fx- m n)])
(if ($fx<= len 0)
""
(fill s ($make-string len) n m 0)))))))
(primitive-set! 'not
(lambda (x) (if x #f #t)))

32
src/ikarus.strings.ss
View File

@ -1,13 +1,13 @@
(library (ikarus strings)
(export string-length string-ref string-set! make-string string->list string=?
string-append)
string-append substring)
(import
(except (ikarus) string-length string-ref string-set! make-string
string->list string=? string-append)
string->list string=? string-append substring)
(only (scheme)
$fx+ $fxsub1 $fxadd1 $char= $car $cdr
$fxzero? $fx= $fx<= $fx< $fx>=
$fxzero? $fx= $fx<= $fx< $fx>= $fx-
$string-length $string-ref
$make-string $string-set!))
@ -67,6 +67,32 @@
make-string))
(module (substring)
(define fill
(lambda (s d si sj di)
(cond
[($fx= si sj) d]
[else
($string-set! d di ($string-ref s si))
(fill s d ($fxadd1 si) sj ($fxadd1 di))])))
(define substring
(lambda (s n m)
(unless (string? s)
(error 'substring "~s is not a string" s))
(let ([len ($string-length s)])
(unless (and (fixnum? n)
($fx>= n 0)
($fx< n len))
(error 'substring "~s is not a valid start index for ~s" n s))
(unless (and (fixnum? m)
($fx>= m 0)
($fx<= m len))
(error 'substring "~s is not a valid end index for ~s" m s))
(let ([len ($fx- m n)])
(if ($fx<= len 0)
""
(fill s ($make-string len) n m 0)))))))
(module (string=?)
(define bstring=?
(lambda (s1 s2 i j)