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

 	*stretch = extra;
     UNPROTECT(4);
     return indx;
+}
+/* Array Subscripts.
-/* Array Subscripts.  dim is the dimension (0 to k-1), s is */
+    dim is the dimension (0 to k-1)
+    s is the subscript list,
+    dims is the dimensions of x
+    dng is a function (usually getAttrib) that obtains the dimnames
-/* the subscript list, x is the array to be subscripted. */
+    x is the array to be subscripted.
+*/
+typedef SEXP DimNamesGetter(SEXP x, SEXP data);
-SEXP arraySubscript(int dim, SEXP s, SEXP x)
+SEXP arraySubscript(int dim, SEXP s, SEXP dims, DimNamesGetter dng, SEXP x)
+{
     int nd, ns, stretch = 0;
-    SEXP dims, dnames, tmp;
+    SEXP dnames, tmp;
     ns = length(s);
-    dims = getAttrib(x, R_DimSymbol);
     nd = INTEGER(dims)[dim];
     switch (TYPEOF(s)) {
     case NILSXP:
 	return allocVector(INTSXP, 0);
     	PROTECT(tmp = coerceVector(s, INTSXP));
 	tmp = integerSubscript(tmp, ns, nd, &stretch);
     	UNPROTECT(1);
 	return tmp;
     case STRSXP:
-	dnames = getAttrib(x, R_DimNamesSymbol);
+	dnames = dng(x, R_DimNamesSymbol);
 	if (dnames == R_NilValue)
 	    error("no dimnames attribute for array");
 	dnames = VECTOR_ELT(dnames, dim);
 	return stringSubscript(s, ns, nd, dnames, &stretch);
     case SYMSXP:

The R Project SVN R