// 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;
}
}
}
void ArgList::merge(const ConsCell* extraargs)
{
if (m_status != PROMISED)
Rf_error("Internal error: ArgList::merge() requires PROMISED ArgList");
// Convert extraargs into a doubly linked list:
typedef std::list<pair<const RObject*, RObject*> > Xargs;
Xargs xargs;
for (const ConsCell* cc = extraargs; cc; cc = cc->tail())
xargs.push_back(make_pair(cc->tag(), cc->car()));
// Apply overriding arg values supplied in extraargs:
PairList* last = 0;
for (PairList* pl = mutable_list(); pl; pl = pl->tail()) {
last = pl;
const RObject* tag = pl->tag();
if (tag) {
Xargs::iterator it = xargs.begin();
while (it != xargs.end() && (*it).first != tag)
++it;
if (it != xargs.end()) {
pl->setCar((*it).second);
xargs.erase(it);
}
}
}
// Append remaining extraargs:
for (Xargs::const_iterator it = xargs.begin(); it != xargs.end(); ++it) {
PairList* cell = PairList::cons((*it).second, 0, (*it).first);
last = append(cell, last);
}
}
