expt implemented in C, handles complex numbers

* libguile/numbers.h:
* libguile/numbers.c (scm_expt): Rename from scm_sys_expt, and handle
  the complex cases as well.

* libguile/deprecated.h:
* libguile/deprecated.c (scm_sys_expt): Add a deprecated shim.

* module/ice-9/boot-9.scm (expt): Remove definition, scm_expt does all
  we need.

diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index 8b1fce8..0b6d83f 100644 (file)
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -1215,6 +1215,14 @@ scm_round (double x)
   return scm_c_round (x);
 }
 
+SCM
+scm_sys_expt (SCM x, SCM y)
+{
+  scm_c_issue_deprecation_warning
+    ("scm_sys_expt is deprecated.  Use scm_expt instead.");
+  return scm_expt (x, y);
+}
+
 char *
 scm_i_deprecated_symbol_chars (SCM sym)
 {

diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index f20e47c..1c58bce 100644 (file)
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -400,6 +400,8 @@ SCM_DEPRECATED char *scm_c_symbol2str (SCM obj, char *str, size_t *lenp);
 */
 SCM_DEPRECATED double scm_truncate (double x);
 SCM_DEPRECATED double scm_round (double x);
+/* Deprecated, use scm_expt */
+SCM_DEPRECATED SCM scm_sys_expt (SCM x, SCM y);
 
 /* Deprecated because we don't want people to access the internal
    representation of strings directly.

diff --git a/libguile/numbers.c b/libguile/numbers.c
index 15c49c0..c0d88f3 100644 (file)
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -5328,15 +5328,19 @@ scm_two_doubles (SCM x, SCM y, const char *sstring, struct dpair *xy)
 }
 
 
-SCM_DEFINE (scm_sys_expt, "$expt", 2, 0, 0,
+SCM_DEFINE (scm_expt, "expt", 2, 0, 0,
             (SCM x, SCM y),
-           "Return @var{x} raised to the power of @var{y}. This\n"
-           "procedure does not accept complex arguments.") 
-#define FUNC_NAME s_scm_sys_expt
+           "Return @var{x} raised to the power of @var{y}.") 
+#define FUNC_NAME s_scm_expt
 {
-  struct dpair xy;
-  scm_two_doubles (x, y, FUNC_NAME, &xy);
-  return scm_from_double (pow (xy.x, xy.y));
+  if (!SCM_INEXACTP (y) && scm_is_integer (y))
+    return scm_integer_expt (x, y);
+  else if (scm_is_real (x) && scm_is_real (y) && scm_to_double (x) >= 0.0)
+    {
+      return scm_from_double (pow (scm_to_double (x), scm_to_double (y)));
+    }
+  else
+    return scm_exp (scm_product (scm_log (x), y));
 }
 #undef FUNC_NAME
 

diff --git a/libguile/numbers.h b/libguile/numbers.h
index 9597afb..c607c4a 100644 (file)
--- a/libguile/numbers.h
+++ b/libguile/numbers.h
@@ -252,7 +252,7 @@ SCM_API double scm_c_truncate (double x);
 SCM_API double scm_c_round (double x);
 SCM_API SCM scm_truncate_number (SCM x);
 SCM_API SCM scm_round_number (SCM x);
-SCM_API SCM scm_sys_expt (SCM z1, SCM z2);
+SCM_API SCM scm_expt (SCM z1, SCM z2);
 SCM_API SCM scm_sys_atan2 (SCM z1, SCM z2);
 SCM_API SCM scm_make_rectangular (SCM z1, SCM z2);
 SCM_API SCM scm_make_polar (SCM z1, SCM z2);

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index f4274f7..b3d9d4f 100644 (file)
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -952,16 +952,6 @@
 ;;; See the file `COPYING' for terms applying to this program.
 ;;;
 
-(define expt
-  (let ((integer-expt integer-expt))
-    (lambda (z1 z2)
-      (cond ((and (exact? z2) (integer? z2))
-            (integer-expt z1 z2))
-           ((and (real? z2) (real? z1) (>= z1 0))
-            ($expt z1 z2))
-           (else
-            (exp (* z2 (log z1))))))))
-
 (define (sinh z)
   (if (real? z) ($sinh z)
       (let ((x (real-part z)) (y (imag-part z)))