fixed a few problems in geometric functions when they are passed

complex numbers or when they're passed real numbers but the results
are complex.

c64

@@ -1,8 +1,8 @@
 #!/usr/bin/env sh
 
 ./configure --prefix=/Users/ikarus/.opt \
-  CFLAGS="-m64 -g -I/Users/ikarus/.opt64/include" \
+  CFLAGS="-m64 -I/Users/ikarus/.opt64/include" \
-  LDFLAGS="-m64 -g -L/Users/ikarus/.opt64/lib" \
+  LDFLAGS="-m64 -L/Users/ikarus/.opt64/lib" \
 && make clean \
 && make
 

scheme/ikarus.compiler.source-optimizer.ss

@@ -238,6 +238,12 @@
       [(sub1 _)                    foldable             result-true]
       [(bitwise-and _ _)           foldable             result-true]
       [(make-rectangular _ _)      foldable             result-true]
+      [(sin _)                     foldable             result-true]
+      [(cos _)                     foldable             result-true]
+      [(tan _)                     foldable             result-true]
+      [(asin _)                    foldable             result-true]
+      [(acos _)                    foldable             result-true]
+      [(atan _)                    foldable             result-true]
       [(make-eq-hashtable)                  effect-free result-true]
       [(string->number _)          foldable                        ]
       [(string->number _ _)        foldable                        ]

scheme/ikarus.numerics.ss

@@ -1401,9 +1401,9 @@
            [else
             (f (max a b) (car ls) (cdr ls))]))]
       [(x) 
-       (if (number? x) 
+       (cond
-           x 
+         [(or (fixnum? x) (bignum? x) (ratnum? x) (flonum? x)) x]
-           (die 'max "not a number" x))]))
+         [else (die 'max "not a number" x)])]))
 
   (define min
     (case-lambda
@@ -1464,9 +1464,9 @@
            [else
             (f (min a b) (car ls) (cdr ls))]))]
       [(x) 
-       (if (number? x) 
+       (cond
-           x 
+         [(or (fixnum? x) (bignum? x) (ratnum? x) (flonum? x)) x]
-           (die 'min "not a number" x))]))
+         [else (die 'min "not a number" x)])]))
 
   (define (abs x)
     (cond
@@ -2388,6 +2388,9 @@
         [(ratnum? x) #f]
         [(flonum? x)
          (or ($fl= x 0.0) ($fl= x -0.0))]
+        [(cflonum? x) 
+         (and ($fl= ($cflonum-real x) 0.0) ($fl= ($cflonum-imag x) 0.0))]
+        [(compnum? x) #f]
         [else 
          (die 'zero? "not a number" x)])))
 
@@ -2512,6 +2515,78 @@
         [(ratnum? x) (negative? ($ratnum-n x))]
         [else (die 'negative? "not a number" x)])))
 
+  (define sinh
+    (lambda (x)
+      (define who 'sinh)
+      (cond
+        [(flonum? x) (foreign-call "ikrt_fl_sinh" x)]
+        [(or (fixnum? x) (bignum? x) (ratnum? x))
+         (sinh (inexact x))]
+        [(number? x) (error who "not implemented" x)]
+        [else (die who "not a number" x)])))
+
+  (define cosh
+    (lambda (x)
+      (define who 'cosh)
+      (cond
+        [(flonum? x) (foreign-call "ikrt_fl_cosh" x)]
+        [(or (fixnum? x) (bignum? x) (ratnum? x))
+         (cosh (inexact x))]
+        [(number? x) (error who "not implemented" x)]
+        [else (die who "not a number" x)])))
+
+  (define tanh
+    (lambda (x)
+      (define who 'tanh)
+      (cond
+        [(flonum? x) (foreign-call "ikrt_fl_tanh" x)]
+        [(or (fixnum? x) (bignum? x) (ratnum? x))
+         (tanh (inexact x))]
+        [(number? x) (error who "not implemented" x)]
+        [else (die who "not a number" x)])))
+
+  (define asinh
+    (lambda (x)
+      (define who 'asinh)
+      (cond
+        [(flonum? x) (foreign-call "ikrt_fl_asinh" x)]
+        [(or (fixnum? x) (bignum? x) (ratnum? x))
+         (asinh (inexact x))]
+        [(number? x) (error who "not implemented" x)]
+        [else (die who "not a number" x)])))
+
+  (define acosh
+    (lambda (x)
+      (define who 'acosh)
+      (cond
+        [(flonum? x) 
+         (cond
+           [($fl>= x 1.0) (foreign-call "ikrt_fl_acosh" x)]
+           [($fl>= x -1.0)
+            (make-rectangular 0 (atan (sqrt (- 1 (* x x))) x))]
+           [($fl< x -1.0)
+            (make-rectangular (acosh (- x)) PI)]
+           [else +nan.0])]
+        [(or (fixnum? x) (bignum? x) (ratnum? x))
+         (acosh (inexact x))]
+        [(number? x) (error who "not implemented" x)]
+        [else (die who "not a number" x)])))
+
+  (define atanh
+    (lambda (x)
+      (define who 'atanh)
+      (cond
+        [(flonum? x) (foreign-call "ikrt_fl_atanh" x)]
+        [(or (fixnum? x) (bignum? x) (ratnum? x))
+         (atanh (inexact x))]
+        [(number? x) (error who "not implemented" x)]
+        [else (die who "not a number" x)])))
+
+
+
+
+
+
   (define sin
     (lambda (x)
       (cond
@@ -2520,6 +2595,11 @@
          (if (fx=? x 0)
              0
              (foreign-call "ikrt_fx_sin" x))]
+        [(or (cflonum? x) (compnum? x))
+         (let ([r (real-part x)] [i (imag-part x)])
+           (make-rectangular 
+             (* (sin r) (cosh i))
+             (* (cos r) (sinh i))))]
         [(number? x) (sin (inexact x))]
         [else (die 'sin "not a number" x)])))
 
@@ -2531,6 +2611,11 @@
          (if (fx=? x 0)
              1
              (foreign-call "ikrt_fx_cos" x))]
+        [(or (cflonum? x) (compnum? x))
+         (let ([r (real-part x)] [i (imag-part x)])
+           (make-rectangular 
+             (* (cos r) (cosh i))
+             (* (sin r) (sinh i))))]
         [(number? x) (cos (inexact x))]
         [else (die 'cos "not a number" x)])))
 
@@ -2542,22 +2627,50 @@
          (if (fx=? x 0)
              0
              (foreign-call "ikrt_fx_tan" x))]
+        [(or (cflonum? x) (compnum? x))
+         (let ([r (real-part x)] [i (imag-part x)])
+           (make-rectangular
+             (/ (sin (* 2 r)) 
+                (+ (cos (* 2 r)) (cosh (* 2 i))))
+             (/ (tanh (* 2 i))
+                (+ 1 (/ (cos (* 2 r)) (cosh (* 2 i)))))))]
         [(number? x) (tan (inexact x))]
         [else (die 'tan "not a number" x)])))
 
+  (module (PI PI/2)
+    (import (ikarus))
+    (define PI (acos -1))
+    (define PI/2 (/ PI 2)))
+
   (define asin
     (lambda (x)
       (cond
-        [(flonum? x) (foreign-call "ikrt_fl_asin" x)]
+        [(flonum? x) 
-        [(fixnum? x) (foreign-call "ikrt_fx_asin" x)]
+         (cond
+           [($fl> x 1.0)
+            (make-rectangular PI/2 (acosh x))]
+           [($fl< x -1.0)
+            (make-rectangular (- PI/2) (- (acosh x)))]
+           [else
+            (foreign-call "ikrt_fl_asin" x)])]
+        [(or (cflonum? x) (compnum? x)) 
+         (error 'asin "not implemented for complex arguments")]
         [(number? x) (asin (inexact x))]
         [else (die 'asin "not a number" x)])))
 
   (define acos
     (lambda (x)
       (cond
-        [(flonum? x) (foreign-call "ikrt_fl_acos" x)]
+        [(flonum? x)
-        [(fixnum? x) (foreign-call "ikrt_fx_acos" x)]
+         (cond
+           [($fl> x 1.0)
+            (make-rectangular 0 (acosh x))]
+           [($fl< x -1.0)
+            (make-rectangular PI (- (acosh (- x))))]
+           [else
+            (foreign-call "ikrt_fl_acos" x)])] 
+        [(or (cflonum? x) (compnum? x)) 
+         (error 'acos "not implemented for complex arguments")]
         [(number? x) (acos (inexact x))]
         [else (die 'acos "not a number" x)])))
 
@@ -3784,10 +3897,10 @@
 
   (define (make-polar mag angle)
     (define who 'make-polar)
-    (unless (number? mag)
+    (unless (real? mag)
-      (die who "not a number" mag))
+      (die who "not a real number" mag))
-    (unless (number? angle)
+    (unless (real? angle)
-      (die who "not a number" angle))
+      (die who "not a real number" angle))
     (make-rectangular 
       (* mag (cos angle))
       (* mag (sin angle))))

scheme/last-revision

@@ -1 +1 @@
-1583
+1584

src/ikarus-flonums.c

@@ -41,10 +41,6 @@ ikrt_flfl_expt(ikptr a, ikptr b, ikptr z){
   return z;
 }
 
-
-
-
-
 ikptr
 ikrt_bytevector_to_flonum(ikptr x, ikpcb* pcb){
   double v = strtod((char*)(long)x+off_bytevector_data, NULL);
@@ -54,7 +50,6 @@ ikrt_bytevector_to_flonum(ikptr x, ikpcb* pcb){
   return r;
 }
 
-
 ikptr
 ikrt_fl_plus(ikptr x, ikptr y,ikpcb* pcb){
   ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
@@ -151,9 +146,6 @@ ikrt_atan2(ikptr y, ikptr x, ikpcb* pcb){
   return r;
 }
 
-
-
-
 ikptr
 ikrt_fl_sqrt(ikptr x, ikpcb* pcb){
   ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
@@ -170,7 +162,6 @@ ikrt_fl_log(ikptr x, ikpcb* pcb){
   return r;
 }
 
-
 ikptr
 ikrt_fx_sin(ikptr x, ikpcb* pcb){
   ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
@@ -219,6 +210,56 @@ ikrt_fx_atan(ikptr x, ikpcb* pcb){
   return r;
 }
 
+ikptr
+ikrt_fl_sinh(ikptr x, ikpcb* pcb){
+  ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
+  ref(r, -vector_tag) = (ikptr)flonum_tag;
+  flonum_data(r) = sinh(flonum_data(x));
+  return r;
+}
+
+ikptr
+ikrt_fl_cosh(ikptr x, ikpcb* pcb){
+  ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
+  ref(r, -vector_tag) = (ikptr)flonum_tag;
+  flonum_data(r) = cosh(flonum_data(x));
+  return r;
+}
+
+ikptr
+ikrt_fl_tanh(ikptr x, ikpcb* pcb){
+  ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
+  ref(r, -vector_tag) = (ikptr)flonum_tag;
+  flonum_data(r) = tanh(flonum_data(x));
+  return r;
+}
+
+ikptr
+ikrt_fl_asinh(ikptr x, ikpcb* pcb){
+  ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
+  ref(r, -vector_tag) = (ikptr)flonum_tag;
+  flonum_data(r) = asinh(flonum_data(x));
+  return r;
+}
+
+ikptr
+ikrt_fl_acosh(ikptr x, ikpcb* pcb){
+  ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
+  ref(r, -vector_tag) = (ikptr)flonum_tag;
+  flonum_data(r) = acosh(flonum_data(x));
+  return r;
+}
+
+ikptr
+ikrt_fl_atanh(ikptr x, ikpcb* pcb){
+  ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
+  ref(r, -vector_tag) = (ikptr)flonum_tag;
+  flonum_data(r) = atanh(flonum_data(x));
+  return r;
+}
+
+
+
 ikptr
 ikrt_fx_sqrt(ikptr x, ikpcb* pcb){
   ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
@@ -227,7 +268,6 @@ ikrt_fx_sqrt(ikptr x, ikpcb* pcb){
   return r;
 }
 
-
 ikptr
 ikrt_fx_log(ikptr x, ikpcb* pcb){
   ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
@@ -236,7 +276,6 @@ ikrt_fx_log(ikptr x, ikpcb* pcb){
   return r;
 }
 
-
 ikptr
 ikrt_fixnum_to_flonum(ikptr x, ikptr r, ikpcb* pcb){
   flonum_data(r) = unfix(x);