math.functions: implement copysign.

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 } "." } ;

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

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 ;