! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: math kernel math.constants math.private
+USING: math kernel math.constants math.private math.bits
math.libm combinators math.order sequences ;
IN: math.functions
M: real sqrt
>float dup 0.0 < [ neg fsqrt 0.0 swap rect> ] [ fsqrt ] if ;
-: each-bit ( n quot: ( ? -- ) -- )
- over [ 0 = ] [ -1 = ] bi or [
- 2drop
- ] [
- 2dup { [ odd? ] [ call ] [ 2/ ] [ each-bit ] } spread
- ] if ; inline recursive
-
-: map-bits ( n quot: ( ? -- obj ) -- seq )
- accumulator [ each-bit ] dip ; inline
-
: factor-2s ( n -- r s )
#! factor an integer into 2^r * s
dup 0 = [ 1 ] [
- 0 swap [ dup even? ] [ [ 1+ ] [ 2/ ] bi* ] [ ] while
+ 0 swap [ dup even? ] [ [ 1+ ] [ 2/ ] bi* ] while
] if ; inline
<PRIVATE
GENERIC# ^n 1 ( z w -- z^w )
: (^n) ( z w -- z^w )
- 1 swap [ [ dupd * ] when [ sq ] dip ] each-bit nip ; inline
+ make-bits 1 [ [ dupd * ] when [ sq ] dip ] reduce nip ; inline
M: integer ^n
[ factor-2s ] dip [ (^n) ] keep rot * shift ;
dup zero? [ drop 0./0. ] [ 0 < 1./0. 0 ? ] if ; inline
: (^mod) ( n x y -- z )
- 1 swap [
+ make-bits 1 [
[ dupd * pick mod ] when [ sq over mod ] dip
- ] each-bit 2nip ; inline
+ ] reduce 2nip ; inline
: (gcd) ( b a x y -- a d )
over zero? [
: -i* ( x -- y ) >rect swap neg rect> ;
-GENERIC: asin ( x -- y ) foldable
-
-M: number asin
+: asin ( x -- y )
dup [-1,1]? [ fasin ] [ i* asinh -i* ] if ; inline
-GENERIC: acos ( x -- y ) foldable
-
-M: number acos
+: acos ( x -- y )
dup [-1,1]? [ facos ] [ asin pi 2 / swap - ] if ;
inline