/*
* re2glob - C implementation
* (c) 2007 ActiveState Software Inc.
*/
#include <tcl.h>
#define DEBUG 0
static void
ExpChopNested _ANSI_ARGS_ ((Tcl_UniChar** xstr,
int* xstrlen,
Tcl_UniChar open,
Tcl_UniChar close));
static Tcl_UniChar*
ExpLiteral _ANSI_ARGS_ ((Tcl_UniChar* nexto,
Tcl_UniChar* str,
int strlen));
static Tcl_UniChar*
ExpCollapseStar _ANSI_ARGS_ ((Tcl_UniChar* src,
Tcl_UniChar* last));
static Tcl_UniChar*
ExpCollapseQForward _ANSI_ARGS_ ((Tcl_UniChar* src,
Tcl_UniChar* last));
static Tcl_UniChar*
ExpCollapseQBack _ANSI_ARGS_ ((Tcl_UniChar* src,
Tcl_UniChar* last));
static Tcl_UniChar
ExpBackslash _ANSI_ARGS_ ((char prefix,
Tcl_UniChar* str,
int strlen));
static int
ExpCountStar _ANSI_ARGS_ ((Tcl_UniChar* src, Tcl_UniChar* last));
static char*
xxx (Tcl_UniChar* x, int xl)
{
static Tcl_DString ds;
Tcl_DStringInit (&ds);
return Tcl_UniCharToUtfDString (x,xl,&ds);
}
Tcl_Obj*
exp_retoglob (
Tcl_UniChar* str,
int strlen)
{
/*
* Output: x2 size of input (literal where every character has to be
* quoted.
* Location: For next translated unit, in output.
* Size of last generated unit, in characters.
* Stack of output locations at opening parens. x1 size of input.
* Location for next location on stack.
*/
static Tcl_UniChar litprefix [] = {'*','*','*','='};
static Tcl_UniChar areprefix [] = {'*','*','*',':'};
static Tcl_UniChar areopts [] = {'(','?'};
static Tcl_UniChar nocapture [] = {'?',':'};
static Tcl_UniChar lookhas [] = {'?','='};
static Tcl_UniChar looknot [] = {'?','!'};
static Tcl_UniChar xcomment [] = {'?','#'};
static Tcl_UniChar classa [] = {'[','.'};
static Tcl_UniChar classb [] = {'[','='};
static Tcl_UniChar classc [] = {'[',':'};
int lastsz, expanded;
Tcl_UniChar* out;
Tcl_UniChar* nexto;
Tcl_UniChar** paren;
Tcl_UniChar** nextp;
Tcl_Obj* glob = NULL;
Tcl_UniChar* mark;
Tcl_UniChar ch;
/*
* Set things up.
*/
out = nexto = (Tcl_UniChar*) Tcl_Alloc (strlen*2*sizeof (Tcl_UniChar));
paren = nextp = (Tcl_UniChar**) Tcl_Alloc (strlen* sizeof (Tcl_UniChar*));
lastsz = -1;
expanded = 0;
/*
* Start processing ...
*/
#define CHOP(n) {str += (n); strlen -= (n);}
#define CHOPC(c) {while (*str != (c) && strlen) CHOP(1) ;}
#define EMIT(c) {lastsz = 1; *nexto++ = (c);}
#define EMITX(c) {lastsz++; *nexto++ = (c);}
#define MATCH(lit) ((strlen >= (sizeof (lit)/sizeof (Tcl_UniChar))) && (0 == Tcl_UniCharNcmp (str,(lit),sizeof(lit)/sizeof (Tcl_UniChar))))
#define MATCHC(c) (strlen && (*str == (c)))
#define PUSHPAREN {*nextp++ = nexto;}
#define UNEMIT {nexto -= lastsz; lastsz = -1;}
/* Tcl_UniCharIsDigit ? */
#define MATCH_DIGIT (MATCHC ('0') || MATCHC ('1') || \
MATCHC ('2') || MATCHC ('3') || \
MATCHC ('4') || MATCHC ('5') || \
MATCHC ('6') || MATCHC ('7') || \
MATCHC ('8') || MATCHC ('9'))
#define MATCH_HEXDIGIT (MATCH_DIGIT || \
MATCHC ('a') || MATCHC ('A') || \
MATCHC ('b') || MATCHC ('B') || \
MATCHC ('c') || MATCHC ('C') || \
MATCHC ('d') || MATCHC ('D') || \
MATCHC ('e') || MATCHC ('E') || \
MATCHC ('f') || MATCHC ('F'))
#define EMITC(c) {if (((c) == '\\') || \
((c) == '*') || \
((c) == '?') || \
((c) == '$') || \
((c) == '^') || \
((c) == '[')) { \
EMIT ('\\'); EMITX ((c)); \
} else { \
EMIT ((c));}}
#define MATCH_AREOPTS(c) (c == 'b' || c == 'c' || \
c == 'e' || c == 'i' || c == 'm' || c == 'n' || \
c == 'p' || c == 'q' || c == 's' || c == 't' || \
c == 'w' || c == 'x')
#if DEBUG
#define LOG if (1) fprintf
#define FF fflush (stderr)
#define MARK(s) LOG (stderr,#s "\n"); FF;
#else
#define LOG if (0) fprintf
#define FF
#define MARK(s)
#endif
/* ***= -> literal string follows */
LOG (stderr,"RE-2-GLOB '%s'\n", xxx(str,strlen)); FF;
if (MATCH (litprefix)) {
CHOP (4);
nexto = ExpLiteral (nexto, str, strlen);
goto done;
}
/* ***: -> RE is ARE. Always for Expect. Therefore ignore */
if (MATCH (areprefix)) {
CHOP (4);
LOG (stderr,"ARE '%s'\n", xxx(str,strlen)); FF;
}
/* (?xyz) ARE options, in {bceimnpqstwx}. Not validating that the
* options are legal. We assume that the RE is valid.
*/
if (MATCH (areopts)) { /* "(?" */
Tcl_UniChar* save = str;
Tcl_UniChar* stop;
int stoplen;
int save_strlen = strlen;
int all_ARE_opts = 1;
/* First, ensure that this is actually an ARE opts string.
* It could be something else (e.g., a non-capturing block).
*/
CHOP (2);
mark = str; CHOPC (')');
stop = str; /* Remember closing parens location, allows */
stoplen = strlen; /* us to avoid a second CHOPC run later */
while (mark < str) {
if (MATCH_AREOPTS(*mark)) {
mark++;
} else {
all_ARE_opts = 0;
break;
}
}
/* Reset back to our entry point. */
str = save;
strlen = save_strlen;
if (all_ARE_opts) {
/* Now actually perform the ARE option processing */
LOG (stderr, "%s\n", "Processing AREOPTS"); FF;
CHOP (2);
mark = str;
/* Equivalent to CHOPC (')') */
str = stop;
strlen = stoplen;
while (mark < str) {
if (*mark == 'q') {
CHOP (1);
nexto = ExpLiteral (nexto, str, strlen);
goto done;
} else if (*mark == 'x') {
expanded = 1;
LOG (stderr,"EXPANDED\n"); FF;
}
mark++;
}
CHOP (1);
}
}
while (strlen) {
LOG (stderr,"'%s' <-- ",xxx(out,nexto-out)); FF;
LOG (stderr,"'%s'\n", xxx(str,strlen)); FF;
if (expanded) {
/* Expanded syntax, whitespace and comments, ignore. */
while (MATCHC (' ') ||
MATCHC (0x9) ||
MATCHC (0xa)) CHOP (1);
if (MATCHC ('#')) {
CHOPC (0xa);
if (strlen) CHOP (1);
continue;
}
}
if (MATCHC ('|')) {
/* branching is too complex */
goto error;
} else if (MATCHC ('(')) {
/* open parens */
CHOP (1);
if (MATCH (nocapture)) { /* "?:" */
/* non capturing -save location */
PUSHPAREN;
CHOP (2);
} else if (MATCH (lookhas) || /* "?=" */
MATCH (looknot)) { /* "?!" */
/* lookahead - ignore */
CHOP (2);
ExpChopNested (&str, &strlen, '(', ')');
} else if (MATCH (xcomment)) { /* "?#" */
/* comment - ignore */
CHOPC (')'); CHOP (1);
} else {
/* plain capturing */
PUSHPAREN;
}
} else if (MATCHC (')')) {
/* Closing parens. */
CHOP (1);
/* Everything coming after the saved result is new, and
* collapsed into a single entry for a possible coming operator
* to handle.
*/
nextp --; /* Back to last save */
mark = *nextp; /* Location where generation for this parens started */
lastsz = (nexto - mark); /* This many chars generated */
/* Now lastsz has the correct value for a possibly following
* UNEMIT
*/
} else if (MATCHC ('$') || MATCHC ('^')) {
/* anchor constraints - ignore */
CHOP (1);
} else if (MATCHC ('[')) {
/* Classes - reduce to any char [[=chars=]] [[.chars.]]
* [[:name:]] [chars] Count brackets to find end.
* These are a bit complicated ... [= =], [. .], [: {] sequences
* always have to be complete. '[' does NOT nest otherwise. And
* a ']' after the opening '[' (with only '^' allowed to
* intervene is a character, not the closing bracket. We have to
* process the class in pieces to handle all this. The Tcl level
* implementations (0-2 all have bugs one way or other, all
* different.
*/
int first = 1;
int allowed = 1;
CHOP (1);
while (strlen) {
if (first && MATCHC ('^')) {
/* ^ as first keeps allowed ok for one more cycle */
CHOP (1);
first = 0;
continue;
} else if (allowed && MATCHC (']')) {
/* Not a closing bracket! */
CHOP (1);
} else if (MATCHC (']')) {
/* Closing bracket found */
CHOP (1);
break;
} else if (MATCH (classa) ||
MATCH (classb) ||
MATCH (classc)) {
Tcl_UniChar delim[2];
delim[0] = str [1];
delim[1] = ']';
CHOP (2);
while (!MATCH (delim)) CHOP (1);
CHOP (2);
} else {
/* Any char in class */
CHOP (1);
}
/* Reset flags handling start of class */
allowed = first = 0;
}
EMIT ('?');
} else if (MATCHC ('\\')) {
/* Escapes */
CHOP (1);
if (MATCHC ('d') || MATCHC ('D') ||
MATCHC ('s') || MATCHC ('S') ||
MATCHC ('w') || MATCHC ('W')) {
/* Class shorthands - reduce to any char */
EMIT ('?');
CHOP (1);
} else if (MATCHC ('m') || MATCHC ('M') ||
MATCHC ('y') || MATCHC ('Y') ||
MATCHC ('A') || MATCHC ('Z')) {
/* constraint escapes - ignore */
CHOP (1);
} else if (MATCHC ('B')) {
/* Backslash */
EMIT ('\\');
EMITX ('\\');
CHOP (1);
} else if (MATCHC ('0')) {
/* Escape NULL */
EMIT ('\0');
CHOP (1);
} else if (MATCHC ('e')) {
/* Escape ESC */
EMIT ('\033');
CHOP (1);
} else if (MATCHC ('a')) {
/* Escape \a */
EMIT (0x7);
CHOP (1);
} else if (MATCHC ('b')) {
/* Escape \b */
EMIT (0x8);
CHOP (1);
} else if (MATCHC ('f')) {
/* Escape \f */
EMIT (0xc);
CHOP (1);
} else if (MATCHC ('n')) {
/* Escape \n */
EMIT (0xa);
CHOP (1);
} else if (MATCHC ('r')) {
/* Escape \r */
EMIT (0xd);
CHOP (1);
} else if (MATCHC ('t')) {
/* Escape \t */
EMIT (0x9);
CHOP (1);
} else if (MATCHC ('v')) {
/* Escape \v */
EMIT (0xb);
CHOP (1);
} else if (MATCHC ('c') && (strlen >= 2)) {
/* Escape \cX - reduce to (.) */
EMIT ('?');
CHOP (2);
} else if (MATCHC ('x')) {
CHOP (1);
if (MATCH_HEXDIGIT) {
/* Escape hex character */
mark = str;
while (MATCH_HEXDIGIT) CHOP (1);
if ((str - mark) > 2) { mark = str - 2; }
ch = ExpBackslash ('x',mark,str-mark);
EMITC (ch);
} else {
/* Without hex digits following this is a plain char */
EMIT ('x');
}
} else if (MATCHC ('u')) {
/* Escapes unicode short. */
CHOP (1);
mark = str;
CHOP (4);
ch = ExpBackslash ('u',mark,str-mark);
EMITC (ch);
} else if (MATCHC ('U')) {
/* Escapes unicode long. */
CHOP (1);
mark = str;
CHOP (8);
ch = ExpBackslash ('U',mark,str-mark);
EMITC (ch);
} else if (MATCH_DIGIT) {
/* Escapes, octal, and backreferences - reduce (.*) */
CHOP (1);
while (MATCH_DIGIT) CHOP (1);
EMIT ('*');
} else {
/* Plain escaped characters - copy over, requote */
EMITC (*str);
CHOP (1);
}
} else if (MATCHC ('{')) {
/* Non-greedy and greedy bounds - reduce to (*) */
CHOP (1);
if (MATCH_DIGIT) {
/* Locate closing brace and remove operator */
CHOPC ('}'); CHOP (1);
/* Remove optional greedy quantifier */
if (MATCHC ('?')) { CHOP (1);}
UNEMIT;
EMIT ('*');
} else {
/* Brace is plain character, copy over */
EMIT ('{');
/* CHOP already done */
}
} else if (MATCHC ('*') ||
MATCHC ('+') ||
MATCHC ('?')) {
/* (Non-)greedy operators - reduce to (*) */
CHOP (1);
/* Remove optional greedy quantifier */
if (MATCHC ('?')) { CHOP (1);}
UNEMIT;
EMIT ('*');
} else if (MATCHC ('.')) {
/* anychar - copy over */
EMIT ('?');
CHOP (1);
} else {
/* Plain char, copy over. */
EMIT (*str);
CHOP (1);
}
}
LOG (stderr,"'%s' <-- ",xxx(out,nexto-out)); FF;
LOG (stderr,"'%s'\n", xxx(str,strlen)); FF;
/*
* Clean up the output a bit (collapse *-sequences and absorb ?'s
* into adjacent *'s.
*/
MARK (QF)
nexto = ExpCollapseQForward (out,nexto);
LOG (stderr,"QF '%s'\n",xxx(out,nexto-out)); FF;
MARK (QB)
nexto = ExpCollapseQBack (out,nexto);
LOG (stderr,"QB '%s'\n",xxx(out,nexto-out)); FF;
MARK (QS)
nexto = ExpCollapseStar (out,nexto);
LOG (stderr,"ST '%s'\n",xxx(out,nexto-out)); FF;
/*
* Heuristic: if there are more than two *s, the risk is far too
* large that the result actually is slower than the normal re
* matching. So bail out.
*/
if (ExpCountStar (out,nexto) > 2) {
goto error;
}
/*
* Check if the result is actually useful.
* Empty or just a *, or ? are not. A series
* of ?'s is borderline, as they semi-count
* the buffer.
*/
if ((nexto == out) ||
(((nexto-out) == 1) &&
((*out == '*') ||
(*out == '?')))) {
goto error;
}
/*
* Result generation and cleanup.
*/
done:
LOG (stderr,"RESULT_ '%s'\n", xxx(out,nexto-out)); FF;
glob = Tcl_NewUnicodeObj (out,(nexto-out));
goto cleanup;
error:
LOG (stderr,"RESULT_ ERROR\n"); FF;
cleanup:
Tcl_Free ((char*)out);
Tcl_Free ((char*)paren);
return glob;
}
static void
#ifdef _AIX
ExpChopNested (Tcl_UniChar** xstr,
int* xstrlen,
Tcl_UniChar open,
Tcl_UniChar close)
#else
ExpChopNested (xstr,xstrlen, open, close)
Tcl_UniChar** xstr;
int* xstrlen;
Tcl_UniChar open;
Tcl_UniChar close;
#endif
{
Tcl_UniChar* str = *xstr;
int strlen = *xstrlen;
int level = 0;
while (strlen) {
if (MATCHC (open)) {
level ++;
} else if (MATCHC (close)) {
level --;
if (level < 0) {
CHOP (1);
break;
}
}
CHOP (1);
}
*xstr = str;
*xstrlen = strlen;
}
static Tcl_UniChar*
ExpLiteral (nexto, str, strlen)
Tcl_UniChar* nexto;
Tcl_UniChar* str;
int strlen;
{
int lastsz;
LOG (stderr,"LITERAL '%s'\n", xxx(str,strlen)); FF;
while (strlen) {
EMITC (*str);
CHOP (1);
}
return nexto;
}
static Tcl_UniChar
#ifdef _AIX
ExpBackslash (char prefix,
Tcl_UniChar* str,
int strlen)
#else
ExpBackslash (prefix, str, strlen)
char prefix;
Tcl_UniChar* str;
int strlen;
#endif
{
/* strlen <= 8 */
char buf[20];
char dst[TCL_UTF_MAX+1];
Tcl_UniChar ch;
int at = 0;
/* Construct an utf backslash sequence we can throw to Tcl */
buf [at++] = '\\';
buf [at++] = prefix;
while (strlen) {
buf [at++] = *str++;
strlen --;
}
Tcl_UtfBackslash (buf, NULL, dst);
TclUtfToUniChar (dst, &ch);
return ch;
}
static Tcl_UniChar*
ExpCollapseStar (src, last)
Tcl_UniChar* src;
Tcl_UniChar* last;
{
Tcl_UniChar* dst, *base;
int skip = 0;
int star = 0;
/* Collapses series of *'s into a single *. State machine. The
* complexity is due to the need of handling escaped characters.
*/
LOG (stderr,"Q-STAR\n"); FF;
for (dst = base = src; src < last;) {
LOG (stderr,"@%1d /%1d '%s' <-- ", star,skip,xxx(base,dst-base)); FF;
LOG (stderr,"'%s'\n", xxx(src,last-src)); FF;
if (skip) {
skip = 0;
star = 0;
} else if (*src == '\\') {
skip = 1; /* Copy next char, whatever its value */
star = 0;
} else if (*src == '*') {
if (star) {
/* Previous char was *, do not copy the current * to collapse
* the sequence
*/
src++;
continue;
}
star = 1; /* *-series starts here */
} else {
star = 0;
}
*dst++ = *src++;
}
LOG (stderr,"@%1d /%1d '%s' <-- ", star,skip,xxx(base,dst-base)); FF;
LOG (stderr,"'%s'\n", xxx(src,last-src)); FF;
return dst;
}
static Tcl_UniChar*
ExpCollapseQForward (src, last)
Tcl_UniChar* src;
Tcl_UniChar* last;
{
Tcl_UniChar* dst, *base;
int skip = 0;
int quest = 0;
/* Collapses series of ?'s coming after a *. State machine. The
* complexity is due to the need of handling escaped characters.
*/
LOG (stderr,"Q-Forward\n"); FF;
for (dst = base = src; src < last;) {
LOG (stderr,"?%1d /%1d '%s' <-- ", quest,skip,xxx(base,dst-base)); FF;
LOG (stderr,"'%s'\n", xxx(src,last-src)); FF;
if (skip) {
skip = 0;
quest = 0;
} else if (*src == '\\') {
skip = 1;
quest = 0;
/* Copy next char, whatever its value */
} else if (*src == '?') {
if (quest) {
/* Previous char was *, do not copy the current ? to collapse
* the sequence
*/
src++;
continue;
}
} else if (*src == '*') {
quest = 1;
} else {
quest = 0;
}
*dst++ = *src++;
}
LOG (stderr,"?%1d /%1d '%s' <-- ", quest,skip,xxx(base,dst-base)); FF;
LOG (stderr,"'%s'\n", xxx(src,last-src)); FF;
return dst;
}
static Tcl_UniChar*
ExpCollapseQBack (src, last)
Tcl_UniChar* src;
Tcl_UniChar* last;
{
Tcl_UniChar* dst, *base;
int skip = 0;
/* Collapses series of ?'s coming before a *. State machine. The
* complexity is due to the need of handling escaped characters.
*/
LOG (stderr,"Q-Backward\n"); FF;
for (dst = base = src; src < last;) {
LOG (stderr,"/%1d '%s' <-- ",skip,xxx(base,dst-base)); FF;
LOG (stderr,"'%s'\n", xxx(src,last-src)); FF;
if (skip) {
skip = 0;
} else if (*src == '\\') {
skip = 1;
/* Copy next char, whatever its value */
} else if (*src == '*') {
/* Move backward in the output while the previous character is
* an unescaped question mark. If there is a previous character,
* or a character before that..
*/
while ((((dst-base) > 2) && (dst[-1] == '?') && (dst[-2] != '\\')) ||
(((dst-base) == 1) && (dst[-1] == '?'))) {
dst --;
}
}
*dst++ = *src++;
}
LOG (stderr,"/%1d '%s' <-- \n",skip,xxx(base,dst-base)); FF;
LOG (stderr,"'%s'\n", xxx(src,last-src)); FF;
return dst;
}
static int
ExpCountStar (src, last)
Tcl_UniChar* src;
Tcl_UniChar* last;
{
int skip = 0;
int stars = 0;
/* Count number of *'s. State machine. The complexity is due to the
* need of handling escaped characters.
*/
for (; src < last; src++) {
if (skip) {
skip = 0;
} else if (*src == '\\') {
skip = 1;
} else if (*src == '*') {
stars++;
}
}
return stars;
}
#undef CHOP
#undef CHOPC
#undef EMIT
#undef EMITX
#undef MATCH
#undef MATCHC
#undef MATCH_DIGIT
#undef MATCH_HEXDIGIT
#undef PUSHPAREN
#undef UNEMIT