[Emacs-diffs] master 47b7a5b: Add bignum support to expt

[Paul Eggert]

branch: master
commit 47b7a5bd492e92dda928843e28a707b9682cb32f
Author: Paul Eggert <address@hidden>
Commit: Paul Eggert <address@hidden>

    Add bignum support to expt
    
    Problem and initial solution reported by Andy Moreton in:
    https://lists.gnu.org/r/emacs-devel/2018-08/msg00503.html
    * doc/lispref/numbers.texi (Math Functions): expt integer
    overflow no longer causes truncation; it now signals an error
    since bignum overflow is a big deal.
    * src/floatfns.c (Fexpt): Support bignum arguments.
    * test/src/floatfns-tests.el (bignum-expt): New test.
---
 doc/lispref/numbers.texi   |  2 +-
 src/floatfns.c             | 47 ++++++++++++++++++++++++++--------------------
 test/src/floatfns-tests.el |  9 +++++++++
 3 files changed, 37 insertions(+), 21 deletions(-)

diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi
index 74a313e..209e9f1 100644
--- a/doc/lispref/numbers.texi
+++ b/doc/lispref/numbers.texi
@@ -1185,7 +1185,7 @@ returns a NaN.
 @defun expt x y
 This function returns @var{x} raised to power @var{y}.  If both
 arguments are integers and @var{y} is nonnegative, the result is an
-integer; in this case, overflow causes truncation, so watch out.
+integer; in this case, overflow signals an error, so watch out.
 If @var{x} is a finite negative number and @var{y} is a finite
 non-integer, @code{expt} returns a NaN.
 @end defun
diff --git a/src/floatfns.c b/src/floatfns.c
index 713d426..54d068c 100644
--- a/src/floatfns.c
+++ b/src/floatfns.c
@@ -204,29 +204,36 @@ DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0,
        doc: /* Return the exponential ARG1 ** ARG2.  */)
   (Lisp_Object arg1, Lisp_Object arg2)
 {
-  CHECK_FIXNUM_OR_FLOAT (arg1);
-  CHECK_FIXNUM_OR_FLOAT (arg2);
-  if (FIXNUMP (arg1)     /* common lisp spec */
-      && FIXNUMP (arg2)   /* don't promote, if both are ints, and */
-      && XFIXNUM (arg2) >= 0) /* we are sure the result is not fractional */
-    {                          /* this can be improved by pre-calculating */
-      EMACS_INT y;             /* some binary powers of x then accumulating */
-      EMACS_UINT acc, x;  /* Unsigned so that overflow is well defined.  */
-      Lisp_Object val;
-
-      x = XFIXNUM (arg1);
-      y = XFIXNUM (arg2);
-      acc = (y & 1 ? x : 1);
-
-      while ((y >>= 1) != 0)
+  CHECK_NUMBER (arg1);
+  CHECK_NUMBER (arg2);
+
+  /* Common Lisp spec: don't promote if both are integers, and if the
+     result is not fractional.  */
+  if (INTEGERP (arg1) && NATNUMP (arg2))
+    {
+      unsigned long exp;
+      if (RANGED_FIXNUMP (0, arg2, ULONG_MAX))
+       exp = XFIXNUM (arg2);
+      else if (MOST_POSITIVE_FIXNUM < ULONG_MAX && BIGNUMP (arg2)
+              && mpz_fits_ulong_p (XBIGNUM (arg2)->value))
+       exp = mpz_get_ui (XBIGNUM (arg2)->value);
+      else
+       xsignal3 (Qrange_error, build_string ("expt"), arg1, arg2);
+
+      mpz_t val;
+      mpz_init (val);
+      if (FIXNUMP (arg1))
        {
-         x *= x;
-         if (y & 1)
-           acc *= x;
+         mpz_set_intmax (val, XFIXNUM (arg1));
+         mpz_pow_ui (val, val, exp);
        }
-      XSETINT (val, acc);
-      return val;
+      else
+       mpz_pow_ui (val, XBIGNUM (arg1)->value, exp);
+      Lisp_Object res = make_number (val);
+      mpz_clear (val);
+      return res;
     }
+
   return make_float (pow (XFLOATINT (arg1), XFLOATINT (arg2)));
 }
 
diff --git a/test/src/floatfns-tests.el b/test/src/floatfns-tests.el
index 43a2e27..e4caaa1 100644
--- a/test/src/floatfns-tests.el
+++ b/test/src/floatfns-tests.el
@@ -42,6 +42,15 @@
   (should (= most-positive-fixnum
              (- (abs most-negative-fixnum) 1))))
 
+(ert-deftest bignum-expt ()
+  (dolist (n (list most-positive-fixnum (1+ most-positive-fixnum)
+                   most-negative-fixnum (1- most-negative-fixnum)
+                   -2 -1 0 1 2))
+    (should (= (expt n 0) 1))
+    (should (= (expt n 1) n))
+    (should (= (expt n 2) (* n n)))
+    (should (= (expt n 3) (* n n n)))))
+
 (ert-deftest bignum-logb ()
   (should (= (+ (logb most-positive-fixnum) 1)
              (logb (+ most-positive-fixnum 1)))))