Commit 1d0d3ad7 authored by Radford Neal's avatar Radford Neal

separate two interfaces for matchArgs, for the inline part

parent 9757c8ab
......@@ -2014,105 +2014,112 @@ static inline int SEQL(SEXP a, SEXP b)
i2 = (i2+1 == n2 ? 0 : i2+1), ++i1, i = i1)
/* MatchArgs - trivial cases done here, non-trivial part in match.c. */
/* MatchArgs - trivial cases are done here, with two interfaces;
non-trivial part is in match.c, where there is more documentation. */
static inline SEXP matchArgs
(SEXP formals, char **formal_names, int arg_count, SEXP supplied, SEXP call)
extern SEXP Rf_matchArgs_nontrivial
(SEXP, const char * const *, int, SEXP, int, SEXP);
static inline SEXP matchArgs_strings
(const char * const *formal_names, int arg_count, SEXP supplied, SEXP call)
{
int n_supplied;
SEXP r;
if (formal_names != NULL) { /* formal names supplied as strings */
if (supplied == R_NilValue) { /* zero arguments supplied */
if (arg_count == 0)
return R_NilValue;
n_supplied = 0;
}
else if (CDR(supplied) == R_NilValue) { /* one argument supplied */
SEXP a = CAR(supplied);
if (arg_count == 1 && strcmp(formal_names[0],"...") != 0
&& TAG(supplied) == R_NilValue && a != R_DotsSymbol) {
r = CONS (a, R_NilValue);
SET_MISSING (r, a == R_MissingArg || a == R_MissingUnder);
return r;
}
n_supplied = 1;
}
else if (CDDR(supplied) == R_NilValue) { /* two arguments supplied */
SEXP a1 = CAR(supplied), a2 = CADR(supplied);
if (arg_count == 2 && a1 != R_DotsSymbol
&& a2 != R_DotsSymbol
&& TAG(supplied) == R_NilValue
&& TAG(CDR(supplied)) == R_NilValue
&& strcmp(formal_names[0],"...") != 0
&& strcmp(formal_names[1],"...") != 0) {
r = CONS (a2, R_NilValue);
SET_MISSING (r, a2 == R_MissingArg || a2 == R_MissingUnder);
r = CONS (a1, r);
SET_MISSING (r, a1 == R_MissingArg || a1 == R_MissingUnder);
return r;
}
n_supplied = 2;
if (supplied == R_NilValue) { /* zero arguments supplied */
if (arg_count == 0)
return R_NilValue;
n_supplied = 0;
}
else if (CDR(supplied) == R_NilValue) { /* one argument supplied */
SEXP a = CAR(supplied);
if (arg_count == 1 && strcmp(formal_names[0],"...") != 0
&& TAG(supplied) == R_NilValue && a != R_DotsSymbol) {
r = CONS (a, R_NilValue);
SET_MISSING (r, a == R_MissingArg || a == R_MissingUnder);
return r;
}
else { /* more than two arguments supplied, count them */
SEXP s = CDDR(supplied);
n_supplied = 2;
do { n_supplied += 1; s = CDR(s); } while (s != R_NilValue);
n_supplied = 1;
}
else if (CDDR(supplied) == R_NilValue) { /* two arguments supplied */
SEXP a1 = CAR(supplied), a2 = CADR(supplied);
if (arg_count == 2 && a1 != R_DotsSymbol
&& a2 != R_DotsSymbol
&& TAG(supplied) == R_NilValue
&& TAG(CDR(supplied)) == R_NilValue
&& strcmp(formal_names[0],"...") != 0
&& strcmp(formal_names[1],"...") != 0) {
r = CONS (a2, R_NilValue);
SET_MISSING (r, a2 == R_MissingArg || a2 == R_MissingUnder);
r = CONS (a1, r);
SET_MISSING (r, a1 == R_MissingArg || a1 == R_MissingUnder);
return r;
}
n_supplied = 2;
}
else { /* more than two arguments supplied, count them */
SEXP s = CDDR(supplied);
n_supplied = 2;
do { n_supplied += 1; s = CDR(s); } while (s != R_NilValue);
}
else { /* formal names supplied as pairlist (in 'formals') */
if (supplied == R_NilValue) { /* zero arguments supplied */
if (formals == R_NilValue)
return R_NilValue;
n_supplied = 0;
}
else if (CDR(supplied) == R_NilValue) { /* one argument supplied */
SEXP a = CAR(supplied);
if (formals != R_NilValue && CDR(formals) == R_NilValue
&& TAG(supplied) == R_NilValue && TAG(formals) != R_DotsSymbol
&& a != R_DotsSymbol) {
r = cons_with_tag (a, R_NilValue, TAG(formals));
SET_MISSING (r, a == R_MissingArg || a == R_MissingUnder);
return r;
}
n_supplied = 1;
}
else if (CDDR(supplied) == R_NilValue) { /* two arguments supplied */
SEXP a1 = CAR(supplied), a2 = CADR(supplied);
if (CDR(formals) != R_NilValue && a1 != R_DotsSymbol
&& a2 != R_DotsSymbol
&& TAG(formals) != R_DotsSymbol
&& TAG(CDR(formals)) != R_DotsSymbol
&& CDDR(formals) == R_NilValue
&& TAG(supplied) == R_NilValue
&& TAG(CDR(supplied))==R_NilValue) {
r = cons_with_tag (a2, R_NilValue, TAG(CDR(formals)));
SET_MISSING (r, a2 == R_MissingArg || a2 == R_MissingUnder);
r = cons_with_tag (a1, r, TAG(formals));
SET_MISSING (r, a1 == R_MissingArg || a1 == R_MissingUnder);
return r;
}
n_supplied = 2;
}
else { /* more than two arguments supplied, count them */
SEXP s = CDDR(supplied);
n_supplied = 2;
do { n_supplied += 1; s = CDR(s); } while (s != R_NilValue);
}
return Rf_matchArgs_nontrivial (R_NilValue, formal_names, arg_count,
supplied, n_supplied, call);
}
static inline SEXP matchArgs_pairlist (SEXP formals, SEXP supplied, SEXP call)
/* Count formal arguments. */
{
int arg_count, n_supplied;
SEXP r;
SEXP a;
arg_count = 0;
for (a = formals; a != R_NilValue; a = CDR(a))
arg_count += 1;
if (supplied == R_NilValue) { /* zero arguments supplied */
if (formals == R_NilValue)
return R_NilValue;
n_supplied = 0;
}
else if (CDR(supplied) == R_NilValue) { /* one argument supplied */
SEXP a = CAR(supplied);
if (formals != R_NilValue && CDR(formals) == R_NilValue
&& TAG(supplied) == R_NilValue && TAG(formals) != R_DotsSymbol
&& a != R_DotsSymbol) {
r = cons_with_tag (a, R_NilValue, TAG(formals));
SET_MISSING (r, a == R_MissingArg || a == R_MissingUnder);
return r;
}
n_supplied = 1;
}
else if (CDDR(supplied) == R_NilValue) { /* two arguments supplied */
SEXP a1 = CAR(supplied), a2 = CADR(supplied);
if (CDR(formals) != R_NilValue && a1 != R_DotsSymbol
&& a2 != R_DotsSymbol
&& TAG(formals) != R_DotsSymbol
&& TAG(CDR(formals)) != R_DotsSymbol
&& CDDR(formals) == R_NilValue
&& TAG(supplied) == R_NilValue
&& TAG(CDR(supplied))==R_NilValue) {
r = cons_with_tag (a2, R_NilValue, TAG(CDR(formals)));
SET_MISSING (r, a2 == R_MissingArg || a2 == R_MissingUnder);
r = cons_with_tag (a1, r, TAG(formals));
SET_MISSING (r, a1 == R_MissingArg || a1 == R_MissingUnder);
return r;
}
n_supplied = 2;
}
else { /* more than two arguments supplied, count them */
SEXP s = CDDR(supplied);
n_supplied = 2;
do { n_supplied += 1; s = CDR(s); } while (s != R_NilValue);
}
/* Count formal arguments. */
extern SEXP Rf_matchArgs_nontrivial(SEXP, char **, int, SEXP, int, SEXP);
SEXP a;
arg_count = 0;
for (a = formals; a != R_NilValue; a = CDR(a))
arg_count += 1;
return Rf_matchArgs_nontrivial (formals, formal_names, arg_count,
return Rf_matchArgs_nontrivial (formals, NULL, arg_count,
supplied, n_supplied, call);
}
......
......@@ -2167,8 +2167,8 @@ SEXP do_Math2(SEXP call, SEXP op, SEXP args, SEXP env)
} else {
/* If named, do argument matching by name */
if (TAG(args) != R_NilValue || TAG(CDR(args)) != R_NilValue) {
static char *ap[2] = { "x", "digits" };
PROTECT(args = matchArgs(R_NilValue, ap, 2, args, call));
static const char * const ap[2] = { "x", "digits" };
PROTECT(args = matchArgs_strings (ap, 2, args, call));
nprotect += 1;
}
if (length(CADR(args)) == 0)
......@@ -2268,8 +2268,8 @@ SEXP do_log (SEXP call, SEXP op, SEXP args, SEXP env, int variant)
case 2:
{
/* match argument names if supplied */
static char *ap[2] = { "x", "base" };
PROTECT(args = matchArgs(R_NilValue, ap, 2, args, call));
static const char * const ap[2] = { "x", "base" };
PROTECT(args = matchArgs_strings (ap, 2, args, call));
if (length(CADR(args)) == 0)
errorcall(call, _("invalid argument 'base' of length 0"));
if (isComplex(CAR(args)) || isComplex(CADR(args)))
......
......@@ -1427,13 +1427,13 @@ static SEXP do_attr(SEXP call, SEXP op, SEXP args, SEXP env)
size_t n;
int nargs = length(args), exact = 0;
enum { NONE, PARTIAL, PARTIAL2, FULL } match = NONE;
static char *ap[3] = { "x", "which", "exact" };
static const char * const ap[3] = { "x", "which", "exact" };
if (nargs < 2 || nargs > 3)
errorcall(call, "either 2 or 3 arguments are required");
/* argument matching */
argList = matchArgs(R_NilValue, ap, 3, args, call);
argList = matchArgs_strings (ap, 3, args, call);
PROTECT(argList);
s = CAR(argList);
......@@ -1591,7 +1591,7 @@ static SEXP do_attrgets(SEXP call, SEXP op, SEXP args, SEXP env)
else { /* attr(x, which = "<name>") <- value */
SEXP obj, name, argList;
static char *ap[3] = { "x", "which", "value" };
static const char * const ap[3] = { "x", "which", "value" };
checkArity(op, args);
......@@ -1602,7 +1602,7 @@ static SEXP do_attrgets(SEXP call, SEXP op, SEXP args, SEXP env)
PROTECT(obj);
/* argument matching */
argList = matchArgs(R_NilValue, ap, 3, args, call);
argList = matchArgs_strings (ap, 3, args, call);
PROTECT(argList);
......
......@@ -259,10 +259,10 @@ static SEXP do_onexit(SEXP call, SEXP op, SEXP args, SEXP rho)
{
RCNTXT *ctxt;
SEXP code, oldcode, tmp, argList;
static char *ap[2] = { "expr", "add" };
static const char * const ap[2] = { "expr", "add" };
int addit = 0;
PROTECT(argList = matchArgs(R_NilValue, ap, 2, args, call));
PROTECT(argList = matchArgs_strings (ap, 2, args, call));
if (CAR(argList) == R_MissingArg) code = R_NilValue;
else code = CAR(argList);
if (CADR(argList) != R_MissingArg) {
......
......@@ -2906,10 +2906,10 @@ SEXP attribute_hidden substituteList(SEXP el, SEXP rho)
static SEXP do_substitute(SEXP call, SEXP op, SEXP args, SEXP rho)
{
SEXP argList, env, s, t;
static char *ap[2] = { "expr", "env" };
static const char * const ap[2] = { "expr", "env" };
/* argument matching */
PROTECT(argList = matchArgs(R_NilValue, ap, 2, args, call));
PROTECT(argList = matchArgs_strings (ap, 2, args, call));
/* set up the environment for substitution */
if (CADR(argList) == R_MissingArg)
......
......@@ -1148,7 +1148,7 @@ SEXP attribute_hidden applyClosure_v(SEXP call, SEXP op, SEXP arglist, SEXP rho,
contains the matched pairs. Note that actuals is protected via
newrho. */
actuals = matchArgs(formals, NULL, 0, arglist, call);
actuals = matchArgs_pairlist (formals, arglist, call);
PROTECT(newrho = NewEnvironment(R_NilValue, actuals, savedrho));
/* no longer passes formals, since matchArg now puts tags in actuals */
......
/*
* pqR : A pretty quick version of R
* Copyright (C) 2013, 2014, 2015, 2016, 2017 by Radford M. Neal
* Copyright (C) 2013, 2014, 2015, 2016, 2017, 2018 by Radford M. Neal
*
* Based on R : A Computer Language for Statistical Data Analysis
* Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka
......@@ -1220,12 +1220,13 @@ SEXP attribute_hidden do_browser(SEXP call, SEXP op, SEXP args, SEXP rho)
RCNTXT thiscontext, returncontext, *cptr;
int savestack, browselevel, tmp;
SEXP topExp, argList;
static char *ap[4] = { "text", "condition", "expr", "skipCalls" };
static const char * const ap[4] =
{ "text", "condition", "expr", "skipCalls" };
R_Visible = FALSE;
/* argument matching */
argList = matchArgs(R_NilValue, ap, 4, args, call);
argList = matchArgs_strings (ap, 4, args, call);
PROTECT(argList);
/* substitute defaults */
if(CAR(argList) == R_MissingArg)
......
......@@ -296,7 +296,7 @@ SEXP attribute_hidden matchArgExact(SEXP tag, SEXP * list)
In applyClosure and some other routines, matchArgs is instead called with
"formals" being a pairlist having tags that are names of formal arguments.
In this case, "formal_names" should be NULL, and "arg_count" should be 0.
In this case, arg_count is computed in the inline function.
If formal names are specifed using "formals", the entries in the list of
actual arguments returned will have tags set from the list of formal
......@@ -318,7 +318,7 @@ SEXP attribute_hidden matchArgExact(SEXP tag, SEXP * list)
code in R-2-8-branch */
SEXP attribute_hidden Rf_matchArgs_nontrivial
(SEXP formals, char **formal_names, int arg_count,
(SEXP formals, const char * const *formal_names, int arg_count,
SEXP supplied, int n_supplied, SEXP call)
{
SEXP b, last_positional, last_potential_match, actuals_list;
......
......@@ -440,9 +440,9 @@ static SEXP do_usemethod (SEXP call, SEXP op, SEXP args, SEXP env,
SEXP callenv, defenv;
SEXP argList;
RCNTXT *cptr;
static char *ap[2] = { "generic", "object" };
static const char * const ap[2] = { "generic", "object" };
PROTECT(argList = matchArgs(R_NilValue, ap, 2, args, call));
PROTECT(argList = matchArgs_strings (ap, 2, args, call));
if (CAR(argList) == R_MissingArg)
errorcall(call, _("there must be a 'generic' argument"));
else
......@@ -640,7 +640,7 @@ static SEXP do_nextmethod (SEXP call, SEXP op, SEXP args, SEXP env,
/* Get formals and actuals; matchArgs attaches the names of the formals to
the actuals. Then expand any ... that occurs. */
formals = FORMALS(s);
PROTECT(actuals = matchArgs(formals, NULL, 0, cptr->promargs, call));
PROTECT(actuals = matchArgs_pairlist (formals, cptr->promargs, call));
i = 0;
for(t = actuals; t != R_NilValue; t = CDR(t)) {
......
/*
* pqR : A pretty quick version of R
* Copyright (C) 2013, 2014, 2015, 2016, 2017 by Radford M. Neal
* Copyright (C) 2013, 2014, 2015, 2016, 2017, 2018 by Radford M. Neal
*
* Based on R : A Computer Language for Statistical Data Analysis
* Copyright (C) 1995-1998 Robert Gentleman and Ross Ihaka
......@@ -542,8 +542,8 @@ void task_rep (helpers_op_t op, SEXP a, SEXP s, SEXP t)
static SEXP do_rep_int(SEXP call, SEXP op, SEXP args, SEXP rho, int variant)
{
static char *ap[2] = { "x", "times" };
PROTECT(args = matchArgs(R_NilValue, ap, 2, args, call));
static const char * const ap[2] = { "x", "times" };
PROTECT(args = matchArgs_strings (ap, 2, args, call));
SEXP s = CAR(args);
SEXP ncopy = CADR(args);
......@@ -630,7 +630,8 @@ static SEXP do_rep(SEXP call, SEXP op, SEXP args, SEXP rho, int variant)
{
SEXP a, ans, times;
int i, len, each, nprotect = 0;
static char *ap[5] = { "x", "times", "length.out", "each", "..." };
static const char * const ap[5] =
{ "x", "times", "length.out", "each", "..." };
if (DispatchOrEval(call, op, "rep", args, rho, &ans, 0, 0))
return(ans);
......@@ -645,7 +646,7 @@ static SEXP do_rep(SEXP call, SEXP op, SEXP args, SEXP rho, int variant)
so we manage the argument matching ourselves. We pretend this is
rep(x, times, length.out, each, ...)
*/
PROTECT(args = matchArgs(R_NilValue, ap, 5, args, call));
PROTECT(args = matchArgs_strings (ap, 5, args, call));
nprotect++;
SEXP x = CAR(args); args = CDR(args);
......@@ -856,7 +857,7 @@ static SEXP do_seq(SEXP call, SEXP op, SEXP args, SEXP rho, int variant)
SEXP ans, from, to, by, len, along;
int i, nargs = length(args), lf, lout = NA_INTEGER;
Rboolean One = nargs == 1;
static char *ap[6] =
static const char * const ap[6] =
{ "from", "to", "by", "length.out", "along.with", "..." };
if (DispatchOrEval(call, op, "seq", args, rho, &ans, 0, 1))
......@@ -867,7 +868,7 @@ static SEXP do_seq(SEXP call, SEXP op, SEXP args, SEXP rho, int variant)
seq(from, to, by, length.out, along.with, ...)
*/
PROTECT(args = matchArgs(R_NilValue, ap, 6, args, call));
PROTECT(args = matchArgs_strings (ap, 6, args, call));
from = CAR(args); args = CDR(args);
to = CAR(args); args = CDR(args);
......
......@@ -1586,7 +1586,7 @@ static SEXP do_matchcall(SEXP call, SEXP op, SEXP args, SEXP env)
}
}
}
rlist = matchArgs(formals, NULL, 0, actuals, call);
rlist = matchArgs_pairlist (formals, actuals, call);
#if 0 /* No longer needed, since matchArgs attaches the tags itself. */
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment