! 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 )
2nip
] [
swap [ /mod [ over * swapd - ] dip ] keep (gcd)
- ] if ;
+ ] if ; inline recursive
PRIVATE>
: nth-root ( n x -- y ) swap recip ^ ; inline
: gcd ( x y -- a d )
- [ 0 1 ] 2dip (gcd) dup 0 < [ neg ] when ; foldable
+ [ 0 1 ] 2dip (gcd) dup 0 < [ neg ] when ; inline
: lcm ( a b -- c )
[ * ] 2keep gcd nip /i ; foldable
: divisor? ( m n -- ? )
- mod 0 = ;
+ mod 0 = ; inline
ERROR: non-trivial-divisor n ;
: >=1? ( x -- ? )
dup complex? [ drop f ] [ 1 >= ] if ; inline
-<PRIVATE
-! to avoid circular dependency on math.bitwise
-: on-bits ( m -- n ) 2^ 1 - ; inline
-PRIVATE>
-
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 11 on-bits bitand 1022 - ] bi
+ [ 0x800f,ffff,ffff,ffff bitand 0.5 double>bits bitor bits>double ]
+ [ -52 shift 0x7ff bitand 1022 - ] bi
] if ; inline
M: integer frexp
[ 0.0 0 ] [
dup 0 > [ 1 ] [ abs -1 ] if swap dup log2 [
- 52 swap - shift 52 on-bits bitand
+ 52 swap - shift 0x000f,ffff,ffff,ffff bitand
0.5 double>bits bitor bits>double
] [ 1 + ] bi [ * ] dip
] if-zero ; 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 )
+ -0x1.ffff,ffff,ffff,fp1023 >integer ; inline
+: most-positive-finite-float ( -- x )
+ 0x1.ffff,ffff,ffff,fp1023 >integer ; inline
+CONSTANT: log-2 0x1.62e42fefa39efp-1
+CONSTANT: log10-2 0x1.34413509f79ffp-2
+
+: (representable-as-float?) ( x -- ? )
+ most-negative-finite-float
+ most-positive-finite-float between? ; inline
-MACRO: bignum-log ( quot: ( x -- y ) -- quot )
- dup dup '[
- dup
- most-negative-finite-float
- most-positive-finite-float
- between?
- [ >float @ ] [ frexp [ @ ] [ 2 @ * ] bi* + ] if
- ] ;
+: (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 )
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