From 599f08f05d84585739fa65229f73e8cbabfd1ad5 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Tue, 18 Oct 2011 10:30:39 -0700 Subject: [PATCH] math.functions: when gcd is inlined, "gcd nip" is almost as good as "gcd*". --- basis/math/functions/functions-tests.factor | 43 ++++++++++----------- basis/math/functions/functions.factor | 12 ++---- basis/math/primes/primes.factor | 2 +- basis/math/ratios/ratios.factor | 2 +- extra/crypto/rsa/rsa.factor | 6 +-- 5 files changed, 28 insertions(+), 37 deletions(-) diff --git a/basis/math/functions/functions-tests.factor b/basis/math/functions/functions-tests.factor index 29bdb1e694..edd66f9b83 100644 --- a/basis/math/functions/functions-tests.factor +++ b/basis/math/functions/functions-tests.factor @@ -117,49 +117,46 @@ 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 -: test-gcd ( x y -- z ) - [ gcd nip ] [ gcd* ] 2bi [ assert= ] keep ; +[ 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 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 +[ 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 [ 6 ] [ 1326264299060955293181542400000006 1591517158873146351817850880000000 - test-gcd + gcd nip ] unit-test [ 11 ] [ 13262642990609552931815424 159151715887314635181785 - test-gcd + gcd nip ] unit-test [ 3 ] [ 13262642990609552931 1591517158873146351 - test-gcd + gcd nip ] unit-test [ 26525285981219 ] [ 132626429906095 159151715887314 - test-gcd + gcd nip ] unit-test diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor index 241261e3bf..bd312406b6 100644 --- a/basis/math/functions/functions.factor +++ b/basis/math/functions/functions.factor @@ -96,9 +96,6 @@ M: complex exp >rect [ exp ] dip polar> ; inline swap [ /mod [ over * swapd - ] dip ] keep (gcd) ] if ; inline recursive -: (gcd*) ( a b -- c ) - [ [ mod ] keep swap (gcd*) ] unless-zero ; inline recursive - PRIVATE> : ^ ( x y -- z ) @@ -112,16 +109,13 @@ PRIVATE> : nth-root ( n x -- y ) swap recip ^ ; inline : gcd ( x y -- a d ) - [ 0 1 ] 2dip (gcd) dup 0 < [ neg ] when ; foldable - -: gcd* ( x y -- d ) - (gcd*) dup 0 < [ neg ] when ; foldable + [ 0 1 ] 2dip (gcd) dup 0 < [ neg ] when ; foldable inline : lcm ( a b -- c ) - [ * ] 2keep gcd* /i ; foldable + [ * ] 2keep gcd nip /i ; foldable : divisor? ( m n -- ? ) - mod 0 = ; + mod 0 = ; inline ERROR: non-trivial-divisor n ; diff --git a/basis/math/primes/primes.factor b/basis/math/primes/primes.factor index 2d9e5af3f4..6be2137135 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* 1 = ; foldable +: coprime? ( a b -- ? ) gcd nip 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 ec5e197dec..dcb8e87e7c 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* [ /i ] curry bi@ fraction> + 2dup gcd nip [ /i ] curry bi@ fraction> ] if-zero ; M: ratio hashcode* diff --git a/extra/crypto/rsa/rsa.factor b/extra/crypto/rsa/rsa.factor index f79a879df1..1e21ccce97 100644 --- a/extra/crypto/rsa/rsa.factor +++ b/extra/crypto/rsa/rsa.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: math.primes kernel math math.functions namespaces -sequences accessors ; +USING: math.primes kernel math math.functions math.primes +namespaces sequences accessors ; IN: crypto.rsa ! The private key is the only secret. @@ -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* 1 = [ + dup public-key coprime? [ rot drop ] [ 2drop modulus-phi