The R Project SVN – R – Diff – /trunk/src/main/envir.c



    if (!isString(CAR(args)) || length(CAR(args)) == 0)
	error(_("invalid first argument"));
    else {
	if (length(CAR(args)) > 1)
	    warning(_("only the first element is used as variable name"));
	name = installTrChar(STRING_ELT(CAR(args), 0));
    }
    PROTECT(val = CADR(args));
    aenv = CADDR(args);
    if (TYPEOF(aenv) == NILSXP)
	error(_("use of NULL environment is defunct"));

    envir = CADR(args);
    if (TYPEOF(envir) != ENVSXP)
	error(_("'envir' argument must be an environment"));
 
    for(int i = 0; i < LENGTH(x) ; i++) {
	SEXP name = installTrChar(STRING_ELT(xnms, i));
	defineVar(name, VECTOR_ELT(x, i), envir);
    }
 
    return envir;
}

    if (ginherits == NA_LOGICAL)
	error(_("invalid '%s' argument"), "inherits");
 
    for (i = 0; i < LENGTH(name); i++) {
	done = 0;
	tsym = installTrChar(STRING_ELT(name, i));
	if( !HASHASH(PRINTNAME(tsym)) )
	    hashcode = R_Newhashpjw(CHAR(PRINTNAME(tsym)));
	else
	    hashcode = HASHVALUE(PRINTNAME(tsym));
	tenv = envarg;

    /* It must be present and a non-empty string */
 
    if (!isValidStringF(CAR(args)))
	error(_("invalid first argument"));
    else
	t1 = installTrChar(STRING_ELT(CAR(args), 0));
 
    /* envir :	originally, the "where=" argument */
 
    if (TYPEOF(CADR(args)) == REALSXP || TYPEOF(CADR(args)) == INTSXP) {
	where = asInteger(CADR(args));

 
    checkArity(op, args);
    check1arg(args, call, "x");
    s = sym = CAR(args);
    if( isString(sym) && length(sym)==1 )
	s = sym = installTrChar(STRING_ELT(CAR(args), 0));
    if (!isSymbol(sym))
	errorcall(call, _("invalid use of 'missing'"));
 
    if (DDVAL(sym)) {
	ddv = ddVal(sym);

    switch (TYPEOF(name)) {
    case SYMSXP:
	break;
    case STRSXP:
	if (LENGTH(name) >= 1) {
 
	    name = installTrChar(STRING_ELT(name, 0));
 
	    break;
	}
	/* else fall through */
    default:
	errorcall(call, _("bad namespace name"));

    if (LENGTH(impnames) != LENGTH(expnames))
	error(_("length of import and export names must match"));
 
    n = LENGTH(impnames);
    for (i = 0; i < n; i++) {
	impsym = installTrChar(STRING_ELT(impnames, i));
	expsym = installTrChar(STRING_ELT(expnames, i));
 
	/* find the binding--may be a CONS cell or a symbol */
	SEXP binding = R_NilValue;
	for (SEXP env = expenv;
	     env != R_EmptyEnv && binding == R_NilValue;

Rev 63181	Rev 63223
Line 1540...	Line 1540...
1540	`if (!isString(CAR(args)) \|\| length(CAR(args)) == 0)`	1540	`if (!isString(CAR(args)) \|\| length(CAR(args)) == 0)`
1541	`error(_("invalid first argument"));`	1541	`error(_("invalid first argument"));`
1542	`else {`	1542	`else {`
1543	`if (length(CAR(args)) > 1)`	1543	`if (length(CAR(args)) > 1)`
1544	`warning(_("only the first element is used as variable name"));`	1544	`warning(_("only the first element is used as variable name"));`
1545	`name = install(translateChar(STRING_ELT(CAR(args), 0)));`	1545	`name = installTrChar(STRING_ELT(CAR(args), 0));`
1546	`}`	1546	`}`
1547	`PROTECT(val = CADR(args));`	1547	`PROTECT(val = CADR(args));`
1548	`aenv = CADDR(args);`	1548	`aenv = CADDR(args);`
1549	`if (TYPEOF(aenv) == NILSXP)`	1549	`if (TYPEOF(aenv) == NILSXP)`
1550	`error(_("use of NULL environment is defunct"));`	1550	`error(_("use of NULL environment is defunct"));`
Line 1582...	Line 1582...
1582	`envir = CADR(args);`	1582	`envir = CADR(args);`
1583	`if (TYPEOF(envir) != ENVSXP)`	1583	`if (TYPEOF(envir) != ENVSXP)`
1584	`error(_("'envir' argument must be an environment"));`	1584	`error(_("'envir' argument must be an environment"));`
1585		1585
1586	`for(int i = 0; i < LENGTH(x) ; i++) {`	1586	`for(int i = 0; i < LENGTH(x) ; i++) {`
1587	`SEXP name = install(translateChar(STRING_ELT(xnms, i)));`	1587	`SEXP name = installTrChar(STRING_ELT(xnms, i));`
1588	`defineVar(name, VECTOR_ELT(x, i), envir);`	1588	`defineVar(name, VECTOR_ELT(x, i), envir);`
1589	`}`	1589	`}`
1590		1590
1591	`return envir;`	1591	`return envir;`
1592	`}`	1592	`}`
Line 1681...	Line 1681...
1681	`if (ginherits == NA_LOGICAL)`	1681	`if (ginherits == NA_LOGICAL)`
1682	`error(_("invalid '%s' argument"), "inherits");`	1682	`error(_("invalid '%s' argument"), "inherits");`
1683		1683
1684	`for (i = 0; i < LENGTH(name); i++) {`	1684	`for (i = 0; i < LENGTH(name); i++) {`
1685	`done = 0;`	1685	`done = 0;`
1686	`tsym = install(translateChar(STRING_ELT(name, i)));`	1686	`tsym = installTrChar(STRING_ELT(name, i));`
1687	`if( !HASHASH(PRINTNAME(tsym)) )`	1687	`if( !HASHASH(PRINTNAME(tsym)) )`
1688	`hashcode = R_Newhashpjw(CHAR(PRINTNAME(tsym)));`	1688	`hashcode = R_Newhashpjw(CHAR(PRINTNAME(tsym)));`
1689	`else`	1689	`else`
1690	`hashcode = HASHVALUE(PRINTNAME(tsym));`	1690	`hashcode = HASHVALUE(PRINTNAME(tsym));`
1691	`tenv = envarg;`	1691	`tenv = envarg;`
Line 1728...	Line 1728...
1728	`/* It must be present and a non-empty string */`	1728	`/* It must be present and a non-empty string */`
1729		1729
1730	`if (!isValidStringF(CAR(args)))`	1730	`if (!isValidStringF(CAR(args)))`
1731	`error(_("invalid first argument"));`	1731	`error(_("invalid first argument"));`
1732	`else`	1732	`else`
1733	`t1 = install(translateChar(STRING_ELT(CAR(args), 0)));`	1733	`t1 = installTrChar(STRING_ELT(CAR(args), 0));`
1734		1734
1735	`/* envir : originally, the "where=" argument */`	1735	`/* envir : originally, the "where=" argument */`
1736		1736
1737	`if (TYPEOF(CADR(args)) == REALSXP \|\| TYPEOF(CADR(args)) == INTSXP) {`	1737	`if (TYPEOF(CADR(args)) == REALSXP \|\| TYPEOF(CADR(args)) == INTSXP) {`
1738	`where = asInteger(CADR(args));`	1738	`where = asInteger(CADR(args));`
Line 1990...	Line 1990...
1990		1990
1991	`checkArity(op, args);`	1991	`checkArity(op, args);`
1992	`check1arg(args, call, "x");`	1992	`check1arg(args, call, "x");`
1993	`s = sym = CAR(args);`	1993	`s = sym = CAR(args);`
1994	`if( isString(sym) && length(sym)==1 )`	1994	`if( isString(sym) && length(sym)==1 )`
1995	`s = sym = install(translateChar(STRING_ELT(CAR(args), 0)));`	1995	`s = sym = installTrChar(STRING_ELT(CAR(args), 0));`
1996	`if (!isSymbol(sym))`	1996	`if (!isSymbol(sym))`
1997	`errorcall(call, _("invalid use of 'missing'"));`	1997	`errorcall(call, _("invalid use of 'missing'"));`
1998		1998
1999	`if (DDVAL(sym)) {`	1999	`if (DDVAL(sym)) {`
2000	`ddv = ddVal(sym);`	2000	`ddv = ddVal(sym);`
Line 3214...	Line 3214...
3214	`switch (TYPEOF(name)) {`	3214	`switch (TYPEOF(name)) {`
3215	`case SYMSXP:`	3215	`case SYMSXP:`
3216	`break;`	3216	`break;`
3217	`case STRSXP:`	3217	`case STRSXP:`
3218	`if (LENGTH(name) >= 1) {`	3218	`if (LENGTH(name) >= 1) {`
3219	`const void *vmax = vmaxget();`	-
3220	`name = install(translateChar(STRING_ELT(name, 0)));`	3219	`name = installTrChar(STRING_ELT(name, 0));`
3221	`vmaxset(vmax);`	-
3222	`break;`	3220	`break;`
3223	`}`	3221	`}`
3224	`/* else fall through */`	3222	`/* else fall through */`
3225	`default:`	3223	`default:`
3226	`errorcall(call, _("bad namespace name"));`	3224	`errorcall(call, _("bad namespace name"));`
Line 3305...	Line 3303...
3305	`if (LENGTH(impnames) != LENGTH(expnames))`	3303	`if (LENGTH(impnames) != LENGTH(expnames))`
3306	`error(_("length of import and export names must match"));`	3304	`error(_("length of import and export names must match"));`
3307		3305
3308	`n = LENGTH(impnames);`	3306	`n = LENGTH(impnames);`
3309	`for (i = 0; i < n; i++) {`	3307	`for (i = 0; i < n; i++) {`
3310	`impsym = install(translateChar(STRING_ELT(impnames, i)));`	3308	`impsym = installTrChar(STRING_ELT(impnames, i));`
3311	`expsym = install(translateChar(STRING_ELT(expnames, i)));`	3309	`expsym = installTrChar(STRING_ELT(expnames, i));`
3312		3310
3313	`/* find the binding--may be a CONS cell or a symbol */`	3311	`/* find the binding--may be a CONS cell or a symbol */`
3314	`SEXP binding = R_NilValue;`	3312	`SEXP binding = R_NilValue;`
3315	`for (SEXP env = expenv;`	3313	`for (SEXP env = expenv;`
3316	`env != R_EmptyEnv && binding == R_NilValue;`	3314	`env != R_EmptyEnv && binding == R_NilValue;`

The R Project SVN R

(root)/trunk/src/main/envir.c – Rev 63181 → 63223