diff --git a/.bzrignore b/.bzrignore index eb92d79..1d958f4 100644 --- a/.bzrignore +++ b/.bzrignore @@ -18,3 +18,4 @@ benchmarks/results.MzScheme-r6rs benchmarks/results.Petite-Chez-Scheme-r5rs benchmarks/results.Petite-Chez-Scheme-r6rs benchmarks/results.Scheme48-r6rs +junk diff --git a/src/ikarus.boot b/src/ikarus.boot index 0d955b5..3bbddd6 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/ikarus.numerics.ss b/src/ikarus.numerics.ss index fa140d5..ab4166c 100644 --- a/src/ikarus.numerics.ss +++ b/src/ikarus.numerics.ss @@ -116,8 +116,8 @@ (define (flabs x) (if (flonum? x) - (if (flnegative? x) - (fl* x -1.0) + (if ($fl> x 0.0) + ($fl* x -1.0) x) (error 'flabs "~s is not a flonum" x))) ) @@ -441,7 +441,7 @@ (foreign-call "ikrt_fxbnminus" x y)] [(flonum? y) (if ($fx= x 0) - (fl* y -1.0) + ($fl* y -1.0) ($fl- (fixnum->flonum x) y))] [(ratnum? y) (let ([n ($ratnum-n y)] [d ($ratnum-d y)]) @@ -881,7 +881,7 @@ (if ($bignum-positive? x) x (- x))] [(flonum? x) (if ($flnegative? x) - (fl* x -1.0) + ($fl* x -1.0) x)] [(ratnum? x) (let ([n ($ratnum-n x)]) @@ -1287,7 +1287,7 @@ (f (fl- ac (car rest)) (cdr rest))))] [(x) (if (flonum? x) - (fl- 0.0 x) + ($fl* -1.0 x) (error 'fl+ "~s is not a flonum" x))])) (define fl* @@ -1532,7 +1532,7 @@ (define flnegative? (lambda (x) (if (flonum? x) - ($flnegative? x) + ($fl< x 0.0) (error 'flnegative? "~s is not a flonum" x)))) (define exact-integer-sqrt diff --git a/src/ikarus.reader.ss b/src/ikarus.reader.ss index 3de6119..9c22ba8 100644 --- a/src/ikarus.reader.ss +++ b/src/ikarus.reader.ss @@ -6,7 +6,7 @@ (ikarus system $fx) (ikarus system $pairs) (ikarus system $bytevectors) - (ikarus unicode-data) + (only (ikarus unicode-data) unicode-printable-char?) (except (ikarus) read read-token comment-handler)) (define delimiter? diff --git a/src/ikarus.writer.ss b/src/ikarus.writer.ss index a01d02d..382e06e 100644 --- a/src/ikarus.writer.ss +++ b/src/ikarus.writer.ss @@ -10,7 +10,7 @@ (ikarus system $pairs) (ikarus system $symbols) (ikarus system $bytevectors) - (ikarus unicode-data) + (only (ikarus unicode-data) unicode-printable-char?) (except (ikarus) write display format printf print-error error-handler error)) diff --git a/src/makefile.ss b/src/makefile.ss index 5657574..45406e6 100755 --- a/src/makefile.ss +++ b/src/makefile.ss @@ -299,6 +299,10 @@ [integer->char i r] [char->integer i r] [char-whitespace? i r] + [char-downcase i] + [char-upcase i] + [char-titlecase i] + [char-foldcase i] [string? i r] [string i r] [make-string i r] diff --git a/src/unicode/extract-cases.ss b/src/unicode/extract-cases.ss index 9e5ca9b..7d7b226 100755 --- a/src/unicode/extract-cases.ss +++ b/src/unicode/extract-cases.ss @@ -28,24 +28,27 @@ (define (compute-foldcase ls) (define (find-vec idx) - (let f ([ls ls]) - (cond - [(null? ls) (error 'find-vec "cannot find ~s" idx)] - [(= (caar ls) idx) (cdar ls)] - [else (f (cdr ls))]))) - (let ([v (list->vector (map cdr ls))]) - (define (upper i) - (+ i (vector-ref (find-vec i) 0))) - (define (lower i) - (+ i (vector-ref (find-vec i) 1))) - (define (set-folder! i j) - (vector-set! (find-vec i) 3 (- j i))) - (for-each - (lambda (x) - (let ([idx (car x)] [vec (cdr x)]) - (vector-set! vec 3 - (- (lower (upper idx)) idx)))) - ls)) + (cond + [(assq idx ls) => cdr] + [else (error 'find-vec "~s is missing" idx)])) + (define (upper i) + (+ i (vector-ref (find-vec i) 0))) + (define (lower i) + (+ i (vector-ref (find-vec i) 1))) + (define (set-folder! i j) + (vector-set! (find-vec i) 3 (- j i))) + (for-each + (lambda (x) + (let ([idx (car x)] [vec (cdr x)]) + (vector-set! vec 3 + (- (lower (upper idx)) idx)))) + ls) + (for-each + (lambda (idx) + (let ([vec (find-vec idx)]) + (vector-set! vec 3 0))) + ;; turkic chars + '(#x130 #x131)) ls) (define uc-index 12) diff --git a/src/unicode/unicode-char-cases.ss b/src/unicode/unicode-char-cases.ss index 0c66bc0..22e1ed6 100644 --- a/src/unicode/unicode-char-cases.ss +++ b/src/unicode/unicode-char-cases.ss @@ -181,33 +181,33 @@ -1 0 -1 0 -7264 0 0 0 -32 0 0 -40 0)) (define char-foldcase-adjustment-vector '#(0 32 0 0 0 775 0 32 0 32 0 0 0 0 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 - 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 -199 -200 1 0 1 0 1 - 0 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 - 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 -121 1 0 1 0 1 0 -268 - 0 210 1 0 1 0 206 1 0 205 1 0 0 79 202 203 1 0 205 207 0 211 209 1 0 0 0 - 211 213 0 214 1 0 1 0 1 0 218 1 0 218 0 1 0 218 1 0 217 1 0 1 0 219 1 0 0 1 - 0 0 0 0 2 1 0 2 1 0 2 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 0 1 0 1 0 1 0 1 0 - 1 0 1 0 1 0 1 0 1 0 0 2 1 0 1 0 -97 -56 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 - 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 -130 0 1 0 1 0 1 0 1 0 1 0 1 0 - 1 0 1 0 1 0 0 10795 1 0 -163 10792 0 1 0 -195 69 71 1 0 1 0 1 0 1 0 1 0 0 0 - 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 116 - 0 0 0 38 0 37 64 63 0 32 0 0 0 0 1 0 0 0 -30 -25 0 -15 -22 0 1 0 1 0 1 0 1 - 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 -54 -48 0 0 -60 -64 0 1 0 -7 1 0 0 -130 - 80 32 0 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 - 0 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 - 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 15 1 0 1 0 1 0 1 0 1 0 1 0 1 0 0 1 0 1 + 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 0 0 1 0 1 0 1 0 0 1 + 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 + 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 -121 1 0 1 0 1 0 -268 0 210 + 1 0 1 0 206 1 0 205 1 0 0 79 202 203 1 0 205 207 0 211 209 1 0 0 0 211 213 + 0 214 1 0 1 0 1 0 218 1 0 218 0 1 0 218 1 0 217 1 0 1 0 219 1 0 0 1 0 0 0 0 + 2 1 0 2 1 0 2 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 0 1 0 1 0 1 0 1 0 1 0 1 0 + 1 0 1 0 1 0 0 2 1 0 1 0 -97 -56 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 + 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 -130 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 + 1 0 0 10795 1 0 -163 10792 0 1 0 -195 69 71 1 0 1 0 1 0 1 0 1 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 116 0 0 0 + 38 0 37 64 63 0 32 0 0 0 0 1 0 0 0 -30 -25 0 -15 -22 0 1 0 1 0 1 0 1 0 1 0 + 1 0 1 0 1 0 1 0 1 0 1 0 1 0 -54 -48 0 0 -60 -64 0 1 0 -7 1 0 0 -130 80 32 0 + 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 0 1 0 + 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 + 1 0 1 0 1 0 1 0 1 0 1 0 1 0 15 1 0 1 0 1 0 1 0 1 0 1 0 1 0 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 - 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 48 0 0 0 7264 0 0 0 1 + 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 48 0 0 0 7264 0 0 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 - 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 0 -58 + 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 0 -58 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 - 1 0 1 0 1 0 1 0 1 0 1 0 1 0 0 -8 0 -8 0 -8 0 -8 0 -8 0 0 0 0 0 0 0 0 -8 0 - -8 0 0 0 0 0 0 0 -8 0 -8 0 -8 0 0 0 0 -8 -74 -9 0 -7173 0 0 0 -86 -9 0 0 0 - -8 -100 0 0 0 0 0 -8 -112 -7 0 0 0 -128 -126 -9 0 -7517 0 -8383 -8262 0 28 - 0 0 0 16 0 0 1 0 0 26 0 0 48 0 1 0 -10743 -3814 -10727 0 0 1 0 1 0 1 0 0 1 - 0 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 + 1 0 1 0 1 0 1 0 1 0 0 -8 0 -8 0 -8 0 -8 0 -8 0 0 0 0 0 0 0 0 -8 0 -8 0 0 0 + 0 0 0 0 -8 0 -8 0 -8 0 0 0 0 -8 -74 -9 0 -7173 0 0 0 -86 -9 0 0 0 -8 -100 0 + 0 0 0 0 -8 -112 -7 0 0 0 -128 -126 -9 0 -7517 0 -8383 -8262 0 28 0 0 0 16 0 + 0 1 0 0 26 0 0 48 0 1 0 -10743 -3814 -10727 0 0 1 0 1 0 1 0 0 1 0 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 - 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 0 0 0 32 0 0 0 40 0 0)) + 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 + 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 0 0 0 32 0 0 0 40 0 0))