Tweak math.functions to inline better
							parent
							
								
									86d45262dc
								
							
						
					
					
						commit
						e1578b5848
					
				| 
						 | 
				
			
			@ -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
 | 
			
		||||
 | 
			
		||||
: tanh ( x -- y )
 | 
			
		||||
    dup complex? [ dup sinh swap cosh / ] [ ftanh ] if ; inline
 | 
			
		||||
M: complex tan [ sin ] [ cos ] bi / ;
 | 
			
		||||
 | 
			
		||||
M: real tan ftan ;
 | 
			
		||||
 | 
			
		||||
GENERIC: tanh ( x -- y ) foldable
 | 
			
		||||
 | 
			
		||||
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
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue