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

* moved fixnum->string to ikarus.fixnums

This commit is contained in:
Abdulaziz Ghuloum 2007-05-05 06:26:09 -04:00
parent 38105f68fe
commit 3fb2afd604
3 changed files with 39 additions and 34 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.

31
src/ikarus.core.ss
View File

@ -231,37 +231,6 @@
(let ()
(define f
(lambda (n i j)
(cond
[($fxzero? n)
(values (make-string i) j)]
[else
(let ([q ($fxquotient n 10)])
(call-with-values
(lambda () (f q ($fxadd1 i) j))
(lambda (str j)
(let ([r ($fx- n ($fx* q 10))])
(string-set! str j
($fixnum->char ($fx+ r ($char->fixnum #\0))))
(values str ($fxadd1 j))))))])))
(primitive-set! 'fixnum->string
(lambda (x)
(unless (fixnum? x) (error 'fixnum->string "~s is not a fixnum" x))
(cond
[($fxzero? x) "0"]
[($fx> x 0)
(call-with-values
(lambda () (f x 0 0))
(lambda (str j) str))]
[($fx= x -536870912) "-536870912"]
[else
(call-with-values
(lambda () (f ($fx- 0 x) 1 1))
(lambda (str j)
($string-set! str 0 #\-)
str))]))))

42
src/ikarus.fixnums.ss
View File

@ -2,14 +2,17 @@
(library (ikarus fixnums) (library (ikarus fixnums)
(export fxzero? fxadd1 fxsub1 fxlognot fx+ fx- fx* fxquotient (export fxzero? fxadd1 fxsub1 fxlognot fx+ fx- fx* fxquotient
fxremainder fxmodulo fxlogor fxlogand fxlogxor fxsll fxsra fxremainder fxmodulo fxlogor fxlogand fxlogxor fxsll fxsra
fx= fx< fx<= fx> fx>=) fx= fx< fx<= fx> fx>= fixnum->string)
(import (import
(only (scheme) $fxadd1 $fxsub1 $fxlognot $fxzero? $fxquotient (only (scheme) $fxadd1 $fxsub1 $fxlognot $fxzero? $fxquotient
$fxmodulo $fx+ $fx- $fx* $fxlogor $fxlogand $fxlogxor $fxmodulo $fx+ $fx- $fx* $fxlogor $fxlogand $fxlogxor
$fxsll $fxsra $fx= $fx< $fx<= $fx> $fx>=) $fxsll $fxsra $fx= $fx< $fx<= $fx> $fx>=
$string-set!
$char->fixnum $fixnum->char)
(except (ikarus) fxzero? fxadd1 fxsub1 fxlognot fx+ fx- fx* (except (ikarus) fxzero? fxadd1 fxsub1 fxlognot fx+ fx- fx*
fxquotient fxremainder fxmodulo fxlogor fxlogand fxquotient fxremainder fxmodulo fxlogor fxlogand
fxlogxor fxsll fxsra fx= fx< fx<= fx> fx>=)) fxlogxor fxsll fxsra fx= fx< fx<= fx> fx>=
fixnum->string))
(define fxzero? (define fxzero?
(lambda (x) (lambda (x)
@ -175,4 +178,37 @@
(error 'fxsll "negative shift not allowed, got ~s" y)) (error 'fxsll "negative shift not allowed, got ~s" y))
($fxsll x y))) ($fxsll x y)))
(module (fixnum->string)
(define f
(lambda (n i j)
(cond
[($fxzero? n)
(values (make-string i) j)]
[else
(let ([q ($fxquotient n 10)])
(call-with-values
(lambda () (f q ($fxadd1 i) j))
(lambda (str j)
(let ([r ($fx- n ($fx* q 10))])
(string-set! str j
($fixnum->char ($fx+ r ($char->fixnum #\0))))
(values str ($fxadd1 j))))))])))
(define fixnum->string
(lambda (x)
(unless (fixnum? x) (error 'fixnum->string "~s is not a fixnum" x))
(cond
[($fxzero? x) "0"]
[($fx> x 0)
(call-with-values
(lambda () (f x 0 0))
(lambda (str j) str))]
;;; FIXME: DON'T HARDCODE CONSTANTS
[($fx= x -536870912) "-536870912"]
[else
(call-with-values
(lambda () (f ($fx- 0 x) 1 1))
(lambda (str j)
($string-set! str 0 #\-)
str))]))))
) )