in source/src/main/deparse.c [1329:1512]
static void vector2buff(SEXP vector, LocalParseData *d)
{
int tlen, i, quote;
const char *strp;
char *buff = 0, hex[64]; // 64 is more than enough
Rboolean surround = FALSE, allNA, addL = TRUE;
tlen = length(vector);
if( isString(vector) )
quote = '"';
else
quote = 0;
if (tlen == 0) {
switch(TYPEOF(vector)) {
case LGLSXP: print2buff("logical(0)", d); break;
case INTSXP: print2buff("integer(0)", d); break;
case REALSXP: print2buff("numeric(0)", d); break;
case CPLXSXP: print2buff("complex(0)", d); break;
case STRSXP: print2buff("character(0)", d); break;
case RAWSXP: print2buff("raw(0)", d); break;
default: UNIMPLEMENTED_TYPE("vector2buff", vector);
}
}
else if(TYPEOF(vector) == INTSXP) {
/* We treat integer separately, as S_compatible is relevant.
Also, it is neat to deparse m:n in that form,
so we do so as from 2.5.0.
*/
Rboolean intSeq = (tlen > 1);
int *tmp = INTEGER(vector);
for(i = 1; i < tlen; i++) {
if((tmp[i] == NA_INTEGER) || (tmp[i-1] == NA_INTEGER)
|| (tmp[i] - tmp[i-1] != 1)) {
intSeq = FALSE;
break;
}
}
if(intSeq) {
strp = EncodeElement(vector, 0, '"', '.');
print2buff(strp, d);
print2buff(":", d);
strp = EncodeElement(vector, tlen - 1, '"', '.');
print2buff(strp, d);
} else {
addL = d->opts & KEEPINTEGER & !(d->opts & S_COMPAT);
allNA = (d->opts & KEEPNA) || addL;
for(i = 0; i < tlen; i++)
if(tmp[i] != NA_INTEGER) {
allNA = FALSE;
break;
}
if((d->opts & KEEPINTEGER && (d->opts & S_COMPAT))) {
surround = TRUE;
print2buff("as.integer(", d);
}
allNA = allNA && !(d->opts & S_COMPAT);
if(tlen > 1) print2buff("c(", d);
for (i = 0; i < tlen; i++) {
if(allNA && tmp[i] == NA_INTEGER) {
print2buff("NA_integer_", d);
} else {
strp = EncodeElement(vector, i, quote, '.');
print2buff(strp, d);
if(addL && tmp[i] != NA_INTEGER) print2buff("L", d);
}
if (i < (tlen - 1)) print2buff(", ", d);
if (tlen > 1 && d->len > d->cutoff) writeline(d);
if (!d->active) break;
}
if(tlen > 1)print2buff(")", d);
if(surround) print2buff(")", d);
}
} else {
allNA = d->opts & KEEPNA;
if((d->opts & KEEPNA) && TYPEOF(vector) == REALSXP) {
for(i = 0; i < tlen; i++)
if(!ISNA(REAL(vector)[i])) {
allNA = FALSE;
break;
}
if(allNA && (d->opts & S_COMPAT)) {
surround = TRUE;
print2buff("as.double(", d);
}
} else if((d->opts & KEEPNA) && TYPEOF(vector) == CPLXSXP) {
Rcomplex *tmp = COMPLEX(vector);
for(i = 0; i < tlen; i++) {
if( !ISNA(tmp[i].r) && !ISNA(tmp[i].i) ) {
allNA = FALSE;
break;
}
}
if(allNA && (d->opts & S_COMPAT)) {
surround = TRUE;
print2buff("as.complex(", d);
}
} else if((d->opts & KEEPNA) && TYPEOF(vector) == STRSXP) {
for(i = 0; i < tlen; i++)
if(STRING_ELT(vector, i) != NA_STRING) {
allNA = FALSE;
break;
}
if(allNA && (d->opts & S_COMPAT)) {
surround = TRUE;
print2buff("as.character(", d);
}
} else if(TYPEOF(vector) == RAWSXP) {
surround = TRUE;
print2buff("as.raw(", d);
}
if(tlen > 1) print2buff("c(", d);
allNA = allNA && !(d->opts & S_COMPAT);
for (i = 0; i < tlen; i++) {
if(allNA && TYPEOF(vector) == REALSXP &&
ISNA(REAL(vector)[i])) {
strp = "NA_real_";
} else if (TYPEOF(vector) == CPLXSXP &&
(ISNA(COMPLEX(vector)[i].r)
&& ISNA(COMPLEX(vector)[i].i)) ) {
strp = allNA ? "NA_complex_" : EncodeElement(vector, i, quote, '.');
} else if(TYPEOF(vector) == CPLXSXP &&
(ISNAN(COMPLEX(vector)[i].r) || !R_FINITE(COMPLEX(vector)[i].i)) ) {
if (!buff)
buff = alloca(NB);
strp = EncodeNonFiniteComplexElement(COMPLEX(vector)[i], buff);
} else if (allNA && TYPEOF(vector) == STRSXP &&
STRING_ELT(vector, i) == NA_STRING) {
strp = "NA_character_";
} else if (TYPEOF(vector) == REALSXP && (d->opts & S_COMPAT)) {
int w, d, e;
formatReal(&REAL(vector)[i], 1, &w, &d, &e, 0);
strp = EncodeReal2(REAL(vector)[i], w, d, e);
} else if (TYPEOF(vector) == STRSXP) {
const void *vmax = vmaxget();
const char *ts = translateChar(STRING_ELT(vector, i));
/* versions of R < 2.7.0 cannot parse strings longer than 8192 chars */
if(strlen(ts) >= 8192) d->longstring = TRUE;
strp = EncodeElement(vector, i, quote, '.');
vmaxset(vmax);
} else if (TYPEOF(vector) == RAWSXP) {
strp = EncodeRaw(RAW(vector)[i], "0x");
} else if (TYPEOF(vector) == REALSXP && (d->opts & HEXNUMERIC)) {
double x = REAL(vector)[i];
// Windows warns here, but incorrectly as this is C99
// and the snprintf used from trio is compliant.
if (R_FINITE(x)) {
snprintf(hex, 32, "%a", x);
strp = hex;
} else
strp = EncodeElement(vector, i, quote, '.');
} else if (TYPEOF(vector) == REALSXP && (d->opts & DIGITS16)) {
double x = REAL(vector)[i];
if (R_FINITE(x)) {
snprintf(hex, 32, "%.17g", x);
strp = hex;
} else
strp = EncodeElement(vector, i, quote, '.');
} else if (TYPEOF(vector) == CPLXSXP && (d->opts & HEXNUMERIC)) {
Rcomplex z = COMPLEX(vector)[i];
if (R_FINITE(z.r) && R_FINITE(z.i)) {
snprintf(hex, 64, "%a + %ai", z.r, z.i);
strp = hex;
} else
strp = EncodeElement(vector, i, quote, '.');
} else if (TYPEOF(vector) == CPLXSXP && (d->opts & DIGITS16)) {
Rcomplex z = COMPLEX(vector)[i];
if (R_FINITE(z.r) && R_FINITE(z.i)) {
snprintf(hex, 64, "%.17g + %17gi", z.r, z.i);
strp = hex;
} else
strp = EncodeElement(vector, i, quote, '.');
} else
strp = EncodeElement(vector, i, quote, '.');
print2buff(strp, d);
if (i < (tlen - 1)) print2buff(", ", d);
if (tlen > 1 && d->len > d->cutoff) writeline(d);
if (!d->active) break;
}
if(tlen > 1) print2buff(")", d);
if(surround) print2buff(")", d);
}
}