diff --git a/src/ikarus.boot b/src/ikarus.boot index 38e4abc..42745a7 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/ikarus.core.ss b/src/ikarus.core.ss index 6fdc1ec..43ad9e4 100644 --- a/src/ikarus.core.ss +++ b/src/ikarus.core.ss @@ -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 diff --git a/src/ikarus.strings.ss b/src/ikarus.strings.ss index cb0f042..a3ec388 100644 --- a/src/ikarus.strings.ss +++ b/src/ikarus.strings.ss @@ -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)