// 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; } }