aboutsummaryrefslogtreecommitdiff
path: root/jim.c
diff options
context:
space:
mode:
authorSteve Bennett <steveb@workware.net.au>2021-01-24 10:35:50 +1000
committerSteve Bennett <steveb@workware.net.au>2021-01-30 10:00:11 +1000
commitfcb7f66be6f8b7012505bfa93674aef98a26f9d6 (patch)
treedfb8bf2d418a222cd4c0e9bb757b272d2f3a6511 /jim.c
parent43e71ad476f4c96815baf973f27e4c8006ebb33f (diff)
downloadjimtcl-fcb7f66be6f8b7012505bfa93674aef98a26f9d6.zip
jimtcl-fcb7f66be6f8b7012505bfa93674aef98a26f9d6.tar.gz
jimtcl-fcb7f66be6f8b7012505bfa93674aef98a26f9d6.tar.bz2
lsearch, lsort: support for -stride and -index
Add -stride support to both lsearch and lsort Add -index support to lsearch Improve -index for lsort to support multiple indices Also harmonise some error messages with Tcl 8.7 Signed-off-by: Steve Bennett <steveb@workware.net.au>
Diffstat (limited to 'jim.c')
-rw-r--r--jim.c285
1 files changed, 223 insertions, 62 deletions
diff --git a/jim.c b/jim.c
index 7c54628..9c4406e 100644
--- a/jim.c
+++ b/jim.c
@@ -139,6 +139,8 @@ static char JimEmptyStringRep[] = "";
static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action);
static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int listindex, Jim_Obj *newObjPtr,
int flags);
+static int Jim_ListIndices(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *const *indexv, int indexc,
+ Jim_Obj **resultObj, int flags);
static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands);
static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr);
static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
@@ -6722,7 +6724,7 @@ Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
* sure that the list object can't shimmer while the vector returned
* is in use, this vector is the one stored inside the internal representation
* of the list object. This function is not exported, extensions should
- * always access to the List object elements using Jim_ListIndex(). */
+ * always access to the List object elements using Jim_ListGetIndex(). */
static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
Jim_Obj ***listVec)
{
@@ -6755,8 +6757,8 @@ struct lsort_info {
JIM_LSORT_COMMAND
} type;
int order;
- int index;
- int indexed;
+ Jim_Obj **indexv;
+ int indexc;
int unique;
int (*subfn)(Jim_Obj **, Jim_Obj **);
};
@@ -6767,8 +6769,8 @@ static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
{
Jim_Obj *lObj, *rObj;
- if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
- Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
+ if (Jim_ListIndices(sort_info->interp, *lhsObj, sort_info->indexv, sort_info->indexc, &lObj, JIM_ERRMSG) != JIM_OK ||
+ Jim_ListIndices(sort_info->interp, *rhsObj, sort_info->indexv, sort_info->indexc, &rObj, JIM_ERRMSG) != JIM_OK) {
longjmp(sort_info->jmpbuf, JIM_ERR);
}
return sort_info->subfn(&lObj, &rObj);
@@ -6910,7 +6912,7 @@ static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsor
return -1; /* Should not be run but keeps static analysers happy */
}
- if (info->indexed) {
+ if (info->indexc) {
/* Need to interpose a "list index" function */
info->subfn = fn;
fn = ListSortIndexHelper;
@@ -7059,6 +7061,57 @@ int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPt
return JIM_OK;
}
+/* Get the value from the list associated to the specified list indices.
+ * Return JIM_ERR if an index is invalid (and sets an error message).
+ * Returns -1 if the list index is out of range.
+ * In this case, if flags includes JIM_ERRMSG, an error result is set.
+ * Otherwise, returns JIM_OK and sets *resultObj to the indexed value.
+ * (This is the only case where *resultObj is set)
+ */
+static int Jim_ListIndices(Jim_Interp *interp, Jim_Obj *listPtr,
+ Jim_Obj *const *indexv, int indexc, Jim_Obj **resultObj, int flags)
+{
+ int i;
+ int static_idxes[5];
+ int *idxes = static_idxes;
+ int ret = JIM_OK;
+
+ if (indexc > sizeof(static_idxes) / sizeof(*static_idxes)) {
+ idxes = Jim_Alloc(indexc * sizeof(*idxes));
+ }
+
+ /* In the rare, contrived case where an index is also the list (or an element)
+ * we need to extract the indices first.
+ */
+ for (i = 0; i < indexc; i++) {
+ ret = Jim_GetIndex(interp, indexv[i], &idxes[i]);
+ if (ret != JIM_OK) {
+ goto err;
+ }
+ }
+
+ for (i = 0; i < indexc; i++) {
+ Jim_Obj *objPtr = Jim_ListGetIndex(interp, listPtr, idxes[i]);
+ if (!objPtr) {
+ if (flags & JIM_ERRMSG) {
+ if (idxes[i] < 0 || idxes[i] > Jim_ListLength(interp, listPtr)) {
+ Jim_SetResultFormatted(interp, "index \"%#s\" out of range", indexv[i]);
+ }
+ else {
+ Jim_SetResultFormatted(interp, "element %#s missing from sublist \"%#s\"", indexv[i], listPtr);
+ }
+ }
+ return -1;
+ }
+ listPtr = objPtr;
+ }
+ *resultObj = listPtr;
+err:
+ if (idxes != static_idxes)
+ Jim_Free(idxes);
+ return ret;
+}
+
static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
Jim_Obj *newObjPtr, int flags)
{
@@ -7096,7 +7149,10 @@ int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
listObjPtr = objPtr;
if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
goto err;
- if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
+
+ objPtr = Jim_ListGetIndex(interp, listObjPtr, idx);
+ if (objPtr == NULL) {
+ Jim_SetResultFormatted(interp, "index \"%#s\" out of range", indexv[i]);
goto err;
}
if (Jim_IsShared(objPtr)) {
@@ -12694,35 +12750,24 @@ static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg
/* [lindex] */
static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
{
- Jim_Obj *objPtr, *listObjPtr;
- int i;
- int idx;
+ Jim_Obj *objPtr;
+ int ret;
if (argc < 2) {
Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?");
return JIM_ERR;
}
- objPtr = argv[1];
- Jim_IncrRefCount(objPtr);
- for (i = 2; i < argc; i++) {
- listObjPtr = objPtr;
- if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
- Jim_DecrRefCount(interp, listObjPtr);
- return JIM_ERR;
- }
- if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
- /* Returns an empty object if the index
- * is out of range. */
- Jim_DecrRefCount(interp, listObjPtr);
- Jim_SetEmptyResult(interp);
- return JIM_OK;
- }
- Jim_IncrRefCount(objPtr);
- Jim_DecrRefCount(interp, listObjPtr);
+ ret = Jim_ListIndices(interp, argv[1], argv + 2, argc - 2, &objPtr, JIM_NONE);
+ if (ret < 0) {
+ /* Returns an empty object if the index
+ * is out of range. */
+ ret = JIM_OK;
+ Jim_SetEmptyResult(interp);
}
- Jim_SetResult(interp, objPtr);
- Jim_DecrRefCount(interp, objPtr);
- return JIM_OK;
+ else if (ret == JIM_OK) {
+ Jim_SetResult(interp, objPtr);
+ }
+ return ret;
}
/* [llength] */
@@ -12741,11 +12786,11 @@ static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *
{
static const char * const options[] = {
"-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
- NULL
+ "-stride", "-index", NULL
};
enum
{ OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
- OPT_COMMAND };
+ OPT_COMMAND, OPT_STRIDE, OPT_INDEX };
int i;
int opt_bool = 0;
int opt_not = 0;
@@ -12756,12 +12801,14 @@ static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *
int rc = JIM_OK;
Jim_Obj *listObjPtr = NULL;
Jim_Obj *commandObj = NULL;
+ Jim_Obj *indexObj = NULL;
int match_flags = 0;
+ long stride = 1;
if (argc < 3) {
wrongargs:
Jim_WrongNumArgs(interp, 1, argv,
- "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
+ "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? ?-stride len? ?-index val? list value");
return JIM_ERR;
}
@@ -12803,6 +12850,24 @@ static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *
case OPT_GLOB:
opt_match = option;
break;
+ case OPT_INDEX:
+ if (i >= argc - 2) {
+ goto wrongargs;
+ }
+ indexObj = argv[++i];
+ break;
+ case OPT_STRIDE:
+ if (i >= argc - 2) {
+ goto wrongargs;
+ }
+ if (Jim_GetLong(interp, argv[++i], &stride) != JIM_OK) {
+ return JIM_ERR;
+ }
+ if (stride < 1) {
+ Jim_SetResultString(interp, "stride length must be at least 1", -1);
+ return JIM_ERR;
+ }
+ break;
}
}
@@ -12812,6 +12877,12 @@ static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *
}
argv += i;
+ listlen = Jim_ListLength(interp, argv[0]);
+ if (listlen % stride) {
+ Jim_SetResultString(interp, "list size must be a multiple of the stride length", -1);
+ return JIM_ERR;
+ }
+
if (opt_all) {
listObjPtr = Jim_NewListObj(interp, NULL, 0);
}
@@ -12822,10 +12893,41 @@ static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *
Jim_IncrRefCount(commandObj);
}
- listlen = Jim_ListLength(interp, argv[0]);
- for (i = 0; i < listlen; i++) {
+ for (i = 0; i < listlen; i += stride) {
int eq = 0;
- Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i);
+ Jim_Obj *searchListObj;
+ Jim_Obj *objPtr;
+ int offset;
+
+ if (indexObj) {
+ int indexlen = Jim_ListLength(interp, indexObj);
+ if (stride == 1) {
+ searchListObj = Jim_ListGetIndex(interp, argv[0], i);
+ }
+ else {
+ searchListObj = Jim_NewListObj(interp, argv[0]->internalRep.listValue.ele + i, stride);
+ }
+ Jim_IncrRefCount(searchListObj);
+ rc = Jim_ListIndices(interp, searchListObj, indexObj->internalRep.listValue.ele, indexlen, &objPtr, JIM_ERRMSG);
+ if (rc != JIM_OK) {
+ Jim_DecrRefCount(interp, searchListObj);
+ rc = JIM_ERR;
+ goto done;
+ }
+ /* now indexObj is the object to compare */
+ offset = 0;
+ }
+ else {
+ /* No -index, so we have an implicit {0} as indexObj */
+ searchListObj = argv[0];
+ offset = i;
+ objPtr = Jim_ListGetIndex(interp, searchListObj, i);
+ Jim_IncrRefCount(searchListObj);
+ }
+ /* At this point objPtr represents the object to search against and
+ * searchListObj represents the list we search in (offset .. offset + stride - 1)
+ * both need to have reference counts decremented when done
+ */
switch (opt_match) {
case OPT_EXACT:
@@ -12840,22 +12942,15 @@ static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *
case OPT_COMMAND:
eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, match_flags);
if (eq < 0) {
- if (listObjPtr) {
- Jim_FreeNewObj(interp, listObjPtr);
- }
+ Jim_DecrRefCount(interp, searchListObj);
rc = JIM_ERR;
goto done;
}
break;
}
- /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
- if (!eq && opt_bool && opt_not && !opt_all) {
- continue;
- }
-
+ /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
- /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
Jim_Obj *resultObj;
if (opt_bool) {
@@ -12864,22 +12959,36 @@ static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *
else if (!opt_inline) {
resultObj = Jim_NewIntObj(interp, i);
}
- else {
+ else if (stride == 1) {
resultObj = objPtr;
}
+ else if (opt_all) {
+ /* Add the entire sublist directly for -all -stride > 1 */
+ ListInsertElements(listObjPtr, -1, stride,
+ searchListObj->internalRep.listValue.ele + offset);
+ }
+ else {
+ resultObj = Jim_NewListObj(interp, searchListObj->internalRep.listValue.ele + offset, stride);
+ }
if (opt_all) {
- Jim_ListAppendElement(interp, listObjPtr, resultObj);
+ /* The stride > 1 case has already been handled above */
+ if (stride == 1) {
+ Jim_ListAppendElement(interp, listObjPtr, resultObj);
+ }
}
else {
Jim_SetResult(interp, resultObj);
+ Jim_DecrRefCount(interp, searchListObj);
goto done;
}
}
+ Jim_DecrRefCount(interp, searchListObj);
}
if (opt_all) {
Jim_SetResult(interp, listObjPtr);
+ listObjPtr = NULL;
}
else {
/* No match */
@@ -12892,6 +13001,9 @@ static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *
}
done:
+ if (listObjPtr) {
+ Jim_FreeNewObj(interp, listObjPtr);
+ }
if (commandObj) {
Jim_DecrRefCount(interp, commandObj);
}
@@ -13028,25 +13140,30 @@ static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg
static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
{
static const char * const options[] = {
- "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
+ "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique",
+ "-stride", NULL
+ };
+ enum {
+ OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE,
+ OPT_STRIDE
};
- enum
- { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
Jim_Obj *resObj;
int i;
int retCode;
int shared;
+ long stride = 1;
struct lsort_info info;
if (argc < 2) {
+wrongargs:
Jim_WrongNumArgs(interp, 1, argv, "?options? list");
return JIM_ERR;
}
info.type = JIM_LSORT_ASCII;
info.order = 1;
- info.indexed = 0;
+ info.indexc = 0;
info.unique = 0;
info.command = NULL;
info.interp = interp;
@@ -13088,28 +13205,72 @@ static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const arg
info.command = argv[i + 1];
i++;
break;
+ case OPT_STRIDE:
+ if (i >= argc - 2) {
+ goto wrongargs;
+ }
+ if (Jim_GetLong(interp, argv[++i], &stride) != JIM_OK) {
+ return JIM_ERR;
+ }
+ if (stride < 2) {
+ Jim_SetResultString(interp, "stride length must be at least 2", -1);
+ return JIM_ERR;
+ }
+ break;
case OPT_INDEX:
if (i >= (argc - 2)) {
+badindex:
Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
return JIM_ERR;
}
- if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
- return JIM_ERR;
+ JimListGetElements(interp, argv[i + 1], &info.indexc, &info.indexv);
+ if (info.indexc == 0) {
+ goto badindex;
}
- info.indexed = 1;
i++;
break;
}
}
resObj = argv[argc - 1];
- if ((shared = Jim_IsShared(resObj)))
- resObj = Jim_DuplicateObj(interp, resObj);
- retCode = ListSortElements(interp, resObj, &info);
- if (retCode == JIM_OK) {
- Jim_SetResult(interp, resObj);
- }
- else if (shared) {
- Jim_FreeNewObj(interp, resObj);
+ if (stride > 1) {
+ Jim_Obj *tmpListObj;
+ Jim_Obj **elements;
+ int listlen;
+ int i;
+
+ JimListGetElements(interp, resObj, &listlen, &elements);
+ if (listlen % stride) {
+ Jim_SetResultString(interp, "list size must be a multiple of the stride length", -1);
+ return JIM_ERR;
+ }
+ /* Need to create a new list of lists for sorting */
+ tmpListObj = Jim_NewListObj(interp, NULL, 0);
+ Jim_IncrRefCount(tmpListObj);
+ for (i = 0; i < listlen; i += stride) {
+ Jim_ListAppendElement(interp, tmpListObj, Jim_NewListObj(interp, elements + i, stride));
+ }
+ retCode = ListSortElements(interp, tmpListObj, &info);
+ if (retCode == JIM_OK) {
+ resObj = Jim_NewListObj(interp, NULL, 0);
+ /* Now we need to unpack the result back into a flat list */
+ for (i = 0; i < listlen; i += stride) {
+ Jim_ListAppendList(interp, resObj, Jim_ListGetIndex(interp, tmpListObj, i / stride));
+ }
+ Jim_SetResult(interp, resObj);
+ }
+ Jim_DecrRefCount(interp, tmpListObj);
+ }
+ else {
+ if ((shared = Jim_IsShared(resObj))) {
+ resObj = Jim_DuplicateObj(interp, resObj);
+ }
+ retCode = ListSortElements(interp, resObj, &info);
+ if (retCode == JIM_OK) {
+ Jim_SetResult(interp, resObj);
+ }
+ else if (shared) {
+ Jim_FreeNewObj(interp, resObj);
+ }
}
return retCode;
}