2 (c) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved.
3 Copying of this file is authorized to users who have executed the true and
4 proper "License Agreement for Kyoto Common LISP" with SIGLISP.
8 #include "num_include.h"
10 object imag_unit
, minus_imag_unit
, imag_two
;
40 return(make_longfloat(exp(number_to_double(x
))));
43 return(make_shortfloat((shortfloat
)exp((double)(sf(x
)))));
46 return(make_longfloat(exp(lf(x
))));
51 object
number_sin(), number_cos();
62 y
= make_complex(y1
, y
);
64 x
= number_times(x
, y
);
70 FEwrong_type_argument(Snumber
, x
);
79 object z
, number_nlog();
84 if (ty
== t_fixnum
&& fix(y
) == 0)
86 case t_fixnum
: case t_bignum
: case t_ratio
:
87 return(small_fixnum(1));
90 return(make_shortfloat((shortfloat
)1.0));
93 return(make_longfloat(1.0));
96 z
= number_expt(x
->cmp
.cmp_real
, y
);
98 z
= make_complex(z
, small_fixnum(0));
103 FEwrong_type_argument(Snumber
, x
);
105 if (number_zerop(x
)) {
106 if (!number_plusp(ty
==t_complex
?y
->cmp
.cmp_real
:y
))
107 FEerror("Cannot raise zero to the power ~S.", 1, y
);
108 return(number_times(x
, y
));
110 if (ty
== t_fixnum
|| ty
== t_bignum
) {
111 if (number_minusp(y
)) {
112 z
= number_negate(y
);
114 z
= number_expt(x
, z
);
116 z
= number_divide(small_fixnum(1), z
);
124 while (number_plusp(y
))
125 if (number_evenp(y
)) {
126 x
= number_times(x
, x
);
128 y
= integer_divide1(y
, small_fixnum(2));
131 z
= number_times(z
, x
);
133 y
= number_minus(y
, small_fixnum(1));
141 z
= number_times(z
, y
);
153 object r
, i
, a
, p
, number_sqrt(), number_atan2();
156 if (type_of(x
) == t_complex
) {
162 FEerror("Zero is the logarithmic singularity.", 0);
163 if (number_minusp(x
)) {
168 switch (type_of(x
)) {
172 return(make_longfloat(log(number_to_double(x
))));
175 return(make_shortfloat((shortfloat
)log((double)(sf(x
)))));
178 return(make_longfloat(log(lf(x
))));
181 FEwrong_type_argument(Snumber
, x
);
185 a
= number_times(r
, r
);
187 p
= number_times(i
, i
);
189 a
= number_plus(a
, p
);
193 a
= number_divide(a
, small_fixnum(2));
195 p
= number_atan2(i
, r
);
197 x
= make_complex(a
, p
);
210 FEerror("Zero is the logarithmic singularity.", 0);
212 return(number_times(x
, y
));
217 z
= number_divide(y
, x
);
230 if (type_of(x
) == t_complex
)
232 if (number_minusp(x
))
234 switch (type_of(x
)) {
238 return(make_longfloat(sqrt(number_to_double(x
))));
241 return(make_shortfloat((shortfloat
)sqrt((double)(sf(x
)))));
244 return(make_longfloat(sqrt(lf(x
))));
247 FEwrong_type_argument(Snumber
, x
);
251 z
= make_ratio(small_fixnum(1), small_fixnum(2));
253 z
= number_expt(x
, z
);
263 double atan(), dy
, dx
, dz
;
265 dy
= number_to_double(y
);
266 dx
= number_to_double(x
);
273 dz
= -atan(-dy
/ dx
);
278 FEerror("Logarithmic singularity.", 0);
283 dz
= PI
- atan(dy
/ -dx
);
287 dz
= -PI
+ atan(-dy
/ -dx
);
288 z
= make_longfloat(dz
);
299 if (type_of(y
) == t_complex
) {
300 z
= number_times(imag_unit
, y
);
304 z1
= number_times(y
, y
);
308 z1
= number_sqrt(z1
);
310 z
= number_divide(z
, z1
);
314 z
= number_times(minus_imag_unit
, z
);
318 return(number_atan2(y
, small_fixnum(1)));
327 switch (type_of(x
)) {
332 return(make_longfloat(sin(number_to_double(x
))));
335 return(make_shortfloat((shortfloat
)sin((double)(sf(x
)))));
338 return(make_longfloat(sin(lf(x
))));
346 x0
= number_times(imag_unit
, x
);
350 x1
= number_times(minus_imag_unit
, x
);
354 x2
= number_minus(x0
, x1
);
356 r
= number_divide(x2
, imag_two
);
363 FEwrong_type_argument(Snumber
, x
);
374 switch (type_of(x
)) {
379 return(make_longfloat(cos(number_to_double(x
))));
382 return(make_shortfloat((shortfloat
)cos((double)(sf(x
)))));
385 return(make_longfloat(cos(lf(x
))));
393 x0
= number_times(imag_unit
, x
);
397 x1
= number_times(minus_imag_unit
, x
);
401 x2
= number_plus(x0
, x1
);
403 r
= number_divide(x2
, small_fixnum(2));
410 FEwrong_type_argument(Snumber
, x
);
426 if (number_zerop(c
) == TRUE
)
427 FEerror("Cannot compute the tangent of ~S.", 1, x
);
428 r
= number_divide(s
, c
);
440 /* check for a real argument in [-1,1] */
441 if (type_of(x
) != t_complex
) {
442 switch (type_of(x
)) {
446 dx
= number_to_double(x
);
455 FEwrong_type_argument(Snumber
, x
);
457 if (-1.0 <= dx
&& dx
<= 1.0) return(make_longfloat(asin(dx
)));
460 /* treat as complex argument, result */
466 x0
= number_times(x
, x
);
468 x0
= number_minus(small_fixnum(1), x0
);
470 x0
= number_sqrt(x0
);
472 x1
= number_times(imag_unit
, x
);
474 x0
= number_plus(x0
, x1
);
476 x0
= number_nlog(x0
);
478 r
= number_times(minus_imag_unit
, x0
);
491 /* check for a real argument in [-1,1] */
492 if (type_of(x
) != t_complex
) {
493 switch (type_of(x
)) {
497 dx
= number_to_double(x
);
506 FEwrong_type_argument(Snumber
, x
);
508 if (-1.0 <= dx
&& dx
<= 1.0) return(make_longfloat(acos(dx
)));
511 /* treat as complex argument, result */
517 x0
= number_times(x
, x
);
519 x0
= number_minus(small_fixnum(1), x0
);
521 x0
= number_sqrt(x0
);
523 x0
= number_times(imag_unit
, x0
);
525 x0
= number_plus(x0
, x
);
527 x0
= number_nlog(x0
);
529 r
= number_times(minus_imag_unit
, x0
);
538 check_type_number(&vs_base
[0]);
539 vs_base
[0] = number_exp(vs_base
[0]);
545 check_type_number(&vs_base
[0]);
546 check_type_number(&vs_base
[1]);
547 vs_base
[0] = number_expt(vs_base
[0], vs_base
[1]);
555 narg
= vs_top
- vs_base
;
558 else if (narg
== 1) {
559 check_type_number(&vs_base
[0]);
560 vs_base
[0] = number_nlog(vs_base
[0]);
561 } else if (narg
== 2) {
562 check_type_number(&vs_base
[0]);
563 check_type_number(&vs_base
[1]);
564 vs_base
[0] = number_log(vs_base
[1], vs_base
[0]);
567 too_many_arguments();
573 check_type_number(&vs_base
[0]);
574 vs_base
[0] = number_sqrt(vs_base
[0]);
580 check_type_number(&vs_base
[0]);
581 vs_base
[0] = number_sin(vs_base
[0]);
587 check_type_number(&vs_base
[0]);
588 vs_base
[0] = number_cos(vs_base
[0]);
594 check_type_number(&vs_base
[0]);
595 vs_base
[0] = number_tan(vs_base
[0]);
602 narg
= vs_top
- vs_base
;
606 check_type_number(&vs_base
[0]);
607 vs_base
[0] = number_atan(vs_base
[0]);
608 } else if (narg
== 2) {
609 check_type_or_rational_float(&vs_base
[0]);
610 check_type_or_rational_float(&vs_base
[1]);
611 vs_base
[0] = number_atan2(vs_base
[0], vs_base
[1]);
614 too_many_arguments();
620 check_type_number(&vs_base
[0]);
621 vs_base
[0] = number_asin(vs_base
[0]);
627 check_type_number(&vs_base
[0]);
628 vs_base
[0] = number_acos(vs_base
[0]);
634 = make_complex(make_longfloat(0.0), make_longfloat(1.0));
635 enter_mark_origin(&imag_unit
);
637 = make_complex(make_longfloat(0.0), make_longfloat(-1.0));
638 enter_mark_origin(&minus_imag_unit
);
640 = make_complex(make_longfloat(0.0), make_longfloat(2.0));
641 enter_mark_origin(&imag_two
);
643 make_constant("PI", make_longfloat(PI
));
645 make_function("EXP", Lexp
);
646 make_function("EXPT", Lexpt
);
647 make_function("LOG", Llog
);
648 make_function("SQRT", Lsqrt
);
649 make_function("SIN", Lsin
);
650 make_function("COS", Lcos
);
651 make_function("TAN", Ltan
);
652 make_function("ATAN", Latan
);
653 make_function("ASIN", Lasin
);
654 make_function("ACOS", Lacos
);