// This follows CR in adding new attributes at the end of the list,
// though it would be easier to add them at the beginning.
void RObject::setAttribute(const Symbol* name, RObject* value)
{
if (!name)
Rf_error(_("attributes must be named"));
// Update 'has class' bit if necessary:
if (name == R_ClassSymbol) {
if (value == 0)
m_type &= static_cast<signed char>(~s_class_mask);
else m_type |= static_cast<signed char>(s_class_mask);
}
// Find attribute:
PairList* prev = 0;
PairList* node = m_attrib;
while (node && node->tag() != name) {
prev = node;
node = node->tail();
}
if (node) { // Attribute already present
// Update existing attribute:
if (value)
node->setCar(value);
// Delete existing attribute:
else if (prev)
prev->setTail(node->tail());
else m_attrib = node->tail();
} else if (value) {
// Create new node:
PairList* newnode = PairList::cons(value, 0, name);
if (prev)
prev->setTail(newnode);
else { // No preexisting attributes at all:
m_attrib = newnode;
}
}
}
static int SubAssignArgs(PairList* args, SEXP *x, PairList** s, SEXP *y)
{
if (CDR(args) == R_NilValue)
Rf_error(_("SubAssignArgs: invalid number of arguments"));
*x = args->car();
if(CDDR(args) == R_NilValue) {
*s = nullptr;
*y = args->tail()->car();
return 0;
}
else {
int nsubs = 1;
PairList* p = args->tail();
*s = p;
PairList* ptail = p->tail();
while (ptail->tail()) {
p = ptail;
ptail = p->tail();
nsubs++;
}
*y = ptail->car();
p->setTail(nullptr);
return nsubs;
}
}
