Add expt (#26)

It signals an error when the exponent is negative, since sigscheme only
implements integer math.

This is an iterative implementation of exponentiation by squaring - and
it works with negative bases.

---------

Co-authored-by: Sutou Kouhei <kou@cozmixng.org>

Author: jpellegrini

doc/spec.txt

@@ -439,7 +439,6 @@ Numbers
   - *procedure:* atan z
   - *procedure:* atan y x
   - *procedure:* sqrt z
-  - *procedure:* expt z1 z2
   - *procedure:* make-rectangular x1 x2
   - *procedure:* make-polar x3 x4
   - *procedure:* real-part z

src/number.c

@@ -45,6 +45,7 @@
 =======================================*/
 #define ERRMSG_DIV_BY_ZERO     "division by zero"
 #define ERRMSG_REQ_1_ARG       "at least 1 argument required"
+#define ERRMSG_NEGATIVE_EXP    "negative exponent"
 
 /*=======================================
   File Local Type Definitions
@@ -417,3 +418,30 @@ scm_p_remainder(ScmObj _n1, ScmObj _n2)
 
     return MAKE_INT(n1 % n2);
 }
+
+SCM_EXPORT ScmObj
+scm_p_expt(ScmObj _base, ScmObj _expo)
+{
+    scm_int_t base, expo, result;
+    DECLARE_FUNCTION("expt", procedure_fixed_2);
+
+    ENSURE_INT(_base);
+    ENSURE_INT(_expo);
+
+    base = SCM_INT_VALUE(_base);
+    expo = SCM_INT_VALUE(_expo);
+
+    /* SigScheme only implements integer numbers, so negative
+       exponents are not allowed. */
+    if (expo < 0) ERR(ERRMSG_NEGATIVE_EXP);
+
+    result = 1;
+    while (expo > 0) {
+        if (expo % 2 == 1)
+            result *= base;
+        base *= base;
+        expo /= 2;
+    }
+
+    return MAKE_INT(result);
+}

src/sigscheme.h

@@ -1474,6 +1474,7 @@ SCM_EXPORT ScmObj scm_p_abs(ScmObj _n);
 SCM_EXPORT ScmObj scm_p_quotient(ScmObj _n1, ScmObj _n2);
 SCM_EXPORT ScmObj scm_p_modulo(ScmObj _n1, ScmObj _n2);
 SCM_EXPORT ScmObj scm_p_remainder(ScmObj _n1, ScmObj _n2);
+SCM_EXPORT ScmObj scm_p_expt(ScmObj _n1, ScmObj _n2);
 #endif /* SCM_USE_NUMBER */
 
 /* number-io.c */

test/test-number-arith.scm

@@ -1843,5 +1843,13 @@
                                                -9223372036854775808))"))
   (else
    (assert-fail (tn) "unknown int bitwidth")))
+(tn "expt")
+(assert-equal? (tn)   9 (expt  3  2))
+(assert-equal? (tn)   9 (expt -3  2))
+(assert-equal? (tn)  27 (expt  3  3))
+(assert-equal? (tn) -27 (expt -3  3))
+(assert-equal? (tn)   1 (expt -3  0))
+(assert-equal? (tn)   0 (expt  0 11))
+(assert-error  (tn)     (lambda () (expt  3 -2)))
 
 (total-report)