* Added fx+/carry, fx*/carry, and fx-/carry (with tests)
This commit is contained in:
parent
96bd57c922
commit
4b0a0411c0
BIN
src/ikarus.boot
BIN
src/ikarus.boot
Binary file not shown.
|
@ -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))]))))
|
||||
|
||||
|
||||
)
|
||||
|
|
|
@ -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]
|
||||
|
|
|
@ -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")
|
||||
|
|
|
@ -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)))
|
||||
|
|
@ -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]
|
||||
|
|
Loading…
Reference in New Issue