/*
Copyright (C) 2004-2011, Parrot Foundation.
=head1 NAME
src/pmc/complex.pmc - Complex Numbers PMC Class
=head1 DESCRIPTION
C<Complex> provides a representation of complex numbers. It handles
string parsing/generating and basic mathematical operations.
=head2 Functions
Equations used are sometimes listed. At times, multiple equations are given,
but those starting with => are the ones used
=over 4
=cut
*/
/* HEADERIZER HFILE: none */
/* HEADERIZER BEGIN: static */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
static void complex_check_divide_zero(PARROT_INTERP, ARGIN(PMC *value))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
static void complex_parse_string(PARROT_INTERP,
ARGOUT(FLOATVAL *re),
ARGOUT(FLOATVAL *im),
ARGIN(STRING *value))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3)
__attribute__nonnull__(4)
FUNC_MODIFIES(*re)
FUNC_MODIFIES(*im);
static void float_check_divide_zero(PARROT_INTERP, FLOATVAL value)
__attribute__nonnull__(1);
static void int_check_divide_zero(PARROT_INTERP, INTVAL value)
__attribute__nonnull__(1);
#define ASSERT_ARGS_complex_check_divide_zero __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(value))
#define ASSERT_ARGS_complex_parse_string __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(re) \
, PARROT_ASSERT_ARG(im) \
, PARROT_ASSERT_ARG(value))
#define ASSERT_ARGS_float_check_divide_zero __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp))
#define ASSERT_ARGS_int_check_divide_zero __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp))
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
/* HEADERIZER END: static */
/*
=item C<static void complex_parse_string(PARROT_INTERP, FLOATVAL *re, FLOATVAL
*im, STRING *value)>
Parses the string in C<value> to produce a complex number, represented
by the real (C<*re>) and imaginary (C<*im>) parts. Raises an exception
if it cannot understand the string. The string should be of the form
C<a+bi> with optional spaces around C<+> and before C<i>. You can also
use C<j> instead of C<i>.
=cut
We have a conflict among our coding standards here. Our 100-character line
limit meant that the following function declaration had to be split over two
lines. However, that leads to t/codingstd/pmc_docs.t reporting that this
function lacks documentation -- reporting due to differences in whitespacing
between '=item' and function declaration.
*/
static void
complex_parse_string(PARROT_INTERP,
ARGOUT(FLOATVAL *re), ARGOUT(FLOATVAL *im), ARGIN(STRING *value))
{
ASSERT_ARGS(complex_parse_string)
char * const str = Parrot_str_to_cstring(interp, value);
char *t = str;
char *first_num_offset = str;
char *second_num_offset = NULL;
STRING *S;
INTVAL i = 0;
INTVAL first_num_minus = 0;
INTVAL second_num_minus = 0;
UINTVAL first_num_length, second_num_length;
/* walk the string and identify the real and imaginary parts */
if (*t == '-') {
/* first number is negative */
++t;
first_num_minus = 1;
/* allow for an optional space */
if (*t == ' ')
++t;
first_num_offset = t;
}
/* skip digits */
while (*t >= '0' && *t <= '9')
++t;
if (*t == '.') {
/* this number has a decimal point */
++t;
/* skip digits */
while (*t >= '0' && *t <= '9')
++t;
}
/* save the length of the real part */
first_num_length = t - first_num_offset;
/* end of string; we only have a real part */
if (*t == 0) {
second_num_length = 0;
}
else if ((*t == 'i' || *t == 'j') && *(t+1) == 0) {
/* there is only an imaginary part, so the first number was
actually the imaginary part */
second_num_length = first_num_length;
first_num_length = 0;
second_num_offset = first_num_offset;
second_num_minus = first_num_minus;
first_num_minus = 0;
/* this is useful if there is no number for
the imaginary part, like in "-i" */
i = 1;
}
else {
/* skip an optional space */
if (*t == ' ')
++t;
/* expect "+" or "-" and the imaginary part */
if (*t == '+' || *t == '-') {
/* save the sign */
second_num_minus = (*t == '-');
++t;
/* skip another optional space */
if (*t == ' ')
++t;
/* save the beginning of the imaginary part */
second_num_offset = t;
/* skip digits */
while (*t >= '0' && *t <= '9')
++t;
if (*t == '.') {
/* this number has a decimal point */
++t;
/* skip digits */
while (*t >= '0' && *t <= '9')
++t;
}
/* save the length of the imaginary part */
second_num_length = t - second_num_offset;
/* allow for one more optional space */
if (*t == ' ')
++t;
/* verify that the string ends properly */
if ((*t != 'i' && *t != 'j') || (*(t+1) != 0)) {
/* imaginary part does not end in 'i' or 'j' */
Parrot_ex_throw_from_c_args(interp, NULL,
EXCEPTION_INVALID_STRING_REPRESENTATION,
"Complex: malformed string");
}
/* this is useful if there is no number for the
imaginary part, like in "2+i" */
i = 1;
/* all is OK, save the number */
}
else {
/* "+" or "-" not found: error */
Parrot_str_free_cstring(str);
Parrot_ex_throw_from_c_args(interp, NULL,
EXCEPTION_INVALID_STRING_REPRESENTATION,
"Complex: malformed string");
}
}
/* now we have the offsets and the lengths we turn them into float values */
if (first_num_length) {
/* there is a real part, interpret it */
S = Parrot_str_new(interp, first_num_offset, first_num_length);
*re = Parrot_str_to_num(interp, S);
}
else {
/* consider the real part 0.0 */
*re = 0.0;
}
if (second_num_length) {
/* there is an imaginary part, interpret it */
S = Parrot_str_new(interp, second_num_offset, second_num_length);
*im = Parrot_str_to_num(interp, S);
}
else {
/* consider the imaginary part 0.0 */
if (i) /* the string was something like "1+i" */
*im = 1.0;
else
*im = 0.0;
}
if (first_num_minus)
*re = -*re;
if (second_num_minus)
*im = -*im;
Parrot_str_free_cstring(str);
}
/*
=item C<static void int_check_divide_zero(PARROT_INTERP, INTVAL value)>
If C<value> is 0, throw a divide by zero exception.
=cut
*/
static void
int_check_divide_zero(PARROT_INTERP, INTVAL value)
{
ASSERT_ARGS(int_check_divide_zero)
if (value == 0)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_DIV_BY_ZERO,
"Divide by zero");
}
/*
=item C<static void float_check_divide_zero(PARROT_INTERP, FLOATVAL value)>
If C<value> is 0.0, throw a divide by zero exception.
=cut
*/
static void
float_check_divide_zero(PARROT_INTERP, FLOATVAL value)
{
ASSERT_ARGS(float_check_divide_zero)
if (FLOAT_IS_ZERO(value))
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_DIV_BY_ZERO,
"Divide by zero");
}
/*
=item C<static void complex_check_divide_zero(PARROT_INTERP, PMC *value)>
If C<value> is a Complex PMC with a value of 0, throw a divide by zero exception.
=cut
*/
static void
complex_check_divide_zero(PARROT_INTERP, ARGIN(PMC *value))
{
ASSERT_ARGS(complex_check_divide_zero)
/* Throw an exception if we are dividing by zero. Check both the real part
* and the imaginary part.*/
if (FLOAT_IS_ZERO(VTABLE_get_number_keyed_int(interp, value, 0))
&& FLOAT_IS_ZERO(VTABLE_get_number_keyed_int(interp, value, 1)))
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_DIV_BY_ZERO,
"Divide by zero");
}
pmclass Complex provides complex provides scalar auto_attrs {
ATTR FLOATVAL re; /* real part */
ATTR FLOATVAL im; /* imaginary part */
/*
=back
=head2 Methods
=over 4
=item C<void init()>
Initializes the complex number with the value 0+0i.
=item C<void init_pmc(PMC *initializer)>
Initializes the complex number with the specified initializer.
The initializer can be a string PMC or a numeric array with (real, imag)
=item C<PMC *clone()>
Creates an identical copy of the complex number.
=cut
*/
VTABLE void init() {
SET_ATTR_re(INTERP, SELF, 0.0);
SET_ATTR_im(INTERP, SELF, 0.0);
}
VTABLE void init_pmc(PMC *initializer) {
const INTVAL arg_type = VTABLE_type(INTERP, initializer);
SELF.init();
switch (arg_type) {
case enum_class_String:
SELF.set_string_native(VTABLE_get_string(INTERP, initializer));
break;
case enum_class_FixedFloatArray:
case enum_class_ResizableFloatArray:
case enum_class_FixedIntegerArray:
case enum_class_ResizableIntegerArray:
if (VTABLE_get_integer(INTERP, initializer) == 2) {
const FLOATVAL re = VTABLE_get_number_keyed_int(INTERP, initializer, 0);
const FLOATVAL im = VTABLE_get_number_keyed_int(INTERP, initializer, 1);
SET_ATTR_re(INTERP, SELF, re);
SET_ATTR_im(INTERP, SELF, im);
break;
}
/* else let it fall to default */
default:
if (VTABLE_isa(INTERP, initializer, CONST_STRING(INTERP, "String"))) {
STRING * const s = VTABLE_get_string(INTERP, initializer);
SELF.set_string_native(s);
}
else {
Parrot_ex_throw_from_c_args(INTERP, NULL,
EXCEPTION_INVALID_OPERATION,
"Invalid Complex initializer");
}
}
}
VTABLE PMC *clone() {
PMC * const dest = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
FLOATVAL re, im;
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
SET_ATTR_re(INTERP, dest, re);
SET_ATTR_im(INTERP, dest, im);
return dest;
}
/*
=item C<void freeze(PMC *visit)>
=item C<void thaw(PMC *visit)>
Serialize/deserialize this object for bytecode.
=cut
*/
VTABLE void freeze(PMC *visit) {
FLOATVAL re, im;
SUPER(visit);
GET_ATTR_re(INTERP, SELF, re);
VTABLE_push_float(INTERP, visit, re);
GET_ATTR_im(INTERP, SELF, im);
VTABLE_push_float(INTERP, visit, im);
}
VTABLE void thaw(PMC *visit) {
FLOATVAL re, im;
SUPER(visit);
re = VTABLE_shift_float(INTERP, visit);
SET_ATTR_re(INTERP, SELF, re);
im = VTABLE_shift_float(INTERP, visit);
SET_ATTR_im(INTERP, SELF, im);
}
/*
=item C<INTVAL get_integer()>
Returns the modulus of the complex number as an integer.
=item C<FLOATVAL get_number()>
Returns the modulus of the complex number.
=item C<STRING *get_string()>
Returns the complex number as a string in the form C<a+bi>.
=item C<INTVAL get_bool()>
Returns true if the complex number is non-zero.
=cut
*/
VTABLE INTVAL get_integer() {
const FLOATVAL f = SELF.get_number();
return (INTVAL)f;
}
VTABLE FLOATVAL get_number() {
FLOATVAL re, im;
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
return sqrt(re * re + im * im);
}
VTABLE STRING *get_string() {
FLOATVAL re, im;
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
return Parrot_sprintf_c(INTERP, "%vg%+vgi", re, im);
}
VTABLE INTVAL get_bool() {
FLOATVAL re, im;
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
return !(FLOAT_IS_ZERO(re) && FLOAT_IS_ZERO(im));
}
/*
=item C<INTVAL get_integer_keyed(PMC *key)>
=item C<INTVAL get_integer_keyed_str(STRING *key)>
=item C<FLOATVAL get_number_keyed(PMC *key)>
=item C<FLOATVAL get_number_keyed_str(STRING *key)>
=item C<PMC *get_pmc_keyed(PMC *key)>
=item C<PMC *get_pmc_keyed_str(STRING *key)>
Returns the requested number (real part for C<real> and imaginary for C<imag>).
=cut
*/
VTABLE INTVAL get_integer_keyed(PMC *key) {
STRING * const s = VTABLE_get_string(INTERP, key);
return SELF.get_integer_keyed_str(s);
}
VTABLE INTVAL get_integer_keyed_str(STRING *key) {
const FLOATVAL f = SELF.get_number_keyed_str(key);
return (INTVAL)f;
}
VTABLE FLOATVAL get_number_keyed(PMC *key) {
STRING * const s = VTABLE_get_string(INTERP, key);
return SELF.get_number_keyed_str(s);
}
VTABLE FLOATVAL get_number_keyed_str(STRING *key) {
FLOATVAL value;
if (STRING_equal(INTERP, key, CONST_STRING(INTERP, "real"))) {
GET_ATTR_re(INTERP, SELF, value);
}
else if (STRING_equal(INTERP, key, CONST_STRING(INTERP, "imag"))) {
GET_ATTR_im(INTERP, SELF, value);
}
else
Parrot_ex_throw_from_c_args(INTERP, NULL,
EXCEPTION_INVALID_OPERATION, "Complex: key is neither 'real' or 'imag'");
return value;
}
VTABLE PMC *get_pmc_keyed(PMC *key) {
if (VTABLE_isa(INTERP, key, CONST_STRING(INTERP, "Integer"))) {
const INTVAL i = VTABLE_get_integer(INTERP, key);
return SELF.get_pmc_keyed_int(i);
}
else {
STRING * const s = VTABLE_get_string(INTERP, key);
return SELF.get_pmc_keyed_str(s);
}
}
VTABLE PMC *get_pmc_keyed_str(STRING *key) {
PMC * const ret = Parrot_pmc_new(INTERP, enum_class_Float);
const FLOATVAL val = SELF.get_number_keyed_str(key);
VTABLE_set_number_native(INTERP, ret, val);
return ret;
}
/*
=item C<PMC *get_pmc_keyed_int(INTVAL key)>
Returns the requested number (real part for C<0> and imaginary for C<1>).
=cut
*/
VTABLE PMC *get_pmc_keyed_int(INTVAL key) {
PMC * const ret = Parrot_pmc_new(INTERP, enum_class_Float);
const FLOATVAL val = SELF.get_number_keyed_int(key);
VTABLE_set_number_native(INTERP, ret, val);
return ret;
}
/*
=item C<FLOATVAL get_number_keyed_int(INTVAL key)>
Quick hack to emulate get_real() and get_imag():
key = 0 ... get real part
key = 1 ... get imag part
=item C<void set_number_keyed_int(INTVAL key, FLOATVAL v)>
Set real or imag depending on key
=cut
*/
VTABLE FLOATVAL get_number_keyed_int(INTVAL key) {
FLOATVAL f;
switch (key) {
case 0:
GET_ATTR_re(INTERP, SELF, f);
break;
case 1:
GET_ATTR_im(INTERP, SELF, f);
break;
default:
Parrot_ex_throw_from_c_args(INTERP, NULL,
EXCEPTION_INVALID_OPERATION, "Complex: key must be 0 or 1");
}
return f;
}
VTABLE void set_number_keyed_int(INTVAL key, FLOATVAL v) {
switch (key) {
case 0:
SET_ATTR_re(INTERP, SELF, v);
break;
case 1:
SET_ATTR_im(INTERP, SELF, v);
break;
default:
Parrot_ex_throw_from_c_args(INTERP, NULL,
EXCEPTION_INVALID_OPERATION, "Complex: key must be 0 or 1");
}
}
/*
=item C<void set_string_native(STRING *value)>
Parses the string C<value> into a complex number; raises an exception
on failure.
=item C<void set_pmc(PMC *value)>
if C<value> is a Complex PMC then the complex number is set to its
value; otherwise C<value>'s string representation is parsed with
C<set_string_native()>.
=item C<void set_integer_native(INTVAL value)>
=item C<void set_number_native(FLOATVAL value)>
Sets the real part of the complex number to C<value> and the imaginary
part to C<0.0>
=cut
*/
VTABLE void set_string_native(STRING *value) {
FLOATVAL re, im;
complex_parse_string(INTERP, &re, &im, value);
SET_ATTR_re(INTERP, SELF, re);
SET_ATTR_im(INTERP, SELF, im);
}
VTABLE void set_pmc(PMC *value) {
if (VTABLE_isa(INTERP, value, CONST_STRING(INTERP, "Complex"))) {
FLOATVAL re, im;
GET_ATTR_re(INTERP, value, re);
GET_ATTR_im(INTERP, value, im);
SET_ATTR_re(INTERP, SELF, re);
SET_ATTR_im(INTERP, SELF, im);
}
else
VTABLE_set_string_native(INTERP, SELF, VTABLE_get_string(INTERP, value));
}
VTABLE void set_integer_native(INTVAL value) {
SELF.set_number_native((FLOATVAL)value);
}
VTABLE void set_number_native(FLOATVAL value) {
SET_ATTR_re(INTERP, SELF, value);
SET_ATTR_im(INTERP, SELF, 0.0);
}
/*
=item C<void set_integer_keyed(PMC *key, INTVAL value)>
=item C<void set_integer_keyed_str(STRING *key, INTVAL value)>
=item C<void set_number_keyed(PMC *key, FLOATVAL value)>
=item C<void set_number_keyed_str(STRING *key, FLOATVAL value)>
=item C<void set_pmc_keyed(PMC *key, PMC *value)>
=item C<void set_pmc_keyed_str(STRING *key, PMC *value)>
Sets the requested number (real part for C<real> and imaginary for C<imag>)
to C<value>.
=cut
*/
VTABLE void set_integer_keyed(PMC *key, INTVAL value) {
SELF.set_number_keyed(key, (FLOATVAL)value);
}
VTABLE void set_integer_keyed_str(STRING *key, INTVAL value) {
SELF.set_number_keyed_str(key, (FLOATVAL)value);
}
VTABLE void set_number_keyed(PMC *key, FLOATVAL value) {
if (VTABLE_isa(INTERP, key, CONST_STRING(INTERP, "Integer"))) {
const INTVAL i = VTABLE_get_integer(INTERP, key);
SELF.set_number_keyed_int(i, value);
}
else {
STRING *s = VTABLE_get_string(INTERP, key);
SELF.set_number_keyed_str(s, value);
}
}
VTABLE void set_number_keyed_str(STRING *key, FLOATVAL value) {
if (STRING_equal(INTERP, key, CONST_STRING(INTERP, "real"))) {
SET_ATTR_re(INTERP, SELF, value);
}
else if (STRING_equal(INTERP, key, CONST_STRING(INTERP, "imag"))) {
SET_ATTR_im(INTERP, SELF, value);
}
else
Parrot_ex_throw_from_c_args(INTERP, NULL,
EXCEPTION_INVALID_OPERATION, "Complex: key is neither 'real' or 'imag'");
}
VTABLE void set_pmc_keyed(PMC *key, PMC *value) {
const FLOATVAL f = VTABLE_get_number(INTERP, value);
SELF.set_number_keyed(key, f);
}
VTABLE void set_pmc_keyed_str(STRING *key, PMC *value) {
const FLOATVAL f = VTABLE_get_number(INTERP, value);
SELF.set_number_keyed_str(key, f);
}
/*
=item C<PMC *add(PMC *value, PMC *dest)>
=item C<PMC *add_int(INTVAL value, PMC *dest)>
=item C<PMC *add_float(FLOATVAL value, PMC *dest)>
Adds C<value> to the complex number, placing the result in C<dest>.
=cut
*/
MULTI PMC *add(Complex value, PMC *dest) {
FLOATVAL self_re, self_im, val_re, val_im;
dest = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
GET_ATTR_re(INTERP, SELF, self_re);
GET_ATTR_im(INTERP, SELF, self_im);
GET_ATTR_re(INTERP, value, val_re);
GET_ATTR_im(INTERP, value, val_im);
SET_ATTR_re(INTERP, dest, self_re + val_re);
SET_ATTR_im(INTERP, dest, self_im + val_im);
return dest;
}
MULTI PMC *add(DEFAULT value, PMC *dest) {
FLOATVAL re, im;
dest = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
SET_ATTR_re(INTERP, dest, re + VTABLE_get_number(INTERP, value));
SET_ATTR_im(INTERP, dest, im);
return dest;
}
VTABLE PMC *add_int(INTVAL value, PMC *dest) {
return SELF.add_float((FLOATVAL)value, dest);
}
VTABLE PMC *add_float(FLOATVAL value, PMC *dest) {
FLOATVAL re, im;
dest = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
SET_ATTR_re(INTERP, dest, re + value);
SET_ATTR_im(INTERP, dest, im);
return dest;
}
MULTI void i_add(Complex value) {
FLOATVAL self_re, self_im, val_re, val_im;
GET_ATTR_re(INTERP, SELF, self_re);
GET_ATTR_im(INTERP, SELF, self_im);
GET_ATTR_re(INTERP, value, val_re);
GET_ATTR_im(INTERP, value, val_im);
SET_ATTR_re(INTERP, SELF, self_re + val_re);
SET_ATTR_im(INTERP, SELF, self_im + val_im);
}
MULTI void i_add(DEFAULT value) {
FLOATVAL re;
GET_ATTR_re(INTERP, SELF, re);
SET_ATTR_re(INTERP, SELF, re + VTABLE_get_number(INTERP, value));
}
VTABLE void i_add_int(INTVAL value) {
SELF.i_add_float((FLOATVAL)value);
}
VTABLE void i_add_float(FLOATVAL value) {
FLOATVAL re;
GET_ATTR_re(INTERP, SELF, re);
SET_ATTR_re(INTERP, SELF, re + value);
}
/*
=item C<PMC *subtract(PMC *value, PMC *dest)>
=item C<PMC *subtract_int(INTVAL value, PMC *dest)>
=item C<PMC *subtract_float(FLOATVAL value, PMC *dest)>
Subtracts C<value> from the complex number, placing the result in C<dest>.
=cut
*/
MULTI PMC *subtract(Complex value, PMC *dest) {
FLOATVAL self_re, self_im, val_re, val_im;
dest = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
GET_ATTR_re(INTERP, SELF, self_re);
GET_ATTR_im(INTERP, SELF, self_im);
GET_ATTR_re(INTERP, value, val_re);
GET_ATTR_im(INTERP, value, val_im);
SET_ATTR_re(INTERP, dest, self_re - val_re);
SET_ATTR_im(INTERP, dest, self_im - val_im);
return dest;
}
MULTI PMC *subtract(DEFAULT value, PMC *dest) {
FLOATVAL re, im;
dest = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
SET_ATTR_re(INTERP, dest, re - VTABLE_get_number(INTERP, value));
SET_ATTR_im(INTERP, dest, im);
return dest;
}
VTABLE PMC *subtract_int(INTVAL value, PMC *dest) {
return SELF.subtract_float((FLOATVAL)value, dest);
}
VTABLE PMC *subtract_float(FLOATVAL value, PMC *dest) {
FLOATVAL re, im;
dest = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
SET_ATTR_re(INTERP, dest, re - value);
SET_ATTR_im(INTERP, dest, im);
return dest;
}
MULTI void i_subtract(Complex value) {
FLOATVAL self_re, self_im, val_re, val_im;
GET_ATTR_re(INTERP, SELF, self_re);
GET_ATTR_im(INTERP, SELF, self_im);
GET_ATTR_re(INTERP, value, val_re);
GET_ATTR_im(INTERP, value, val_im);
SET_ATTR_re(INTERP, SELF, self_re - val_re);
SET_ATTR_im(INTERP, SELF, self_im - val_im);
}
MULTI void i_subtract(DEFAULT value) {
FLOATVAL re;
GET_ATTR_re(INTERP, SELF, re);
SET_ATTR_re(INTERP, SELF, re - VTABLE_get_number(INTERP, value));
}
VTABLE void i_subtract_int(INTVAL value) {
SELF.i_subtract_float((FLOATVAL) value);
}
VTABLE void i_subtract_float(FLOATVAL value) {
FLOATVAL re;
GET_ATTR_re(INTERP, SELF, re);
SET_ATTR_re(INTERP, SELF, re - value);
}
/*
=item C<PMC *multiply(PMC *value, PMC *dest)>
=item C<PMC *multiply_int(INTVAL value, PMC *dest)>
=item C<PMC *multiply_float(FLOATVAL value, PMC *dest)>
Multiplies the complex number with C<value>, placing the result in C<dest>.
=item C<void i_multiply(PMC *value)>
=item C<void i_multiply_int(INTVAL value)>
=item C<void i_multiply_float(FLOATVAL value)>
Multiplies the complex number SELF inplace with C<value>.
=cut
*/
/*
(a+ib)(c+id)=(ac-bd)+i((a+b)(c+d)-ac-bd).
(a+bi)(c+di)=(ac-bd)+i(ad+bc)
*/
MULTI PMC *multiply(Complex value, PMC *dest) {
FLOATVAL a, b, c, d;
dest = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
GET_ATTR_re(INTERP, SELF, a);
GET_ATTR_im(INTERP, SELF, b);
GET_ATTR_re(INTERP, value, c);
GET_ATTR_im(INTERP, value, d);
SET_ATTR_re(INTERP, dest, a * c - b * d);
SET_ATTR_im(INTERP, dest, a * d + b * c);
return dest;
}
MULTI PMC *multiply(DEFAULT value, PMC *dest) {
FLOATVAL re, im;
dest = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
SET_ATTR_re(INTERP, dest, re * VTABLE_get_number(INTERP, value));
SET_ATTR_im(INTERP, dest, im * VTABLE_get_number(INTERP, value));
return dest;
}
VTABLE PMC *multiply_int(INTVAL value, PMC *dest) {
return SELF.multiply_float((FLOATVAL) value, dest);
}
VTABLE PMC *multiply_float(FLOATVAL value, PMC *dest) {
FLOATVAL re, im;
dest = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
SET_ATTR_re(INTERP, dest, re * value);
SET_ATTR_im(INTERP, dest, im * value);
return dest;
}
MULTI void i_multiply(Complex value) {
FLOATVAL a, b, c, d;
GET_ATTR_re(INTERP, SELF, a);
GET_ATTR_im(INTERP, SELF, b);
GET_ATTR_re(INTERP, value, c);
GET_ATTR_im(INTERP, value, d);
SET_ATTR_re(INTERP, SELF, a * c - b * d);
SET_ATTR_im(INTERP, SELF, a * d + b * c);
}
MULTI void i_multiply(DEFAULT value) {
FLOATVAL re, im;
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
SET_ATTR_re(INTERP, SELF, re * VTABLE_get_number(INTERP, value));
SET_ATTR_im(INTERP, SELF, im * VTABLE_get_number(INTERP, value));
}
VTABLE void i_multiply_int(INTVAL value) {
FLOATVAL re, im;
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
SET_ATTR_re(INTERP, SELF, re * value);
SET_ATTR_im(INTERP, SELF, im * value);
}
VTABLE void i_multiply_float(FLOATVAL value) {
FLOATVAL re, im;
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
SET_ATTR_re(INTERP, SELF, re * value);
SET_ATTR_im(INTERP, SELF, im * value);
}
/*
=item C<PMC *divide(PMC *value, PMC *dest)>
=item C<PMC *divide_int(INTVAL value, PMC *dest)>
=item C<PMC *divide_float(FLOATVAL value, PMC *dest)>
Divide the complex number by C<value>, placing the result in C<dest>.
=item C<void i_divide(PMC *value, PMC *dest)>
=item C<void i_divide_int(INTVAL value, PMC *dest)>
=item C<void i_divide_float(FLOATVAL value, PMC *dest)>
Divide the complex number C<SELF> by C<value> inplace.
Throws divide by zero exception if divisor is zero.
=cut
TODO: for better fp precision
http://docs.sun.com/source/806-3568/ncg_goldberg.html
(a+ib)/(c+id) =
(a + b(d/c)) / (c + d(d/c)) + i(b - a(d/c)) / (c + d(d/c)) if |d|<|c|
(b + a(c/d)) / (d + c(c/d)) + i(-a + b(c/d)) / (d + c(c/d)) if |d|>=|c|
*/
MULTI PMC *divide(Complex value, PMC *dest) {
FLOATVAL mod, re, im;
FLOATVAL self_re, self_im, val_re, val_im;
complex_check_divide_zero(INTERP, value);
dest = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
GET_ATTR_re(INTERP, SELF, self_re);
GET_ATTR_im(INTERP, SELF, self_im);
GET_ATTR_re(INTERP, value, val_re);
GET_ATTR_im(INTERP, value, val_im);
/* a little speed optimisation: cache an intermediate number;
I'm not sure the compiler does this */
if (self_im == 0.0 && val_im == 0.0) {
re = self_re / val_re;
im = 0.0;
}
else {
mod = (val_re * val_re + val_im * val_im);
re = (self_re * val_re + self_im * val_im) / mod;
im = (self_im * val_re - self_re * val_im) / mod;
}
SET_ATTR_re(INTERP, dest, re);
SET_ATTR_im(INTERP, dest, im);
return dest;
}
MULTI PMC *divide(DEFAULT value, PMC *dest) {
FLOATVAL re, im;
const FLOATVAL d = VTABLE_get_number(INTERP, value);
float_check_divide_zero(INTERP, d);
dest = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
SET_ATTR_re(INTERP, dest, re / d);
SET_ATTR_im(INTERP, dest, im / d);
return dest;
}
VTABLE PMC *divide_int(INTVAL value, PMC *dest) {
FLOATVAL re, im;
int_check_divide_zero(INTERP, value);
dest = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
SET_ATTR_re(INTERP, dest, re / value);
SET_ATTR_im(INTERP, dest, im / value);
return dest;
}
VTABLE PMC *divide_float(FLOATVAL value, PMC *dest) {
FLOATVAL re, im;
float_check_divide_zero(INTERP, value);
dest = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
SET_ATTR_re(INTERP, dest, re / value);
SET_ATTR_im(INTERP, dest, im / value);
return dest;
}
MULTI void i_divide(Complex value) {
FLOATVAL re, im;
FLOATVAL self_re, self_im, val_re, val_im;
complex_check_divide_zero(INTERP, value);
GET_ATTR_re(INTERP, SELF, self_re);
GET_ATTR_im(INTERP, SELF, self_im);
GET_ATTR_re(INTERP, value, val_re);
GET_ATTR_im(INTERP, value, val_im);
if (self_im == 0.0 && val_im == 0.0) {
re = self_re / val_re;
im = 0.0;
}
else {
/* a little speed optimisation: cache an intermediate number;
I'm not sure the compiler does this */
const FLOATVAL mod = (val_re * val_re + val_im * val_im);
re = (self_re * val_re + self_im * val_im) / mod;
im = (self_im * val_re - self_re * val_im) / mod;
}
SET_ATTR_re(INTERP, SELF, re);
SET_ATTR_im(INTERP, SELF, im);
}
MULTI void i_divide(DEFAULT value) {
FLOATVAL re, im;
const FLOATVAL d = VTABLE_get_number(INTERP, value);
float_check_divide_zero(INTERP, d);
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
SET_ATTR_re(INTERP, SELF, re / d);
SET_ATTR_im(INTERP, SELF, im / d);
}
VTABLE void i_divide_int(INTVAL value) {
FLOATVAL re, im;
int_check_divide_zero(INTERP, value);
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
SET_ATTR_re(INTERP, SELF, re / value);
SET_ATTR_im(INTERP, SELF, im / value);
}
VTABLE void i_divide_float(FLOATVAL value) {
FLOATVAL re, im;
float_check_divide_zero(INTERP, value);
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
SET_ATTR_re(INTERP, SELF, re / value);
SET_ATTR_im(INTERP, SELF, im / value);
}
/*
=item C<PMC *neg(PMC *dest)>
=item C<void neg()>
Set C<dest> to the negated value of C<SELF>.
=cut
*/
VTABLE PMC *neg(PMC *dest) {
FLOATVAL re, im;
dest = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
SET_ATTR_re(INTERP, dest, -re);
SET_ATTR_im(INTERP, dest, -im);
return dest;
}
VTABLE void i_neg() {
FLOATVAL re, im;
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
SET_ATTR_re(INTERP, SELF, -re);
SET_ATTR_im(INTERP, SELF, -im);
}
/*
=item C<INTVAL is_equal(PMC *value)>
Compares the complex number with C<value> and returns true if they are equal.
=cut
*/
MULTI INTVAL is_equal(Complex value) {
FLOATVAL self_re, self_im, val_re, val_im;
GET_ATTR_re(INTERP, SELF, self_re);
GET_ATTR_im(INTERP, SELF, self_im);
GET_ATTR_re(INTERP, value, val_re);
GET_ATTR_im(INTERP, value, val_im);
return (INTVAL)(self_re == val_re && self_im == val_im);
}
MULTI INTVAL is_equal(DEFAULT value) {
FLOATVAL re, im;
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
if (im != 0.0)
return (INTVAL)0;
return (re == VTABLE_get_number(INTERP, value));
}
/*
=item C<PMC *absolute(PMC *dest)>
=item C<void i_absolute()>
Sets C<dest> to the absolute value of SELF that is the distance from (0.0).
=cut
*/
/*
TODO for better precision: hinted by vaxman according to "Numerical Recipes
in Fortran 77", 2nd edition, Press, Vetterling, Teukolsky, Flannery,
Cambridge University Press, 2001, pp. 171ff:
|a+ib|=|a|*sqrt(1+(b/a)**2), if |a|>=|b|,
|b|*sqrt(1+(a/b)**2) else.
*/
VTABLE PMC *absolute(PMC *dest) {
FLOATVAL re, im, d;
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
d = sqrt(re*re + im*im);
dest = Parrot_pmc_new(INTERP,
Parrot_hll_get_ctx_HLL_type(INTERP, enum_class_Float));
VTABLE_set_number_native(INTERP, dest, d);
return dest;
}
VTABLE void i_absolute() {
FLOATVAL re, im, d;
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
d = sqrt(re*re + im*im);
Parrot_pmc_reuse(INTERP, SELF, enum_class_Float, 0);
VTABLE_set_number_native(INTERP, SELF, d);
}
/*
=item C<METHOD ln()>
Returns the natural logarithm of SELF as a PMC.
=cut
ln z = ln |z| + i arg(z)
|x + iy| = sqrt(x^2 + y^2)
arg(x + iy) = atan2(y, x)
Some special cases
ln(-1) = pi i
ln(0) = -inf
ln(1) = 0
ln(e) = 1
ln(+-i) = +- (pi i)/2
*/
METHOD ln() {
PMC * const d = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
FLOATVAL re, im, result_re, result_im;
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
/* This is necessary for atan2 to behave */
if (im == -0.0)
im = 0.0;
result_re = log(sqrt(re*re + im*im));
if (re == 0.0 && im == 0.0) /* atan2(0, 0) not portable */
result_im = 0.0;
else
result_im = atan2(im, re);
SET_ATTR_re(INTERP, d, result_re);
SET_ATTR_im(INTERP, d, result_im);
RETURN(PMC *d);
}
/*
=item C<METHOD exp()>
Returns e ^ SELF as a PMC.
=cut
exp(a + bi) = exp(a) * (cos(b) + i * sin(b))
*/
METHOD exp() {
PMC * const d = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
FLOATVAL re, im, f;
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
f = exp(re);
SET_ATTR_re(INTERP, d, f * cos(im));
/* If only sin(pi) worked. */
if (im == 4.0 * atan(1.0)) {
SET_ATTR_im(INTERP, d, 0.0);
}
else {
SET_ATTR_im(INTERP, d, f * sin(im));
}
RETURN(PMC *d);
}
/*
=item C<METHOD PMC *sin()>
=item C<METHOD PMC *cos()>
=item C<METHOD PMC *tan()>
=item C<METHOD PMC *csc()>
=item C<METHOD PMC *sec()>
=item C<METHOD PMC *cot()>
Returns C<FUNC>(SELF).
=cut
=> sin(a + bi) = sin(a)cosh(b)+i*cos(a)sinh(b)
sin(z) = ((e ^ zi) - (e ^ -zi)) / (2i)
=> cos(a + bi) = cos(a) * cosh(b) - i * sin(a) * sinh(b)
cos(z) = ((e ^ zi) + (e ^ -zi)) / 2
sin(iz) = i sinh(z)
cos(iz) = cosh(z)
sinh(iz) = i sin(z)
cosh(iz) = cos z
sinh(a + bi) = sinh(a) * cos(b) + i * cosh(a) * sin(b)
cosh(a + bi) = cosh(a) * cos(b) + i * sinh(a) * sin(b)
*/
METHOD sin() {
PMC * const d = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
FLOATVAL re, im, result_re, result_im;
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
if (FLOAT_IS_ZERO(im)) {
result_re = sin(re);
result_im = 0.0;
}
else if (FLOAT_IS_ZERO(re)) {
result_re = 0.0;
result_im = sinh(im);
}
else {
result_re = sin(re) * cosh(im);
if (im == -0.0)
result_im = 0.0;
else
result_im = cos(re) * sinh(im);
}
SET_ATTR_re(INTERP, d, result_re);
SET_ATTR_im(INTERP, d, result_im);
RETURN(PMC *d);
}
METHOD cos() {
PMC * const d = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
FLOATVAL re, im, result_re, result_im;
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
if (FLOAT_IS_ZERO(re)) {
result_re = cosh(im);
result_im = 0.0;
}
else if (FLOAT_IS_ZERO(im)) {
result_re = cos(re);
result_im = 0.0;
}
else {
result_re = cos(re) * cosh(im);
result_im = -1.0 * sin(re) * sinh(im);
}
SET_ATTR_re(INTERP, d, result_re);
SET_ATTR_im(INTERP, d, result_im);
RETURN(PMC *d);
}
METHOD tan() {
PMC * const d = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
PMC * const e = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
(PMC *d) = PCCINVOKE(INTERP, SELF, "sin");
(PMC *e) = PCCINVOKE(INTERP, SELF, "cos");
Parrot_Complex_multi_i_divide_Complex(INTERP, d, e);
RETURN(PMC *d);
}
METHOD cot() {
PMC * const d = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
PMC * const e = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
(PMC *d) = PCCINVOKE(INTERP, SELF, "cos");
(PMC *e) = PCCINVOKE(INTERP, SELF, "sin");
Parrot_Complex_multi_i_divide_Complex(INTERP, d, e);
RETURN(PMC *d);
}
METHOD sec() {
PMC * const d = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
PMC * const e = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
SET_ATTR_re(INTERP, d, 1.0);
SET_ATTR_im(INTERP, d, 0.0);
(PMC *e) = PCCINVOKE(INTERP, SELF, "cos");
Parrot_Complex_multi_i_divide_Complex(INTERP, d, e);
RETURN(PMC *d);
}
METHOD csc() {
PMC * const d = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
PMC * const e = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
SET_ATTR_re(INTERP, d, 1.0);
SET_ATTR_im(INTERP, d, 0.0);
(PMC *e) = PCCINVOKE(INTERP, SELF, "sin");
Parrot_Complex_multi_i_divide_Complex(INTERP, d, e);
RETURN(PMC *d);
}
/*
=item C<METHOD PMC *asin()>
=item C<METHOD PMC *acos()>
=item C<METHOD PMC *atan()>
=item C<METHOD PMC *acsc()>
=item C<METHOD PMC *asec()>
=item C<METHOD PMC *acot()>
Returns the inverse function of SELF.
=cut
=> arcsin z = -i ln(iz + sqrt(1-z*z))
=> arccos z = pi/2 + i * ln(iz + sqrt(1 - z*z))
arccos z = -i ln(z + sqrt(z*z-1))
=> arctan z = i/2 ln((i+z) / (i-z))
arctan z = 1/2 i (ln(1-iz) - ln(1 + iz))
=> acot(z) = atan(1 / z)
acot(z) = i/2 (ln((z - i) / z) - ln((z + i) / z))
=> asec(z) = acos(1 / z)
asec(z) = 1/2 pi + i ln(sqrt(1 - 1/zz) + i/z)
=> acsc(z) = asin(1 / z)
acsc(z) = -i ln(sqrt(1 - 1/zz + i/z))
*/
METHOD asin() {
FLOATVAL d_re, d_im, e_re, e_im, self_re, self_im;
PMC * const d = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
PMC * e = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
GET_ATTR_re(INTERP, SELF, self_re);
GET_ATTR_im(INTERP, SELF, self_im);
e = Parrot_Complex_multi_multiply_Complex_PMC(INTERP, SELF, SELF, e);
GET_ATTR_re(INTERP, e, e_re);
GET_ATTR_im(INTERP, e, e_im);
SET_ATTR_re(INTERP, e, 1.0 - e_re);
SET_ATTR_im(INTERP, e, -e_im);
(PMC *d) = PCCINVOKE(INTERP, e, "sqrt");
GET_ATTR_re(INTERP, d, d_re);
GET_ATTR_im(INTERP, d, d_im);
SET_ATTR_re(INTERP, d, d_re - self_im);
SET_ATTR_im(INTERP, d, d_im + self_re);
(PMC *d) = PCCINVOKE(INTERP, d, "ln");
GET_ATTR_re(INTERP, d, d_re);
GET_ATTR_im(INTERP, d, d_im);
SET_ATTR_re(INTERP, e, d_im);
SET_ATTR_im(INTERP, e, d_re ? -d_re : 0.0);
RETURN(PMC *e);
}
METHOD acos() {
FLOATVAL d_re, d_im, e_re, e_im, self_re, self_im;
PMC * const d = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
PMC * e = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
GET_ATTR_re(INTERP, SELF, self_re);
GET_ATTR_im(INTERP, SELF, self_im);
e = Parrot_Complex_multi_multiply_Complex_PMC(INTERP, SELF, SELF, e);
GET_ATTR_re(INTERP, e, e_re);
GET_ATTR_im(INTERP, e, e_im);
SET_ATTR_re(INTERP, e, 1.0 - e_re);
SET_ATTR_im(INTERP, e, -e_im);
(PMC *d) = PCCINVOKE(INTERP, e, "sqrt");
GET_ATTR_re(INTERP, d, d_re);
GET_ATTR_im(INTERP, d, d_im);
SET_ATTR_re(INTERP, d, d_re + self_im);
SET_ATTR_im(INTERP, d, d_im - self_re);
(PMC *e) = PCCINVOKE(INTERP, d, "ln");
GET_ATTR_re(INTERP, e, e_re);
GET_ATTR_im(INTERP, e, e_im);
SET_ATTR_re(INTERP, d, e_im + 2.0 * atan(1.0));
SET_ATTR_im(INTERP, d, e_re ? -e_re : 0.0);
RETURN(PMC *d);
}
METHOD atan() {
PMC * const d = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
PMC * const e = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
FLOATVAL re, im, d_re, d_im;
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
SET_ATTR_re(INTERP, d, re);
SET_ATTR_im(INTERP, d, 1 + im);
SET_ATTR_re(INTERP, e, -re);
SET_ATTR_im(INTERP, e, 1 - im);
Parrot_Complex_multi_i_divide_Complex(INTERP, d, e);
(PMC *d) = PCCINVOKE(INTERP, d, "ln");
GET_ATTR_re(INTERP, d, d_re);
GET_ATTR_im(INTERP, d, d_im);
SET_ATTR_re(INTERP, e, (d_im ? d_im : -0.0) / -2.0);
SET_ATTR_im(INTERP, e, d_re / 2.0);
RETURN(PMC *e);
}
METHOD acot() {
PMC * const d = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
PMC *e;
FLOATVAL re, im;
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
SET_ATTR_re(INTERP, d, re / (re * re + im * im));
SET_ATTR_im(INTERP, d, -im / (re * re + im * im));
(PMC *e) = PCCINVOKE(INTERP, d, "atan");
RETURN(PMC *e);
}
METHOD acsc() {
PMC * const d = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
PMC *e;
FLOATVAL re, im;
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
SET_ATTR_re(INTERP, d, re / (re * re + im * im));
SET_ATTR_im(INTERP, d, -im / (re * re + im * im));
(PMC *e) = PCCINVOKE(INTERP, d, "asin");
RETURN(PMC *e);
}
METHOD asec() {
PMC * const d = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
PMC *e;
FLOATVAL re, im;
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
SET_ATTR_re(INTERP, d, re / (re * re + im * im));
SET_ATTR_im(INTERP, d, -im / (re * re + im * im));
(PMC *e) = PCCINVOKE(INTERP, d, "acos");
RETURN(PMC *e);
}
/*
=item C<METHOD PMC *sinh()>
Returns the arctangent of SELF.
=item C<METHOD PMC *cosh()>
Returns the arcsine of SELF.
=item C<METHOD PMC *tanh()>
Returns the arccosine of SELF.
=cut
tanh(z) = sinh(z) / cosh(z)
*/
METHOD sinh() {
PMC * const d = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
FLOATVAL re, im;
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
SET_ATTR_re(INTERP, d, sinh(re) * cos(im));
SET_ATTR_im(INTERP, d, im ? cosh(re) * sin(im) : 0.0);
RETURN(PMC *d);
}
METHOD cosh() {
PMC * const d = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
FLOATVAL re, im;
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
SET_ATTR_re(INTERP, d, cosh(re) * cos(im));
if (re == 0.0 || im == 0.0) {
SET_ATTR_im(INTERP, d, 0.0);
}
else {
SET_ATTR_im(INTERP, d, sinh(re) * sin(im));
}
RETURN(PMC *d);
}
METHOD tanh() {
PMC * const d = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
PMC * const e = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
(PMC *d) = PCCINVOKE(INTERP, SELF, "sinh");
(PMC *e) = PCCINVOKE(INTERP, SELF, "cosh");
Parrot_Complex_multi_i_divide_Complex(INTERP, d, e);
RETURN(PMC *d);
}
METHOD coth() {
FLOATVAL re, im;
PMC * const d = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
(PMC *d) = PCCINVOKE(INTERP, SELF, "tanh");
GET_ATTR_re(INTERP, d, re);
GET_ATTR_im(INTERP, d, im);
SET_ATTR_re(INTERP, d, re ? re / (re * re + im * im) : 0.0);
SET_ATTR_im(INTERP, d, im ? -im / (re * re + im * im) : 0.0);
RETURN(PMC *d);
}
METHOD csch() {
FLOATVAL re, im;
PMC * const d = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
(PMC *d) = PCCINVOKE(INTERP, SELF, "sinh");
GET_ATTR_re(INTERP, d, re);
GET_ATTR_im(INTERP, d, im);
SET_ATTR_re(INTERP, d, re ? re / (re * re + im * im) : 0.0);
SET_ATTR_im(INTERP, d, im ? -im / (re * re + im * im) : 0.0);
RETURN(PMC *d);
}
METHOD sech() {
FLOATVAL re, im;
PMC * const d = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
(PMC *d) = PCCINVOKE(INTERP, SELF, "cosh");
GET_ATTR_re(INTERP, d, re);
GET_ATTR_im(INTERP, d, im);
SET_ATTR_re(INTERP, d, re ? re / (re * re + im * im) : 0.0);
SET_ATTR_im(INTERP, d, im ? -im / (re * re + im * im) : 0.0);
RETURN(PMC *d);
}
/*
=item C<METHOD PMC *asinh()>
=item C<METHOD PMC *acosh()>
=item C<METHOD PMC *atanh()>
=item C<METHOD PMC *acsch()>
=item C<METHOD PMC *asech()>
=item C<METHOD PMC *acoth()>
The inverse hyperbolic functions. Currently all broken, but for
C<func(a+bi) = c+di>, C<|c|> and C<|d|> will be correct, confusingly enough.
=cut
asinh z = -ln(sqrt(1+zz) - z)
asinh z = ln(sqrt(zz + 1) + z)
asinh = i asin(-ix)
acosh = i acos(x)
atanh = i atan(-ix)
*/
METHOD asinh() {
FLOATVAL re, im;
PMC * const d = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
PMC * const e = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
SET_ATTR_re(INTERP, d, im);
SET_ATTR_im(INTERP, d, -re);
(PMC *d) = PCCINVOKE(INTERP, d, "asin");
GET_ATTR_re(INTERP, d, re);
GET_ATTR_im(INTERP, d, im);
SET_ATTR_re(INTERP, e, -im);
SET_ATTR_im(INTERP, e, re);
RETURN(PMC *e);
}
METHOD acosh() {
FLOATVAL re, im;
PMC * const d = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
PMC * const e = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
(PMC *d) = PCCINVOKE(INTERP, SELF, "acos");
GET_ATTR_re(INTERP, d, re);
GET_ATTR_im(INTERP, d, im);
SET_ATTR_re(INTERP, e, -im);
SET_ATTR_im(INTERP, e, re);
RETURN(PMC *e);
}
METHOD atanh() {
FLOATVAL re, im;
PMC * const d = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
PMC * const e = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
SET_ATTR_re(INTERP, d, im);
SET_ATTR_im(INTERP, d, -re);
(PMC *d) = PCCINVOKE(INTERP, d, "atan");
GET_ATTR_re(INTERP, d, re);
GET_ATTR_im(INTERP, d, im);
SET_ATTR_re(INTERP, e, -im);
SET_ATTR_im(INTERP, e, re);
RETURN(PMC *e);
}
METHOD acoth() {
PMC * const d = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
PMC *e;
FLOATVAL re, im;
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
SET_ATTR_re(INTERP, d, re / (re * re + im * im));
SET_ATTR_im(INTERP, d, -im / (re * re + im * im));
(PMC *e) = PCCINVOKE(INTERP, d, "atanh");
RETURN(PMC *e);
}
METHOD acsch() {
PMC * const d = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
PMC *e;
FLOATVAL re, im;
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
SET_ATTR_re(INTERP, d, re / (re * re + im * im));
SET_ATTR_im(INTERP, d, -im / (re * re + im * im));
(PMC *e) = PCCINVOKE(INTERP, d, "asinh");
RETURN(PMC *e);
}
METHOD asech() {
PMC * const d = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
PMC *e;
FLOATVAL re, im;
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
SET_ATTR_re(INTERP, d, re / (re * re + im * im));
SET_ATTR_im(INTERP, d, -im / (re * re + im * im));
(PMC *e) = PCCINVOKE(INTERP, d, "acosh");
RETURN(PMC *e);
}
/*
=item C<METHOD PMC *pow(PMC *value)>
Raise SELF to the power of value. Replacement for the old pow() vtable, which
was deleted.
TODO: Requires testing
=item C<METHOD PMC *sqrt()>
Return the square root of SELF.
=cut
TODO: mmd in other pmc's to allow .Integer ^ .Complex, etc.
and i_pow, and pow_(float|int), etc
x ^ y = exp(y * ln x))
*/
METHOD pow(PMC * value) {
PMC *l = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
PMC *log;
PMC * const dest = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
Parrot_pcc_invoke_method_from_c_args(INTERP, SELF, CONST_STRING(INTERP, "ln"),
"->P", &log);
l = VTABLE_multiply(INTERP, log, value, l);
Parrot_pcc_invoke_method_from_c_args(INTERP, l, CONST_STRING(INTERP, "exp"),
"->P", &dest);
RETURN(PMC *dest);
}
METHOD sqrt() {
PMC * const result = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
const FLOATVAL absval = SELF.get_number();
FLOATVAL sx, sy, rx, ry;
GET_ATTR_re(INTERP, SELF, sx);
GET_ATTR_im(INTERP, SELF, sy);
rx = sqrt((absval + sx) / 2);
ry = sqrt((absval - sx) / 2);
if (sy < 0)
ry = -ry;
SET_ATTR_re(INTERP, result, rx);
SET_ATTR_im(INTERP, result, ry);
RETURN(PMC *result);
}
}
/*
=back
=cut
*/
/*
* Local variables:
* c-file-style: "parrot"
* End:
* vim: expandtab shiftwidth=4 cinoptions='\:2=2' :
*/