math.functions: more accurate log10 (fixes problem reported by OneEyed)

diff --git a/basis/compiler/cfg/intrinsics/intrinsics.factor b/basis/compiler/cfg/intrinsics/intrinsics.factor
index a54caf23deaa6cc9846f83c088b86f07b40a759f..0daab823955172b8bd6150f405c3c8cd23140982 100644 (file)
--- a/basis/compiler/cfg/intrinsics/intrinsics.factor
+++ b/basis/compiler/cfg/intrinsics/intrinsics.factor
@@ -129,6 +129,7 @@ IN: compiler.cfg.intrinsics
         { math.libm:ftanh [ drop "tanh" emit-unary-float-function ] }
         { math.libm:fexp [ drop "exp" emit-unary-float-function ] }
         { math.libm:flog [ drop "log" emit-unary-float-function ] }
+        { math.libm:flog10 [ drop "log10" emit-unary-float-function ] }
         { math.libm:fpow [ drop "pow" emit-binary-float-function ] }
         { math.libm:facosh [ drop "acosh" emit-unary-float-function ] }
         { math.libm:fasinh [ drop "asinh" emit-unary-float-function ] }

diff --git a/basis/math/functions/functions-tests.factor b/basis/math/functions/functions-tests.factor
index 7a6da72005954fc08dc44d6249a748ff0b140472..fa880f77af5593c16471b3c597272dbaa6ec2d4f 100644 (file)
--- a/basis/math/functions/functions-tests.factor
+++ b/basis/math/functions/functions-tests.factor
@@ -33,6 +33,12 @@ IN: math.functions.tests
 [ 0.0 ] [ 1.0 log ] unit-test
 [ 1.0 ] [ e log ] 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
+
 [ t ] [ 1 exp e 1.e-10 ~ ] unit-test
 [ t ] [ 1.0 exp e 1.e-10 ~ ] unit-test
 [ t ] [ -1 exp e * 1.0 1.e-10 ~ ] unit-test

diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor
index 0cf9467795919d097c3b2f612f9a5749a7bc7766..f124c202b833025d78ca9c5b4e7d8ff45241c6fd 100644 (file)
--- a/basis/math/functions/functions.factor
+++ b/basis/math/functions/functions.factor
@@ -173,7 +173,11 @@ M: float log1+ dup -1.0 >= [ flog1+ ] [ 1.0 + 0.0 rect> log ] if ; inline
 
 : 10^ ( x -- y ) 10 swap ^ ; inline
 
-: log10 ( x -- y ) log 10 log / ; inline
+GENERIC: log10 ( x -- y ) foldable
+
+M: real log10 >float flog10 ; inline
+
+M: complex log10 log 10 log / ; inline
 
 GENERIC: cos ( x -- y ) foldable
 

diff --git a/basis/math/libm/libm.factor b/basis/math/libm/libm.factor
index 1ac0ec0ae7fd278590f0a8d2c93b44739eb2970a..df8b36fd28c49377518c191a4ab4f12edb119f62 100644 (file)
--- a/basis/math/libm/libm.factor
+++ b/basis/math/libm/libm.factor
@@ -39,6 +39,9 @@ IN: math.libm
 : flog ( x -- y )
     "double" "libm" "log" { "double" } alien-invoke ;
 
+: flog10 ( x -- y )
+    "double" "libm" "log10" { "double" } alien-invoke ;
+
 : fpow ( x y -- z )
     "double" "libm" "pow" { "double" "double" } alien-invoke ;