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

* moved string to ikarus.strings

This commit is contained in:
Abdulaziz Ghuloum 2007-05-05 04:04:58 -04:00
parent 970613559c
commit bc4b74b895
3 changed files with 22 additions and 36 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.

34
src/ikarus.core.ss
View File

@ -111,22 +111,7 @@
(error 'set-top-level-value! "~s is not a symbol" x))
($set-symbol-value! x v)))
(primitive-set! 'symbol? (lambda (x) (symbol? x)))
;(primitive-set! 'primitive?
; (lambda (x)
; (unless (symbol? x)
; (error 'primitive? "~s is not a symbol" x))
; (procedure? (primitive-ref x))))
;
;(primitive-set! 'primitive-ref
; (lambda (x)
; (unless (symbol? x)
; (error 'primitive-ref "~s is not a symbol" x))
; (let ([v (primitive-ref x)])
; (unless (procedure? v)
; (error 'primitive-ref "~s is not a primitive" x))
; v)))
(primitive-set! 'primitive-set!
(lambda (x v)
@ -573,25 +558,6 @@
(let ([v (make-vector n)])
(loop v ls 0 n))))))
(primitive-set! 'string
;;; FIXME: add case-lambda
(letrec ([length
(lambda (ls n)
(cond
[(null? ls) n]
[(char? ($car ls)) (length ($cdr ls) ($fx+ n 1))]
[else (error 'string "~s is not a character" ($car ls))]))]
[loop
(lambda (s ls i n)
(cond
[($fx= i n) s]
[else
($string-set! s i ($car ls))
(loop s ($cdr ls) ($fx+ i 1) n)]))])
(lambda ls
(let ([n (length ls 0)])
(let ([s (make-string n)])
(loop s ls 0 n))))))
(primitive-set! 'list?
(letrec ([race

24
src/ikarus.strings.ss
View File

@ -1,10 +1,10 @@
(library (ikarus strings)
(export string-length string-ref string-set! make-string string->list string=?
string-append substring)
string-append substring string)
(import
(except (ikarus) string-length string-ref string-set! make-string
string->list string=? string-append substring)
string->list string=? string-append substring string)
(only (scheme)
$fx+ $fxsub1 $fxadd1 $char= $car $cdr
$fxzero? $fx= $fx<= $fx< $fx>= $fx-
@ -67,6 +67,26 @@
make-string))
(define string
;;; FIXME: add case-lambda
(letrec ([length
(lambda (ls n)
(cond
[(null? ls) n]
[(char? ($car ls)) (length ($cdr ls) ($fx+ n 1))]
[else (error 'string "~s is not a character" ($car ls))]))]
[loop
(lambda (s ls i n)
(cond
[($fx= i n) s]
[else
($string-set! s i ($car ls))
(loop s ($cdr ls) ($fx+ i 1) n)]))])
(lambda ls
(let ([n (length ls 0)])
(let ([s (make-string n)])
(loop s ls 0 n))))))
(module (substring)
(define fill
(lambda (s d si sj di)