PARROT_INLINE
static int
is_invokable(PARROT_INTERP, ARGIN(PMC*sub_obj)) /* HEADERIZER SKIP */
{
if (VTABLE_isa(interp, sub_obj, CONST_STRING(interp, "Sub")))
return 1;
else
return VTABLE_does(interp, sub_obj, CONST_STRING(interp, "invokable"));
}
void
get_complex_value_from_pmc(PARROT_INTERP, PMC * value, FLOATVAL * real,
FLOATVAL * imag)
{
if (PMC_IS_NULL(value)) {
*real = 0.0;
*imag = 0.0;
}
else if (VTABLE_does(interp, value, Parrot_str_new(interp, "complex", 7))) {
*real = VTABLE_get_number_keyed_int(interp, value, 0);
*imag = VTABLE_get_number_keyed_int(interp, value, 1);
}
else if (VTABLE_does(interp, value, Parrot_str_new(interp, "array", 5))) {
const INTVAL size = VTABLE_elements(interp, value);
if(size <= 2) {
*real = (size == 0) ? 0.0 : VTABLE_get_number_keyed_int(interp, value, 0);
*imag = (size < 2) ? 0.0 : VTABLE_get_number_keyed_int(interp, value, 1);
}
else
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_OUT_OF_BOUNDS,
"PLA: array too long to be converted into complex number");
}
else if (VTABLE_does(interp, value, Parrot_str_new(interp, "float", 5))) {
*real = VTABLE_get_number(interp, value);
*imag = 0.0;
}
else if (VTABLE_does(interp, value, Parrot_str_new(interp, "integer", 7))) {
const INTVAL _r = VTABLE_get_integer(interp, value);
*real = (FLOATVAL)_r;
*imag = 0.0;
}
else if (VTABLE_does(interp, value, Parrot_str_new(interp, "string", 6))) {
PMC * const c = get_external_pmc_init(interp, enum_class_Complex, value);
*real = VTABLE_get_number_keyed_int(interp, c, 0);
*imag = VTABLE_get_number_keyed_int(interp, c, 1);
}
else
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_OUT_OF_BOUNDS,
"PLA: cannot set unknown PMC type");
}
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
SV *
blizkost_marshal_arg(BLIZKOST_NEXUS, PMC *arg) {
struct sv *result = NULL;
dBNPERL; dBNINTERP;
/* If it's a P5Scalar PMC, then we just fetch the SV from it - trivial
* round-tripping. */
if (VTABLE_isa(interp, arg, CONST_STRING(interp, "P5Scalar"))) {
GETATTR_P5Scalar_sv(interp, arg, result);
}
/* XXX At this point, we should probably wrap it up in a tied Perl 5
* scalar so we can round-trip Parrot objects to. However, that's hard,
* so for now we cheat on a few special cases and just panic otherwise. */
else if (VTABLE_isa(interp, arg, CONST_STRING(interp, "Integer"))) {
result = sv_2mortal(newSViv(VTABLE_get_integer(interp, arg)));
}
else if (VTABLE_isa(interp, arg, CONST_STRING(interp, "Float"))) {
result = sv_2mortal(newSVnv(VTABLE_get_number(interp, arg)));
}
else if (VTABLE_isa(interp, arg, CONST_STRING(interp, "P5Namespace"))) {
STRING *pkg;
char *c_str;
GETATTR_P5Namespace_ns_name(interp, arg, pkg);
c_str = Parrot_str_to_cstring(interp, pkg);
result = sv_2mortal(newSVpv(c_str, strlen(c_str)));
}
else if (VTABLE_isa(interp, arg, CONST_STRING(interp, "String"))) {
char *c_str = Parrot_str_to_cstring(interp, VTABLE_get_string(interp, arg));
result = sv_2mortal(newSVpv(c_str, strlen(c_str)));
}
else if (VTABLE_does(interp, arg, CONST_STRING(interp, "invokable"))) {
CV *wrapper = blizkost_wrap_callable(nexus, arg);
result = sv_2mortal(newRV_inc((SV*)wrapper));
}
else if ( VTABLE_does(interp, arg, CONST_STRING(interp, "array"))) {
PMC *iter;
struct av *array = newAV();
iter = VTABLE_get_iter(interp, arg);
while (VTABLE_get_bool(interp, iter)) {
PMC *item = VTABLE_shift_pmc(interp, iter);
struct sv *marshaled =
blizkost_marshal_arg(nexus, item);
av_push( array, marshaled);
}
result = newRV_inc((SV*)array);
}
else if ( VTABLE_does(interp, arg, CONST_STRING(interp, "hash"))) {
PMC *iter = VTABLE_get_iter(interp, arg);
struct hv *hash = newHV();
INTVAL n = VTABLE_elements(interp, arg);
INTVAL i;
for(i = 0; i < n; i++) {
STRING *s = VTABLE_shift_string(interp, iter);
char *c_str = Parrot_str_to_cstring(interp, s);
struct sv *val = blizkost_marshal_arg(nexus,
VTABLE_get_pmc_keyed_str(interp, arg, s));
hv_store(hash, c_str, strlen(c_str), val, 0);
}
result = newRV_inc((SV*)hash);
}
else {
Parrot_ex_throw_from_c_args(interp, NULL, 1,
"Sorry, we do not support marshaling most things to Perl 5 yet.");
}
return result;
}
