* Partial fix for bug 160780: missing 2 and 3 arg forms of number->string

- second argument is implemented, precision is yet to be done.

scheme/ikarus.fixnums.ss

@@ -368,7 +368,7 @@
         (sra (- (- fx1 fx2) (+ s0 fx3)) (fixnum-width)))))
 
   (module (fixnum->string)
-    (define mapping-string "0123456789abcdef")
+    (define mapping-string "0123456789ABCDEF")
     (define f
       (lambda (n i j radix)
         (cond

scheme/ikarus.numerics.ss

@@ -1182,6 +1182,7 @@
     (cond
       [(fixnum? x) ($fxeven? x)]
       [(bignum? x) (even-bignum? x)]
+      [(flonum? x) (error 'even? "BUG" x)]
       [else (error 'even? "not an integer" x)]))
 
   (define (odd? x)
@@ -1189,28 +1190,85 @@
       (cond
         [(fixnum? x) ($fxeven? x)]
         [(bignum? x) (even-bignum? x)]
+        [(flonum? x) (error 'odd? "BUG" x)]
         [else (error 'odd? "not an integer" x)])))
-
-  (define bignum->string
-    (lambda (x)
-      (utf8->string
-        (foreign-call "ikrt_bignum_to_bytevector" x))))
   
-  (define ratnum->string
+  (module (number->string)
-    (lambda (x) 
+    (module (bignum->string)
-      (string-append 
+      (define (bignum->decimal-string x)
-        (number->string ($ratnum-n x))
+        (utf8->string (foreign-call "ikrt_bignum_to_bytevector" x)))
-        "/"
+      (module (bignum->power-string)
-        (number->string ($ratnum-d x)))))
+        (define string-map "0123456789ABCDEF")
-  
+        (define (init-string x chars) 
-  (define number->string
+          (if ($bignum-positive? x) 
-    (lambda (x)
+              (make-string chars)
-      (cond
+              (let ([s (make-string ($fxadd1 chars))])
-        [(fixnum? x) (fixnum->string x)]
+                (string-set! s 0 #\-)
-        [(bignum? x) (bignum->string x)]
+                s)))
-        [(flonum? x) (flonum->string x)]
+        (define (bignum-bits x)
-        [(ratnum? x) (ratnum->string x)]
+          (define (add-bits b n)
-        [else (error 'number->string "not a number" x)])))
+            (cond
+              [($fxzero? b) n]
+              [else (add-bits ($fxsra b 1) ($fx+ n 1))]))
+          (let f ([i ($fxsub1 ($bignum-size x))])
+            (let ([i ($fxsub1 i)])
+              (let ([b ($bignum-byte-ref x i)])
+                (cond
+                  [($fxzero? b) (f i)]
+                  [else (add-bits b ($fxsll i 3))])))))
+        (define (bignum->power-string x mask shift)
+          (let ([bits (bignum-bits x)])
+            (let ([chars (fxquotient (fx+ bits (fx- shift 1)) shift)])
+              (let* ([s (init-string x chars)]
+                     [n ($fx- (string-length s) 1)])
+                (let f ([i 0] [j 0] [k 0] [b 0])
+                  (cond
+                    [($fx= i chars) s]
+                    [($fx< k 8)
+                     (f i ($fxadd1 j) ($fx+ k 8)
+                        ($fxlogor b
+                          ($fxsll ($bignum-byte-ref x j) k)))]
+                    [else
+                     (string-set! s ($fx- n i) 
+                       (string-ref string-map 
+                         ($fxlogand mask b)))
+                     (f ($fxadd1 i) j ($fx- k shift) ($fxsra b shift))])))))))
+      (define (bignum->string x r)
+        (case r
+          [(10) (bignum->decimal-string x)]
+          [(2)  (bignum->power-string x  1 1)]
+          [(8)  (bignum->power-string x  7 3)]
+          [(16) (bignum->power-string x 15 4)]
+          [else (error 'number->string "BUG")])))
+    (define ratnum->string
+      (lambda (x r) 
+        (string-append 
+          ($number->string ($ratnum-n x) r)
+          "/"
+          ($number->string ($ratnum-d x) r))))
+    (define $number->string
+      (lambda (x r)
+        (cond
+          [(fixnum? x) (fixnum->string x r)]
+          [(bignum? x) (bignum->string x r)]
+          [(flonum? x) 
+           (unless (eqv? r 10) 
+             (error 'number->string 
+                "invalid radix for inexact number"
+                r x))
+           (flonum->string x)]
+          [(ratnum? x) (ratnum->string x r)]
+          [else (error 'number->string "not a number" x)])))
+    (define number->string
+      (case-lambda
+        [(x) ($number->string x 10)]
+        [(x r) 
+         (unless (memv r '(2 8 10 16)) 
+           (error 'number->string "invalid radix" r))
+         ($number->string x r)]
+        [(x r precision)
+         (error 'number->string 
+            "BUG: precision is not supported yet")])))
 
   (define modulo
     (lambda (n m)

scheme/run-tests.ss

@@ -56,4 +56,5 @@
 (test-lists)
 (test-hashtables)
 (test-input-ports)
+(test-bignum-conversion)
 (printf "Happy Happy Joy Joy\n")

scheme/tests/bignums.ss

@@ -1,7 +1,25 @@
 (library (tests bignums)
-  (export test-bignums)
+  (export test-bignums test-bignum-conversion)
   (import (ikarus) (tests framework))
 
+  (define (test-bignum-conversion)
+    (define (test x) 
+      (define (test1 x prefix radix)
+        (let ([s (string-append prefix 
+                   (number->string x radix))])
+          (assert (equal? x (read (open-input-string s))))))
+      (test1 x "#x" 16)
+      (test1 x "#o" 8)
+      (test1 x "#b" 2))
+    (test #b11111111111111111111111111111111111111111111111111)
+    (test #b1111111111111111111111111111111111111111)
+    (test 39487932748923498234)
+    (test #b-11111111111111111111111111111111111111111111111111)
+    (test #b-1111111111111111111111111111111111111111)
+    (test -39487932748923498234))
+
+
+
   (define-tests test-bignums
     ; first, some simple quotients
     [(lambda (x) (= x 101))  (quotient 348972 3434)]