| … | |
… | |
| 3999 | |
3999 | |
| 4000 | switch (op) |
4000 | switch (op) |
| 4001 | { |
4001 | { |
| 4002 | #if USE_MATH |
4002 | #if USE_MATH |
| 4003 | case OP_INEX2EX: /* inexact->exact */ |
4003 | case OP_INEX2EX: /* inexact->exact */ |
| 4004 | { |
|
|
| 4005 | if (is_integer (x)) |
4004 | if (!is_integer (x)) |
| 4006 | s_return (x); |
4005 | { |
| 4007 | |
|
|
| 4008 | RVALUE r = rvalue_unchecked (x); |
4006 | RVALUE r = rvalue_unchecked (x); |
| 4009 | |
4007 | |
| 4010 | if (r == (RVALUE)(IVALUE)r) |
4008 | if (r == (RVALUE)(IVALUE)r) |
| 4011 | s_return (mk_integer (SCHEME_A_ rvalue_unchecked (x))); |
4009 | x = mk_integer (SCHEME_A_ rvalue_unchecked (x)); |
| 4012 | else |
4010 | else |
| 4013 | Error_1 ("inexact->exact: not integral:", x); |
4011 | Error_1 ("inexact->exact: not integral:", x); |
| 4014 | } |
4012 | } |
|
|
4013 | |
|
|
4014 | s_return (x); |
| 4015 | |
4015 | |
| 4016 | case OP_EXP: s_return (mk_real (SCHEME_A_ exp (rvalue (x)))); |
4016 | case OP_EXP: s_return (mk_real (SCHEME_A_ exp (rvalue (x)))); |
| 4017 | case OP_LOG: s_return (mk_real (SCHEME_A_ log (rvalue (x)))); |
4017 | case OP_LOG: s_return (mk_real (SCHEME_A_ log (rvalue (x)) |
|
|
4018 | / (cadr (args) == NIL ? 1 : log (rvalue (cadr (args)))))); |
| 4018 | case OP_SIN: s_return (mk_real (SCHEME_A_ sin (rvalue (x)))); |
4019 | case OP_SIN: s_return (mk_real (SCHEME_A_ sin (rvalue (x)))); |
| 4019 | case OP_COS: s_return (mk_real (SCHEME_A_ cos (rvalue (x)))); |
4020 | case OP_COS: s_return (mk_real (SCHEME_A_ cos (rvalue (x)))); |
| 4020 | case OP_TAN: s_return (mk_real (SCHEME_A_ tan (rvalue (x)))); |
4021 | case OP_TAN: s_return (mk_real (SCHEME_A_ tan (rvalue (x)))); |
| 4021 | case OP_ASIN: s_return (mk_real (SCHEME_A_ asin (rvalue (x)))); |
4022 | case OP_ASIN: s_return (mk_real (SCHEME_A_ asin (rvalue (x)))); |
| 4022 | case OP_ACOS: s_return (mk_real (SCHEME_A_ acos (rvalue (x)))); |
4023 | case OP_ACOS: s_return (mk_real (SCHEME_A_ acos (rvalue (x)))); |
| 4023 | |
4024 | |
| 4024 | case OP_ATAN: |
4025 | case OP_ATAN: |
|
|
4026 | s_return (mk_real (SCHEME_A_ |
| 4025 | if (cdr (args) == NIL) |
4027 | cdr (args) == NIL |
| 4026 | s_return (mk_real (SCHEME_A_ atan (rvalue (x)))); |
4028 | ? atan (rvalue (x)) |
| 4027 | else |
4029 | : atan2 (rvalue (x), rvalue (cadr (args))))); |
| 4028 | { |
|
|
| 4029 | pointer y = cadr (args); |
|
|
| 4030 | s_return (mk_real (SCHEME_A_ atan2 (rvalue (x), rvalue (y)))); |
|
|
| 4031 | } |
|
|
| 4032 | |
4030 | |
| 4033 | case OP_SQRT: |
4031 | case OP_SQRT: |
| 4034 | s_return (mk_real (SCHEME_A_ sqrt (rvalue (x)))); |
4032 | s_return (mk_real (SCHEME_A_ sqrt (rvalue (x)))); |
| 4035 | |
4033 | |
| 4036 | case OP_EXPT: |
4034 | case OP_EXPT: |
