[Guile-commits] 41/85: Clean up scm_sum

[Andy Wingo]

wingo pushed a commit to branch main
in repository guile.

commit 10953e067c749a4976e749399946abb468fb9251
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Tue Jan 4 15:09:01 2022 +0100

    Clean up scm_sum
    
    * libguile/integers.h:
    * libguile/integers.c (scm_integer_to_double_z):
    (scm_integer_add_ii, scm_integer_add_zi, scm_integer_add_zz): New
    internal functions.
    * libguile/numbers.c (sum): New helper for scm_sum.  Clean up to avoid
    repetition.  The dispatch is less optimal but the code is shorter and
    more maintainable; in any case if speed is important, the compiler needs
    to be involved.
    (scm_sum): Adapt.
---
 libguile/integers.c |  57 +++++++++++++++
 libguile/integers.h |   6 ++
 libguile/numbers.c  | 207 ++++++++++++++++------------------------------------
 3 files changed, 126 insertions(+), 144 deletions(-)

diff --git a/libguile/integers.c b/libguile/integers.c
index 27c33d072..1b11efe16 100644
--- a/libguile/integers.c
+++ b/libguile/integers.c
@@ -2502,3 +2502,60 @@ scm_is_integer_negative_z (struct scm_bignum *x)
 {
   return bignum_is_negative (x);
 }
+
+double
+scm_integer_to_double_z (struct scm_bignum *x)
+{
+  mpz_t zx;
+  alias_bignum_to_mpz (x, zx);
+  double result = mpz_get_d (zx);
+  scm_remember_upto_here_1 (x);
+  return result;
+}
+
+SCM
+scm_integer_add_ii (scm_t_inum x, scm_t_inum y)
+{
+  return long_to_scm (x + y);
+}
+
+SCM
+scm_integer_add_zi (struct scm_bignum *x, scm_t_inum y)
+{
+  if (y == 0)
+    return scm_from_bignum (x);
+
+  mpz_t result, zx;
+  mpz_init (result);
+  alias_bignum_to_mpz (x, zx);
+  if (y < 0)
+    {
+      mpz_sub_ui (result, zx, - y);
+      scm_remember_upto_here_1 (x);
+      // FIXME: We know that if X is negative, no need to check if
+      // result is fixable.
+      return take_mpz (result);
+    }
+  else
+    {
+      mpz_add_ui (result, zx, y);
+      scm_remember_upto_here_1 (x);
+      // FIXME: We know that if X is positive, no need to check if
+      // result is fixable.
+      return take_mpz (result);
+    }
+}
+
+SCM
+scm_integer_add_zz (struct scm_bignum *x, struct scm_bignum *y)
+{
+  mpz_t result, zx, zy;
+  mpz_init (result);
+  alias_bignum_to_mpz (x, zx);
+  alias_bignum_to_mpz (y, zy);
+  mpz_add (result, zx, zy);
+  scm_remember_upto_here_2 (x, y);
+  // FIXME: We know that if X and Y have the same sign, no need to check
+  // if result is fixable.
+  return take_mpz (result);
+}
diff --git a/libguile/integers.h b/libguile/integers.h
index bd9f528b0..1dcd75112 100644
--- a/libguile/integers.h
+++ b/libguile/integers.h
@@ -166,6 +166,12 @@ SCM_INTERNAL int scm_is_integer_less_than_rz (double y, 
struct scm_bignum *x);
 SCM_INTERNAL int scm_is_integer_positive_z (struct scm_bignum *x);
 SCM_INTERNAL int scm_is_integer_negative_z (struct scm_bignum *x);
 
+SCM_INTERNAL double scm_integer_to_double_z (struct scm_bignum *x);
+
+SCM_INTERNAL SCM scm_integer_add_ii (scm_t_inum x, scm_t_inum y);
+SCM_INTERNAL SCM scm_integer_add_zi (struct scm_bignum *x, scm_t_inum y);
+SCM_INTERNAL SCM scm_integer_add_zz (struct scm_bignum *x, struct scm_bignum 
*y);
+
 
 
 #endif  /* SCM_INTEGERS_H */
diff --git a/libguile/numbers.c b/libguile/numbers.c
index 60421fcb0..e47448d16 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -5132,185 +5132,104 @@ SCM_PRIMITIVE_GENERIC (scm_i_sum, "+", 0, 2, 1,
 #define s_sum s_scm_i_sum
 #define g_sum g_scm_i_sum
 
-SCM
-scm_sum (SCM x, SCM y)
+static SCM
+sum (SCM x, SCM y)
 {
-  if (SCM_UNLIKELY (SCM_UNBNDP (y)))
-    {
-      if (SCM_NUMBERP (x)) return x;
-      if (SCM_UNBNDP (x)) return SCM_INUM0;
-      return scm_wta_dispatch_1 (g_sum, x, SCM_ARG1, s_sum);
-    }
-
-  if (SCM_LIKELY (SCM_I_INUMP (x)))
+  if (SCM_I_INUMP (x))
     {
-      if (SCM_LIKELY (SCM_I_INUMP (y)))
-        {
-          scm_t_inum xx = SCM_I_INUM (x);
-          scm_t_inum yy = SCM_I_INUM (y);
-          scm_t_inum z = xx + yy;
-          return SCM_FIXABLE (z) ? SCM_I_MAKINUM (z) : scm_i_inum2big (z);
-        }
+      if (SCM_I_INUMP (y))
+        return scm_integer_add_ii (SCM_I_INUM (x), SCM_I_INUM (y));
       else if (SCM_BIGP (y))
-        {
-          SCM_SWAP (x, y);
-          goto add_big_inum;
-        }
+        return scm_integer_add_zi (scm_bignum (y), SCM_I_INUM (x));
       else if (SCM_REALP (y))
-        {
-          scm_t_inum xx = SCM_I_INUM (x);
-          return scm_i_from_double (xx + SCM_REAL_VALUE (y));
-        }
+        return scm_i_from_double (SCM_I_INUM (x) + SCM_REAL_VALUE (y));
       else if (SCM_COMPLEXP (y))
-        {
-          scm_t_inum xx = SCM_I_INUM (x);
-          return scm_c_make_rectangular (xx + SCM_COMPLEX_REAL (y),
-                                         SCM_COMPLEX_IMAG (y));
-        }
+        return scm_c_make_rectangular (SCM_I_INUM (x) + SCM_COMPLEX_REAL (y),
+                                       SCM_COMPLEX_IMAG (y));
       else if (SCM_FRACTIONP (y))
-       return scm_i_make_ratio (scm_sum (SCM_FRACTION_NUMERATOR (y), 
-                                          scm_product (x, 
SCM_FRACTION_DENOMINATOR (y))),
-                                 SCM_FRACTION_DENOMINATOR (y));
-      else
-        return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARGn, s_sum);
+        return scm_i_make_ratio
+          (scm_sum (SCM_FRACTION_NUMERATOR (y),
+                    scm_product (x, SCM_FRACTION_DENOMINATOR (y))),
+           SCM_FRACTION_DENOMINATOR (y));
+      abort (); /* Unreachable.  */
     }
   else if (SCM_BIGP (x))
     {
-      if (SCM_I_INUMP (y))
-        {
-          scm_t_inum inum;
-          int bigsgn;
-        add_big_inum:
-          inum = SCM_I_INUM (y);      
-          if (inum == 0)
-            return x;
-          bigsgn = mpz_sgn (SCM_I_BIG_MPZ (x));
-          if (inum < 0)
-            {
-              SCM result = scm_i_mkbig ();
-              mpz_sub_ui (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (x), - inum);
-              scm_remember_upto_here_1 (x);
-              /* we know the result will have to be a bignum */
-              if (bigsgn == -1)
-                return result;
-              return scm_i_normbig (result);
-            }
-          else
-            {
-              SCM result = scm_i_mkbig ();
-              mpz_add_ui (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (x), inum);
-              scm_remember_upto_here_1 (x);
-              /* we know the result will have to be a bignum */
-              if (bigsgn == 1)
-                return result;
-              return scm_i_normbig (result);        
-            }
-        }
-      else if (SCM_BIGP (y))
-        {
-          SCM result = scm_i_mkbig ();
-          int sgn_x = mpz_sgn (SCM_I_BIG_MPZ (x)); 
-          int sgn_y = mpz_sgn (SCM_I_BIG_MPZ (y)); 
-          mpz_add (SCM_I_BIG_MPZ (result),
-                   SCM_I_BIG_MPZ (x),
-                   SCM_I_BIG_MPZ (y));
-          scm_remember_upto_here_2 (x, y);
-          /* we know the result will have to be a bignum */
-          if (sgn_x == sgn_y)
-            return result;
-          return scm_i_normbig (result);
-        }
+      if (SCM_BIGP (y))
+        return scm_integer_add_zz (scm_bignum (x), scm_bignum (y));
       else if (SCM_REALP (y))
-        {
-          double result = mpz_get_d (SCM_I_BIG_MPZ (x)) + SCM_REAL_VALUE (y);
-          scm_remember_upto_here_1 (x);
-          return scm_i_from_double (result);
-        }
+        return scm_i_from_double (scm_integer_to_double_z (scm_bignum (x))
+                                  + SCM_REAL_VALUE (y));
       else if (SCM_COMPLEXP (y))
-        {
-          double real_part = (mpz_get_d (SCM_I_BIG_MPZ (x))
-                              + SCM_COMPLEX_REAL (y));
-          scm_remember_upto_here_1 (x);
-          return scm_c_make_rectangular (real_part, SCM_COMPLEX_IMAG (y));
-        }
+        return scm_c_make_rectangular (scm_integer_to_double_z (scm_bignum (x))
+                                       + SCM_COMPLEX_REAL (y),
+                                       SCM_COMPLEX_IMAG (y));
       else if (SCM_FRACTIONP (y))
         return scm_i_make_ratio (scm_sum (SCM_FRACTION_NUMERATOR (y), 
-                                         scm_product (x, 
SCM_FRACTION_DENOMINATOR (y))),
-                                SCM_FRACTION_DENOMINATOR (y));
+                                          scm_product (x, 
SCM_FRACTION_DENOMINATOR (y))),
+                                 SCM_FRACTION_DENOMINATOR (y));
       else
-        return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARGn, s_sum);
+        return sum (y, x);
     }
   else if (SCM_REALP (x))
     {
-      if (SCM_I_INUMP (y))
-       return scm_i_from_double (SCM_REAL_VALUE (x) + SCM_I_INUM (y));
-      else if (SCM_BIGP (y))
-       {
-         double result = mpz_get_d (SCM_I_BIG_MPZ (y)) + SCM_REAL_VALUE (x);
-         scm_remember_upto_here_1 (y);
-         return scm_i_from_double (result);
-       }
-      else if (SCM_REALP (y))
+      if (SCM_REALP (y))
        return scm_i_from_double (SCM_REAL_VALUE (x) + SCM_REAL_VALUE (y));
       else if (SCM_COMPLEXP (y))
        return scm_c_make_rectangular (SCM_REAL_VALUE (x) + SCM_COMPLEX_REAL 
(y),
                                 SCM_COMPLEX_IMAG (y));
       else if (SCM_FRACTIONP (y))
-       return scm_i_from_double (SCM_REAL_VALUE (x) + scm_i_fraction2double 
(y));
+        return scm_i_from_double (SCM_REAL_VALUE (x) + scm_i_fraction2double 
(y));
       else
-       return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARGn, s_sum);
+        return sum (y, x);
     }
   else if (SCM_COMPLEXP (x))
     {
-      if (SCM_I_INUMP (y))
-       return scm_c_make_rectangular (SCM_COMPLEX_REAL (x) + SCM_I_INUM (y),
-                                SCM_COMPLEX_IMAG (x));
-      else if (SCM_BIGP (y))
-       {
-         double real_part = (mpz_get_d (SCM_I_BIG_MPZ (y))
-                             + SCM_COMPLEX_REAL (x));
-         scm_remember_upto_here_1 (y);
-         return scm_c_make_rectangular (real_part, SCM_COMPLEX_IMAG (x));
-       }
-      else if (SCM_REALP (y))
-       return scm_c_make_rectangular (SCM_COMPLEX_REAL (x) + SCM_REAL_VALUE 
(y),
-                                SCM_COMPLEX_IMAG (x));
-      else if (SCM_COMPLEXP (y))
+      if (SCM_COMPLEXP (y))
        return scm_c_make_rectangular (SCM_COMPLEX_REAL (x) + SCM_COMPLEX_REAL 
(y),
-                                SCM_COMPLEX_IMAG (x) + SCM_COMPLEX_IMAG (y));
+                                       SCM_COMPLEX_IMAG (x) + SCM_COMPLEX_IMAG 
(y));
       else if (SCM_FRACTIONP (y))
-       return scm_c_make_rectangular (SCM_COMPLEX_REAL (x) + 
scm_i_fraction2double (y),
-                                SCM_COMPLEX_IMAG (x));
+        return scm_c_make_rectangular (SCM_COMPLEX_REAL (x) + 
scm_i_fraction2double (y),
+                                       SCM_COMPLEX_IMAG (x));
       else
-       return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARGn, s_sum);
+        return sum (y, x);
     }
   else if (SCM_FRACTIONP (x))
     {
-      if (SCM_I_INUMP (y))
-       return scm_i_make_ratio (scm_sum (SCM_FRACTION_NUMERATOR (x), 
-                                       scm_product (y, 
SCM_FRACTION_DENOMINATOR (x))),
-                              SCM_FRACTION_DENOMINATOR (x));
-      else if (SCM_BIGP (y))
-       return scm_i_make_ratio (scm_sum (SCM_FRACTION_NUMERATOR (x), 
-                                       scm_product (y, 
SCM_FRACTION_DENOMINATOR (x))),
-                              SCM_FRACTION_DENOMINATOR (x));
-      else if (SCM_REALP (y))
-       return scm_i_from_double (SCM_REAL_VALUE (y) + scm_i_fraction2double 
(x));
-      else if (SCM_COMPLEXP (y))
-       return scm_c_make_rectangular (SCM_COMPLEX_REAL (y) + 
scm_i_fraction2double (x),
-                                SCM_COMPLEX_IMAG (y));
-      else if (SCM_FRACTIONP (y))
-       /* a/b + c/d = (ad + bc) / bd */
-       return scm_i_make_ratio (scm_sum (scm_product (SCM_FRACTION_NUMERATOR 
(x), SCM_FRACTION_DENOMINATOR (y)),
-                                       scm_product (SCM_FRACTION_NUMERATOR 
(y), SCM_FRACTION_DENOMINATOR (x))),
-                              scm_product (SCM_FRACTION_DENOMINATOR (x), 
SCM_FRACTION_DENOMINATOR (y)));
+      if (SCM_FRACTIONP (y))
+        {
+          SCM nx = SCM_FRACTION_NUMERATOR (x);
+          SCM ny = SCM_FRACTION_NUMERATOR (y);
+          SCM dx = SCM_FRACTION_DENOMINATOR (x);
+          SCM dy = SCM_FRACTION_DENOMINATOR (y);
+          return scm_i_make_ratio (scm_sum (scm_product (nx, dy),
+                                            scm_product (ny, dx)),
+                                   scm_product (dx, dy));
+        }
       else
-       return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARGn, s_sum);
+        return sum (y, x);
     }
   else
-    return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARG1, s_sum);
+    abort (); /* Unreachable.  */
 }
 
+SCM
+scm_sum (SCM x, SCM y)
+{
+  if (SCM_UNBNDP (y))
+    {
+      if (SCM_NUMBERP (x)) return x;
+      if (SCM_UNBNDP (x)) return SCM_INUM0;
+      return scm_wta_dispatch_1 (g_sum, x, SCM_ARG1, s_sum);
+    }
+
+  if (!SCM_NUMBERP (x))
+    return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARG1, s_sum);
+  if (!SCM_NUMBERP (y))
+    return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARG2, s_sum);
+
+  return sum (x, y);
+}
 
 SCM_DEFINE (scm_oneplus, "1+", 1, 0, 0, 
             (SCM x),
@@ -5375,9 +5294,9 @@ scm_difference (SCM x, SCM y)
           return scm_wta_dispatch_1 (g_difference, x, SCM_ARG1, s_difference);
     }
   
-  if (SCM_LIKELY (SCM_I_INUMP (x)))
+  if (SCM_I_INUMP (x))
     {
-      if (SCM_LIKELY (SCM_I_INUMP (y)))
+      if (SCM_I_INUMP (y))
        {
          scm_t_inum xx = SCM_I_INUM (x);
          scm_t_inum yy = SCM_I_INUM (y);