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

* Added fx+/carry, fx*/carry, and fx-/carry (with tests)

This commit is contained in:
Abdulaziz Ghuloum 2007-09-15 03:16:55 -04:00
parent 96bd57c922
commit 4b0a0411c0
6 changed files with 91 additions and 3 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.

21
src/ikarus.fixnums.ss
View File

@ -1,6 +1,7 @@
(library (ikarus fixnums)
(export fxzero? fxadd1 fxsub1 fxlognot fx+ fx- fx* fxquotient
fx+/carry fx*/carry fx-/carry
fxremainder fxmodulo fxlogor fxlogand fxlogxor fxsll fxsra
fx= fx< fx<= fx> fx>=
fx=? fx<? fx<=? fx>? fx>=?
@ -25,6 +26,7 @@
fxpositive? fxnegative?
fxeven? fxodd?
fxarithmetic-shift-left fxarithmetic-shift-right fxarithmetic-shift
fx+/carry fx*/carry fx-/carry
fxmin fxmax
fixnum->string))
@ -320,6 +322,24 @@
(error 'fxmax "~s is not a fixnum" z)))]
[(x) (if (fixnum? x) x (error 'fxmax "~s is not a fixnum" x))]))
(define (fx*/carry fx1 fx2 fx3)
(let ([s0 ($fx+ ($fx* fx1 fx2) fx3)])
(values
s0
(sra (+ (* fx1 fx2) (- fx3 s0)) (fixnum-width)))))
(define (fx+/carry fx1 fx2 fx3)
(let ([s0 ($fx+ ($fx+ fx1 fx2) fx3)])
(values
s0
(sra (+ (+ fx1 fx2) (- fx3 s0)) (fixnum-width)))))
(define (fx-/carry fx1 fx2 fx3)
(let ([s0 ($fx- ($fx- fx1 fx2) fx3)])
(values
s0
(sra (- (- fx1 fx2) (+ s0 fx3)) (fixnum-width)))))
(module (fixnum->string)
(define f
(lambda (n i j)
@ -353,4 +373,5 @@
($string-set! str 0 #\-)
str))]))))
)

4
src/makefile.ss
View File

@ -462,6 +462,10 @@
[fixnum-width i]
[least-fixnum i]
[greatest-fixnum i]
[fx+/carry i]
[fx*/carry i]
[fx-/carry i]
[for-each i r]
[map i r]

2
src/run-tests.ss
View File

@ -6,6 +6,7 @@
(tests strings)
(tests numbers)
(tests bignums)
(tests fxcarry)
(tests bignum-to-flonum)
(tests string-to-number))
@ -30,4 +31,5 @@
(test-string-to-number)
(test-div-and-mod)
(test-bignums)
(test-fxcarry)
(printf "Happy Happy Joy Joy\n")

61
src/tests/fxcarry.ss Executable file
View File

@ -0,0 +1,61 @@
(library (tests fxcarry)
(export test-fxcarry)
(import (ikarus) (tests framework))
(define (fx*/carry-reference fx1 fx2 fx3)
(let* ([s (+ (* fx1 fx2) fx3)]
[s0 (mod0 s (expt 2 (fixnum-width)))]
[s1 (div0 s (expt 2 (fixnum-width)))])
(values s0 s1)))
(define (fx+/carry-reference fx1 fx2 fx3)
(let* ([s (+ (+ fx1 fx2) fx3)]
[s0 (mod0 s (expt 2 (fixnum-width)))]
[s1 (div0 s (expt 2 (fixnum-width)))])
(values s0 s1)))
(define (fx-/carry-reference fx1 fx2 fx3)
(let* ([s (- (- fx1 fx2) fx3)]
[s0 (mod0 s (expt 2 (fixnum-width)))]
[s1 (div0 s (expt 2 (fixnum-width)))])
(values s0 s1)))
(define (test name fxop/carry fxop/carry-reference fx1 fx2 fx3)
(let-values ([(s0 s1) (fxop/carry fx1 fx2 fx3)]
[(s2 s3) (fxop/carry-reference fx1 fx2 fx3)])
(unless (fx= s0 s2)
(error name "failed (value1) on ~s ~s ~s, got ~s, should be ~s"
fx1 fx2 fx3 s0 s2))
(unless (fx= s1 s3)
(error name "failed (value2) on ~s ~s ~s, got ~s, should be ~s"
fx1 fx2 fx3 s1 s3))))
(define ls
(list 0 1 2 -1 -2 38734 -3843 2484598 -348732487 (greatest-fixnum) (least-fixnum)))
(define (test-fxcarry)
(printf "[~s: test-fxcarry] " (expt (length ls) 3))
(for-each
(lambda (fx1)
(for-each
(lambda (fx2)
(for-each
(lambda (fx3)
(test 'fx*/carry fx*/carry fx*/carry-reference fx1 fx2 fx3)
(test 'fx+/carry fx+/carry fx+/carry-reference fx1 fx2 fx3)
(test 'fx-/carry fx-/carry fx-/carry-reference fx1 fx2 fx3))
ls))
ls))
ls)
(printf "Happy Happy Joy Joy\n"))
)
#!eof
(define (t x)
(= (fxsra (fx+ x 1) 1)
(quotient x 2)))

6
src/todo-r6rs.ss
View File

@ -261,11 +261,11 @@
[least-fixnum C fx]
[greatest-fixnum C fx]
[fx* C fx]
[fx*/carry D fx]
[fx*/carry C fx]
[fx+ C fx]
[fx+/carry D fx]
[fx+/carry C fx]
[fx- C fx]
[fx-/carry D fx]
[fx-/carry C fx]
[fx<=? C fx]
[fx<? C fx]
[fx=? C fx]