SEXP attribute_hidden do_provCommand (SEXP call, SEXP op, SEXP args, SEXP rho) { #ifndef PROVENANCE_TRACKING Rf_error(_("provenance tracking not implemented in this build")); return 0; #else int n; if ((n=length(args))!=1) errorcall(call,_("%d arguments passed to 'provCommand' which requires 1"),n); if (TYPEOF(CAR(args))!=SYMSXP) errorcall(call,_("provCommand expects Symbol argument")); Symbol* sym=SEXP_downcast<Symbol*>(CAR(args)); Environment* env=static_cast<Environment*>(rho); Frame::Binding* bdg = env->findBinding(sym); return const_cast<RObject*>(bdg->provenance()->command()); #endif // PROVENANCE_TRACKING }
SEXP attribute_hidden do_hasProvenance (SEXP call, SEXP op, SEXP args, SEXP rho) { int n; if ((n=length(args))!=1) errorcall(call,_("%d arguments passed to 'hasProvenance' which requires 1"),n); if (TYPEOF(CAR(args))!=SYMSXP) errorcall(call,_("hasProvenance expects Symbol argument")); GCStackRoot<LogicalVector> v(GCNode::expose(new LogicalVector(1))); #ifdef PROVENANCE_TRACKING Symbol* sym=SEXP_downcast<Symbol*>(CAR(args)); Environment* env=static_cast<Environment*>(rho); Frame::Binding* bdg = env->findBinding(sym); (*v)[0] = (bdg->provenance() != 0); #else (*v)[0] = false; #endif return v; }
SEXP attribute_hidden do_provenance_graph(SEXP call, SEXP op, SEXP args, SEXP rho) { #ifndef PROVENANCE_TRACKING Rf_error(_("provenance tracking not implemented in this build")); return 0; #else int nargs = length(args); if (nargs != 1) Rf_error(_("%d arguments passed to 'provenance.graph' which requires 1"), nargs); SEXP arg1 = CAR(args); if (!arg1 || arg1->sexptype() != STRSXP) Rf_error(_("invalid 'names' argument")); Environment* env = static_cast<Environment*>(rho); Provenance::Set provs; StringVector* sv = static_cast<StringVector*>(arg1); for (size_t i = 0; i < sv->size(); i++) { const char* name = (*sv)[i]->c_str(); Symbol* sym = Symbol::obtain(name); Frame::Binding* bdg = env->findBinding(sym); if (!bdg) Rf_error(_("symbol '%s' not found"), name); else { Provenance* prov = const_cast<Provenance*>(bdg->provenance()); if (!prov) Rf_warning(_("'%s' does not have provenance information"), name); else provs.insert(prov); } } Provenance::Set* ancestors = Provenance::ancestors(provs); GCStackRoot<ListVector> ans(CXXR_NEW(ListVector(7))); std::map<const Provenance*, unsigned int> ancestor_index; std::vector<std::pair<unsigned int, const RObject*> > xenogenous_bdgs; // Assemble information on graph nodes: { size_t n = ancestors->size(); GCStackRoot<ListVector> symbols(CXXR_NEW(ListVector(n))); GCStackRoot<ListVector> commands(CXXR_NEW(ListVector(n))); GCStackRoot<RealVector> timestamps(CXXR_NEW(RealVector(n))); size_t i = 0; for (Provenance::Set::iterator it = ancestors->begin(); it != ancestors->end(); ++it) { const Provenance* p = *it; (*symbols)[i] = const_cast<Symbol*>(p->symbol()); (*commands)[i] = const_cast<RObject*>(p->command()); (*timestamps)[i] = p->timestamp(); ++i; ancestor_index[p] = i; if (p->isXenogenous()) xenogenous_bdgs.push_back(std::make_pair(i, p->value())); } (*ans)[0] = symbols; (*ans)[1] = commands; (*ans)[2] = timestamps; } // Record information on xenogenous bindings: { size_t xn = xenogenous_bdgs.size(); GCStackRoot<IntVector> xenogenous(CXXR_NEW(IntVector(xn))); GCStackRoot<ListVector> values(CXXR_NEW(ListVector(xn))); for (unsigned int i = 0; i < xn; ++i) { std::pair<unsigned int, const RObject*>& pr = xenogenous_bdgs[i]; (*xenogenous)[i] = pr.first; (*values)[i] = const_cast<RObject*>(pr.second); } (*ans)[3] = xenogenous; (*ans)[4] = values; } // Assemble information on graph edges: { typedef std::set<std::pair<unsigned int, unsigned int> > EdgeSet; EdgeSet edges; for (Provenance::Set::iterator it = ancestors->begin(); it != ancestors->end(); ++it) { const Provenance* child = *it; unsigned int child_idx = ancestor_index[child]; std::pair<CommandChronicle::ParentVector::const_iterator, CommandChronicle::ParentVector::const_iterator> pr = child->parents(); for (CommandChronicle::ParentVector::const_iterator it = pr.first; it != pr.second; ++it) { const Provenance* parent = *it; unsigned int parent_idx = ancestor_index[parent]; edges.insert(std::make_pair(parent_idx, child_idx)); } } size_t en = edges.size(); GCStackRoot<IntVector> parents(CXXR_NEW(IntVector(en))); GCStackRoot<IntVector> children(CXXR_NEW(IntVector(en))); unsigned int i = 0; for (EdgeSet::const_iterator it = edges.begin(); it != edges.end(); ++it) { const std::pair<unsigned int, unsigned int>& edge = *it; (*parents)[i] = edge.first; (*children)[i] = edge.second; ++i; } (*ans)[5] = parents; (*ans)[6] = children; } delete ancestors; return ans; #endif // PROVENANCE_TRACKING }
SEXP attribute_hidden do_provenance (SEXP call, SEXP op, SEXP args, SEXP rho) { #ifndef PROVENANCE_TRACKING Rf_error(_("provenance tracking not implemented in this build")); return 0; #else const int nfields=5; int n; if ((n=length(args))!=1) errorcall(call,_("%d arguments passed to 'provenance' which requires 1"),n); if (TYPEOF(CAR(args))!=SYMSXP) errorcall(call,_("provenance expects Symbol argument")); Symbol* sym=SEXP_downcast<Symbol*>(CAR(args)); Environment* env=static_cast<Environment*>(rho); Frame::Binding* bdg = env->findBinding(sym); if (!bdg) errorcall(call,_("invalid Symbol passed to 'provenance'")); Provenance* provenance=const_cast<Provenance*>(bdg->provenance()); if (!provenance) errorcall(call,_("object does not have any provenance")); const Provenance::Set& children=provenance->children(); GCStackRoot<ListVector> list(GCNode::expose(new ListVector(nfields))); GCStackRoot<StringVector> timestamp(GCNode::expose(new StringVector(1))); GCStackRoot<StringVector> names(GCNode::expose(new StringVector(nfields))); (*timestamp)[0]=const_cast<String*>(provenance->getTime()); (*names)[0]=const_cast<String*>(String::obtain("command")); (*names)[1]=const_cast<String*>(String::obtain("symbol")); (*names)[2]=const_cast<String*>(String::obtain("timestamp")); (*names)[3]=const_cast<String*>(String::obtain("parents")); (*names)[4]=const_cast<String*>(String::obtain("children")); (*list)[0] = const_cast<RObject*>(provenance->command()); (*list)[1] = const_cast<Symbol*>(provenance->symbol()); (*list)[2]=timestamp; // Handle parents: { std::pair<CommandChronicle::ParentVector::const_iterator, CommandChronicle::ParentVector::const_iterator> pr = provenance->parents(); size_t sz = pr.second - pr.first; StringVector* sv = CXXR_NEW(StringVector(sz)); (*list)[3] = sv; unsigned int i = 0; for (CommandChronicle::ParentVector::const_iterator it = pr.first; it != pr.second; ++it) { const Provenance* p = *it; (*sv)[i++] = const_cast<String*>(p->symbol()->name()); } } if (!children.empty()) { StringVector* sv = CXXR_NEW(StringVector(children.size())); (*list)[4] = sv; unsigned int i = 0; for (Provenance::Set::const_iterator it = children.begin(); it != children.end(); ++it) { const Provenance* p = *it; (*sv)[i++] = const_cast<String*>(p->symbol()->name()); } } setAttrib(list,R_NamesSymbol,names); return list; #endif // PROVENANCE_TRACKING }