diff --git a/basis/math/functions/functions-docs.factor b/basis/math/functions/functions-docs.factor index 4ee8556fb3..dac39428e0 100644 --- a/basis/math/functions/functions-docs.factor +++ b/basis/math/functions/functions-docs.factor @@ -340,3 +340,7 @@ HELP: sigmoid HELP: signum { $values { "x" number } { "y" number } } { $description "Calculates the signum value. For a real number, " { $snippet "x" } ", this is its sign (-1, 0, or 1). For a complex number, " { $snippet "x" } ", this is the point on the unit circle of the complex plane that is nearest to " { $snippet "x" } "." } ; + +HELP: copysign +{ $values { "x" number } { "y" number } { "x'" number } } +{ $description "Returns " { $snippet "x" } " with the sign of " { $snippet "y" } ", as a " { $link float } "." } ; diff --git a/basis/math/functions/functions-tests.factor b/basis/math/functions/functions-tests.factor index d1e1c94b65..3880e4c508 100644 --- a/basis/math/functions/functions-tests.factor +++ b/basis/math/functions/functions-tests.factor @@ -248,3 +248,10 @@ CONSTANT: log10-factorial-1000 0x1.40f3593ed6f8ep11 { 0 } [ 0 signum ] unit-test { t } [ C{ 3.0 -1.5 } signum C{ 0.8944271909999157 -0.4472135954999579 } 1e-10 ~ ] unit-test +{ 1.0 } [ 1 2 copysign ] unit-test +{ -1.0 } [ 1 -2 copysign ] unit-test +{ 1.0 } [ -1 0 copysign ] unit-test +{ -0.0 } [ 0 -1.0 copysign ] unit-test +{ -1.0 } [ -1 -0.0 copysign ] unit-test +{ 1.5 } [ -1.5 2 copysign ] unit-test +{ -1.5 } [ -1.5 -2 copysign ] unit-test diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor index 8ae04e1881..8e47a9b45f 100644 --- a/basis/math/functions/functions.factor +++ b/basis/math/functions/functions.factor @@ -370,3 +370,12 @@ GENERIC: signum ( x -- y ) M: real signum sgn ; M: complex signum dup abs / ; + +MATH: copysign ( x y -- x' ) + +M: real copysign [ >float ] bi@ copysign ; + +M: float copysign + [ double>bits ] [ fp-sign ] bi* + [ 63 2^ bitor ] [ 63 2^ bitnot bitand ] if + bits>double ;