]> gitweb.factorcode.org Git - factor.git/commitdiff
Tweak math.functions to inline better
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Sat, 29 Nov 2008 09:49:24 +0000 (03:49 -0600)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Sat, 29 Nov 2008 09:49:24 +0000 (03:49 -0600)
basis/math/functions/functions.factor
basis/math/libm/libm.factor

index c582c560a9c867a20ef32598c8914572e8789a59..1cea0a74dd3790305ef47b967a0436caac33e94f 100644 (file)
@@ -100,7 +100,7 @@ PRIVATE>
         { [ dup integer? ] [ integer^ ] }
         { [ 2dup real^? ] [ fpow ] }
         [ ^complex ]
-    } cond ;
+    } cond ; inline
 
 : (^mod) ( n x y -- z )
     1 swap [
@@ -174,47 +174,61 @@ M: real log dup 0.0 >= [ flog ] [ 0.0 rect> log ] if ;
 
 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
 
@@ -231,7 +245,7 @@ M: complex log >polar swap flog swap rect> ;
 : 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
 
@@ -246,8 +260,11 @@ M: complex log >polar swap flog swap rect> ;
     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
 
index 8bda6a6dd0421cedbfc92b9d7fc64cc722ced5b9..96f5f134cc7ce047f62f0735ebf884f7b869f74b 100644 (file)
@@ -5,69 +5,69 @@ IN: math.libm
 
 : 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