From fec5dcd419eac2bdc59ceda53714b8575436b148 Mon Sep 17 00:00:00 2001
From: Abdulaziz Ghuloum <aghuloum@cs.indiana.edu>
Date: Wed, 28 May 2008 22:21:08 -0700
Subject: [PATCH] sqrt, log, and expt now understand complex numbers.

---
 scheme/ikarus.numerics.ss | 44 +++++++++++++++++++++++++++++++++------
 scheme/last-revision      |  2 +-
 src/ikarus-flonums.c      |  8 +++++++
 3 files changed, 47 insertions(+), 7 deletions(-)

diff --git a/scheme/ikarus.numerics.ss b/scheme/ikarus.numerics.ss
index 1ebe90f..caa5473 100644
--- a/scheme/ikarus.numerics.ss
+++ b/scheme/ikarus.numerics.ss
@@ -2344,6 +2344,19 @@
             (die 'expt "result is too big to compute" n m)])]
         [(flonum? m) (flexpt (inexact n) m)]
         [(ratnum? m) (flexpt (inexact n) (inexact m))]
+        [(or (compnum? m) (cflonum? m))
+         ;; n^m = e^(m ln n)
+         ;; z = m ln n
+         ;; e^z = e^(zr + zi i)
+         ;;     = e^zr cos(zi) + e^zr sin(zi) i
+         (let ([e 2.718281828459045])
+           (define (ln x) (/ (log x) (log e)))
+           (let ([z (* m (ln n))])
+             (let ([zr (real-part z)] [zi (imag-part z)])
+               (let ([e^zr (expt e zr)])
+                 (make-rectangular 
+                   (* e^zr (cos zi))
+                   (* e^zr (sin zi)))))))]
         [else (die 'expt "not a number" m)])))
 
   (define quotient
@@ -2462,12 +2475,17 @@
         [else (die 'acos "not a number" x)])))
 
   (define atan
-    (lambda (x)
-      (cond
-        [(flonum? x) (foreign-call "ikrt_fl_atan" x)]
-        [(fixnum? x) (foreign-call "ikrt_fx_atan" x)]
-        [(number? x) (atan (inexact x))]
-        [else (die 'atan "not a number" x)])))
+    (case-lambda
+      [(x)
+       (cond
+         [(flonum? x) (foreign-call "ikrt_fl_atan" x)]
+         [(fixnum? x) (foreign-call "ikrt_fx_atan" x)]
+         [(or (ratnum? x) (bignum? x)) (atan (inexact x))]
+         [else (die 'atan "not a number" x)])]
+      [(y x)
+       (unless (real? x) (die 'atan "not a real number" x))
+       (unless (real? y) (die 'atan "not a real number" y))
+       (foreign-call "ikrt_atan2" (inexact y) (inexact x))]))
 
   (define sqrt
     (lambda (x)
@@ -2513,6 +2531,13 @@
         [(ratnum? x)
          ;;; FIXME: incorrect as per bug 180170
          (/ (sqrt ($ratnum-n x)) (sqrt ($ratnum-d x)))]
+        [(or (compnum? x) (cflonum? x))
+         (let ([xr (real-part x)] [xi (imag-part x)])
+           (let ([m (sqrt (+ (* xr xr) (* xi xi)))]
+                 [s (if (> xi 0) 1 -1)])
+             (make-rectangular 
+               (sqrt (/ (+ m xr) 2))
+               (* s (sqrt (/ (- m xr) 2))))))]
         [else (die 'sqrt "not a number" x)])))
 
   (define flsqrt
@@ -2694,6 +2719,13 @@
         [(ratnum? x) 
          ;;; FIXME: incorrect as per bug 180170
          (- (log (numerator x)) (log (denominator x)))]
+        [(or (compnum? x) (cflonum? x))
+         (let ([e 2.718281828459045])
+           (define (ln x) (/ (log x) (log e)))
+           (let ([xr (real-part x)] [xi (imag-part x)])
+             (make-rectangular 
+               (/ (ln (+ (* xr xr) (* xi xi))) 2)
+               (atan xi xr))))]
         [else (die 'log "not a number" x)])))
 
   (define string->number
diff --git a/scheme/last-revision b/scheme/last-revision
index 941df00..f3526cb 100644
--- a/scheme/last-revision
+++ b/scheme/last-revision
@@ -1 +1 @@
-1489
+1490
diff --git a/src/ikarus-flonums.c b/src/ikarus-flonums.c
index f699c56..d71e189 100644
--- a/src/ikarus-flonums.c
+++ b/src/ikarus-flonums.c
@@ -143,6 +143,14 @@ ikrt_fl_atan(ikptr x, ikpcb* pcb){
   return r;
 }
 
+ikptr
+ikrt_atan2(ikptr y, ikptr x, ikpcb* pcb){
+  ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
+  ref(r, -vector_tag) = (ikptr)flonum_tag;
+  flonum_data(r) = atan2(flonum_data(y), flonum_data(x));
+  return r;
+}
+