// 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); } }
RObject* RObject::getAttribute(const Symbol* name) const { for (PairList* node = m_attrib; node; node = node->tail()) if (node->tag() == name) return node->car(); return 0; }
int main(int argc, char* argv[]) { Evaluator evalr; if (argc < 3 || argc > 4) usage(argv[0]); // Set up error reporting: ptr_R_WriteConsoleEx = WriteConsoleEx; ptr_R_ResetConsole = ptr_R_FlushConsole = ptr_R_ClearerrConsole = DoNothing; Rf_InitOptions(); // Set up Environments: GCStackRoot<Frame> ff(CXXR_NEW(ListFrame)); GCStackRoot<Environment> fenvrt(CXXR_NEW(Environment(0, ff))); fenv = fenvrt; // Process formals: cout << "Formal arguments:\n\n"; GCStackRoot<PairList> formals(getArgs(argv[1])); GCStackRoot<ArgMatcher> matcher; try { matcher = GCNode::expose(new ArgMatcher(formals)); } catch (CommandTerminated) { cerr << "ArgMatchertest: Error encountered while processing formals" << endl; return 0; } // Process supplied arguments: cout << "\nSupplied arguments:\n\n"; ArgList supplied(getArgs(argv[2]), ArgList::RAW); // Set up frame and prior bindings (if any): Frame* frame = fenv->frame(); if (argc == 4) { cout << "\nPrior bindings:\n\n"; GCStackRoot<PairList> prior_bindings(getArgs(argv[3])); for (PairList* pb = prior_bindings; pb; pb = pb->tail()) { const Symbol* tag = static_cast<const Symbol*>(pb->tag()); Frame::Binding* bdg = frame->obtainBinding(tag); bdg->setValue(pb->car(), Frame::Binding::EXPLICIT); } } // Perform match and show result: try { matcher->match(fenv, &supplied); } catch (CommandTerminated) { cerr << "ArgMatchertest: Error encountered while matching arguments" << endl; return 0; } cout << "\nMatch result:\n\n"; showFrame(frame); return 0; }