mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 20:00:19 +02:00
Code Activity

Fix (* x -1) for GOOPS types

Browse source 
* libguile/numbers.c (scm_product): Only reduce (* x -1) to (- x) when X
  is a bignum.  Fixes weirdness when X is not a number and instead
  multiplication should dispatch to GOOPS.  Thanks to Alejandro Sanchez
  for the report.
This commit is contained in:
Andy Wingo 2017-02-28 10:12:57 +01:00
parent f8dd4f67b5
commit 70d4c4b284
1 changed files with 13 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

28
libguile/numbers.c
View file

@ -8021,17 +8021,6 @@ scm_product (SCM x, SCM y)
else else
return scm_wta_dispatch_2 (g_product, x, y, SCM_ARGn, s_product); return scm_wta_dispatch_2 (g_product, x, y, SCM_ARGn, s_product);
break; break;
case -1:
/*
* This case is important for more than just optimization.
* It handles the case of negating
* (+ 1 most-positive-fixnum) aka (- most-negative-fixnum),
* which is a bignum that must be changed back into a fixnum.
* Failure to do so will cause the following to return #f:
* (= most-negative-fixnum (* -1 (- most-negative-fixnum)))
*/
return scm_difference(y, SCM_UNDEFINED);
break;
} }
if (SCM_LIKELY (SCM_I_INUMP (y))) if (SCM_LIKELY (SCM_I_INUMP (y)))
@ -8056,10 +8045,19 @@ scm_product (SCM x, SCM y)
} }
else if (SCM_BIGP (y)) else if (SCM_BIGP (y))
{ {
SCM result = scm_i_mkbig (); /* There is one bignum which, when multiplied by negative one,
mpz_mul_si (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (y), xx); becomes a non-zero fixnum: (1+ most-positive-fixum). Since
scm_remember_upto_here_1 (y); we know the type of X and Y are numbers, delegate this
return result; special case to scm_difference. */
if (xx == -1)
return scm_difference (y, SCM_UNDEFINED);
else
{
SCM result = scm_i_mkbig ();
mpz_mul_si (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (y), xx);
scm_remember_upto_here_1 (y);
return result;
}
} }
else if (SCM_REALP (y)) else if (SCM_REALP (y))
return scm_i_from_double (xx * SCM_REAL_VALUE (y)); return scm_i_from_double (xx * SCM_REAL_VALUE (y));