* Fixed some parts of bug 160101: modulo produces "BUG: unsupported"
* Modulo still fails on two bignum arguments, will fix later.
This commit is contained in:
Abdulaziz Ghuloum
parent
c4424f8de4
commit
b27bb61802
|
|
@ -1218,8 +1218,50 @@
|
|||
[(fixnum? n)
|
||||
(cond
|
||||
[(fixnum? m) ($fxmodulo n m)]
|
||||
[else (error 'modulo "BUG: unsupported" m)])]
|
||||
[else (error 'modulo "BUG: unsupported" n)])))
|
||||
[(bignum? m)
|
||||
(if ($fx< n 0)
|
||||
(if ($bignum-positive? m)
|
||||
(foreign-call "ikrt_fxbnplus" n m)
|
||||
n)
|
||||
(if ($bignum-positive? m)
|
||||
n
|
||||
(foreign-call "ikrt_fxbnplus" n m)))]
|
||||
[(flonum? m)
|
||||
(let ([v ($flonum->exact m)])
|
||||
(cond
|
||||
[(or (fixnum? v) (bignum? v))
|
||||
(inexact (modulo n v))]
|
||||
[else
|
||||
(error 'modulo "not an integer" m)]))]
|
||||
[(ratnum? m) (error 'modulo "not an integer" m)]
|
||||
[else (error 'modulo "not a number" m)])]
|
||||
[(bignum? n)
|
||||
(cond
|
||||
[(fixnum? m)
|
||||
(foreign-call "ikrt_bnfx_modulo" n m)]
|
||||
[(bignum? m)
|
||||
(error 'modulo
|
||||
"BUG: two bignum arguments are not yet implemented"
|
||||
n m)
|
||||
(foreign-call "ikrt_bnbn_modulo" n m)]
|
||||
[(flonum? m)
|
||||
(let ([v ($flonum->exact m)])
|
||||
(cond
|
||||
[(or (fixnum? v) (bignum? v))
|
||||
(inexact (modulo n v))]
|
||||
[else
|
||||
(error 'modulo "not an integer" m)]))]
|
||||
[(ratnum? m) (error 'modulo "not an integer" m)]
|
||||
[else (error 'modulo "not a number" m)])]
|
||||
[(flonum? n)
|
||||
(let ([v ($flonum->exact n)])
|
||||
(cond
|
||||
[(or (fixnum? v) (bignum? v))
|
||||
(inexact (modulo v m))]
|
||||
[else
|
||||
(error 'modulo "not an integer" n)]))]
|
||||
[(ratnum? n) (error 'modulo "not an integer" n)]
|
||||
[else (error 'modulo "not a number" n)])))
|
||||
|
||||
(define-syntax mk<
|
||||
(syntax-rules ()
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#!/usr/bin/env ikarus --r6rs-script
|
||||
#!../src/ikarus -b ikarus.boot --r6rs-script
|
||||
|
||||
;;; Ikarus Scheme -- A compiler for R6RS Scheme.
|
||||
;;; Copyright (C) 2006,2007 Abdulaziz Ghuloum
|
||||
|
|
@ -23,7 +23,7 @@
|
|||
(tests strings)
|
||||
(tests hashtables)
|
||||
;(tests numbers)
|
||||
;(tests bignums)
|
||||
(tests bignums)
|
||||
(tests fxcarry)
|
||||
(tests bignum-to-flonum)
|
||||
(tests string-to-number))
|
||||
|
|
@ -48,7 +48,7 @@
|
|||
(test-bignum-to-flonum)
|
||||
(test-string-to-number)
|
||||
;(test-div-and-mod)
|
||||
;(test-bignums)
|
||||
(test-bignums)
|
||||
(test-fxcarry)
|
||||
(test-lists)
|
||||
(test-hashtables)
|
||||
|
|
|
|||
|
|
@ -0,0 +1,95 @@
|
|||
(library (tests bignums)
|
||||
(export test-bignums)
|
||||
(import (ikarus) (tests framework))
|
||||
|
||||
(define-tests test-bignums
|
||||
; first, some simple quotients
|
||||
[(lambda (x) (= x 101)) (quotient 348972 3434)]
|
||||
[(lambda (x) (= x -101)) (quotient -348972 3434)]
|
||||
[(lambda (x) (= x -101)) (quotient 348972 -3434)]
|
||||
[(lambda (x) (= x 101)) (quotient -348972 -3434)]
|
||||
; then bump first argument to a small bignum:
|
||||
[(lambda (x) (= x 2255760)) (quotient 536870912 238)]
|
||||
[(lambda (x) (= x -2255760)) (quotient -536870912 238)]
|
||||
[(lambda (x) (= x -2255760)) (quotient 536870912 -238)]
|
||||
[(lambda (x) (= x 2255760)) (quotient -536870912 -238)]
|
||||
; then bump first argument to a big bignum:
|
||||
[(lambda (x) (= x 1652556267336712615))
|
||||
(quotient 536870912238479837489374 324873)]
|
||||
[(lambda (x) (= x -1652556267336712615))
|
||||
(quotient -536870912238479837489374 324873)]
|
||||
[(lambda (x) (= x -1652556267336712615))
|
||||
(quotient 536870912238479837489374 -324873)]
|
||||
[(lambda (x) (= x 1652556267336712615))
|
||||
(quotient -536870912238479837489374 -324873)]
|
||||
; then make both arguments bignums, but result fixnum:
|
||||
[(lambda (x) (= x 165))
|
||||
(quotient 536870912238479837489374 3248732398479823749283)]
|
||||
[(lambda (x) (= x -165))
|
||||
(quotient -536870912238479837489374 3248732398479823749283)]
|
||||
[(lambda (x) (= x -165))
|
||||
(quotient 536870912238479837489374 -3248732398479823749283)]
|
||||
[(lambda (x) (= x 165))
|
||||
(quotient -536870912238479837489374 -3248732398479823749283)]
|
||||
; then both arguments and result are all bignums:
|
||||
[(lambda (x) (= x 1652555047284588078))
|
||||
(quotient 5368709122384798374893743894798327498234 3248732398479823749283)]
|
||||
[(lambda (x) (= x -1652555047284588078))
|
||||
(quotient -5368709122384798374893743894798327498234 3248732398479823749283)]
|
||||
[(lambda (x) (= x -1652555047284588078))
|
||||
(quotient 5368709122384798374893743894798327498234 -3248732398479823749283)]
|
||||
[(lambda (x) (= x 1652555047284588078))
|
||||
(quotient -5368709122384798374893743894798327498234 -3248732398479823749283)]
|
||||
|
||||
|
||||
|
||||
|
||||
[(lambda (x) (= x 23)) (remainder 23 349839489348)]
|
||||
[(lambda (x) (= x -23)) (remainder -23 349839489348)]
|
||||
[(lambda (x) (= x 23)) (remainder 23 -349839489348)]
|
||||
[(lambda (x) (= x -23)) (remainder -23 -349839489348)]
|
||||
|
||||
|
||||
;;; Next, modulo
|
||||
; first, some simple arguments
|
||||
[(lambda (x) (= x 2138)) (modulo 348972 3434)]
|
||||
[(lambda (x) (= x 1296)) (modulo -348972 3434)]
|
||||
[(lambda (x) (= x -1296)) (modulo 348972 -3434)]
|
||||
[(lambda (x) (= x -2138)) (modulo -348972 -3434)]
|
||||
; then bignum second argument: can be done with +/-
|
||||
[(lambda (x) (= x 349839489325)) (modulo -23 349839489348)]
|
||||
[(lambda (x) (= x -23)) (modulo -23 -349839489348)]
|
||||
[(lambda (x) (= x 23)) (modulo 23 349839489348)]
|
||||
[(lambda (x) (= x -349839489325)) (modulo 23 -349839489348)]
|
||||
|
||||
; then bump first argument to a small bignum:
|
||||
[(lambda (x) (= x 32)) (remainder 536870912 238)]
|
||||
[(lambda (x) (= x -32)) (remainder -536870912 238)]
|
||||
[(lambda (x) (= x 32)) (remainder 536870912 -238)]
|
||||
[(lambda (x) (= x -32)) (remainder -536870912 -238)]
|
||||
|
||||
[(lambda (x) (= x 32)) (modulo 536870912 238)]
|
||||
[(lambda (x) (= x 206)) (modulo -536870912 238)]
|
||||
[(lambda (x) (= x -206)) (modulo 536870912 -238)]
|
||||
[(lambda (x) (= x -32)) (modulo -536870912 -238)]
|
||||
; then bump first argument to a big bignum:
|
||||
[(lambda (x) (= x 116479))
|
||||
(modulo 536870912238479837489374 324873)]
|
||||
[(lambda (x) (= x 208394))
|
||||
(modulo -536870912238479837489374 324873)]
|
||||
[(lambda (x) (= x -208394))
|
||||
(modulo 536870912238479837489374 -324873)]
|
||||
[(lambda (x) (= x -116479))
|
||||
(modulo -536870912238479837489374 -324873)]
|
||||
; then make both arguments bignums
|
||||
;[(lambda (x) (= x 830066489308918857679))
|
||||
; (modulo 536870912238479837489374 3248732398479823749283)]
|
||||
;[(lambda (x) (= x 2418665909170904891604))
|
||||
; (modulo -536870912238479837489374 3248732398479823749283)]
|
||||
;[(lambda (x) (= x -2418665909170904891604))
|
||||
; (modulo 536870912238479837489374 -3248732398479823749283)]
|
||||
;[(lambda (x) (= x -830066489308918857679))
|
||||
; (modulo -536870912238479837489374 -3248732398479823749283)]
|
||||
))
|
||||
|
||||
|
||||
|
|
@ -1435,6 +1435,43 @@ ikrt_bnfxdivrem(ikp x, ikp y, ikpcb* pcb){
|
|||
return p+pair_tag;
|
||||
}
|
||||
|
||||
ikp
|
||||
ikrt_bnfx_modulo(ikp x, ikp y, ikpcb* pcb){
|
||||
int yint = unfix(y);
|
||||
mp_limb_t* s2p = (mp_limb_t*)(x+off_bignum_data);
|
||||
ikp fst = ref(x, -vector_tag);
|
||||
mp_size_t s2n = ((unsigned int) fst) >> bignum_length_shift;
|
||||
if(yint < 0){
|
||||
if(((unsigned int) fst) & bignum_sign_mask){
|
||||
/* x negative, y negative */
|
||||
mp_limb_t m = mpn_mod_1(s2p, s2n, -yint);
|
||||
return fix(-m);
|
||||
} else {
|
||||
/* x positive, y negative */
|
||||
mp_limb_t m = mpn_mod_1(s2p, s2n, -yint);
|
||||
return fix(yint+m);
|
||||
}
|
||||
} else {
|
||||
if(((unsigned int) fst) & bignum_sign_mask){
|
||||
/* x negative, y positive */
|
||||
mp_limb_t m = mpn_mod_1(s2p, s2n, yint);
|
||||
return fix(yint-m);
|
||||
} else {
|
||||
/* x positive, y positive */
|
||||
mp_limb_t m = mpn_mod_1(s2p, s2n, yint);
|
||||
return fix(m);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
ikp
|
||||
ikrt_bnbn_modulo(ikp x, ikp y, ikpcb* pcb){
|
||||
fprintf(stderr, "error in bnbnmodulo\n");
|
||||
exit(-1);
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
ikp
|
||||
ikrt_bignum_to_bytevector(ikp x, ikpcb* pcb){
|
||||
|
|
|
|||
Loading…
Reference in New Issue