diff --git a/basis/math/functions/functions-tests.factor b/basis/math/functions/functions-tests.factor index edd66f9b83..29bdb1e694 100644 --- a/basis/math/functions/functions-tests.factor +++ b/basis/math/functions/functions-tests.factor @@ -117,46 +117,49 @@ CONSTANT: log10-factorial-1000 HEX: 1.40f3593ed6f8ep11 [ t ] [ 10 atanh tanh 10 1.e-10 ~ ] unit-test [ t ] [ 0.5 atanh tanh 0.5 1.e-10 ~ ] unit-test -[ 100 ] [ 100 100 gcd nip ] unit-test -[ 100 ] [ 1000 100 gcd nip ] unit-test -[ 100 ] [ 100 1000 gcd nip ] unit-test -[ 4 ] [ 132 64 gcd nip ] unit-test -[ 4 ] [ -132 64 gcd nip ] unit-test -[ 4 ] [ -132 -64 gcd nip ] unit-test -[ 4 ] [ 132 -64 gcd nip ] unit-test -[ 4 ] [ -132 -64 gcd nip ] unit-test +: test-gcd ( x y -- z ) + [ gcd nip ] [ gcd* ] 2bi [ assert= ] keep ; -[ 100 ] [ 100 >bignum 100 >bignum gcd nip ] unit-test -[ 100 ] [ 1000 >bignum 100 >bignum gcd nip ] unit-test -[ 100 ] [ 100 >bignum 1000 >bignum gcd nip ] unit-test -[ 4 ] [ 132 >bignum 64 >bignum gcd nip ] unit-test -[ 4 ] [ -132 >bignum 64 >bignum gcd nip ] unit-test -[ 4 ] [ -132 >bignum -64 >bignum gcd nip ] unit-test -[ 4 ] [ 132 >bignum -64 >bignum gcd nip ] unit-test -[ 4 ] [ -132 >bignum -64 >bignum gcd nip ] unit-test +[ 100 ] [ 100 100 test-gcd ] unit-test +[ 100 ] [ 1000 100 test-gcd ] unit-test +[ 100 ] [ 100 1000 test-gcd ] unit-test +[ 4 ] [ 132 64 test-gcd ] unit-test +[ 4 ] [ -132 64 test-gcd ] unit-test +[ 4 ] [ -132 -64 test-gcd ] unit-test +[ 4 ] [ 132 -64 test-gcd ] unit-test +[ 4 ] [ -132 -64 test-gcd ] unit-test + +[ 100 ] [ 100 >bignum 100 >bignum test-gcd ] unit-test +[ 100 ] [ 1000 >bignum 100 >bignum test-gcd ] unit-test +[ 100 ] [ 100 >bignum 1000 >bignum test-gcd ] unit-test +[ 4 ] [ 132 >bignum 64 >bignum test-gcd ] unit-test +[ 4 ] [ -132 >bignum 64 >bignum test-gcd ] unit-test +[ 4 ] [ -132 >bignum -64 >bignum test-gcd ] unit-test +[ 4 ] [ 132 >bignum -64 >bignum test-gcd ] unit-test +[ 4 ] [ -132 >bignum -64 >bignum test-gcd ] unit-test [ 6 ] [ 1326264299060955293181542400000006 1591517158873146351817850880000000 - gcd nip + test-gcd ] unit-test [ 11 ] [ 13262642990609552931815424 159151715887314635181785 - gcd nip + test-gcd ] unit-test [ 3 ] [ 13262642990609552931 1591517158873146351 - gcd nip + test-gcd ] unit-test [ 26525285981219 ] [ 132626429906095 159151715887314 - gcd nip + test-gcd ] unit-test diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor index be956333c6..284d6fc8d9 100644 --- a/basis/math/functions/functions.factor +++ b/basis/math/functions/functions.factor @@ -94,7 +94,10 @@ M: complex exp >rect [ exp ] dip polar> ; inline 2nip ] [ swap [ /mod [ over * swapd - ] dip ] keep (gcd) - ] if ; + ] if ; inline recursive + +: (gcd*) ( a b -- c ) + [ [ mod ] keep swap (gcd*) ] unless-zero ; inline recursive PRIVATE> @@ -111,8 +114,11 @@ PRIVATE> : gcd ( x y -- a d ) [ 0 1 ] 2dip (gcd) dup 0 < [ neg ] when ; foldable +: gcd* ( a b -- c ) + (gcd*) dup 0 < [ neg ] when ; foldable + : lcm ( a b -- c ) - [ * ] 2keep gcd nip /i ; foldable + [ * ] 2keep gcd* /i ; foldable : divisor? ( m n -- ? ) mod 0 = ; diff --git a/basis/math/primes/primes.factor b/basis/math/primes/primes.factor index 6be2137135..2d9e5af3f4 100644 --- a/basis/math/primes/primes.factor +++ b/basis/math/primes/primes.factor @@ -68,7 +68,7 @@ PRIVATE> : nprimes ( n -- seq ) [ 2 swap [ dup , next-prime ] times ] { } make nip ; -: coprime? ( a b -- ? ) gcd nip 1 = ; foldable +: coprime? ( a b -- ? ) gcd* 1 = ; foldable : random-prime ( numbits -- p ) [ ] [ 2^ ] [ random-bits* next-prime ] tri diff --git a/basis/math/ratios/ratios.factor b/basis/math/ratios/ratios.factor index dcb8e87e7c..ec5e197dec 100644 --- a/basis/math/ratios/ratios.factor +++ b/basis/math/ratios/ratios.factor @@ -30,7 +30,7 @@ M: integer / division-by-zero ] [ dup 0 < [ [ neg ] bi@ ] when - 2dup gcd nip [ /i ] curry bi@ fraction> + 2dup gcd* [ /i ] curry bi@ fraction> ] if-zero ; M: ratio hashcode* diff --git a/extra/crypto/rsa/rsa.factor b/extra/crypto/rsa/rsa.factor index 917e98a6ee..f79a879df1 100644 --- a/extra/crypto/rsa/rsa.factor +++ b/extra/crypto/rsa/rsa.factor @@ -27,7 +27,7 @@ CONSTANT: public-key 65537 #! Loop until phi is not divisible by the public key. dup rsa-primes [ * ] 2keep [ 1 - ] bi@ * - dup public-key gcd nip 1 = [ + dup public-key gcd* 1 = [ rot drop ] [ 2drop modulus-phi