steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

db4
Slava Pestov 2009-09-14 16:19:58 -05:00
parent d772bff8b9
commit 4f702de449
4 changed files with 15 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
basis/compiler/cfg/intrinsics/intrinsics.factor
View File

@ -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 ] }

6
basis/math/functions/functions-tests.factor
View File

@ -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

6
basis/math/functions/functions.factor
View File

@ -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

3
basis/math/libm/libm.factor
View File

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