diff options
author | dgp <dgp@users.sourceforge.net> | 2016-11-04 21:29:30 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2016-11-04 21:29:30 (GMT) |
commit | 5f1098561b5067a8f429be371166ed3b1e6189e4 (patch) | |
tree | 67179cf720569f5de357549751755dd9d0332b0e /generic/tclStringObj.c | |
parent | 9bbdc1599de82b388e548191a669524d9b577653 (diff) | |
download | tcl-5f1098561b5067a8f429be371166ed3b1e6189e4.zip tcl-5f1098561b5067a8f429be371166ed3b1e6189e4.tar.gz tcl-5f1098561b5067a8f429be371166ed3b1e6189e4.tar.bz2 |
First draft refactoring the [string first] functionality.
Diffstat (limited to 'generic/tclStringObj.c')
-rw-r--r-- | generic/tclStringObj.c | 84 |
1 files changed, 84 insertions, 0 deletions
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index b486106..6e1529c 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -2841,6 +2841,90 @@ TclStringCatObjv( /* *--------------------------------------------------------------------------- * + * TclStringFind -- + * + * Implements the [string first] operation. + * + * Results: + * If needle is found as a substring of haystack, the index of the + * first instance of such a find is returned. If needle is not present + * as a substring of haystack, -1 is returned. + * + * Side effects: + * needle and haystack may have their Tcl_ObjType changed. + * + *--------------------------------------------------------------------------- + */ + +int +TclStringFind( + Tcl_Obj *needle, + Tcl_Obj *haystack, + unsigned int start) +{ + int ln, lh; + + if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) { + unsigned char *end, *try, *bh; + unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln); + + if (ln == 0) { + /* + * We don't find empty substrings. Bizarre! + * + * TODO: When we one day make this a true substring + * finder, change this to "return 0" + */ + return -1; + } + + bh = Tcl_GetByteArrayFromObj(haystack, &lh); + end = bh + lh; + + try = bh + start; + while (try + ln <= end) { + try = memchr(try, bn[0], end - try); + + if (try == NULL) { + return -1; + } + if (0 == memcmp(try+1, bn+1, ln-1)) { + return (try - bh); + } + try++; + } + return -1; + } + + /* TODO: Detect and optimize case with single byte chars only */ + + { + Tcl_UniChar *try, *end, *uh; + Tcl_UniChar *un = Tcl_GetUnicodeFromObj(needle, &ln); + + if (ln == 0) { + /* See above */ + return -1; + } + + uh = Tcl_GetUnicodeFromObj(haystack, &lh); + end = uh + lh; + + try = uh + start; + while (try + ln <= end) { + if ((*try == *un) + && (0 == memcmp(try+1, un+1, (ln-1)*sizeof(Tcl_UniChar)))) { + return (try - uh); + } + try++; + } + return -1; + } +} + +/* + *--------------------------------------------------------------------------- + * * TclStringObjReverse -- * * Implements the [string reverse] operation. |