[Guile-commits] 42/85: Simplify scm_difference, use integer lib

[Andy Wingo]

wingo pushed a commit to branch main
in repository guile.

commit c096670d38c3c3c6074a0a0cc91b22f13516defb
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Tue Jan 4 16:01:28 2022 +0100

    Simplify scm_difference, use integer lib
    
    * libguile/numbers.c (scm_sum): Remove need for s_sum defines.
    (negate, difference): New helpers.
    (scm_difference): Call out to difference or negate, as appropriate.
    * libguile/integers.h:
    * libguile/integers.c (scm_integer_negate_i):
    (scm_integer_negate_z):
    (scm_integer_sub_ii):
    (scm_integer_sub_iz):
    (scm_integer_sub_zi):
    (scm_integer_sub_zz): New internal functions.
---
 libguile/integers.c |  44 +++++++
 libguile/integers.h |   8 ++
 libguile/numbers.c  | 355 ++++++++++++++++++----------------------------------
 3 files changed, 174 insertions(+), 233 deletions(-)

diff --git a/libguile/integers.c b/libguile/integers.c
index 1b11efe16..1133d2215 100644
--- a/libguile/integers.c
+++ b/libguile/integers.c
@@ -2559,3 +2559,47 @@ scm_integer_add_zz (struct scm_bignum *x, struct 
scm_bignum *y)
   // if result is fixable.
   return take_mpz (result);
 }
+
+SCM
+scm_integer_negate_i (scm_t_inum x)
+{
+  return long_to_scm (-x);
+}
+
+SCM
+scm_integer_negate_z (struct scm_bignum *x)
+{
+  /* Must normalize here because -SCM_MOST_NEGATIVE_FIXNUM is a bignum,
+     but negating that gives a fixnum.  */
+  return normalize_bignum (negate_bignum (clone_bignum (x)));
+}
+
+SCM
+scm_integer_sub_ii (scm_t_inum x, scm_t_inum y)
+{
+  // Assumes that -INUM_MIN can fit in a scm_t_inum, even if that
+  // scm_t_inum is not fixable, and that scm_integer_add_ii can handle
+  // scm_t_inum inputs outside the fixable range.
+  return scm_integer_add_ii (x, -y);
+}
+
+SCM
+scm_integer_sub_iz (scm_t_inum x, struct scm_bignum *y)
+{
+  return scm_integer_add_zi (negate_bignum (clone_bignum (y)), x);
+}
+
+SCM
+scm_integer_sub_zi (struct scm_bignum *x, scm_t_inum y)
+{
+  // Assumes that -INUM_MIN can fit in a scm_t_inum, even if that
+  // scm_t_inum is not fixable, and that scm_integer_add_ii can handle
+  // scm_t_inum inputs outside the fixable range.
+  return scm_integer_add_zi (x, -y);
+}
+
+SCM
+scm_integer_sub_zz (struct scm_bignum *x, struct scm_bignum *y)
+{
+  return scm_integer_add_zz (x, negate_bignum (clone_bignum (y)));
+}
diff --git a/libguile/integers.h b/libguile/integers.h
index 1dcd75112..3f3bf279e 100644
--- a/libguile/integers.h
+++ b/libguile/integers.h
@@ -172,6 +172,14 @@ 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);
 
+SCM_INTERNAL SCM scm_integer_negate_i (scm_t_inum x);
+SCM_INTERNAL SCM scm_integer_negate_z (struct scm_bignum *x);
+
+SCM_INTERNAL SCM scm_integer_sub_ii (scm_t_inum x, scm_t_inum y);
+SCM_INTERNAL SCM scm_integer_sub_iz (scm_t_inum x, struct scm_bignum *y);
+SCM_INTERNAL SCM scm_integer_sub_zi (struct scm_bignum *x, scm_t_inum y);
+SCM_INTERNAL SCM scm_integer_sub_zz (struct scm_bignum *x, struct scm_bignum 
*y);
+
 
 
 #endif  /* SCM_INTEGERS_H */
diff --git a/libguile/numbers.c b/libguile/numbers.c
index e47448d16..80c775f28 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -5128,9 +5128,6 @@ SCM_PRIMITIVE_GENERIC (scm_i_sum, "+", 0, 2, 1,
   return scm_sum (x, y);
 }
 #undef FUNC_NAME
-                       
-#define s_sum s_scm_i_sum
-#define g_sum g_scm_i_sum
 
 static SCM
 sum (SCM x, SCM y)
@@ -5220,13 +5217,13 @@ scm_sum (SCM x, SCM 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);
+      return scm_wta_dispatch_1 (g_scm_i_sum, x, SCM_ARG1, s_scm_i_sum);
     }
 
   if (!SCM_NUMBERP (x))
-    return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARG1, s_sum);
+    return scm_wta_dispatch_2 (g_scm_i_sum, x, y, SCM_ARG1, s_scm_i_sum);
   if (!SCM_NUMBERP (y))
-    return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARG2, s_sum);
+    return scm_wta_dispatch_2 (g_scm_i_sum, x, y, SCM_ARG2, s_scm_i_sum);
 
   return sum (x, y);
 }
@@ -5240,284 +5237,176 @@ SCM_DEFINE (scm_oneplus, "1+", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-
-SCM_PRIMITIVE_GENERIC (scm_i_difference, "-", 0, 2, 1,
-                       (SCM x, SCM y, SCM rest),
-                       "If called with one argument @var{z1}, -@var{z1} 
returned. Otherwise\n"
-                       "the sum of all but the first argument are subtracted 
from the first\n"
-                       "argument.")
-#define FUNC_NAME s_scm_i_difference
+static SCM
+negate (SCM x)
 {
-  while (!scm_is_null (rest))
-    { x = scm_difference (x, y);
-      y = scm_car (rest);
-      rest = scm_cdr (rest);
-    }
-  return scm_difference (x, y);
+  if (SCM_I_INUMP (x))
+    return scm_integer_negate_i (SCM_I_INUM (x));
+  else if (SCM_BIGP (x))
+    return scm_integer_negate_z (scm_bignum (x));
+  else if (SCM_REALP (x))
+    return scm_i_from_double (-SCM_REAL_VALUE (x));
+  else if (SCM_COMPLEXP (x))
+    return scm_c_make_rectangular (-SCM_COMPLEX_REAL (x),
+                                   -SCM_COMPLEX_IMAG (x));
+  else if (SCM_FRACTIONP (x))
+    return scm_i_make_ratio_already_reduced
+      (negate (SCM_FRACTION_NUMERATOR (x)), SCM_FRACTION_DENOMINATOR (x));
+  else
+    abort (); /* Unreachable.  */
 }
-#undef FUNC_NAME
-                       
-#define s_difference s_scm_i_difference
-#define g_difference g_scm_i_difference
 
-SCM
-scm_difference (SCM x, SCM y)
-#define FUNC_NAME s_difference
+static SCM
+difference (SCM x, SCM y)
 {
-  if (SCM_UNLIKELY (SCM_UNBNDP (y)))
-    {
-      if (SCM_UNBNDP (x))
-        return scm_wta_dispatch_0 (g_difference, s_difference);
-      else 
-        if (SCM_I_INUMP (x))
-          {
-            scm_t_inum xx = -SCM_I_INUM (x);
-            if (SCM_FIXABLE (xx))
-              return SCM_I_MAKINUM (xx);
-            else
-              return scm_i_inum2big (xx);
-          }
-        else if (SCM_BIGP (x))
-          /* Must scm_i_normbig here because -SCM_MOST_NEGATIVE_FIXNUM is a
-             bignum, but negating that gives a fixnum.  */
-          return scm_i_normbig (scm_i_clonebig (x, 0));
-        else if (SCM_REALP (x))
-          return scm_i_from_double (-SCM_REAL_VALUE (x));
-        else if (SCM_COMPLEXP (x))
-          return scm_c_make_rectangular (-SCM_COMPLEX_REAL (x),
-                                   -SCM_COMPLEX_IMAG (x));
-       else if (SCM_FRACTIONP (x))
-         return scm_i_make_ratio_already_reduced
-           (scm_difference (SCM_FRACTION_NUMERATOR (x), SCM_UNDEFINED),
-            SCM_FRACTION_DENOMINATOR (x));
-        else
-          return scm_wta_dispatch_1 (g_difference, x, SCM_ARG1, s_difference);
-    }
-  
   if (SCM_I_INUMP (x))
     {
+      if (SCM_I_INUM (x) == 0)
+        /* We need to handle x == exact 0 specially because R6RS states
+           that:
+             (- 0.0)     ==> -0.0  and
+             (- 0.0 0.0) ==>  0.0
+           and the scheme compiler changes
+             (- 0.0) into (- 0 0.0)
+           So we need to treat (- 0 0.0) like (- 0.0).
+           At the C level, (-x) is different than (0.0 - x).
+           (0.0 - 0.0) ==> 0.0, but (- 0.0) ==> -0.0.  */
+        return negate (y);
       if (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;
-         if (SCM_FIXABLE (z))
-           return SCM_I_MAKINUM (z);
-         else
-           return scm_i_inum2big (z);
-       }
+        return scm_integer_sub_ii (SCM_I_INUM (x), SCM_I_INUM (y));
       else if (SCM_BIGP (y))
-       {
-         /* inum-x - big-y */
-         scm_t_inum xx = SCM_I_INUM (x);
-
-         if (xx == 0)
-           {
-             /* Must scm_i_normbig here because -SCM_MOST_NEGATIVE_FIXNUM is a
-                bignum, but negating that gives a fixnum.  */
-             return scm_i_normbig (scm_i_clonebig (y, 0));
-           }
-         else
-           {
-             int sgn_y = mpz_sgn (SCM_I_BIG_MPZ (y));
-             SCM result = scm_i_mkbig ();
-
-             if (xx >= 0)
-               mpz_ui_sub (SCM_I_BIG_MPZ (result), xx, SCM_I_BIG_MPZ (y));
-             else
-               {
-                 /* x - y == -(y + -x) */
-                 mpz_add_ui (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (y), -xx);
-                 mpz_neg (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (result));
-               }
-             scm_remember_upto_here_1 (y);
-
-             if ((xx < 0 && (sgn_y > 0)) || ((xx > 0) && sgn_y < 0))
-               /* we know the result will have to be a bignum */
-               return result;
-             else
-               return scm_i_normbig (result);
-           }
-       }
+        return scm_integer_sub_iz (SCM_I_INUM (x), scm_bignum (y));
       else if (SCM_REALP (y))
-       {
-         scm_t_inum xx = SCM_I_INUM (x);
-
-         /*
-          * We need to handle x == exact 0
-          * specially because R6RS states that:
-          *   (- 0.0)     ==> -0.0  and
-          *   (- 0.0 0.0) ==>  0.0
-          * and the scheme compiler changes
-          *   (- 0.0) into (- 0 0.0)
-          * So we need to treat (- 0 0.0) like (- 0.0).
-          * At the C level, (-x) is different than (0.0 - x).
-          * (0.0 - 0.0) ==> 0.0, but (- 0.0) ==> -0.0.
-          */
-         if (xx == 0)
-           return scm_i_from_double (- SCM_REAL_VALUE (y));
-         else
-           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);
-
-         /* We need to handle x == exact 0 specially.
-            See the comment above (for SCM_REALP (y)) */
-         if (xx == 0)
-           return scm_c_make_rectangular (- SCM_COMPLEX_REAL (y),
-                                          - SCM_COMPLEX_IMAG (y));
-         else
-           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))
        /* a - b/c = (ac - b) / c */
        return scm_i_make_ratio (scm_difference (scm_product (x, 
SCM_FRACTION_DENOMINATOR (y)),
-                                              SCM_FRACTION_NUMERATOR (y)),
-                              SCM_FRACTION_DENOMINATOR (y));
+                                                 SCM_FRACTION_NUMERATOR (y)),
+                                 SCM_FRACTION_DENOMINATOR (y));
       else
-       return scm_wta_dispatch_2 (g_difference, x, y, SCM_ARGn, s_difference);
+        abort (); /* Unreachable.  */
     }
   else if (SCM_BIGP (x))
     {
       if (SCM_I_INUMP (y))
-       {
-         /* big-x - inum-y */
-         scm_t_inum yy = SCM_I_INUM (y);
-         int sgn_x = mpz_sgn (SCM_I_BIG_MPZ (x));
-
-         scm_remember_upto_here_1 (x);
-         if (sgn_x == 0)
-           return (SCM_FIXABLE (-yy) ?
-                   SCM_I_MAKINUM (-yy) : scm_from_inum (-yy));
-         else
-           {
-             SCM result = scm_i_mkbig ();
-
-             if (yy >= 0)
-               mpz_sub_ui (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (x), yy);
-             else
-               mpz_add_ui (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (x), -yy);
-             scm_remember_upto_here_1 (x);
-
-             if ((sgn_x < 0 && (yy > 0)) || ((sgn_x > 0) && yy < 0))
-               /* we know the result will have to be a bignum */
-               return result;
-             else
-               return scm_i_normbig (result);
-           }
-       }
+        return scm_integer_sub_zi (scm_bignum (x), SCM_I_INUM (y));
       else if (SCM_BIGP (y))
-       {
-         int sgn_x = mpz_sgn (SCM_I_BIG_MPZ (x)); 
-         int sgn_y = mpz_sgn (SCM_I_BIG_MPZ (y)); 
-         SCM result = scm_i_mkbig ();
-         mpz_sub (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 == 1) && (sgn_y == -1))
-           return result;
-         if ((sgn_x == -1) && (sgn_y == 1))
-           return result;
-         return scm_i_normbig (result);
-       }
+        return scm_integer_sub_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_difference (scm_product (x, 
SCM_FRACTION_DENOMINATOR (y)),
-                                              SCM_FRACTION_NUMERATOR (y)),
-                              SCM_FRACTION_DENOMINATOR (y));
+       return scm_i_make_ratio
+          (difference (scm_product (x, SCM_FRACTION_DENOMINATOR (y)),
+                       SCM_FRACTION_NUMERATOR (y)),
+           SCM_FRACTION_DENOMINATOR (y));
       else
-        return scm_wta_dispatch_2 (g_difference, x, y, SCM_ARGn, s_difference);
+        abort (); /* Unreachable.  */
     }
   else if (SCM_REALP (x))
     {
+      double r = SCM_REAL_VALUE (x);
       if (SCM_I_INUMP (y))
-       return scm_i_from_double (SCM_REAL_VALUE (x) - SCM_I_INUM (y));
+       return scm_i_from_double (r - SCM_I_INUM (y));
       else if (SCM_BIGP (y))
-       {
-         double result = SCM_REAL_VALUE (x) - mpz_get_d (SCM_I_BIG_MPZ (y));
-         scm_remember_upto_here_1 (x);
-         return scm_i_from_double (result);
-       }
+        return scm_i_from_double (r - scm_integer_to_double_z (scm_bignum 
(y)));
       else if (SCM_REALP (y))
-       return scm_i_from_double (SCM_REAL_VALUE (x) - SCM_REAL_VALUE (y));
+       return scm_i_from_double (r - 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));
+       return scm_c_make_rectangular (r - 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 (r - scm_i_fraction2double (y));
       else
-       return scm_wta_dispatch_2 (g_difference, x, y, SCM_ARGn, s_difference);
+        abort (); /* Unreachable.  */
     }
   else if (SCM_COMPLEXP (x))
     {
+      double r = SCM_COMPLEX_REAL (x);
+      double i = SCM_COMPLEX_IMAG (x);
       if (SCM_I_INUMP (y))
-       return scm_c_make_rectangular (SCM_COMPLEX_REAL (x) - SCM_I_INUM (y),
-                                SCM_COMPLEX_IMAG (x));
+       r -= SCM_I_INUM (y);
       else if (SCM_BIGP (y))
-       {
-         double real_part = (SCM_COMPLEX_REAL (x)
-                             - mpz_get_d (SCM_I_BIG_MPZ (y)));
-         scm_remember_upto_here_1 (x);
-         return scm_c_make_rectangular (real_part, SCM_COMPLEX_IMAG (y));      
-       }
+        r -= scm_integer_to_double_z (scm_bignum (y));
       else if (SCM_REALP (y))
-       return scm_c_make_rectangular (SCM_COMPLEX_REAL (x) - SCM_REAL_VALUE 
(y),
-                                SCM_COMPLEX_IMAG (x));
+        r -= SCM_REAL_VALUE (y);
       else 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));
+        r -= SCM_COMPLEX_REAL (y), i -= 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));
+       r -= scm_i_fraction2double (y);
       else
-       return scm_wta_dispatch_2 (g_difference, x, y, SCM_ARGn, s_difference);
+        abort (); /* Unreachable.  */
+      return scm_c_make_rectangular (r, i);
     }
   else if (SCM_FRACTIONP (x))
     {
-      if (SCM_I_INUMP (y))
-       /* a/b - c = (a - cb) / b */
-       return scm_i_make_ratio (scm_difference (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_difference (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_i_fraction2double (x) - SCM_REAL_VALUE 
(y));
+      if (scm_is_exact (y))
+        {
+          /* a/b - c/d = (ad - bc) / bd */
+          SCM n = scm_difference (scm_product (SCM_FRACTION_NUMERATOR (x),
+                                               scm_denominator (y)),
+                                  scm_product (scm_numerator (y),
+                                               SCM_FRACTION_DENOMINATOR (x)));
+          SCM d = scm_product (SCM_FRACTION_DENOMINATOR (x),
+                               scm_denominator (y));
+          return scm_i_make_ratio (n, d);
+        }
+
+      double xx = scm_i_fraction2double (x);
+      if (SCM_REALP (y))
+        return scm_i_from_double (xx - SCM_REAL_VALUE (y));
       else if (SCM_COMPLEXP (y))
-       return scm_c_make_rectangular (scm_i_fraction2double (x) - 
SCM_COMPLEX_REAL (y),
-                                -SCM_COMPLEX_IMAG (y));
-      else if (SCM_FRACTIONP (y))
-       /* a/b - c/d = (ad - bc) / bd */
-       return scm_i_make_ratio (scm_difference (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)));
+        return scm_c_make_rectangular (xx - SCM_COMPLEX_REAL (y),
+                                       -SCM_COMPLEX_IMAG (y));
       else
-       return scm_wta_dispatch_2 (g_difference, x, y, SCM_ARGn, s_difference);
+        abort (); /* Unreachable.  */
     }
   else
-    return scm_wta_dispatch_2 (g_difference, x, y, SCM_ARG1, s_difference);
+    abort (); /* Unreachable.  */
+}
+
+SCM_PRIMITIVE_GENERIC (scm_i_difference, "-", 0, 2, 1,
+                       (SCM x, SCM y, SCM rest),
+                       "If called with one argument @var{z1}, -@var{z1} 
returned. Otherwise\n"
+                       "the sum of all but the first argument are subtracted 
from the first\n"
+                       "argument.")
+#define FUNC_NAME s_scm_i_difference
+{
+  while (!scm_is_null (rest))
+    { x = scm_difference (x, y);
+      y = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return scm_difference (x, y);
 }
 #undef FUNC_NAME
 
+SCM
+scm_difference (SCM x, SCM y)
+{
+  if (SCM_UNBNDP (y))
+    {
+      if (SCM_NUMBERP (x)) return negate (x);
+      if (SCM_UNBNDP (x))
+        return scm_wta_dispatch_0 (g_scm_i_difference, s_scm_i_difference);
+      return scm_wta_dispatch_1 (g_scm_i_difference, x, SCM_ARG1,
+                                 s_scm_i_difference);
+    }
+  if (!SCM_NUMBERP (x))
+    return scm_wta_dispatch_2 (g_scm_i_difference, x, y, SCM_ARG1,
+                               s_scm_i_difference);
+  if (!SCM_NUMBERP (y))
+    return scm_wta_dispatch_2 (g_scm_i_difference, x, y, SCM_ARG2,
+                               s_scm_i_difference);
+  return difference (x, y);
+}
 
 SCM_DEFINE (scm_oneminus, "1-", 1, 0, 0, 
             (SCM x),