The R Project SVN R

Rev

Rev 63181 | Rev 65019 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 63181 Rev 63223
Line 385... Line 385...
385 
 
 385 
 
386 
SEXP VectorToPairList(SEXP x)
 386 
SEXP VectorToPairList(SEXP x)
387 
{
 387 
{
388 
    SEXP xptr, xnew, xnames;
 388 
    SEXP xptr, xnew, xnames;
389 
    int i, len, named;
 389 
    int i, len, named;
390 
    const void *vmax = vmaxget();
 - 
 
391 
 
 390 
 
392 
    len = length(x);
 391 
    len = length(x);
393 
    PROTECT(x);
 392 
    PROTECT(x);
394 
    PROTECT(xnew = allocList(len)); /* limited to int */
 393 
    PROTECT(xnew = allocList(len)); /* limited to int */
395 
    PROTECT(xnames = getAttrib(x, R_NamesSymbol));
 394 
    PROTECT(xnames = getAttrib(x, R_NamesSymbol));
396 
    named = (xnames != R_NilValue);
 395 
    named = (xnames != R_NilValue);
397 
    xptr = xnew;
 396 
    xptr = xnew;
398 
    for (i = 0; i < len; i++) {
 397 
    for (i = 0; i < len; i++) {
399 
	SETCAR(xptr, VECTOR_ELT(x, i));
 398 
	SETCAR(xptr, VECTOR_ELT(x, i));
400 
	if (named && CHAR(STRING_ELT(xnames, i))[0] != '\0') /* ASCII */
 399 
	if (named && CHAR(STRING_ELT(xnames, i))[0] != '\0') /* ASCII */
401 
	    SET_TAG(xptr, install(translateChar(STRING_ELT(xnames, i))));
 400 
	    SET_TAG(xptr, installTrChar(STRING_ELT(xnames, i)));
402 
	xptr = CDR(xptr);
 401 
	xptr = CDR(xptr);
403 
    }
 402 
    }
404 
    if (len > 0)       /* can't set attributes on NULL */
 403 
    if (len > 0)       /* can't set attributes on NULL */
405 
	copyMostAttrib(x, xnew);
 404 
	copyMostAttrib(x, xnew);
406 
    UNPROTECT(3);
 405 
    UNPROTECT(3);
407 
    vmaxset(vmax);
 - 
 
408 
    return xnew;
 406 
    return xnew;
409 
}
 407 
}
410 
 
 408 
 
411 
static SEXP coerceToSymbol(SEXP v)
 409 
static SEXP coerceToSymbol(SEXP v)
412 
{
 410 
{
Line 1283... Line 1281...
1283 
    if (isNull(x) || isSymbol(x))
 1281 
    if (isNull(x) || isSymbol(x))
1284 
	return x;
 1282 
	return x;
1285 
    if (isString(x)
 1283 
    if (isString(x)
1286 
	&& length(x) >= 1
 1284 
	&& length(x) >= 1
1287 
	&& length(STRING_ELT(x, 0)) >= 1) {
 1285 
	&& length(STRING_ELT(x, 0)) >= 1) {
1288 
	const void *vmax = vmaxget();
 - 
 
1289 
	x = install(translateChar(STRING_ELT(x, 0)));
 1286 
	x = installTrChar(STRING_ELT(x, 0));
1290 
	vmaxset(vmax);
 - 
 
1291 
    } else
 1287 
    } else
1292 
	x = install(CHAR(STRING_ELT(deparse1(x, 1, SIMPLEDEPARSE), 0)));
 1288 
	x = install(CHAR(STRING_ELT(deparse1(x, 1, SIMPLEDEPARSE), 0)));
1293 
    return x;
 1289 
    return x;
1294 
}
 1290 
}
1295 
 
 1291 
 
Line 1550... Line 1546...
1550 
    names = getAttrib(arglist, R_NamesSymbol);
 1546 
    names = getAttrib(arglist, R_NamesSymbol);
1551 
    PROTECT(pargs = args = allocList(n - 1));
 1547 
    PROTECT(pargs = args = allocList(n - 1));
1552 
    for (i = 0; i < n - 1; i++) {
 1548 
    for (i = 0; i < n - 1; i++) {
1553 
	SETCAR(pargs, VECTOR_ELT(arglist, i));
 1549 
	SETCAR(pargs, VECTOR_ELT(arglist, i));
1554 
	if (names != R_NilValue && *CHAR(STRING_ELT(names, i)) != '\0') /* ASCII */
 1550 
	if (names != R_NilValue && *CHAR(STRING_ELT(names, i)) != '\0') /* ASCII */
1555 
	    SET_TAG(pargs, install(translateChar(STRING_ELT(names, i))));
 1551 
	    SET_TAG(pargs, installTrChar(STRING_ELT(names, i)));
1556 
	else
 1552 
	else
1557 
	    SET_TAG(pargs, R_NilValue);
 1553 
	    SET_TAG(pargs, R_NilValue);
1558 
	pargs = CDR(pargs);
 1554 
	pargs = CDR(pargs);
1559 
    }
 1555 
    }
1560 
    CheckFormals(args);
 1556 
    CheckFormals(args);
Line 1595... Line 1591...
1595 
	names = getAttrib(args, R_NamesSymbol);
 1591 
	names = getAttrib(args, R_NamesSymbol);
1596 
	PROTECT(ap = ans = allocList(n));
 1592 
	PROTECT(ap = ans = allocList(n));
1597 
	for (i = 0; i < n; i++) {
 1593 
	for (i = 0; i < n; i++) {
1598 
	    SETCAR(ap, VECTOR_ELT(args, i));
 1594 
	    SETCAR(ap, VECTOR_ELT(args, i));
1599 
	    if (names != R_NilValue && !StringBlank(STRING_ELT(names, i)))
 1595 
	    if (names != R_NilValue && !StringBlank(STRING_ELT(names, i)))
1600 
		SET_TAG(ap, install(translateChar(STRING_ELT(names, i))));
 1596 
		SET_TAG(ap, installTrChar(STRING_ELT(names, i)));
1601 
	    ap = CDR(ap);
 1597 
	    ap = CDR(ap);
1602 
	}
 1598 
	}
1603 
	UNPROTECT(1);
 1599 
	UNPROTECT(1);
1604 
	break;
 1600 
	break;
1605 
    case LISTSXP:
 1601 
    case LISTSXP:
Line 2443... Line 2439...
2443 
#else
 2439 
#else
2444 
	SETCAR(c, mkPROMISE(VECTOR_ELT(args, i), rho));
 2440 
	SETCAR(c, mkPROMISE(VECTOR_ELT(args, i), rho));
2445 
	SET_PRVALUE(CAR(c), VECTOR_ELT(args, i));
 2441 
	SET_PRVALUE(CAR(c), VECTOR_ELT(args, i));
2446 
#endif
 2442 
#endif
2447 
	if (ItemName(names, (int)i) != R_NilValue)
 2443 
	if (ItemName(names, (int)i) != R_NilValue)
2448 
	    SET_TAG(c, install(translateChar(ItemName(names, i))));
 2444 
	    SET_TAG(c, installTrChar(ItemName(names, i)));
2449 
	c = CDR(c);
 2445 
	c = CDR(c);
2450 
    }
 2446 
    }
2451 
    call = eval(call, envir);
 2447 
    call = eval(call, envir);
2452 
 
 2448 
 
2453 
    UNPROTECT(1);
 2449 
    UNPROTECT(1);