math.functions: faster gcd means faster ratios.

diff --git a/basis/math/functions/functions-tests.factor b/basis/math/functions/functions-tests.factor
index edd66f9b83534a638f23e16d93a0f0dc0417deb3..29bdb1e694f03f334bde5cf673995792dfe8a6f2 100644 (file)
--- 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
-
-[ 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
+: test-gcd ( x y -- z )
+    [ gcd nip ] [ gcd* ] 2bi [ assert= ] keep ;
+
+[ 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 be956333c6aff3071e038727c340aae82678bff8..284d6fc8d9470ddb41c6d4f6669c14b77c1ce5c6 100644 (file)
--- 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 6be21371352784383d1ad11f5a4b73872ef4a40e..2d9e5af3f4e56dfc47bca84e2f22b01731b6c8d8 100644 (file)
--- 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 dcb8e87e7c85ee1b874d783829e7e63a0806fd0d..ec5e197dec19b46b5bd441c210943c5d8fd2889e 100644 (file)
--- 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 917e98a6ee52cc7f251e7abf19a99ee737de90e4..f79a879df1de144f219c0996dd613c9c8419e700 100644 (file)
--- 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