{ [ dup integer? ] [ integer^ ] }
{ [ 2dup real^? ] [ fpow ] }
[ ^complex ]
- } cond ;
+ } cond ; inline
: (^mod) ( n x y -- z )
1 swap [
M: complex log >polar swap flog swap rect> ;
-: cos ( x -- y )
- dup complex? [
- >float-rect 2dup
- fcosh swap fcos * -rot
- fsinh swap fsin neg * rect>
- ] [ fcos ] if ; foldable
+GENERIC: cos ( x -- y ) foldable
+
+M: complex cos
+ >float-rect 2dup
+ fcosh swap fcos * -rot
+ fsinh swap fsin neg * rect> ;
+
+M: real cos fcos ;
: sec ( x -- y ) cos recip ; inline
-: cosh ( x -- y )
- dup complex? [
- >float-rect 2dup
- fcos swap fcosh * -rot
- fsin swap fsinh * rect>
- ] [ fcosh ] if ; foldable
+GENERIC: cosh ( x -- y ) foldable
+
+M: complex cosh
+ >float-rect 2dup
+ fcos swap fcosh * -rot
+ fsin swap fsinh * rect> ;
+
+M: real cosh fcosh ;
: sech ( x -- y ) cosh recip ; inline
-: sin ( x -- y )
- dup complex? [
- >float-rect 2dup
- fcosh swap fsin * -rot
- fsinh swap fcos * rect>
- ] [ fsin ] if ; foldable
+GENERIC: sin ( x -- y ) foldable
+
+M: complex sin
+ >float-rect 2dup
+ fcosh swap fsin * -rot
+ fsinh swap fcos * rect> ;
+
+M: real sin fsin ;
: cosec ( x -- y ) sin recip ; inline
-: sinh ( x -- y )
- dup complex? [
- >float-rect 2dup
- fcos swap fsinh * -rot
- fsin swap fcosh * rect>
- ] [ fsinh ] if ; foldable
+GENERIC: sinh ( x -- y ) foldable
+
+M: complex sinh
+ >float-rect 2dup
+ fcos swap fsinh * -rot
+ fsin swap fcosh * rect> ;
+
+M: real sinh fsinh ;
: cosech ( x -- y ) sinh recip ; inline
-: tan ( x -- y )
- dup complex? [ dup sin swap cos / ] [ ftan ] if ; inline
+GENERIC: tan ( x -- y ) foldable
+
+M: complex tan [ sin ] [ cos ] bi / ;
+
+M: real tan ftan ;
+
+GENERIC: tanh ( x -- y ) foldable
-: tanh ( x -- y )
- dup complex? [ dup sinh swap cosh / ] [ ftanh ] if ; inline
+M: complex tanh [ sinh ] [ cosh ] bi / ;
+
+M: real tanh ftanh ;
: cot ( x -- y ) tan recip ; inline
: acosech ( x -- y ) recip asinh ; inline
: atanh ( x -- y )
- dup 1+ swap 1- neg / log 2 / ; inline
+ [ 1+ ] [ 1- neg ] bi / log 2 / ; inline
: acoth ( x -- y ) recip atanh ; inline
dup [-1,1]? [ facos ] [ asin pi 2 / swap - ] if ;
inline
-: atan ( x -- y )
- dup complex? [ i* atanh i* ] [ fatan ] if ; inline
+GENERIC: atan ( x -- y ) foldable
+
+M: complex atan i* atanh i* ;
+
+M: real atan fatan ;
: asec ( x -- y ) recip acos ; inline
: facos ( x -- y )
"double" "libm" "acos" { "double" } alien-invoke ;
- foldable
+ inline
: fasin ( x -- y )
"double" "libm" "asin" { "double" } alien-invoke ;
- foldable
+ inline
: fatan ( x -- y )
"double" "libm" "atan" { "double" } alien-invoke ;
- foldable
+ inline
: fatan2 ( x y -- z )
"double" "libm" "atan2" { "double" "double" } alien-invoke ;
- foldable
+ inline
: fcos ( x -- y )
"double" "libm" "cos" { "double" } alien-invoke ;
- foldable
+ inline
: fsin ( x -- y )
"double" "libm" "sin" { "double" } alien-invoke ;
- foldable
+ inline
: ftan ( x -- y )
"double" "libm" "tan" { "double" } alien-invoke ;
- foldable
+ inline
: fcosh ( x -- y )
"double" "libm" "cosh" { "double" } alien-invoke ;
- foldable
+ inline
: fsinh ( x -- y )
"double" "libm" "sinh" { "double" } alien-invoke ;
- foldable
+ inline
: ftanh ( x -- y )
"double" "libm" "tanh" { "double" } alien-invoke ;
- foldable
+ inline
: fexp ( x -- y )
"double" "libm" "exp" { "double" } alien-invoke ;
- foldable
+ inline
: flog ( x -- y )
"double" "libm" "log" { "double" } alien-invoke ;
- foldable
+ inline
: fpow ( x y -- z )
"double" "libm" "pow" { "double" "double" } alien-invoke ;
- foldable
+ inline
: fsqrt ( x -- y )
"double" "libm" "sqrt" { "double" } alien-invoke ;
- foldable
+ inline
! Windows doesn't have these...
: facosh ( x -- y )
"double" "libm" "acosh" { "double" } alien-invoke ;
- foldable
+ inline
: fasinh ( x -- y )
"double" "libm" "asinh" { "double" } alien-invoke ;
- foldable
+ inline
: fatanh ( x -- y )
"double" "libm" "atanh" { "double" } alien-invoke ;
- foldable
+ inline