math.functions: faster gcd means faster ratios.

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
+: test-gcd ( x y -- z )
-[ 100 ] [ 1000 100 gcd nip ] unit-test
+    [ gcd nip ] [ gcd* ] 2bi [ assert= ] keep ;
-[ 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 ] [ 100 100 test-gcd ] unit-test
-[ 100 ] [ 1000 >bignum 100 >bignum gcd nip ] unit-test
+[ 100 ] [ 1000 100 test-gcd ] unit-test
-[ 100 ] [ 100 >bignum 1000 >bignum gcd nip ] unit-test
+[ 100 ] [ 100 1000 test-gcd ] unit-test
-[ 4 ] [ 132 >bignum 64 >bignum gcd nip ] unit-test
+[ 4 ] [ 132 64 test-gcd ] unit-test
-[ 4 ] [ -132 >bignum 64 >bignum gcd nip ] unit-test
+[ 4 ] [ -132 64 test-gcd ] unit-test
-[ 4 ] [ -132 >bignum -64 >bignum gcd nip ] unit-test
+[ 4 ] [ -132 -64 test-gcd ] unit-test
-[ 4 ] [ 132 >bignum -64 >bignum gcd nip ] unit-test
+[ 4 ] [ 132 -64 test-gcd ] unit-test
-[ 4 ] [ -132 >bignum -64 >bignum gcd nip ] 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
 
 

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 = ;

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

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*

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