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

* fixnum->string now takes an extra radix (in 2 8 10 16) argument.

This commit is contained in:
Abdulaziz Ghuloum 2007-11-07 20:02:32 -05:00
parent ca25f972fc
commit 75705649e2
1 changed files with 31 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
scheme/ikarus.fixnums.ss
View File

@ -368,37 +368,52 @@
(sra (- (- fx1 fx2) (+ s0 fx3)) (fixnum-width))))) (sra (- (- fx1 fx2) (+ s0 fx3)) (fixnum-width)))))
(module (fixnum->string) (module (fixnum->string)
(define mapping-string "0123456789abcdef")
(define f (define f
(lambda (n i j) (lambda (n i j radix)
(cond (cond
[($fxzero? n) [($fxzero? n)
(values (make-string i) j)] (values (make-string i) j)]
[else [else
(let ([q ($fxquotient n 10)]) (let* ([q ($fxquotient n radix)]
[c ($string-ref mapping-string
($fx- n ($fx* q radix)))])
(call-with-values (call-with-values
(lambda () (f q ($fxadd1 i) j)) (lambda () (f q ($fxadd1 i) j radix))
(lambda (str j) (lambda (str j)
(let ([r ($fx- n ($fx* q 10))]) (string-set! str j c)
(string-set! str j (values str ($fxadd1 j)))))])))
($fixnum->char ($fx+ r ($char->fixnum #\0)))) (define $fixnum->string
(values str ($fxadd1 j))))))]))) (lambda (x radix)
(define fixnum->string
(lambda (x)
(unless (fixnum? x) (error 'fixnum->string "not a fixnum" x))
(cond (cond
[($fxzero? x) "0"] [($fxzero? x) "0"]
[($fx> x 0) [($fx> x 0)
(call-with-values (call-with-values
(lambda () (f x 0 0)) (lambda () (f x 0 0 radix))
(lambda (str j) str))] (lambda (str j) str))]
;;; FIXME: DON'T HARDCODE CONSTANTS [($fx= x (least-fixnum))
[($fx= x -536870912) "-536870912"] (string-append
($fixnum->string ($fxquotient x radix) radix)
($fixnum->string ($fx- radix ($fxmodulo x radix)) radix))]
[else [else
(call-with-values (call-with-values
(lambda () (f ($fx- 0 x) 1 1)) (lambda () (f ($fx- 0 x) 1 1 radix))
(lambda (str j) (lambda (str j)
($string-set! str 0 #\-) ($string-set! str 0 #\-)
str))])))) str))])))
(define fixnum->string
(case-lambda
[(x)
(unless (fixnum? x) (error 'fixnum->string "not a fixnum" x))
($fixnum->string x 10)]
[(x r)
(unless (fixnum? x) (error 'fixnum->string "not a fixnum" x))
(case r
[(2) ($fixnum->string x 2)]
[(8) ($fixnum->string x 8)]
[(10) ($fixnum->string x 10)]
[(16) ($fixnum->string x 16)]
[else (error 'fixnum->string "invalid radix" r)])])))
) )