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



 
 
/* We need to leave 'supplied' unchanged in case we call UseMethod */
/* MULTIPLE_MATCHES was added by RI in Jan 2005 but never activated:
   code in R-2-8-branch */
/* Renamed to matchArgs_NR to reflect that it returns a
   non-reference-tracking list */
 
SEXP attribute_hidden matchArgs_NR(SEXP formals, SEXP supplied, SEXP call)
{
    Rboolean seendots;
    int i, arg_i = 0;
    SEXP f, a, b, dots, actuals;
 

	actuals = CONS_NR(R_MissingArg, actuals);
	SET_MISSING(actuals, 1);
    }
    /* We use fargused instead of ARGUSED/SET_ARGUSED on elements of
       formals to avoid modification of the formals SEXPs.  A gc can
       cause matchArgs_NR to be called from finalizer code, resulting in
       another matchArgs_NR call with the same formals.  In R-2.10.x, this
       corrupted the ARGUSED data of the formals and resulted in an
       incorrect "formal argument 'foo' matched by multiple actual
       arguments" error.
     */
    int fargused[arg_i ? arg_i : 1]; // avoid undefined behaviour

}
 
/* Use matchArgs_RC if the result might escape into R. */
SEXP attribute_hidden matchArgs_RC(SEXP formals, SEXP supplied, SEXP call)
{
    SEXP args = matchArgs_NR(formals, supplied, call);
    /* it would be better not to build this arglist with CONS_NR in
       the first place */
    for (SEXP a = args; a  != R_NilValue; a = CDR(a)) {
	if (! TRACKREFS(a)) {
	    ENABLE_REFCNT(a);

 
/* patchArgsByActuals - patch promargs (given as 'supplied') to be promises
   for the respective actuals in the given environment 'cloenv'.  This is
   used by NextMethod to allow patching of arguments to the current closure
   before dispatching to the next method.  The implementation is based on
   matchArgs_NR, but there is no error/warning checking, assuming that it has
   already been done by a call to matchArgs_NR when the current closure was
   invoked.
*/
 
typedef enum {
    FS_UNMATCHED       = 0, /* the formal was not matched by any supplied arg */

	if (TAG(f) != R_DotsSymbol) {
	    for (b = prsupplied; b != R_NilValue; b = CDR(b)) {
		if (TAG(b) != R_NilValue && pmatch(TAG(f), TAG(b), 1)) {
		    patchArgument(b, TAG(f), &farg[farg_i], cloenv);
		    SET_ARGUSED(b, 2);
		    break; /* Previous invocation of matchArgs_NR */
		           /* ensured unique matches */
		}
	    }
	}
	f = CDR(f);

		    if (!ARGUSED(b) && TAG(b) != R_NilValue &&
			pmatch(TAG(f), TAG(b), seendots)) {
 
			patchArgument(b, TAG(f), &farg[farg_i], cloenv);
			SET_ARGUSED(b, 1);
			break; /* Previous invocation of matchArgs_NR */
			       /* ensured unique matches */
		    }
		}
	    }
	}

	if (TAG(f) == R_DotsSymbol) {
	    /* Done, ... and following args cannot be patched */
	    break;
	} else if (farg[farg_i] == FS_MATCHED_PRESENT) {
	    /* Note that this check corresponds to CAR(b) == R_MissingArg */
	    /* in matchArgs_NR */
 
	    /* Already matched by tag */
	    /* skip to next formal */
	    f = CDR(f);
	    farg_i++;

	    f = CDR(f);
	    farg_i++;
	}
    }
 
    /* Previous invocation of matchArgs_NR ensured all args are used */
    UNPROTECT(1);
    return(prsupplied);
}

Rev 74035	Rev 77452
Line 181...	Line 181...
181		181
182		182
183	`/* We need to leave 'supplied' unchanged in case we call UseMethod */`	183	`/* We need to leave 'supplied' unchanged in case we call UseMethod */`
184	`/* MULTIPLE_MATCHES was added by RI in Jan 2005 but never activated:`	184	`/* MULTIPLE_MATCHES was added by RI in Jan 2005 but never activated:`
185	`code in R-2-8-branch */`	185	`code in R-2-8-branch */`
-		186	`/* Renamed to matchArgs_NR to reflect that it returns a`
-		187	`non-reference-tracking list */`
186		188
187	`SEXP attribute_hidden matchArgs(SEXP formals, SEXP supplied, SEXP call)`	189	`SEXP attribute_hidden matchArgs_NR(SEXP formals, SEXP supplied, SEXP call)`
188	`{`	190	`{`
189	`Rboolean seendots;`	191	`Rboolean seendots;`
190	`int i, arg_i = 0;`	192	`int i, arg_i = 0;`
191	`SEXP f, a, b, dots, actuals;`	193	`SEXP f, a, b, dots, actuals;`
192		194
Line 198...	Line 200...
198	`actuals = CONS_NR(R_MissingArg, actuals);`	200	`actuals = CONS_NR(R_MissingArg, actuals);`
199	`SET_MISSING(actuals, 1);`	201	`SET_MISSING(actuals, 1);`
200	`}`	202	`}`
201	`/* We use fargused instead of ARGUSED/SET_ARGUSED on elements of`	203	`/* We use fargused instead of ARGUSED/SET_ARGUSED on elements of`
202	`formals to avoid modification of the formals SEXPs. A gc can`	204	`formals to avoid modification of the formals SEXPs. A gc can`
203	`cause matchArgs to be called from finalizer code, resulting in`	205	`cause matchArgs_NR to be called from finalizer code, resulting in`
204	`another matchArgs call with the same formals. In R-2.10.x, this`	206	`another matchArgs_NR call with the same formals. In R-2.10.x, this`
205	`corrupted the ARGUSED data of the formals and resulted in an`	207	`corrupted the ARGUSED data of the formals and resulted in an`
206	`incorrect "formal argument 'foo' matched by multiple actual`	208	`incorrect "formal argument 'foo' matched by multiple actual`
207	`arguments" error.`	209	`arguments" error.`
208	`*/`	210	`*/`
209	`int fargused[arg_i ? arg_i : 1]; // avoid undefined behaviour`	211	`int fargused[arg_i ? arg_i : 1]; // avoid undefined behaviour`
Line 399...	Line 401...
399	`}`	401	`}`
400		402
401	`/* Use matchArgs_RC if the result might escape into R. */`	403	`/* Use matchArgs_RC if the result might escape into R. */`
402	`SEXP attribute_hidden matchArgs_RC(SEXP formals, SEXP supplied, SEXP call)`	404	`SEXP attribute_hidden matchArgs_RC(SEXP formals, SEXP supplied, SEXP call)`
403	`{`	405	`{`
404	`SEXP args = matchArgs(formals, supplied, call);`	406	`SEXP args = matchArgs_NR(formals, supplied, call);`
405	`/* it would be better not to build this arglist with CONS_NR in`	407	`/* it would be better not to build this arglist with CONS_NR in`
406	`the first place */`	408	`the first place */`
407	`for (SEXP a = args; a != R_NilValue; a = CDR(a)) {`	409	`for (SEXP a = args; a != R_NilValue; a = CDR(a)) {`
408	`if (! TRACKREFS(a)) {`	410	`if (! TRACKREFS(a)) {`
409	`ENABLE_REFCNT(a);`	411	`ENABLE_REFCNT(a);`
Line 417...	Line 419...
417		419
418	`/* patchArgsByActuals - patch promargs (given as 'supplied') to be promises`	420	`/* patchArgsByActuals - patch promargs (given as 'supplied') to be promises`
419	`for the respective actuals in the given environment 'cloenv'. This is`	421	`for the respective actuals in the given environment 'cloenv'. This is`
420	`used by NextMethod to allow patching of arguments to the current closure`	422	`used by NextMethod to allow patching of arguments to the current closure`
421	`before dispatching to the next method. The implementation is based on`	423	`before dispatching to the next method. The implementation is based on`
422	`matchArgs, but there is no error/warning checking, assuming that it has`	424	`matchArgs_NR, but there is no error/warning checking, assuming that it has`
423	`already been done by a call to matchArgs when the current closure was`	425	`already been done by a call to matchArgs_NR when the current closure was`
424	`invoked.`	426	`invoked.`
425	`*/`	427	`*/`
426		428
427	`typedef enum {`	429	`typedef enum {`
428	`FS_UNMATCHED = 0, /* the formal was not matched by any supplied arg */`	430	`FS_UNMATCHED = 0, /* the formal was not matched by any supplied arg */`
Line 477...	Line 479...
477	`if (TAG(f) != R_DotsSymbol) {`	479	`if (TAG(f) != R_DotsSymbol) {`
478	`for (b = prsupplied; b != R_NilValue; b = CDR(b)) {`	480	`for (b = prsupplied; b != R_NilValue; b = CDR(b)) {`
479	`if (TAG(b) != R_NilValue && pmatch(TAG(f), TAG(b), 1)) {`	481	`if (TAG(b) != R_NilValue && pmatch(TAG(f), TAG(b), 1)) {`
480	`patchArgument(b, TAG(f), &farg[farg_i], cloenv);`	482	`patchArgument(b, TAG(f), &farg[farg_i], cloenv);`
481	`SET_ARGUSED(b, 2);`	483	`SET_ARGUSED(b, 2);`
482	`break; /* Previous invocation of matchArgs */`	484	`break; /* Previous invocation of matchArgs_NR */`
483	`/* ensured unique matches */`	485	`/* ensured unique matches */`
484	`}`	486	`}`
485	`}`	487	`}`
486	`}`	488	`}`
487	`f = CDR(f);`	489	`f = CDR(f);`
Line 504...	Line 506...
504	`if (!ARGUSED(b) && TAG(b) != R_NilValue &&`	506	`if (!ARGUSED(b) && TAG(b) != R_NilValue &&`
505	`pmatch(TAG(f), TAG(b), seendots)) {`	507	`pmatch(TAG(f), TAG(b), seendots)) {`
506		508
507	`patchArgument(b, TAG(f), &farg[farg_i], cloenv);`	509	`patchArgument(b, TAG(f), &farg[farg_i], cloenv);`
508	`SET_ARGUSED(b, 1);`	510	`SET_ARGUSED(b, 1);`
509	`break; /* Previous invocation of matchArgs */`	511	`break; /* Previous invocation of matchArgs_NR */`
510	`/* ensured unique matches */`	512	`/* ensured unique matches */`
511	`}`	513	`}`
512	`}`	514	`}`
513	`}`	515	`}`
514	`}`	516	`}`
Line 530...	Line 532...
530	`if (TAG(f) == R_DotsSymbol) {`	532	`if (TAG(f) == R_DotsSymbol) {`
531	`/* Done, ... and following args cannot be patched */`	533	`/* Done, ... and following args cannot be patched */`
532	`break;`	534	`break;`
533	`} else if (farg[farg_i] == FS_MATCHED_PRESENT) {`	535	`} else if (farg[farg_i] == FS_MATCHED_PRESENT) {`
534	`/* Note that this check corresponds to CAR(b) == R_MissingArg */`	536	`/* Note that this check corresponds to CAR(b) == R_MissingArg */`
535	`/* in matchArgs */`	537	`/* in matchArgs_NR */`
536		538
537	`/* Already matched by tag */`	539	`/* Already matched by tag */`
538	`/* skip to next formal */`	540	`/* skip to next formal */`
539	`f = CDR(f);`	541	`f = CDR(f);`
540	`farg_i++;`	542	`farg_i++;`
Line 563...	Line 565...
563	`f = CDR(f);`	565	`f = CDR(f);`
564	`farg_i++;`	566	`farg_i++;`
565	`}`	567	`}`
566	`}`	568	`}`
567		569
568	`/* Previous invocation of matchArgs ensured all args are used */`	570	`/* Previous invocation of matchArgs_NR ensured all args are used */`
569	`UNPROTECT(1);`	571	`UNPROTECT(1);`
570	`return(prsupplied);`	572	`return(prsupplied);`
571	`}`	573	`}`

The R Project SVN R

(root)/trunk/src/main/match.c – Rev 74035 → 77452