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



    for (a = ans; a != R_NilValue; a = next) {
	n = TAG(a);
	next = CDR(a);
	if (n != R_NilValue && pmatch(R_RecursiveSymbol, n, 1)) {
	    if (n_recurse++ == 1)
		error(_("repeated formal argument 'recursive'"));
	    if ((v = asLogical(CAR(a))) != NA_INTEGER) {
		*recurse = v;
	    }
	    if (last == NULL)
		ans = next;
	    else
		SETCDR(last, next);
	}
	else if (n != R_NilValue && pmatch(R_UseNamesSymbol, n, 1)) {
	    if (n_usenames++ == 1)
		error(_("repeated formal argument 'use.names'"));
	    if ((v = asLogical(CAR(a))) != NA_INTEGER) {
		*usenames = v;
	    }
	    if (last == NULL)
		ans = next;

	}
    }
    else {
	UNPROTECT(1);
	if (isVector(args)) return args;
	else errorcall(call, _("argument not a list"));
    }
 
    /* If a non-vector argument was encountered (perhaps a list if */
    /* recursive = F) then we must return a list.  Otherwise, we use */
    /* the natural coercion for vector types. */

SEXP FetchMethod(char *generic, char *classname, SEXP env)
{
    char buf[LNAMBUF];
    SEXP method;
    if (strlen(generic) + strlen(classname) + 2 > LNAMBUF)
	error(_("class name too long in %s"), generic);
    sprintf(buf, "%s.%s", generic, classname);
    method = findVar(install(buf), env);
    if (TYPEOF(method)==PROMSXP)
	method = eval(method, env);
    if (TYPEOF(method) != CLOSXP)

    case VECSXP:
	break;
	/* we don't handle expressions: we could, but coercion of a matrix 
	   to an expression is not ideal */
    default:
	errorcall(call, _("cannot create a matrix from these types"));
    }
 
    if (PRIMVAL(op) == 1)
	a = cbind(call, args, mode, rho);
    else

	dims = getAttrib(u, R_DimSymbol);
	if (length(dims) == 2) {
	    if (mrows == -1)
		mrows = INTEGER(dims)[0];
	    else if (mrows != INTEGER(dims)[0])
		errorcall(call, 
			  _("number of rows of matrices must match (see arg %d)"),
			  n + 1);
	    cols += INTEGER(dims)[1];
	}
	else if (length(u) >= lenmin) {
	    rows = imax2(rows, length(u));
	    cols += 1;

	    if (!have_mcols){
		mcols = INTEGER(dims)[1];
		have_mcols=1;
	    }
	    else if (mcols != INTEGER(dims)[1])
		errorcall(call,
			  _("number of columns of matrices must match (see arg %d)"),
			  n + 1);
	    rows += INTEGER(dims)[0];
	}
	else if (length(u) >= lenmin){
	    cols = imax2(cols, length(u));
	    rows += 1;

Rev 32380	Rev 32860
Line 548...	Line 548...
548	`for (a = ans; a != R_NilValue; a = next) {`	548	`for (a = ans; a != R_NilValue; a = next) {`
549	`n = TAG(a);`	549	`n = TAG(a);`
550	`next = CDR(a);`	550	`next = CDR(a);`
551	`if (n != R_NilValue && pmatch(R_RecursiveSymbol, n, 1)) {`	551	`if (n != R_NilValue && pmatch(R_RecursiveSymbol, n, 1)) {`
552	`if (n_recurse++ == 1)`	552	`if (n_recurse++ == 1)`
553	`error("repeated formal argument 'recursive'");`	553	`error(_("repeated formal argument 'recursive'"));`
554	`if ((v = asLogical(CAR(a))) != NA_INTEGER) {`	554	`if ((v = asLogical(CAR(a))) != NA_INTEGER) {`
555	`*recurse = v;`	555	`*recurse = v;`
556	`}`	556	`}`
557	`if (last == NULL)`	557	`if (last == NULL)`
558	`ans = next;`	558	`ans = next;`
559	`else`	559	`else`
560	`SETCDR(last, next);`	560	`SETCDR(last, next);`
561	`}`	561	`}`
562	`else if (n != R_NilValue && pmatch(R_UseNamesSymbol, n, 1)) {`	562	`else if (n != R_NilValue && pmatch(R_UseNamesSymbol, n, 1)) {`
563	`if (n_usenames++ == 1)`	563	`if (n_usenames++ == 1)`
564	`error("repeated formal argument 'use.names'");`	564	`error(_("repeated formal argument 'use.names'"));`
565	`if ((v = asLogical(CAR(a))) != NA_INTEGER) {`	565	`if ((v = asLogical(CAR(a))) != NA_INTEGER) {`
566	`*usenames = v;`	566	`*usenames = v;`
567	`}`	567	`}`
568	`if (last == NULL)`	568	`if (last == NULL)`
569	`ans = next;`	569	`ans = next;`
Line 770...	Line 770...
770	`}`	770	`}`
771	`}`	771	`}`
772	`else {`	772	`else {`
773	`UNPROTECT(1);`	773	`UNPROTECT(1);`
774	`if (isVector(args)) return args;`	774	`if (isVector(args)) return args;`
775	`else errorcall(call, "argument not a list");`	775	`else errorcall(call, _("argument not a list"));`
776	`}`	776	`}`
777		777
778	`/* If a non-vector argument was encountered (perhaps a list if */`	778	`/* If a non-vector argument was encountered (perhaps a list if */`
779	`/* recursive = F) then we must return a list. Otherwise, we use */`	779	`/* recursive = F) then we must return a list. Otherwise, we use */`
780	`/* the natural coercion for vector types. */`	780	`/* the natural coercion for vector types. */`
Line 868...	Line 868...
868	`SEXP FetchMethod(char generic, char classname, SEXP env)`	868	`SEXP FetchMethod(char generic, char classname, SEXP env)`
869	`{`	869	`{`
870	`char buf[LNAMBUF];`	870	`char buf[LNAMBUF];`
871	`SEXP method;`	871	`SEXP method;`
872	`if (strlen(generic) + strlen(classname) + 2 > LNAMBUF)`	872	`if (strlen(generic) + strlen(classname) + 2 > LNAMBUF)`
873	`error("class name too long in %s", generic);`	873	`error(_("class name too long in %s"), generic);`
874	`sprintf(buf, "%s.%s", generic, classname);`	874	`sprintf(buf, "%s.%s", generic, classname);`
875	`method = findVar(install(buf), env);`	875	`method = findVar(install(buf), env);`
876	`if (TYPEOF(method)==PROMSXP)`	876	`if (TYPEOF(method)==PROMSXP)`
877	`method = eval(method, env);`	877	`method = eval(method, env);`
878	`if (TYPEOF(method) != CLOSXP)`	878	`if (TYPEOF(method) != CLOSXP)`
Line 994...	Line 994...
994	`case VECSXP:`	994	`case VECSXP:`
995	`break;`	995	`break;`
996	`/* we don't handle expressions: we could, but coercion of a matrix`	996	`/* we don't handle expressions: we could, but coercion of a matrix`
997	`to an expression is not ideal */`	997	`to an expression is not ideal */`
998	`default:`	998	`default:`
999	`errorcall(call, "cannot create a matrix from these types");`	999	`errorcall(call, _("cannot create a matrix from these types"));`
1000	`}`	1000	`}`
1001		1001
1002	`if (PRIMVAL(op) == 1)`	1002	`if (PRIMVAL(op) == 1)`
1003	`a = cbind(call, args, mode, rho);`	1003	`a = cbind(call, args, mode, rho);`
1004	`else`	1004	`else`
Line 1069...	Line 1069...
1069	`dims = getAttrib(u, R_DimSymbol);`	1069	`dims = getAttrib(u, R_DimSymbol);`
1070	`if (length(dims) == 2) {`	1070	`if (length(dims) == 2) {`
1071	`if (mrows == -1)`	1071	`if (mrows == -1)`
1072	`mrows = INTEGER(dims)[0];`	1072	`mrows = INTEGER(dims)[0];`
1073	`else if (mrows != INTEGER(dims)[0])`	1073	`else if (mrows != INTEGER(dims)[0])`
-		1074	`errorcall(call,`
1074	`errorcall(call, "number of rows of matrices must match (see arg %d)", n + 1);`	1075	`_("number of rows of matrices must match (see arg %d)"),`
-		1076	`n + 1);`
1075	`cols += INTEGER(dims)[1];`	1077	`cols += INTEGER(dims)[1];`
1076	`}`	1078	`}`
1077	`else if (length(u) >= lenmin) {`	1079	`else if (length(u) >= lenmin) {`
1078	`rows = imax2(rows, length(u));`	1080	`rows = imax2(rows, length(u));`
1079	`cols += 1;`	1081	`cols += 1;`
Line 1279...	Line 1281...
1279	`if (!have_mcols){`	1281	`if (!have_mcols){`
1280	`mcols = INTEGER(dims)[1];`	1282	`mcols = INTEGER(dims)[1];`
1281	`have_mcols=1;`	1283	`have_mcols=1;`
1282	`}`	1284	`}`
1283	`else if (mcols != INTEGER(dims)[1])`	1285	`else if (mcols != INTEGER(dims)[1])`
-		1286	`errorcall(call,`
1284	`errorcall(call, "number of columns of matrices must match (see arg %d)", n + 1);`	1287	`_("number of columns of matrices must match (see arg %d)"),`
-		1288	`n + 1);`
1285	`rows += INTEGER(dims)[0];`	1289	`rows += INTEGER(dims)[0];`
1286	`}`	1290	`}`
1287	`else if (length(u) >= lenmin){`	1291	`else if (length(u) >= lenmin){`
1288	`cols = imax2(cols, length(u));`	1292	`cols = imax2(cols, length(u));`
1289	`rows += 1;`	1293	`rows += 1;`

The R Project SVN R

(root)/trunk/src/main/bind.c – Rev 32380 → 32860