math.functions: clean up some more to trim back load-time dependencies; alter tests...

diff --git a/basis/math/functions/functions-tests.factor b/basis/math/functions/functions-tests.factor
index e2c6c0d7b3f72cf3f653b06e7f7bb771c5479b5b..edd66f9b83534a638f23e16d93a0f0dc0417deb3 100644 (file)
--- a/basis/math/functions/functions-tests.factor
+++ b/basis/math/functions/functions-tests.factor
@@ -1,4 +1,4 @@
-USING: kernel math math.constants math.functions math.libm
+USING: kernel literals math math.constants math.functions math.libm
 math.order math.ranges math.private sequences tools.test ;
 
 IN: math.functions.tests
@@ -45,27 +45,32 @@ IN: math.functions.tests
 [ -0.5 1 ] [ -1 frexp ] unit-test
 [ 0.5 2 ] [ 2 frexp ] unit-test
 [ -0.5 2 ] [ -2 frexp ] unit-test
-[ 0.64 -6 ] [ 0.01 frexp ] unit-test
-[ -0.64 -6 ] [ -0.01 frexp ] unit-test
+[ 0.75 2 ] [ 3 frexp ] unit-test
+[ -0.75 2 ] [ -3 frexp ] unit-test
 [ 0.75 0 ] [ 0.75 frexp ] unit-test
 [ -0.75 0 ] [ -0.75 frexp ] unit-test
-[ 1/0. 0 ] [ 1/0. frexp ] unit-test
-[ -1/0. 0 ] [ -1/0. frexp ] unit-test
-[ 0.6588418960767314 8530 t ] [ 1000 factorial [ frexp ] [ bignum? ] bi ] unit-test
-[ -0.6588418960767314 8530 t ] [ 1000 factorial neg [ frexp ] [ bignum? ] bi ] unit-test
+[ 1/0. ] [ 1/0. frexp drop ] unit-test
+[ -1/0. ] [ -1/0. frexp drop ] unit-test
+[ t ] [ 0/0. frexp drop fp-nan? ] unit-test
+[  0.75 10,002 t ] [  3 10,000 2^ * [ frexp ] [ bignum? ] bi ] unit-test
+[ -0.75 10,002 t ] [ -3 10,000 2^ * [ frexp ] [ bignum? ] bi ] unit-test
 
 [ 0.0 ] [ 1 log ] unit-test
 [ 0.0 ] [ 1.0 log ] unit-test
 [ 1.0 ] [ e log ] unit-test
-[ 5912.128178488163 t ] [ 1000 factorial [ log ] [ bignum? ] bi ] unit-test
-[ C{ 5912.128178488163 3.141592653589793 } t ] [ 1000 factorial neg [ log ] [ bignum? ] bi ] unit-test
+
+CONSTANT: log-factorial-1000 HEX: 1.71820d04e2eb6p12
+CONSTANT: log10-factorial-1000 HEX: 1.40f3593ed6f8ep11
+
+[ $ log-factorial-1000 t ] [ 1000 factorial [ log ] [ bignum? ] bi ] unit-test
+[ C{ $ log-factorial-1000 $ pi } t ] [ 1000 factorial neg [ log ] [ bignum? ] bi ] unit-test
 
 [ 0.0 ] [ 1.0 log10 ] unit-test
 [ 1.0 ] [ 10.0 log10 ] unit-test
 [ 2.0 ] [ 100.0 log10 ] unit-test
 [ 3.0 ] [ 1000.0 log10 ] unit-test
 [ 4.0 ] [ 10000.0 log10 ] unit-test
-[ 2567.604644222133 t ] [ 1000 factorial [ log10 ] [ bignum? ] bi ] unit-test
+[ $ log10-factorial-1000 t ] [ 1000 factorial [ log10 ] [ bignum? ] bi ] unit-test
 
 [ t ] [ 1 exp e 1.e-10 ~ ] unit-test
 [ f ] [ 1 exp 0/0. 1.e-10 ~ ] unit-test

diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor
index 837e7579bd36a3e3aa1507df3727cdcbbd2bee45..be956333c6aff3071e038727c340aae82678bff8 100644 (file)
--- a/basis/math/functions/functions.factor
+++ b/basis/math/functions/functions.factor
@@ -1,8 +1,7 @@
 ! Copyright (C) 2004, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: math kernel math.constants math.private math.bits
-math.libm combinators fry math.order sequences
-combinators.short-circuit macros literals ;
+math.libm combinators fry math.order sequences ;
 IN: math.functions
 
 : >fraction ( a/b -- a b )
@@ -159,7 +158,7 @@ M: real absq sq ; inline
 GENERIC: frexp ( x -- y exp )
 
 M: float frexp
-    dup { [ fp-special? ] [ zero? ] } 1|| [ 0 ] [
+    dup fp-special? [ dup zero? ] unless* [ 0 ] [
         double>bits
         [ HEX: 800f,ffff,ffff,ffff bitand 0.5 double>bits bitor bits>double ]
         [ -52 shift HEX: 7ff bitand 1022 - ] bi
@@ -183,21 +182,26 @@ M: complex log >polar [ flog ] dip rect> ; inline
 
 <PRIVATE
 
-CONSTANT: most-negative-finite-float $[ -1/0. next-float >integer ]
-CONSTANT: most-positive-finite-float $[ 1/0. prev-float >integer ]
+: most-negative-finite-float ( -- x )
+    HEX: -1.ffff,ffff,ffff,fp1023 >integer ; inline
+: most-positive-finite-float ( -- x )
+    HEX:  1.ffff,ffff,ffff,fp1023 >integer ; inline
+CONSTANT: log-2   HEX: 1.62e42fefa39efp-1
+CONSTANT: log10-2 HEX: 1.34413509f79ffp-2
 
-MACRO: bignum-log ( quot: ( x -- y ) -- quot )
-    dup dup '[
-        dup
-        most-negative-finite-float
-        most-positive-finite-float
-        between?
-        [ >float @ ] [ frexp [ @ ] [ 2 @ * ] bi* + ] if
-    ] ;
+: (representable-as-float?) ( x -- ? )
+    most-negative-finite-float
+    most-positive-finite-float between? ; inline
+
+: (bignum-log) ( n log-quot: ( x -- y ) log-2 -- log )
+    [ dup ] dip '[
+        dup (representable-as-float?)
+        [ >float @ ] [ frexp [ @ ] [ _ * ] bi* + ] if
+    ] call ; inline
 
 PRIVATE>
 
-M: bignum log [ log ] bignum-log ;
+M: bignum log [ log ] log-2 (bignum-log) ;
 
 GENERIC: log1+ ( x -- y )
 
@@ -213,7 +217,7 @@ M: real log10 >float flog10 ; inline
 
 M: complex log10 log 10 log / ; inline
 
-M: bignum log10 [ log10 ] bignum-log ;
+M: bignum log10 [ log10 ] log10-2 (bignum-log) ;
 
 GENERIC: cos ( x -- y ) foldable