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; +} +