| … | |
… | |
| 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 | } |
| 4015 | |
4013 | |
|
|
4014 | s_return (x); |
|
|
4015 | |
|
|
4016 | case OP_FLOOR: s_return (mk_real (SCHEME_A_ floor (rvalue (x)))); |
|
|
4017 | case OP_CEILING: s_return (mk_real (SCHEME_A_ ceil (rvalue (x)))); |
|
|
4018 | case OP_TRUNCATE: s_return (mk_real (SCHEME_A_ trunc (rvalue (x)))); |
|
|
4019 | case OP_ROUND: s_return (mk_real (SCHEME_A_ nearbyint (rvalue (x)))); |
|
|
4020 | |
|
|
4021 | case OP_SQRT: s_return (mk_real (SCHEME_A_ sqrt (rvalue (x)))); |
| 4016 | case OP_EXP: s_return (mk_real (SCHEME_A_ exp (rvalue (x)))); |
4022 | 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)))); |
4023 | case OP_LOG: s_return (mk_real (SCHEME_A_ log (rvalue (x)) |
|
|
4024 | / (cadr (args) == NIL ? 1 : log (rvalue (cadr (args)))))); |
| 4018 | case OP_SIN: s_return (mk_real (SCHEME_A_ sin (rvalue (x)))); |
4025 | 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)))); |
4026 | 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)))); |
4027 | 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)))); |
4028 | 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)))); |
4029 | case OP_ACOS: s_return (mk_real (SCHEME_A_ acos (rvalue (x)))); |
| 4023 | |
4030 | |
| 4024 | case OP_ATAN: |
4031 | case OP_ATAN: |
|
|
4032 | s_return (mk_real (SCHEME_A_ |
| 4025 | if (cdr (args) == NIL) |
4033 | cdr (args) == NIL |
| 4026 | s_return (mk_real (SCHEME_A_ atan (rvalue (x)))); |
4034 | ? atan (rvalue (x)) |
| 4027 | else |
4035 | : 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 | |
|
|
| 4033 | case OP_SQRT: |
|
|
| 4034 | s_return (mk_real (SCHEME_A_ sqrt (rvalue (x)))); |
|
|
| 4035 | |
4036 | |
| 4036 | case OP_EXPT: |
4037 | case OP_EXPT: |
| 4037 | { |
4038 | { |
| 4038 | RVALUE result; |
4039 | RVALUE result; |
| 4039 | int real_result = 1; |
4040 | int real_result = 1; |
| … | |
… | |
| 4062 | if (real_result) |
4063 | if (real_result) |
| 4063 | s_return (mk_real (SCHEME_A_ result)); |
4064 | s_return (mk_real (SCHEME_A_ result)); |
| 4064 | else |
4065 | else |
| 4065 | s_return (mk_integer (SCHEME_A_ result)); |
4066 | s_return (mk_integer (SCHEME_A_ result)); |
| 4066 | } |
4067 | } |
| 4067 | |
|
|
| 4068 | case OP_FLOOR: s_return (mk_real (SCHEME_A_ floor (rvalue (x)))); |
|
|
| 4069 | case OP_CEILING: s_return (mk_real (SCHEME_A_ ceil (rvalue (x)))); |
|
|
| 4070 | case OP_TRUNCATE: s_return (mk_real (SCHEME_A_ trunc (rvalue (x)))); |
|
|
| 4071 | case OP_ROUND: s_return (mk_real (SCHEME_A_ nearbyint (rvalue (x)))); |
|
|
| 4072 | #endif |
4068 | #endif |
| 4073 | |
4069 | |
| 4074 | case OP_ADD: /* + */ |
4070 | case OP_ADD: /* + */ |
| 4075 | v = num_zero; |
4071 | v = num_zero; |
| 4076 | |
4072 | |
