SEXP
GetRScalar(SV *val)
{
dTHX;
SEXP ans = NULL_USER_OBJECT;
if(SvIOKp(val)) {
PROTECT(ans = NEW_INTEGER(1));
INTEGER_DATA(ans)[0] = SvIV(val);
UNPROTECT(1);
} else if(SvNOKp(val)) {
PROTECT(ans = NEW_NUMERIC(1));
NUMERIC_DATA(ans)[0] = SvNV(val);
UNPROTECT(1);
} else if(SvPOK(val)) {
PROTECT(ans = NEW_CHARACTER(1));
SET_STRING_ELT(ans, 0, COPY_TO_USER_STRING(SvPV(val, PL_na)));
UNPROTECT(1);
} else if(SvROK(val)) {
fprintf(stderr, "Not handling nested references in conversion from Perl to R at present. Suggestions for semantics welcome!\n");fflush(stderr);
} else if(SvTYPE(val) == SVt_PVMG) {
/*XXX get more info about the type of the magic object.
struct magic *mg = SvMAGIC(val);
*/
PROTECT(ans = createPerlReference(val));
UNPROTECT(1);
} else {
fprintf(stderr, "Cannot deal currently with Perl types %d\n", SvTYPE(val));fflush(stderr);
}
return(ans);
}
USER_OBJECT_
R_makePerlReference(USER_OBJECT_ s_obj)
{
SV *obj, *ref;
USER_OBJECT_ ans;
dTHX;
obj = toPerl(s_obj, TRUE);
/* SvREFCNT_inc(obj); not needed */
ref = newRV_inc(obj);
ans = createPerlReference((SV*) ref);
return(ans);
}
void
GCCNode_convert(SV *obj, PerlClassInfoPtr className, RSFromPerlConverter *converters)
{
return(createPerlReference(SvRV(obj)));
}
USER_OBJECT_
fromPerl(SV *val, unsigned int depth)
{
USER_OBJECT_ ans = NULL_USER_OBJECT;
USER_OBJECT_ classes;
svtype type = SvTYPE(val);
svtype elementType = SVt_NULL;
svtype refType;
SV *refVal = NULL;
dTHX;
if(type == SVt_PVGV) {
if(GvHV(val))
ans = fromPerlHV(GvHV(val), depth - 1);
else if(GvAV(val))
ans = fromPerlAV(GvAV(val), NULL, depth - 1);
else if(GvCV(val))
ans = fromPerl((SV *) GvCV(val), 0);
else if(GvSV(val))
ans = fromPerl(GvSV(val), depth - 1);
else if(GvIOp(val)) {
/* XXX */
} else {
PROBLEM "Don't understand particular type of PVGV at this point"
ERROR;
}
return(ans);
} else if (type == SVt_PVMG && !sv_isobject(val)) {
/* If it is magic and not an object, then treat it as a scalar and
get it back to R as a value, not a reference.
Would ideally like to respect the convert option. But
we can get ourselves into an infinite loop. Needs more investigation.
*/
return(GetRScalar(val));
}
if(val == NULL || val == &sv_undef || (!SvOK(val) && !SvROK(val) && type != SVt_PVCV) /* || type == SVt_NULL */) {
#ifdef R_PERL_DEBUG
fprintf(stderr, "Null result: %p (%d) (undef = %p) (type is %s) SvOK=%d, SvROK=%d\n",
val, type, &sv_undef, type == SVt_NULL ? "null" : "not null",
SvOK(val), SvROK(val)); fflush(stderr);
#endif
return(NULL_USER_OBJECT);
}
if(SvROK(val)) { /* && sv_isobject(val)) { */
if(sv_isa(val, "RReferences")) {
return(RPerl_getProxyValue(val));
} else {
ans = userLevelConversionFromPerl(val, depth);
if(ans != NULL)
return(ans);
#ifdef R_PERL_DEBUG
fprintf(stderr, "Didn't get a user-leve conversion. Continuining with regular conversion\n");
#endif
}
}
classes = computeRSPerlClassVector(val, &elementType, depth);
if(!depth || (classes && GET_LENGTH(classes))) {
/* We protect classes in the subroutines. */
PROTECT(classes);
ans = makeForeignPerlReference(val, classes, &exportReferenceTable);
UNPROTECT(1);
return(ans);
}
#ifdef R_PERL_DEBUG
fprintf(stderr, "[Converting] element type %d %d %d\n", (int) elementType, (int) SvTYPE(val), (int) (SvTYPE(val) == SVt_RV));
#endif
/*
If it is a reference, then check whether it is an array or hash.
*/
if(SvROK(val)) {
refVal = SvRV(val);
refType = SvTYPE(refVal);
} else {
refVal = val;
refType = type;
}
#ifdef R_PERL_DEBUG
fprintf(stderr, "[fromPerl] refType = %d\n", refType);
#endif
if(refType == SVt_PVAV || refType == SVt_PVHV) {
if(isHomogeneous(refVal, &elementType)) {
return( (refType == SVt_PVAV) ?
fromHomogeneousArray(refVal, elementType) :
fromHomogeneousTable(refVal, elementType));
} else {
return( (refType == SVt_PVAV) ? fromPerlAV((AV*)refVal, NULL, depth) : fromPerlHV((HV*)refVal, depth));
}
} else if(refType == SVt_PVCV) {
return(createPerlReference(refVal));
}
#ifdef R_PERL_DEBUG
fprintf(stderr, "[fromPerl] continuing again as refType (%d) was not an array or table.\n", refType);
#endif
ans = GetRScalar(val);
return(ans);
}
