conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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.
This commit is contained in:
Abdulaziz Ghuloum 2008-08-11 10:37:05 -07:00
parent e58c53cca5
commit c64fda7619
5 changed files with 186 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
c64
View File

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

6
scheme/ikarus.compiler.source-optimizer.ss
View File

@ -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 ]

141
scheme/ikarus.numerics.ss
View File

@ -1401,9 +1401,9 @@
[else
(f (max a b) (car ls) (cdr ls))]))]
[(x)
(if (number? x)
x
(die 'max "not a number" x))]))
(cond
[(or (fixnum? x) (bignum? x) (ratnum? x) (flonum? x)) 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)
x
(die 'min "not a number" x))]))
(cond
[(or (fixnum? x) (bignum? x) (ratnum? x) (flonum? x)) 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)]
[(fixnum? x) (foreign-call "ikrt_fx_asin" x)]
[(flonum? 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)]
[(fixnum? x) (foreign-call "ikrt_fx_acos" x)]
[(flonum? 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)
(die who "not a number" mag))
(unless (number? angle)
(die who "not a number" angle))
(unless (real? mag)
(die who "not a real number" mag))
(unless (real? angle)
(die who "not a real number" angle))
(make-rectangular
(* mag (cos angle))
(* mag (sin angle))))

2
scheme/last-revision
View File

@ -1 +1 @@
1583
1584

61
src/ikarus-flonums.c
View File

@ -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);