in source/src/main/deparse.c [747:1269]
static void deparse2buff(SEXP s, LocalParseData *d)
{
PPinfo fop;
Rboolean lookahead = FALSE, lbreak = FALSE, parens, fnarg = d->fnarg,
outerparens, doquote;
SEXP op, t;
int localOpts = d->opts, i, n;
d->fnarg = FALSE;
if (!d->active) return;
if (IS_S4_OBJECT(s)) d->isS4 = TRUE;
switch (TYPEOF(s)) {
case NILSXP:
print2buff("NULL", d);
break;
case SYMSXP:
doquote = (localOpts & QUOTEEXPRESSIONS) && strlen(CHAR(PRINTNAME(s)));
if (doquote) {
attr1(s, d);
print2buff("quote(", d);
}
if (localOpts & S_COMPAT) {
print2buff(quotify(PRINTNAME(s), '"'), d);
} else if (d->backtick)
print2buff(quotify(PRINTNAME(s), '`'), d);
else
print2buff(CHAR(PRINTNAME(s)), d);
if (doquote) {
print2buff(")", d);
attr2(s, d);
}
break;
case CHARSXP:
{
const void *vmax = vmaxget();
const char *ts = translateChar(s);
/* versions of R < 2.7.0 cannot parse strings longer than 8192 chars */
if(strlen(ts) >= 8192) d->longstring = TRUE;
print2buff(ts, d);
vmaxset(vmax);
break;
}
case SPECIALSXP:
case BUILTINSXP:
print2buff(".Primitive(\"", d);
print2buff(PRIMNAME(s), d);
print2buff("\")", d);
break;
case PROMSXP:
if(d->opts & DELAYPROMISES) {
d->sourceable = FALSE;
print2buff("<promise: ", d);
d->opts &= ~QUOTEEXPRESSIONS; /* don't want delay(quote()) */
deparse2buff(PREXPR(s), d);
d->opts = localOpts;
print2buff(">", d);
} else {
PROTECT(s = eval(s, R_EmptyEnv)); /* eval uses env of promise */
deparse2buff(s, d);
UNPROTECT(1);
}
break;
case CLOSXP:
if (localOpts & SHOWATTRIBUTES) attr1(s, d);
if ((d->opts & USESOURCE)
&& !isNull(t = getAttrib(s, R_SrcrefSymbol)))
src2buff1(t, d);
else {
/* We have established that we don't want to use the
source for this function */
d->opts &= SIMPLE_OPTS & ~USESOURCE;
print2buff("function (", d);
args2buff(FORMALS(s), 0, 1, d);
print2buff(") ", d);
writeline(d);
deparse2buff(BODY_EXPR(s), d);
d->opts = localOpts;
}
if (localOpts & SHOWATTRIBUTES) attr2(s, d);
break;
case ENVSXP:
d->sourceable = FALSE;
print2buff("<environment>", d);
break;
case VECSXP:
if (localOpts & SHOWATTRIBUTES) attr1(s, d);
print2buff("list(", d);
vec2buff(s, d);
print2buff(")", d);
if (localOpts & SHOWATTRIBUTES) attr2(s, d);
break;
case EXPRSXP:
if (localOpts & SHOWATTRIBUTES) attr1(s, d);
if(length(s) <= 0)
print2buff("expression()", d);
else {
print2buff("expression(", d);
d->opts &= SIMPLE_OPTS;
vec2buff(s, d);
d->opts = localOpts;
print2buff(")", d);
}
if (localOpts & SHOWATTRIBUTES) attr2(s, d);
break;
case LISTSXP:
if (localOpts & SHOWATTRIBUTES) attr1(s, d);
print2buff("pairlist(", d);
d->inlist++;
for (t=s ; CDR(t) != R_NilValue ; t=CDR(t) ) {
if( TAG(t) != R_NilValue ) {
d->opts = SIMPLEDEPARSE; /* turn off quote()ing */
deparse2buff(TAG(t), d);
d->opts = localOpts;
print2buff(" = ", d);
}
deparse2buff(CAR(t), d);
print2buff(", ", d);
}
if( TAG(t) != R_NilValue ) {
d->opts = SIMPLEDEPARSE; /* turn off quote()ing */
deparse2buff(TAG(t), d);
d->opts = localOpts;
print2buff(" = ", d);
}
deparse2buff(CAR(t), d);
print2buff(")", d);
d->inlist--;
if (localOpts & SHOWATTRIBUTES) attr2(s, d);
break;
case LANGSXP:
printcomment(s, d);
if (!isNull(ATTRIB(s)))
d->sourceable = FALSE;
if (localOpts & QUOTEEXPRESSIONS) {
print2buff("quote(", d);
d->opts &= SIMPLE_OPTS;
}
if (TYPEOF(CAR(s)) == SYMSXP) {
int userbinop = 0;
op = CAR(s);
if ((TYPEOF(SYMVALUE(op)) == BUILTINSXP) ||
(TYPEOF(SYMVALUE(op)) == SPECIALSXP) ||
(userbinop = isUserBinop(op))) {
s = CDR(s);
if (userbinop) {
if (isNull(getAttrib(s, R_NamesSymbol))) {
fop.kind = PP_BINARY2; /* not quite right for spacing, but can't be unary */
fop.precedence = PREC_PERCENT;
fop.rightassoc = 0;
} else
fop.kind = PP_FUNCALL; /* if args are named, deparse as function call (PR#15350) */
} else
fop = PPINFO(SYMVALUE(op));
if (fop.kind == PP_BINARY) {
switch (length(s)) {
case 1:
fop.kind = PP_UNARY;
if (fop.precedence == PREC_SUM) /* binary +/- precedence upgraded as unary */
fop.precedence = PREC_SIGN;
break;
case 2:
break;
default:
fop.kind = PP_FUNCALL;
break;
}
}
else if (fop.kind == PP_BINARY2) {
if (length(s) != 2)
fop.kind = PP_FUNCALL;
else if (userbinop)
fop.kind = PP_BINARY;
}
switch (fop.kind) {
case PP_IF:
print2buff("if (", d);
/* print the predicate */
deparse2buff(CAR(s), d);
print2buff(") ", d);
if (d->incurly && !d->inlist ) {
lookahead = curlyahead(CAR(CDR(s)));
if (!lookahead) {
writeline(d);
d->indent++;
}
}
/* need to find out if there is an else */
if (length(s) > 2) {
deparse2buff(CAR(CDR(s)), d);
if (d->incurly && !d->inlist) {
writeline(d);
if (!lookahead)
d->indent--;
}
else
print2buff(" ", d);
print2buff("else ", d);
deparse2buff(CAR(CDDR(s)), d);
}
else {
deparse2buff(CAR(CDR(s)), d);
if (d->incurly && !lookahead && !d->inlist )
d->indent--;
}
break;
case PP_WHILE:
print2buff("while (", d);
deparse2buff(CAR(s), d);
print2buff(") ", d);
deparse2buff(CADR(s), d);
break;
case PP_FOR:
print2buff("for (", d);
deparse2buff(CAR(s), d);
print2buff(" in ", d);
deparse2buff(CADR(s), d);
print2buff(") ", d);
deparse2buff(CADR(CDR(s)), d);
break;
case PP_REPEAT:
print2buff("repeat ", d);
deparse2buff(CAR(s), d);
break;
case PP_CURLY:
print2buff("{", d);
d->incurly += 1;
d->indent++;
writeline(d);
while (s != R_NilValue) {
deparse2buff(CAR(s), d);
writeline(d);
s = CDR(s);
}
d->indent--;
print2buff("}", d);
d->incurly -= 1;
break;
case PP_PAREN:
print2buff("(", d);
deparse2buff(CAR(s), d);
print2buff(")", d);
break;
case PP_SUBSET:
if ((parens = needsparens(fop, CAR(s), 1)))
print2buff("(", d);
deparse2buff(CAR(s), d);
if (parens)
print2buff(")", d);
if (PRIMVAL(SYMVALUE(op)) == 1)
print2buff("[", d);
else
print2buff("[[", d);
args2buff(CDR(s), 0, 0, d);
if (PRIMVAL(SYMVALUE(op)) == 1)
print2buff("]", d);
else
print2buff("]]", d);
break;
case PP_FUNCALL:
case PP_RETURN:
if (d->backtick)
print2buff(quotify(PRINTNAME(op), '`'), d);
else
print2buff(quotify(PRINTNAME(op), '"'), d);
print2buff("(", d);
d->inlist++;
args2buff(s, 0, 0, d);
d->inlist--;
print2buff(")", d);
break;
case PP_FOREIGN:
print2buff(CHAR(PRINTNAME(op)), d); /* ASCII */
print2buff("(", d);
d->inlist++;
args2buff(s, 1, 0, d);
d->inlist--;
print2buff(")", d);
break;
case PP_FUNCTION:
printcomment(s, d);
if (!(d->opts & USESOURCE) || !isString(CADDR(s))) {
print2buff(CHAR(PRINTNAME(op)), d); /* ASCII */
print2buff("(", d);
args2buff(FORMALS(s), 0, 1, d);
print2buff(") ", d);
deparse2buff(CADR(s), d);
} else {
s = CADDR(s);
n = length(s);
const void *vmax = vmaxget();
for(i = 0 ; i < n ; i++) {
print2buff(translateChar(STRING_ELT(s, i)), d);
writeline(d);
}
vmaxset(vmax);
}
break;
case PP_ASSIGN:
case PP_ASSIGN2:
if ((outerparens = (fnarg && !strcmp(CHAR(PRINTNAME(op)), "="))))
print2buff("(", d);
if ((parens = needsparens(fop, CAR(s), 1)))
print2buff("(", d);
deparse2buff(CAR(s), d);
if (parens)
print2buff(")", d);
print2buff(" ", d);
print2buff(CHAR(PRINTNAME(op)), d); /* ASCII */
print2buff(" ", d);
if ((parens = needsparens(fop, CADR(s), 0)))
print2buff("(", d);
deparse2buff(CADR(s), d);
if (parens)
print2buff(")", d);
if (outerparens)
print2buff(")", d);
break;
case PP_DOLLAR:
if ((parens = needsparens(fop, CAR(s), 1)))
print2buff("(", d);
deparse2buff(CAR(s), d);
if (parens)
print2buff(")", d);
print2buff(CHAR(PRINTNAME(op)), d); /* ASCII */
/*temp fix to handle printing of x$a's */
if( isString(CADR(s)) &&
isValidName(CHAR(STRING_ELT(CADR(s), 0))))
deparse2buff(STRING_ELT(CADR(s), 0), d);
else {
if ((parens = needsparens(fop, CADR(s), 0)))
print2buff("(", d);
deparse2buff(CADR(s), d);
if (parens)
print2buff(")", d);
}
break;
case PP_BINARY:
if ((parens = needsparens(fop, CAR(s), 1)))
print2buff("(", d);
deparse2buff(CAR(s), d);
if (parens)
print2buff(")", d);
print2buff(" ", d);
print2buff(CHAR(PRINTNAME(op)), d); /* ASCII */
print2buff(" ", d);
linebreak(&lbreak, d);
if ((parens = needsparens(fop, CADR(s), 0)))
print2buff("(", d);
deparse2buff(CADR(s), d);
if (parens)
print2buff(")", d);
if (lbreak) {
d->indent--;
lbreak = FALSE;
}
break;
case PP_BINARY2: /* no space between op and args */
if ((parens = needsparens(fop, CAR(s), 1)))
print2buff("(", d);
deparse2buff(CAR(s), d);
if (parens)
print2buff(")", d);
print2buff(CHAR(PRINTNAME(op)), d); /* ASCII */
if ((parens = needsparens(fop, CADR(s), 0)))
print2buff("(", d);
deparse2buff(CADR(s), d);
if (parens)
print2buff(")", d);
break;
case PP_UNARY:
print2buff(CHAR(PRINTNAME(op)), d); /* ASCII */
if ((parens = needsparens(fop, CAR(s), 0)))
print2buff("(", d);
deparse2buff(CAR(s), d);
if (parens)
print2buff(")", d);
break;
case PP_BREAK:
print2buff("break", d);
break;
case PP_NEXT:
print2buff("next", d);
break;
case PP_SUBASS:
if(d->opts & S_COMPAT) {
print2buff("\"", d);
print2buff(CHAR(PRINTNAME(op)), d); /* ASCII */
print2buff("\'(", d);
} else {
print2buff("`", d);
print2buff(CHAR(PRINTNAME(op)), d); /* ASCII */
print2buff("`(", d);
}
args2buff(s, 0, 0, d);
print2buff(")", d);
break;
default:
d->sourceable = FALSE;
UNIMPLEMENTED("deparse2buff");
}
}
else {
SEXP val = R_NilValue; /* -Wall */
if (isSymbol(CAR(s))) {
val = SYMVALUE(CAR(s));
if (TYPEOF(val) == PROMSXP)
val = eval(val, R_BaseEnv);
}
if ( isSymbol(CAR(s))
&& TYPEOF(val) == CLOSXP
&& streql(CHAR(PRINTNAME(CAR(s))), "::") ){ /* :: is special case */
deparse2buff(CADR(s), d);
print2buff("::", d);
deparse2buff(CADDR(s), d);
}
else if ( isSymbol(CAR(s))
&& TYPEOF(val) == CLOSXP
&& streql(CHAR(PRINTNAME(CAR(s))), ":::") ){ /* ::: is special case */
deparse2buff(CADR(s), d);
print2buff(":::", d);
deparse2buff(CADDR(s), d);
}
else {
if ( isSymbol(CAR(s)) ){
if(d->opts & S_COMPAT)
print2buff(quotify(PRINTNAME(CAR(s)), '\''), d);
else
print2buff(quotify(PRINTNAME(CAR(s)), '`'), d);
}
else
deparse2buff(CAR(s), d);
print2buff("(", d);
args2buff(CDR(s), 0, 0, d);
print2buff(")", d);
}
}
}
else if (TYPEOF(CAR(s)) == CLOSXP || TYPEOF(CAR(s)) == SPECIALSXP
|| TYPEOF(CAR(s)) == BUILTINSXP) {
if (parenthesizeCaller(CAR(s))) {
print2buff("(", d);
deparse2buff(CAR(s), d);
print2buff(")", d);
} else
deparse2buff(CAR(s), d);
print2buff("(", d);
args2buff(CDR(s), 0, 0, d);
print2buff(")", d);
}
else { /* we have a lambda expression */
if (parenthesizeCaller(CAR(s))) {
print2buff("(", d);
deparse2buff(CAR(s), d);
print2buff(")", d);
} else
deparse2buff(CAR(s), d);
print2buff("(", d);
args2buff(CDR(s), 0, 0, d);
print2buff(")", d);
}
if (localOpts & QUOTEEXPRESSIONS) {
d->opts = localOpts;
print2buff(")", d);
}
break;
case STRSXP:
case LGLSXP:
case INTSXP:
case REALSXP:
case CPLXSXP:
case RAWSXP:
if (localOpts & SHOWATTRIBUTES) attr1(s, d);
vector2buff(s, d);
if (localOpts & SHOWATTRIBUTES) attr2(s, d);
break;
case EXTPTRSXP:
{
char tpb[32]; /* need 12+2+2*sizeof(void*) */
d->sourceable = FALSE;
snprintf(tpb, 32, "<pointer: %p>", R_ExternalPtrAddr(s));
tpb[31] = '\0';
print2buff(tpb, d);
}
break;
case BCODESXP:
d->sourceable = FALSE;
print2buff("<bytecode>", d);
break;
case WEAKREFSXP:
d->sourceable = FALSE;
print2buff("<weak reference>", d);
break;
case S4SXP: {
SEXP class = getAttrib(s, R_ClassSymbol);
d->isS4 = TRUE;
#ifndef _TRY_S4_DEPARSE_
d->sourceable = FALSE;
print2buff("<S4 object of class ", d);
deparse2buff(class, d);
print2buff(">", d);
#else
/* somewhat like the VECSXP [ "list()" ] case : */
/* if (localOpts & SHOWATTRIBUTES) attr1(s, d); */
print2buff("new(\"", d);
print2buff(translateChar(STRING_ELT(class, 0)), d);
print2buff("\",\n", d);
//>>>> call vec2buf on the Attributes >>>>>>>>> vec2buff(s, d);
print2buff(")", d);
/* if (localOpts & SHOWATTRIBUTES) attr2(s, d); */
#endif
break;
}
default:
d->sourceable = FALSE;
UNIMPLEMENTED_TYPE("deparse2buff", s);
}
}