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



OneIndex(SEXP x, SEXP s, R_xlen_t len, int partial, SEXP *newname, 
	 int pos, SEXP call)
{
    SEXP names;
    R_xlen_t i, indx, nx;
    const void *vmax;
 
    if (pos < 0 && length(s) > 1) {
	ECALL(call, _("attempt to select more than one element"));
    }
    if (pos < 0 && length(s) < 1) {

	break;
    case REALSXP:
	indx = integerOneIndex((int)REAL(s)[pos], len, call);
	break;
    case STRSXP:
	vmax = vmaxget();
	nx = xlength(x);
	names = getAttrib(x, R_NamesSymbol);
	if (names != R_NilValue) {
	    /* Try for exact match */
	    for (i = 0; i < nx; i++) {

	    }
	}
	if (indx == -1)
	    indx = nx;
	*newname = STRING_ELT(s, pos);
	vmaxset(vmax);
	break;
    case SYMSXP:
	vmax = vmaxget();
	nx = xlength(x);
	names = getAttrib(x, R_NamesSymbol);
	if (names != R_NilValue) {
	    for (i = 0; i < nx; i++)
		if (streql(translateChar(STRING_ELT(names, i)),

		}
	}
	if (indx == -1)
	    indx = nx;
	*newname = STRING_ELT(s, pos);
	vmaxset(vmax);
	break;
    default:
	if (call == R_NilValue)
	    error(_("invalid subscript type '%s'"), type2char(TYPEOF(s)));
	else

	 if pok is -1, warn if partial matching occurs, but allow.
*/
    int  warn_pok = 0;
    const char *ss, *cur_name;
    R_xlen_t indx;
    const void *vmax;
 
    if (pok == -1) {
	pok = 1;
	warn_pok = 1;
    }

	if(STRING_ELT(s, pos) == NA_STRING) break;
	/* "" matches nothing: see names.Rd */
	if(!CHAR(STRING_ELT(s, pos))[0]) break;
 
	/* Try for exact match */
	vmax = vmaxget();
	ss = translateChar(STRING_ELT(s, pos));
	for (R_xlen_t i = 0; i < xlength(names); i++)
	    if (STRING_ELT(names, i) != NA_STRING) {
		if (streql(translateChar(STRING_ELT(names, i)), ss)) {
		    indx = i;

			}
		    }
		}
	    }
	}
	vmaxset(vmax);
	break;
    case SYMSXP:
	vmax = vmaxget();
	for (R_xlen_t i = 0; i < xlength(names); i++)
	    if (STRING_ELT(names, i) != NA_STRING &&
		streql(translateChar(STRING_ELT(names, i)),
		       CHAR(PRINTNAME(s)))) {
		indx = i;
		vmaxset(vmax);
		break;
	    }
    default:
	if (call == R_NilValue)
	    error(_("invalid subscript type '%s'"), type2char(TYPEOF(s)));

Rev 63166	Rev 63181
Line 65...	Line 65...
65	`OneIndex(SEXP x, SEXP s, R_xlen_t len, int partial, SEXP *newname,`	65	`OneIndex(SEXP x, SEXP s, R_xlen_t len, int partial, SEXP *newname,`
66	`int pos, SEXP call)`	66	`int pos, SEXP call)`
67	`{`	67	`{`
68	`SEXP names;`	68	`SEXP names;`
69	`R_xlen_t i, indx, nx;`	69	`R_xlen_t i, indx, nx;`
-		70	`const void *vmax;`
70		71
71	`if (pos < 0 && length(s) > 1) {`	72	`if (pos < 0 && length(s) > 1) {`
72	`ECALL(call, _("attempt to select more than one element"));`	73	`ECALL(call, _("attempt to select more than one element"));`
73	`}`	74	`}`
74	`if (pos < 0 && length(s) < 1) {`	75	`if (pos < 0 && length(s) < 1) {`
Line 86...	Line 87...
86	`break;`	87	`break;`
87	`case REALSXP:`	88	`case REALSXP:`
88	`indx = integerOneIndex((int)REAL(s)[pos], len, call);`	89	`indx = integerOneIndex((int)REAL(s)[pos], len, call);`
89	`break;`	90	`break;`
90	`case STRSXP:`	91	`case STRSXP:`
-		92	`vmax = vmaxget();`
91	`nx = xlength(x);`	93	`nx = xlength(x);`
92	`names = getAttrib(x, R_NamesSymbol);`	94	`names = getAttrib(x, R_NamesSymbol);`
93	`if (names != R_NilValue) {`	95	`if (names != R_NilValue) {`
94	`/* Try for exact match */`	96	`/* Try for exact match */`
95	`for (i = 0; i < nx; i++) {`	97	`for (i = 0; i < nx; i++) {`
Line 116...	Line 118...
116	`}`	118	`}`
117	`}`	119	`}`
118	`if (indx == -1)`	120	`if (indx == -1)`
119	`indx = nx;`	121	`indx = nx;`
120	`*newname = STRING_ELT(s, pos);`	122	`*newname = STRING_ELT(s, pos);`
-		123	`vmaxset(vmax);`
121	`break;`	124	`break;`
122	`case SYMSXP:`	125	`case SYMSXP:`
-		126	`vmax = vmaxget();`
123	`nx = xlength(x);`	127	`nx = xlength(x);`
124	`names = getAttrib(x, R_NamesSymbol);`	128	`names = getAttrib(x, R_NamesSymbol);`
125	`if (names != R_NilValue) {`	129	`if (names != R_NilValue) {`
126	`for (i = 0; i < nx; i++)`	130	`for (i = 0; i < nx; i++)`
127	`if (streql(translateChar(STRING_ELT(names, i)),`	131	`if (streql(translateChar(STRING_ELT(names, i)),`
Line 131...	Line 135...
131	`}`	135	`}`
132	`}`	136	`}`
133	`if (indx == -1)`	137	`if (indx == -1)`
134	`indx = nx;`	138	`indx = nx;`
135	`*newname = STRING_ELT(s, pos);`	139	`*newname = STRING_ELT(s, pos);`
-		140	`vmaxset(vmax);`
136	`break;`	141	`break;`
137	`default:`	142	`default:`
138	`if (call == R_NilValue)`	143	`if (call == R_NilValue)`
139	`error(_("invalid subscript type '%s'"), type2char(TYPEOF(s)));`	144	`error(_("invalid subscript type '%s'"), type2char(TYPEOF(s)));`
140	`else`	145	`else`
Line 160...	Line 165...
160	`if pok is -1, warn if partial matching occurs, but allow.`	165	`if pok is -1, warn if partial matching occurs, but allow.`
161	`*/`	166	`*/`
162	`int warn_pok = 0;`	167	`int warn_pok = 0;`
163	`const char ss, cur_name;`	168	`const char ss, cur_name;`
164	`R_xlen_t indx;`	169	`R_xlen_t indx;`
-		170	`const void *vmax;`
165		171
166	`if (pok == -1) {`	172	`if (pok == -1) {`
167	`pok = 1;`	173	`pok = 1;`
168	`warn_pok = 1;`	174	`warn_pok = 1;`
169	`}`	175	`}`
Line 210...	Line 216...
210	`if(STRING_ELT(s, pos) == NA_STRING) break;`	216	`if(STRING_ELT(s, pos) == NA_STRING) break;`
211	`/* "" matches nothing: see names.Rd */`	217	`/* "" matches nothing: see names.Rd */`
212	`if(!CHAR(STRING_ELT(s, pos))[0]) break;`	218	`if(!CHAR(STRING_ELT(s, pos))[0]) break;`
213		219
214	`/* Try for exact match */`	220	`/* Try for exact match */`
-		221	`vmax = vmaxget();`
215	`ss = translateChar(STRING_ELT(s, pos));`	222	`ss = translateChar(STRING_ELT(s, pos));`
216	`for (R_xlen_t i = 0; i < xlength(names); i++)`	223	`for (R_xlen_t i = 0; i < xlength(names); i++)`
217	`if (STRING_ELT(names, i) != NA_STRING) {`	224	`if (STRING_ELT(names, i) != NA_STRING) {`
218	`if (streql(translateChar(STRING_ELT(names, i)), ss)) {`	225	`if (streql(translateChar(STRING_ELT(names, i)), ss)) {`
219	`indx = i;`	226	`indx = i;`
Line 249...	Line 256...
249	`}`	256	`}`
250	`}`	257	`}`
251	`}`	258	`}`
252	`}`	259	`}`
253	`}`	260	`}`
-		261	`vmaxset(vmax);`
254	`break;`	262	`break;`
255	`case SYMSXP:`	263	`case SYMSXP:`
-		264	`vmax = vmaxget();`
256	`for (R_xlen_t i = 0; i < xlength(names); i++)`	265	`for (R_xlen_t i = 0; i < xlength(names); i++)`
257	`if (STRING_ELT(names, i) != NA_STRING &&`	266	`if (STRING_ELT(names, i) != NA_STRING &&`
258	`streql(translateChar(STRING_ELT(names, i)),`	267	`streql(translateChar(STRING_ELT(names, i)),`
259	`CHAR(PRINTNAME(s)))) {`	268	`CHAR(PRINTNAME(s)))) {`
260	`indx = i;`	269	`indx = i;`
-		270	`vmaxset(vmax);`
261	`break;`	271	`break;`
262	`}`	272	`}`
263	`default:`	273	`default:`
264	`if (call == R_NilValue)`	274	`if (call == R_NilValue)`
265	`error(_("invalid subscript type '%s'"), type2char(TYPEOF(s)));`	275	`error(_("invalid subscript type '%s'"), type2char(TYPEOF(s)));`

The R Project SVN R

(root)/trunk/src/main/subscript.c @ 63243 – Rev 63166 → 63181