The R Project SVN R

Rev

Rev 10172 | Rev 32380 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 10172 Rev 10718
Line 14... Line 14...
14 
 *  GNU General Public License for more details.
 14 
 *  GNU General Public License for more details.
15 
 *
 15 
 *
16 
 *  You should have received a copy of the GNU General Public License
 16 
 *  You should have received a copy of the GNU General Public License
17 
 *  along with this program; if not, write to the Free Software
 17 
 *  along with this program; if not, write to the Free Software
18 
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 18 
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
19 
 *
 19 
 
20 
 *
 20 
 
21 
 *  Matching and Partial Matching for Strings
 21 
 *  Matching and Partial Matching for Strings
22 
 *
 22 
 *
23 
 *  In theory all string matching code should be placed in this file
 23 
 *  In theory all string matching code should be placed in this file
24 
 *  At present there are still a couple of rogue matchers about.
 24 
 *  At present there are still a couple of rogue matchers about.
25 
 *
 25 
 *
Line 43... Line 43...
43 
#endif
 43 
#endif
44 
 
 44 
 
45 
#include "Defn.h"
 45 
#include "Defn.h"
46 
 
 46 
 
47 
 
 47 
 
48 
int NonNullStringMatch(SEXP s, SEXP t)
 48 
Rboolean NonNullStringMatch(SEXP s, SEXP t)
49 
{
 49 
{
50 
    if (CHAR(s)[0] && CHAR(t)[0] && strcmp(CHAR(s), CHAR(t)) == 0)
 50 
    if (CHAR(s)[0] && CHAR(t)[0] && strcmp(CHAR(s), CHAR(t)) == 0)
51 
	return 1;
 51 
	return TRUE;
52 
    else
 52 
    else
53 
	return 0;
 53 
	return FALSE;
54 
}
 54 
}
55 
 
 55 
 
56 
static int psmatch(char *f, char *t, int exact)
 56 
Rboolean psmatch(char *f, char *t, Rboolean exact)
57 
{
 57 
{
58 
    if (exact) {
 58 
    if (exact)
59 
	return !strcmp(f, t);
 59 
	return (Rboolean)!strcmp(f, t);
60 
    }
 - 
 
61 
    else {
 60 
    /* else */
62 
	while (*f || *t) {
 61 
    while (*f || *t) {
63 
	    if (*t == '\0') return 1;
 62 
	if (*t == '\0') return TRUE;
64 
	    if (*f == '\0') return 0;
 63 
	if (*f == '\0') return FALSE;
65 
	    if (*t != *f)   return 0;
 64 
	if (*t != *f)   return FALSE;
66 
	    t++;
 65 
	t++;
67 
	    f++;
 66 
	f++;
68 
	}
 - 
 
69 
	return 1;
 - 
 
70 
    }
 67 
    }
- 
 
 68 
    return TRUE;
71 
}
 69 
}
72 
 
 70 
 
- 
 
 71 
 
73 
/* Matching formals and arguments */
 72 
/* Matching formals and arguments */
74 
 
 73 
 
75 
int pmatch(SEXP formal, SEXP tag, int exact)
 74 
Rboolean pmatch(SEXP formal, SEXP tag, Rboolean exact)
76 
{
 75 
{
77 
    char *f, *t;
 76 
    char *f, *t;
78 
    switch (TYPEOF(formal)) {
 77 
    switch (TYPEOF(formal)) {
79 
    case SYMSXP:
 78 
    case SYMSXP:
80 
	f = CHAR(PRINTNAME(formal));
 79 
	f = CHAR(PRINTNAME(formal));
Line 102... Line 101...
102 
	goto fail;
 101 
	goto fail;
103 
    }
 102 
    }
104 
    return psmatch(f, t, exact);
 103 
    return psmatch(f, t, exact);
105 
 fail:
 104 
 fail:
106 
    error("invalid partial string match");
 105 
    error("invalid partial string match");
107 
    return 0;/* for -Wall */
 106 
    return FALSE;/* for -Wall */
108 
}
 107 
}
109 
 
 108 
 
110 
 
 109 
 
111 
/* Destructively Extract A Named List Element. */
 110 
/* Destructively Extract A Named List Element. */
112 
/* Returns the first partially matching tag found. */
 111 
/* Returns the first partially matching tag found. */
Line 114... Line 113...
114 
 
 113 
 
115 
SEXP matchPar(char *tag, SEXP * list)
 114 
SEXP matchPar(char *tag, SEXP * list)
116 
{
 115 
{
117 
  if (*list == R_NilValue)
 116 
  if (*list == R_NilValue)
118 
    return R_MissingArg;
 117 
    return R_MissingArg;
119 
  else if (TAG(*list) != R_NilValue &&
118 
  else if (TAG(*list) != R_NilValue &&
120 
	   psmatch(tag, CHAR(PRINTNAME(TAG(*list))), 0)) {
 119 
	   psmatch(tag, CHAR(PRINTNAME(TAG(*list))), 0)) {
121 
    SEXP s = *list;
 120 
    SEXP s = *list;
122 
    *list = CDR(*list);
 121 
    *list = CDR(*list);
123 
    return CAR(s);
 122 
    return CAR(s);
124 
  }
 123 
  }
125 
  else {
 124 
  else {
126 
    SEXP last = *list;
 125 
    SEXP last = *list;
127 
    SEXP next = CDR(*list);
 126 
    SEXP next = CDR(*list);
128 
    while (next != R_NilValue) {
 127 
    while (next != R_NilValue) {
129 
      if (TAG(next) != R_NilValue &&
128 
      if (TAG(next) != R_NilValue &&
130 
	  psmatch(tag, CHAR(PRINTNAME(TAG(next))), 0)) {
 129 
	  psmatch(tag, CHAR(PRINTNAME(TAG(next))), 0)) {
131 
	SETCDR(last, CDR(next));
 130 
	SETCDR(last, CDR(next));
132 
	return CAR(next);
 131 
	return CAR(next);
133 
      }
 132 
      }
134 
      else {
 133 
      else {