summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/lseq.n92
-rwxr-xr-xgeneric/tclArithSeries.c952
-rw-r--r--generic/tclArithSeries.h54
-rw-r--r--generic/tclBasic.c1
-rw-r--r--generic/tclCmdAH.c54
-rw-r--r--generic/tclCmdIL.c507
-rw-r--r--generic/tclExecute.c55
-rw-r--r--generic/tclInt.h4
-rw-r--r--generic/tclListObj.c68
-rw-r--r--tests/lseq.test482
-rw-r--r--tests/range.test0
-rw-r--r--unix/Makefile.in11
-rw-r--r--win/Makefile.in1
-rw-r--r--win/makefile.vc1
14 files changed, 2245 insertions, 37 deletions
diff --git a/doc/lseq.n b/doc/lseq.n
new file mode 100644
index 0000000..5c7d03b
--- /dev/null
+++ b/doc/lseq.n
@@ -0,0 +1,92 @@
+'\"
+'\" Copyright (c) 2022 Eric Taylor. All rights reserved.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH lseq n 8.7 Tcl "Tcl Built-In Commands"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+lseq \- Build a numeric sequence returned as a list
+.SH SYNOPSIS
+\fBlseq \fIStart \fR?(\fB..\fR|\fBto\fR)? \fIEnd\fR ??\fBby\fR? \fIStep\fR?
+
+\fBlseq \fIStart \fBcount\fR \fICount\fR ??\fBby\fR? \fIStep\fR?
+
+\fBlseq \fICount\fR ?\fBby \fIStep\fR?
+.BE
+.SH DESCRIPTION
+.PP
+The \fBlseq\fR command creates a sequence of numeric values using the given
+parameters \fIStart\fR, \fIEnd\fR, and \fIStep\fR. The \fIoperation\fR
+argument ".." or "to" defines an inclusive range. The "count" option is used
+to define a count of the number of elements in the list. The short form with a
+single count value will create a range from 0 to count-1.
+
+The numeric arguments, \fIStart\fR, \fIEnd\fR, \fIStep\fR, and \fICount\fR,
+can also be a valid expression. the lseq command will evaluate the expression
+and use the numeric result, or return an error as with any invalid argument
+value. A valid expression is a valid [expr] expression, however, the result
+must be numeric; a non-numeric string will result in an error.
+
+.SH EXAMPLES
+.CS
+.\"
+
+ lseq 3
+ \(-> 0 1 2
+
+ lseq 3 0
+ \(-> 3 2 1 0
+
+ lseq 10 .. 1 by -2
+ \(-> 10 8 6 4 2
+
+ set l [lseq 0 -5]
+ \(-> 0 -1 -2 -3 -4 -5
+
+ foreach i [lseq [llength $l]] {
+ puts l($i)=[lindex $l $i]
+ }
+ \(-> l(0)=0
+ l(1)=-1
+ l(2)=-2
+ l(3)=-3
+ l(4)=-4
+ l(5)=-5
+
+ foreach i [lseq [llength $l]-1 0] {
+ puts l($i)=[lindex $l $i]
+ }
+ \(-> l(5)=-5
+ l(4)=-4
+ l(3)=-3
+ l(2)=-2
+ l(1)=-1
+ l(0)=0
+
+ set i 17
+ \(-> 17
+ if {$i in [lseq 0 50]} { # equivalent to: (0 <= $i && $i < 50)
+ puts "Ok"
+ } else {
+ puts "outside :("
+ }
+ \(-> Ok
+
+ set sqrs [lmap i [lseq 1 10] {expr $i*$i}]
+ \(-> 1 4 9 16 25 36 49 64 81 100
+.\"
+.CE
+.SH "SEE ALSO"
+foreach(n), list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n),
+lmap(n), lpop(n), lrange(n), lremove(n), lreplace(n),
+lreverse(n), lsearch(n), lset(n), lsort(n)
+.SH KEYWORDS
+element, index, list
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c
new file mode 100755
index 0000000..93177a7
--- /dev/null
+++ b/generic/tclArithSeries.c
@@ -0,0 +1,952 @@
+/*
+ * tclArithSeries.c --
+ *
+ * This file contains the ArithSeries concrete abstract list
+ * implementation. It implements the inner workings of the lseq command.
+ *
+ * Copyright © 2022 Brian S. Griffin.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tclInt.h"
+#include "tclArithSeries.h"
+#include <assert.h>
+
+/* -------------------------- ArithSeries object ---------------------------- */
+
+
+#define ArithSeriesRepPtr(arithSeriesObjPtr) \
+ (ArithSeries *) ((arithSeriesObjPtr)->internalRep.twoPtrValue.ptr1)
+
+#define ArithSeriesIndexM(arithSeriesRepPtr, index) \
+ ((arithSeriesRepPtr)->isDouble ? \
+ (((ArithSeriesDbl*)(arithSeriesRepPtr))->start+((index) * ((ArithSeriesDbl*)(arithSeriesRepPtr))->step)) \
+ : \
+ ((arithSeriesRepPtr)->start+((index) * arithSeriesRepPtr->step)))
+
+#define ArithSeriesGetInternalRep(objPtr, arithRepPtr) \
+ do { \
+ const Tcl_ObjInternalRep *irPtr; \
+ irPtr = TclFetchInternalRep((objPtr), &tclArithSeriesType); \
+ (arithRepPtr) = irPtr ? (ArithSeries *)irPtr->twoPtrValue.ptr1 : NULL; \
+ } while (0)
+
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static void DupArithSeriesInternalRep (Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
+static void FreeArithSeriesInternalRep (Tcl_Obj *listPtr);
+static int SetArithSeriesFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr);
+static void UpdateStringOfArithSeries (Tcl_Obj *listPtr);
+
+/*
+ * The structure below defines the arithmetic series Tcl object type by
+ * means of procedures that can be invoked by generic object code.
+ *
+ * The arithmetic series object is a special case of Tcl list representing
+ * an interval of an arithmetic series in constant space.
+ *
+ * The arithmetic series is internally represented with three integers,
+ * *start*, *end*, and *step*, Where the length is calculated with
+ * the following algorithm:
+ *
+ * if RANGE == 0 THEN
+ * ERROR
+ * if RANGE > 0
+ * LEN is (((END-START)-1)/STEP) + 1
+ * else if RANGE < 0
+ * LEN is (((END-START)-1)/STEP) - 1
+ *
+ * And where the equivalent's list I-th element is calculated
+ * as:
+ *
+ * LIST[i] = START+(STEP*i)
+ *
+ * Zero elements ranges, like in the case of START=10 END=10 STEP=1
+ * are valid and will be equivalent to the empty list.
+ */
+
+const Tcl_ObjType tclArithSeriesType = {
+ "arithseries", /* name */
+ FreeArithSeriesInternalRep, /* freeIntRepProc */
+ DupArithSeriesInternalRep, /* dupIntRepProc */
+ UpdateStringOfArithSeries, /* updateStringProc */
+ SetArithSeriesFromAny /* setFromAnyProc */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ArithSeriesLen --
+ *
+ * Compute the length of the equivalent list where
+ * every element is generated starting from *start*,
+ * and adding *step* to generate every successive element
+ * that's < *end* for positive steps, or > *end* for negative
+ * steps.
+ *
+ * Results:
+ *
+ * The length of the list generated by the given range,
+ * that may be zero.
+ * The function returns -1 if the list is of length infinite.
+ *
+ * Side effects:
+ *
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+static Tcl_WideInt
+ArithSeriesLen(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step)
+{
+ Tcl_WideInt len;
+
+ if (step == 0) return 0;
+ len = (step ? (1 + (((end-start))/step)) : 0);
+ return (len < 0) ? -1 : len;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNewArithSeriesInt --
+ *
+ * Creates a new ArithSeries object. The returned object has
+ * refcount = 0.
+ *
+ * Results:
+ *
+ * A Tcl_Obj pointer to the created ArithSeries object.
+ * A NULL pointer of the range is invalid.
+ *
+ * Side Effects:
+ *
+ * None.
+ *----------------------------------------------------------------------
+ */
+Tcl_Obj *
+TclNewArithSeriesInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step, Tcl_WideInt len)
+{
+ Tcl_WideInt length = (len>=0 ? len : ArithSeriesLen(start, end, step));
+ Tcl_Obj *arithSeriesPtr;
+ ArithSeries *arithSeriesRepPtr;
+
+ TclNewObj(arithSeriesPtr);
+
+ if (length <= 0) {
+ return arithSeriesPtr;
+ }
+
+ arithSeriesRepPtr = (ArithSeries*) ckalloc(sizeof (ArithSeries));
+ arithSeriesRepPtr->isDouble = 0;
+ arithSeriesRepPtr->start = start;
+ arithSeriesRepPtr->end = end;
+ arithSeriesRepPtr->step = step;
+ arithSeriesRepPtr->len = length;
+ arithSeriesRepPtr->elements = NULL;
+ arithSeriesPtr->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr;
+ arithSeriesPtr->internalRep.twoPtrValue.ptr2 = NULL;
+ arithSeriesPtr->typePtr = &tclArithSeriesType;
+ if (length > 0)
+ Tcl_InvalidateStringRep(arithSeriesPtr);
+
+ return arithSeriesPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNewArithSeriesDbl --
+ *
+ * Creates a new ArithSeries object with doubles. The returned object has
+ * refcount = 0.
+ *
+ * Results:
+ *
+ * A Tcl_Obj pointer to the created ArithSeries object.
+ * A NULL pointer of the range is invalid.
+ *
+ * Side Effects:
+ *
+ * None.
+ *----------------------------------------------------------------------
+ */
+Tcl_Obj *
+TclNewArithSeriesDbl(double start, double end, double step, Tcl_WideInt len)
+{
+ Tcl_WideInt length = (len>=0 ? len : ArithSeriesLen(start, end, step));
+ Tcl_Obj *arithSeriesPtr;
+ ArithSeriesDbl *arithSeriesRepPtr;
+
+ TclNewObj(arithSeriesPtr);
+
+ if (length <= 0) {
+ return arithSeriesPtr;
+ }
+
+ arithSeriesRepPtr = (ArithSeriesDbl*) ckalloc(sizeof (ArithSeriesDbl));
+ arithSeriesRepPtr->isDouble = 1;
+ arithSeriesRepPtr->start = start;
+ arithSeriesRepPtr->end = end;
+ arithSeriesRepPtr->step = step;
+ arithSeriesRepPtr->len = length;
+ arithSeriesRepPtr->elements = NULL;
+ arithSeriesPtr->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr;
+ arithSeriesPtr->internalRep.twoPtrValue.ptr2 = NULL;
+ arithSeriesPtr->typePtr = &tclArithSeriesType;
+ if (length > 0)
+ Tcl_InvalidateStringRep(arithSeriesPtr);
+
+ return arithSeriesPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * assignNumber --
+ *
+ * Create the appropriate Tcl_Obj value for the given numeric values.
+ * Used locally only for decoding [lseq] numeric arguments.
+ * refcount = 0.
+ *
+ * Results:
+ *
+ * A Tcl_Obj pointer.
+ * No assignment on error.
+ *
+ * Side Effects:
+ *
+ * None.
+ *----------------------------------------------------------------------
+ */
+static void
+assignNumber(int useDoubles, Tcl_WideInt *intNumberPtr, double *dblNumberPtr, Tcl_Obj *numberObj)
+{
+ union {
+ double d;
+ Tcl_WideInt i;
+ } *number;
+ int tcl_number_type;
+
+ if (TclGetNumberFromObj(NULL, numberObj, (ClientData*)&number, &tcl_number_type) != TCL_OK) {
+ return;
+ }
+ if (useDoubles) {
+ if (tcl_number_type == TCL_NUMBER_DOUBLE) {
+ *dblNumberPtr = number->d;
+ } else {
+ *dblNumberPtr = (double)number->i;
+ }
+ } else {
+ if (tcl_number_type == TCL_NUMBER_INT) {
+ *intNumberPtr = number->i;
+ } else {
+ *intNumberPtr = (Tcl_WideInt)number->d;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNewArithSeriesObj --
+ *
+ * Creates a new ArithSeries object. Some arguments may be NULL and will
+ * be computed based on the other given arguments.
+ * refcount = 0.
+ *
+ * Results:
+ *
+ * A Tcl_Obj pointer to the created ArithSeries object.
+ * An empty Tcl_Obj if the range is invalid.
+ *
+ * Side Effects:
+ *
+ * None.
+ *----------------------------------------------------------------------
+ */
+Tcl_Obj *
+TclNewArithSeriesObj(int useDoubles, Tcl_Obj *startObj, Tcl_Obj *endObj, Tcl_Obj *stepObj, Tcl_Obj *lenObj)
+{
+ double dstart, dend, dstep;
+ Tcl_WideInt start, end, step, len;
+
+ if (startObj) {
+ assignNumber(useDoubles, &start, &dstart, startObj);
+ } else {
+ start = 0;
+ dstart = start;
+ }
+ if (stepObj) {
+ assignNumber(useDoubles, &step, &dstep, stepObj);
+ if (useDoubles) {
+ step = dstep;
+ } else {
+ dstep = step;
+ }
+ if (dstep == 0) {
+ return Tcl_NewObj();
+ }
+ }
+ if (endObj) {
+ assignNumber(useDoubles, &end, &dend, endObj);
+ }
+ if (lenObj) {
+ Tcl_GetWideIntFromObj(NULL, lenObj, &len);
+ }
+
+ if (startObj && endObj) {
+ if (!stepObj) {
+ if (useDoubles) {
+ dstep = (dstart < dend) ? 1.0 : -1.0;
+ step = dstep;
+ } else {
+ step = (start < end) ? 1 : -1;
+ dstep = step;
+ }
+ }
+ assert(dstep!=0);
+ if (!lenObj) {
+ if (useDoubles) {
+ len = (dend - dstart + dstep)/dstep;
+ } else {
+ len = (end - start + step)/step;
+ }
+ }
+ }
+
+ if (!endObj) {
+ if (useDoubles) {
+ dend = dstart + (dstep * (len-1));
+ end = dend;
+ } else {
+ end = start + (step * (len-1));
+ dend = end;
+ }
+ }
+
+ if (useDoubles) {
+ return TclNewArithSeriesDbl(dstart, dend, dstep, len);
+ } else {
+ return TclNewArithSeriesInt(start, end, step, len);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclArithSeriesObjStep --
+ *
+ * Return a Tcl_Obj with the step value from the give ArithSeries Obj.
+ * refcount = 0.
+ *
+ * Results:
+ *
+ * A Tcl_Obj pointer to the created ArithSeries object.
+ * A NULL pointer of the range is invalid.
+ *
+ * Side Effects:
+ *
+ * None.
+ *----------------------------------------------------------------------
+ */
+/*
+ * TclArithSeriesObjStep --
+ */
+int
+TclArithSeriesObjStep(
+ Tcl_Obj *arithSeriesPtr,
+ Tcl_Obj **stepObj)
+{
+ ArithSeries *arithSeriesRepPtr;
+
+ if (arithSeriesPtr->typePtr != &tclArithSeriesType) {
+ Tcl_Panic("TclArithSeriesObjIndex called with a not ArithSeries Obj.");
+ }
+ arithSeriesRepPtr = ArithSeriesRepPtr(arithSeriesPtr);
+ if (arithSeriesRepPtr->isDouble) {
+ *stepObj = Tcl_NewDoubleObj(((ArithSeriesDbl*)(arithSeriesRepPtr))->step);
+ } else {
+ *stepObj = Tcl_NewWideIntObj(arithSeriesRepPtr->step);
+ }
+ return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclArithSeriesObjIndex --
+ *
+ * Returns the element with the specified index in the list
+ * represented by the specified Arithmetic Sequence object.
+ * If the index is out of range, TCL_ERROR is returned,
+ * otherwise TCL_OK is returned and the integer value of the
+ * element is stored in *element.
+ *
+ * Results:
+ *
+ * TCL_OK on success, TCL_ERROR on index out of range.
+ *
+ * Side Effects:
+ *
+ * On success, the integer pointed by *element is modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclArithSeriesObjIndex(Tcl_Obj *arithSeriesPtr, Tcl_WideInt index, Tcl_Obj **elementObj)
+{
+ ArithSeries *arithSeriesRepPtr;
+
+ if (arithSeriesPtr->typePtr != &tclArithSeriesType) {
+ Tcl_Panic("TclArithSeriesObjIndex called with a not ArithSeries Obj.");
+ }
+ arithSeriesRepPtr = ArithSeriesRepPtr(arithSeriesPtr);
+ if (index < 0 || index >= arithSeriesRepPtr->len) {
+ return TCL_ERROR;
+ }
+ /* List[i] = Start + (Step * index) */
+ if (arithSeriesRepPtr->isDouble) {
+ *elementObj = Tcl_NewDoubleObj(ArithSeriesIndexM(arithSeriesRepPtr, index));
+ } else {
+ *elementObj = Tcl_NewWideIntObj(ArithSeriesIndexM(arithSeriesRepPtr, index));
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclArithSeriesObjLength
+ *
+ * Returns the length of the arithmetic series.
+ *
+ * Results:
+ *
+ * The length of the series as Tcl_WideInt.
+ *
+ * Side Effects:
+ *
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+Tcl_WideInt TclArithSeriesObjLength(Tcl_Obj *arithSeriesPtr)
+{
+ ArithSeries *arithSeriesRepPtr = (ArithSeries*)
+ arithSeriesPtr->internalRep.twoPtrValue.ptr1;
+ return arithSeriesRepPtr->len;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeArithSeriesInternalRep --
+ *
+ * Deallocate the storage associated with an arithseries object's
+ * internal representation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees arithSeriesPtr's ArithSeries* internal representation and
+ * sets listPtr's internalRep.twoPtrValue.ptr1 to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeArithSeriesInternalRep(Tcl_Obj *arithSeriesPtr)
+{
+ ArithSeries *arithSeriesRepPtr =
+ (ArithSeries *) arithSeriesPtr->internalRep.twoPtrValue.ptr1;
+ if (arithSeriesRepPtr->elements) {
+ Tcl_WideInt i;
+ Tcl_Obj**elmts = arithSeriesRepPtr->elements;
+ for(i=0; i<arithSeriesRepPtr->len; i++) {
+ if (elmts[i]) {
+ Tcl_DecrRefCount(elmts[i]);
+ }
+ }
+ ckfree((char *) arithSeriesRepPtr->elements);
+ }
+ ckfree((char *) arithSeriesRepPtr);
+ arithSeriesPtr->internalRep.twoPtrValue.ptr1 = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupArithSeriesInternalRep --
+ *
+ * Initialize the internal representation of a arithseries Tcl_Obj to a
+ * copy of the internal representation of an existing arithseries object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * We set "copyPtr"s internal rep to a pointer to a
+ * newly allocated ArithSeries structure.
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupArithSeriesInternalRep(
+ Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
+ Tcl_Obj *copyPtr) /* Object with internal rep to set. */
+{
+ ArithSeries *srcArithSeriesRepPtr =
+ (ArithSeries *) srcPtr->internalRep.twoPtrValue.ptr1;
+ ArithSeries *copyArithSeriesRepPtr;
+
+ /*
+ * Allocate a new ArithSeries structure. */
+
+ copyArithSeriesRepPtr = (ArithSeries*) ckalloc(sizeof(ArithSeries));
+ *copyArithSeriesRepPtr = *srcArithSeriesRepPtr;
+ copyArithSeriesRepPtr->elements = NULL;
+ copyPtr->internalRep.twoPtrValue.ptr1 = copyArithSeriesRepPtr;
+ copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
+ copyPtr->typePtr = &tclArithSeriesType;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfArithSeries --
+ *
+ * Update the string representation for an arithseries object.
+ * Note: This procedure does not invalidate an existing old string rep
+ * so storage will be lost if this has not already been done.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The object's string is set to a valid string that results from
+ * the list-to-string conversion. This string will be empty if the
+ * list has no elements. The list internal representation
+ * should not be NULL and we assume it is not NULL.
+ *
+ * Notes:
+ * At the cost of overallocation it's possible to estimate
+ * the length of the string representation and make this procedure
+ * much faster. Because the programmer shouldn't expect the
+ * string conversion of a big arithmetic sequence to be fast
+ * this version takes more care of space than time.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfArithSeries(Tcl_Obj *arithSeriesPtr)
+{
+ ArithSeries *arithSeriesRepPtr =
+ (ArithSeries*) arithSeriesPtr->internalRep.twoPtrValue.ptr1;
+ char *elem, *p;
+ Tcl_Obj *elemObj;
+ Tcl_WideInt i;
+ Tcl_WideInt length = 0;
+ int slen;
+
+ /*
+ * Pass 1: estimate space.
+ */
+ for (i = 0; i < arithSeriesRepPtr->len; i++) {
+ TclArithSeriesObjIndex(arithSeriesPtr, i, &elemObj);
+ elem = TclGetStringFromObj(elemObj, &slen);
+ Tcl_DecrRefCount(elemObj);
+ slen += 1; /* + 1 is for the space or the nul-term */
+ length += slen;
+ }
+
+ /*
+ * Pass 2: generate the string repr.
+ */
+
+ p = Tcl_InitStringRep(arithSeriesPtr, NULL, length);
+ for (i = 0; i < arithSeriesRepPtr->len; i++) {
+ TclArithSeriesObjIndex(arithSeriesPtr, i, &elemObj);
+ elem = TclGetStringFromObj(elemObj, &slen);
+ strcpy(p, elem);
+ p[slen] = ' ';
+ p += slen+1;
+ Tcl_DecrRefCount(elemObj);
+ }
+ if (length > 0) arithSeriesPtr->bytes[length-1] = '\0';
+ arithSeriesPtr->length = length-1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetArithSeriesFromAny --
+ *
+ * The Arithmetic Series object is just an way to optimize
+ * Lists space complexity, so no one should try to convert
+ * a string to an Arithmetic Series object.
+ *
+ * This function is here just to populate the Type structure.
+ *
+ * Results:
+ *
+ * The result is always TCL_ERROR. But see Side Effects.
+ *
+ * Side effects:
+ *
+ * Tcl Panic if called.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetArithSeriesFromAny(
+ TCL_UNUSED(Tcl_Interp *), /* Used for error reporting if not NULL. */
+ TCL_UNUSED(Tcl_Obj *)) /* The object to convert. */
+{
+ Tcl_Panic("SetArithSeriesFromAny: should never be called");
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclArithSeriesObjCopy --
+ *
+ * Makes a "pure arithSeries" copy of an ArithSeries value. This provides for the C
+ * level a counterpart of the [lrange $list 0 end] command, while using
+ * internals details to be as efficient as possible.
+ *
+ * Results:
+ *
+ * Normally returns a pointer to a new Tcl_Obj, that contains the same
+ * arithSeries value as *arithSeriesPtr does. The returned Tcl_Obj has a
+ * refCount of zero. If *arithSeriesPtr does not hold an arithSeries,
+ * NULL is returned, and if interp is non-NULL, an error message is
+ * recorded there.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclArithSeriesObjCopy(
+ Tcl_Interp *interp, /* Used to report errors if not NULL. */
+ Tcl_Obj *arithSeriesPtr) /* List object for which an element array is
+ * to be returned. */
+{
+ Tcl_Obj *copyPtr;
+ ArithSeries *arithSeriesRepPtr;
+
+ ArithSeriesGetInternalRep(arithSeriesPtr, arithSeriesRepPtr);
+ if (NULL == arithSeriesRepPtr) {
+ if (SetArithSeriesFromAny(interp, arithSeriesPtr) != TCL_OK) {
+ /* We know this is going to panic, but it's the message we want */
+ return NULL;
+ }
+ }
+
+ TclNewObj(copyPtr);
+ TclInvalidateStringRep(copyPtr);
+ DupArithSeriesInternalRep(arithSeriesPtr, copyPtr);
+ return copyPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclArithSeriesObjRange --
+ *
+ * Makes a slice of an ArithSeries value.
+ * *arithSeriesPtr must be known to be a valid list.
+ *
+ * Results:
+ * Returns a pointer to the sliced series.
+ * This may be a new object or the same object if not shared.
+ *
+ * Side effects:
+ * ?The possible conversion of the object referenced by listPtr?
+ * ?to a list object.?
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclArithSeriesObjRange(
+ Tcl_Obj *arithSeriesPtr, /* List object to take a range from. */
+ int fromIdx, /* Index of first element to include. */
+ int toIdx) /* Index of last element to include. */
+{
+ ArithSeries *arithSeriesRepPtr;
+ Tcl_Obj *startObj, *endObj, *stepObj;
+
+ ArithSeriesGetInternalRep(arithSeriesPtr, arithSeriesRepPtr);
+
+ if (fromIdx < 0) {
+ fromIdx = 0;
+ }
+ if (fromIdx > toIdx) {
+ Tcl_Obj *obj;
+ TclNewObj(obj);
+ return obj;
+ }
+
+ TclArithSeriesObjIndex(arithSeriesPtr, fromIdx, &startObj);
+ Tcl_IncrRefCount(startObj);
+ TclArithSeriesObjIndex(arithSeriesPtr, toIdx, &endObj);
+ Tcl_IncrRefCount(endObj);
+ TclArithSeriesObjStep(arithSeriesPtr, &stepObj);
+ Tcl_IncrRefCount(stepObj);
+
+ if (Tcl_IsShared(arithSeriesPtr) ||
+ ((arithSeriesPtr->refCount > 1))) {
+ Tcl_Obj *newSlicePtr = TclNewArithSeriesObj(arithSeriesRepPtr->isDouble,
+ startObj, endObj, stepObj, NULL);
+ Tcl_DecrRefCount(startObj);
+ Tcl_DecrRefCount(endObj);
+ Tcl_DecrRefCount(stepObj);
+ return newSlicePtr;
+ }
+
+ /*
+ * In-place is possible.
+ */
+
+ /*
+ * Even if nothing below causes any changes, we still want the
+ * string-canonizing effect of [lrange 0 end].
+ */
+
+ TclInvalidateStringRep(arithSeriesPtr);
+
+ if (arithSeriesRepPtr->isDouble) {
+ ArithSeriesDbl *arithSeriesDblRepPtr = (ArithSeriesDbl*)arithSeriesPtr;
+ double start, end, step;
+ Tcl_GetDoubleFromObj(NULL, startObj, &start);
+ Tcl_GetDoubleFromObj(NULL, endObj, &end);
+ Tcl_GetDoubleFromObj(NULL, stepObj, &step);
+ arithSeriesDblRepPtr->start = start;
+ arithSeriesDblRepPtr->end = end;
+ arithSeriesDblRepPtr->step = step;
+ arithSeriesDblRepPtr->len = (end-start+step)/step;
+ arithSeriesDblRepPtr->elements = NULL;
+
+ } else {
+ Tcl_WideInt start, end, step;
+ Tcl_GetWideIntFromObj(NULL, startObj, &start);
+ Tcl_GetWideIntFromObj(NULL, endObj, &end);
+ Tcl_GetWideIntFromObj(NULL, stepObj, &step);
+ arithSeriesRepPtr->start = start;
+ arithSeriesRepPtr->end = end;
+ arithSeriesRepPtr->step = step;
+ arithSeriesRepPtr->len = (end-start+step)/step;
+ arithSeriesRepPtr->elements = NULL;
+ }
+
+ Tcl_DecrRefCount(startObj);
+ Tcl_DecrRefCount(endObj);
+ Tcl_DecrRefCount(stepObj);
+
+ return arithSeriesPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclArithSeriesGetElements --
+ *
+ * This function returns an (objc,objv) array of the elements in a list
+ * object.
+ *
+ * Results:
+ * The return value is normally TCL_OK; in this case *objcPtr is set to
+ * the count of list elements and *objvPtr is set to a pointer to an
+ * array of (*objcPtr) pointers to each list element. If listPtr does not
+ * refer to an Abstract List object and the object can not be converted
+ * to one, TCL_ERROR is returned and an error message will be left in the
+ * interpreter's result if interp is not NULL.
+ *
+ * The objects referenced by the returned array should be treated as
+ * readonly and their ref counts are _not_ incremented; the caller must
+ * do that if it holds on to a reference. Furthermore, the pointer and
+ * length returned by this function may change as soon as any function is
+ * called on the list object; be careful about retaining the pointer in a
+ * local data structure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclArithSeriesGetElements(
+ Tcl_Interp *interp, /* Used to report errors if not NULL. */
+ Tcl_Obj *objPtr, /* AbstractList object for which an element
+ * array is to be returned. */
+ int *objcPtr, /* Where to store the count of objects
+ * referenced by objv. */
+ Tcl_Obj ***objvPtr) /* Where to store the pointer to an array of
+ * pointers to the list's objects. */
+{
+ if (TclHasInternalRep(objPtr,&tclArithSeriesType)) {
+ ArithSeries *arithSeriesRepPtr;
+ Tcl_Obj **objv;
+ int i, objc;
+
+ ArithSeriesGetInternalRep(objPtr, arithSeriesRepPtr);
+ objc = arithSeriesRepPtr->len;
+ if (objc > 0) {
+ if (arithSeriesRepPtr->elements) {
+ /* If this exists, it has already been populated */
+ objv = arithSeriesRepPtr->elements;
+ } else {
+ /* Construct the elements array */
+ objv = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj*) * objc);
+ if (objv == NULL) {
+ if (interp) {
+ Tcl_SetObjResult(
+ interp,
+ Tcl_NewStringObj("max length of a Tcl list exceeded", -1));
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+ }
+ return TCL_ERROR;
+ }
+ arithSeriesRepPtr->elements = objv;
+ for (i = 0; i < objc; i++) {
+ if (TclArithSeriesObjIndex(objPtr, i, &objv[i]) != TCL_OK) {
+ if (interp) {
+ Tcl_SetObjResult(
+ interp,
+ Tcl_NewStringObj("indexing error", -1));
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+ }
+ return TCL_ERROR;
+ }
+ Tcl_IncrRefCount(objv[i]);
+ }
+ }
+ } else {
+ objv = NULL;
+ }
+ *objvPtr = objv;
+ *objcPtr = objc;
+ } else {
+ if (interp != NULL) {
+ Tcl_SetObjResult(
+ interp,
+ Tcl_ObjPrintf("value is not an arithseries"));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "UNKNOWN", NULL);
+ }
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclArithSeriesObjReverse --
+ *
+ * Reverse the order of the ArithSeries value.
+ * *arithSeriesPtr must be known to be a valid list.
+ *
+ * Results:
+ * Returns a pointer to the reordered series.
+ * This may be a new object or the same object if not shared.
+ *
+ * Side effects:
+ * ?The possible conversion of the object referenced by listPtr?
+ * ?to a list object.?
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclArithSeriesObjReverse(
+ Tcl_Obj *arithSeriesPtr) /* List object to reverse. */
+{
+ ArithSeries *arithSeriesRepPtr;
+ Tcl_Obj *startObj, *endObj, *stepObj;
+ Tcl_Obj *resultObj;
+ Tcl_WideInt start, end, step, len;
+ double dstart, dend, dstep;
+ int isDouble;
+
+ ArithSeriesGetInternalRep(arithSeriesPtr, arithSeriesRepPtr);
+
+ isDouble = arithSeriesRepPtr->isDouble;
+ len = arithSeriesRepPtr->len;
+
+ TclArithSeriesObjIndex(arithSeriesPtr, (len-1), &startObj);
+ TclArithSeriesObjIndex(arithSeriesPtr, 0, &endObj);
+ TclArithSeriesObjStep(arithSeriesPtr, &stepObj);
+
+ if (isDouble) {
+ Tcl_GetDoubleFromObj(NULL, startObj, &dstart);
+ Tcl_GetDoubleFromObj(NULL, endObj, &dend);
+ Tcl_GetDoubleFromObj(NULL, stepObj, &dstep);
+ dstep = -dstep;
+ TclSetDoubleObj(stepObj, dstep);
+ } else {
+ Tcl_GetWideIntFromObj(NULL, startObj, &start);
+ Tcl_GetWideIntFromObj(NULL, endObj, &end);
+ Tcl_GetWideIntFromObj(NULL, stepObj, &step);
+ step = -step;
+ TclSetIntObj(stepObj, step);
+ }
+
+ if (Tcl_IsShared(arithSeriesPtr) ||
+ ((arithSeriesPtr->refCount > 1))) {
+ Tcl_Obj *lenObj = Tcl_NewWideIntObj(len);
+ resultObj = TclNewArithSeriesObj(isDouble,
+ startObj, endObj, stepObj, lenObj);
+ Tcl_DecrRefCount(lenObj);
+ } else {
+
+ /*
+ * In-place is possible.
+ */
+
+ TclInvalidateStringRep(arithSeriesPtr);
+
+ if (isDouble) {
+ ArithSeriesDbl *arithSeriesDblRepPtr =
+ (ArithSeriesDbl*)arithSeriesRepPtr;
+ arithSeriesDblRepPtr->start = dstart;
+ arithSeriesDblRepPtr->end = dend;
+ arithSeriesDblRepPtr->step = dstep;
+ } else {
+ arithSeriesRepPtr->start = start;
+ arithSeriesRepPtr->end = end;
+ arithSeriesRepPtr->step = step;
+ }
+ if (arithSeriesRepPtr->elements) {
+ Tcl_WideInt i;
+ for (i=0; i<len; i++) {
+ Tcl_DecrRefCount(arithSeriesRepPtr->elements[i]);
+ }
+ ckfree((char*)arithSeriesRepPtr->elements);
+ }
+ arithSeriesRepPtr->elements = NULL;
+
+ resultObj = arithSeriesPtr;
+ }
+
+ Tcl_DecrRefCount(startObj);
+ Tcl_DecrRefCount(endObj);
+ Tcl_DecrRefCount(stepObj);
+
+ return resultObj;
+}
diff --git a/generic/tclArithSeries.h b/generic/tclArithSeries.h
new file mode 100644
index 0000000..f855c22
--- /dev/null
+++ b/generic/tclArithSeries.h
@@ -0,0 +1,54 @@
+/*
+ * tclArithSeries.h --
+ *
+ * This file contains the ArithSeries concrete abstract list
+ * implementation. It implements the inner workings of the lseq command.
+ *
+ * Copyright © 2022 Brian S. Griffin.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+/*
+ * The structure used for the ArithSeries internal representation.
+ * Note that the len can in theory be always computed by start,end,step
+ * but it's faster to cache it inside the internal representation.
+ */
+typedef struct ArithSeries {
+ Tcl_WideInt start;
+ Tcl_WideInt end;
+ Tcl_WideInt step;
+ Tcl_WideInt len;
+ Tcl_Obj **elements;
+ int isDouble;
+} ArithSeries;
+typedef struct ArithSeriesDbl {
+ double start;
+ double end;
+ double step;
+ Tcl_WideInt len;
+ Tcl_Obj **elements;
+ int isDouble;
+} ArithSeriesDbl;
+
+
+MODULE_SCOPE Tcl_Obj * TclArithSeriesObjCopy(Tcl_Interp *interp,
+ Tcl_Obj *arithSeriesPtr);
+MODULE_SCOPE int TclArithSeriesObjStep(Tcl_Obj *arithSeriesPtr,
+ Tcl_Obj **stepObj);
+MODULE_SCOPE int TclArithSeriesObjIndex(Tcl_Obj *arithSeriesPtr,
+ Tcl_WideInt index, Tcl_Obj **elementObj);
+MODULE_SCOPE Tcl_WideInt TclArithSeriesObjLength(Tcl_Obj *arithSeriesPtr);
+MODULE_SCOPE Tcl_Obj * TclArithSeriesObjRange(Tcl_Obj *arithSeriesPtr,
+ int fromIdx, int toIdx);
+MODULE_SCOPE Tcl_Obj * TclArithSeriesObjReverse(Tcl_Obj *arithSeriesPtr);
+MODULE_SCOPE int TclArithSeriesGetElements(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, int *objcPtr, Tcl_Obj ***objvPtr);
+MODULE_SCOPE Tcl_Obj * TclNewArithSeriesInt(Tcl_WideInt start,
+ Tcl_WideInt end, Tcl_WideInt step,
+ Tcl_WideInt len);
+MODULE_SCOPE Tcl_Obj * TclNewArithSeriesDbl(double start, double end,
+ double step, Tcl_WideInt len);
+MODULE_SCOPE Tcl_Obj * TclNewArithSeriesObj(int useDoubles, Tcl_Obj *startObj,
+ Tcl_Obj *endObj, Tcl_Obj *stepObj, Tcl_Obj *lenObj);
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index b806c33..83111b1 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -322,6 +322,7 @@ static const CmdInfo builtInCmds[] = {
{"lreplace", Tcl_LreplaceObjCmd, TclCompileLreplaceCmd, NULL, CMD_IS_SAFE},
{"lreverse", Tcl_LreverseObjCmd, NULL, NULL, CMD_IS_SAFE},
{"lsearch", Tcl_LsearchObjCmd, NULL, NULL, CMD_IS_SAFE},
+ {"lseq", Tcl_LseqObjCmd, NULL, NULL, CMD_IS_SAFE},
{"lset", Tcl_LsetObjCmd, TclCompileLsetCmd, NULL, CMD_IS_SAFE},
{"lsort", Tcl_LsortObjCmd, NULL, NULL, CMD_IS_SAFE},
{"package", Tcl_PackageObjCmd, NULL, TclNRPackageObjCmd, CMD_IS_SAFE},
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 06919a2..092bbd1 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -15,6 +15,7 @@
#ifdef _WIN32
# include "tclWinInt.h"
#endif
+#include "tclArithSeries.h"
/*
* The state structure used by [foreach]. Note that the actual structure has
@@ -2803,32 +2804,47 @@ EachloopCmd(
*/
for (i=0 ; i<numLists ; i++) {
+ /* List */
+ /* Variables */
statePtr->vCopyList[i] = TclListObjCopy(interp, objv[1+i*2]);
if (statePtr->vCopyList[i] == NULL) {
result = TCL_ERROR;
goto done;
}
TclListObjGetElementsM(NULL, statePtr->vCopyList[i],
- &statePtr->varcList[i], &statePtr->varvList[i]);
+ &statePtr->varcList[i], &statePtr->varvList[i]);
if (statePtr->varcList[i] < 1) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "%s varlist is empty",
- (statePtr->resultList != NULL ? "lmap" : "foreach")));
+ "%s varlist is empty",
+ (statePtr->resultList != NULL ? "lmap" : "foreach")));
Tcl_SetErrorCode(interp, "TCL", "OPERATION",
- (statePtr->resultList != NULL ? "LMAP" : "FOREACH"),
- "NEEDVARS", NULL);
+ (statePtr->resultList != NULL ? "LMAP" : "FOREACH"),
+ "NEEDVARS", NULL);
result = TCL_ERROR;
goto done;
}
- statePtr->aCopyList[i] = TclListObjCopy(interp, objv[2+i*2]);
- if (statePtr->aCopyList[i] == NULL) {
- result = TCL_ERROR;
- goto done;
- }
- TclListObjGetElementsM(NULL, statePtr->aCopyList[i],
+ /* Values */
+ if (TclHasInternalRep(objv[2+i*2],&tclArithSeriesType)) {
+ /* Special case for Arith Series */
+ statePtr->vCopyList[i] = TclArithSeriesObjCopy(interp, objv[2+i*2]);
+ if (statePtr->vCopyList[i] == NULL) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ /* Don't compute values here, wait until the last momement */
+ statePtr->argcList[i] = TclArithSeriesObjLength(statePtr->vCopyList[i]);
+ } else {
+ /* List values */
+ statePtr->aCopyList[i] = TclListObjCopy(interp, objv[2+i*2]);
+ if (statePtr->aCopyList[i] == NULL) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ TclListObjGetElementsM(NULL, statePtr->aCopyList[i],
&statePtr->argcList[i], &statePtr->argvList[i]);
-
+ }
+ /* account for variable <> value mismatch */
j = statePtr->argcList[i] / statePtr->varcList[i];
if ((statePtr->argcList[i] % statePtr->varcList[i]) != 0) {
j++;
@@ -2950,11 +2966,21 @@ ForeachAssignments(
Tcl_Obj *valuePtr, *varValuePtr;
for (i=0 ; i<statePtr->numLists ; i++) {
+ int isarithseries = TclHasInternalRep(statePtr->vCopyList[i],&tclArithSeriesType);
for (v=0 ; v<statePtr->varcList[i] ; v++) {
k = statePtr->index[i]++;
-
if (k < statePtr->argcList[i]) {
- valuePtr = statePtr->argvList[i][k];
+ if (isarithseries) {
+ if (TclArithSeriesObjIndex(statePtr->vCopyList[i], k, &valuePtr) != TCL_OK) {
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (setting %s loop variable \"%s\")",
+ (statePtr->resultList != NULL ? "lmap" : "foreach"),
+ TclGetString(statePtr->varvList[i][v])));
+ return TCL_ERROR;
+ }
+ } else {
+ valuePtr = statePtr->argvList[i][k];
+ }
} else {
TclNewObj(valuePtr); /* Empty string */
}
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index cdc302c..9430eb5 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -19,6 +19,8 @@
#include "tclInt.h"
#include "tclRegexp.h"
+#include "tclArithSeries.h"
+#include <math.h>
#include <assert.h>
/*
@@ -95,6 +97,23 @@ typedef struct {
#define SORTMODE_ASCII_NC 8
/*
+ * Definitions for [lseq] command
+ */
+static const char *const seq_operations[] = {
+ "..", "to", "count", "by", NULL
+};
+typedef enum Sequence_Operators {
+ LSEQ_DOTS, LSEQ_TO, LSEQ_COUNT, LSEQ_BY
+} SequenceOperators;
+static const char *const seq_step_keywords[] = {"by", NULL};
+typedef enum Step_Operators {
+ STEP_BY = 4
+} SequenceByMode;
+typedef enum Sequence_Decoded {
+ NoneArg, NumericArg, RangeKeywordArg, ByKeywordArg
+} SequenceDecoded;
+
+/*
* Forward declarations for procedures defined in this file:
*/
@@ -2182,7 +2201,7 @@ Tcl_JoinObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
- int length, listLen;
+ int length, listLen, isArithSeries = 0;
Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs;
if ((objc < 2) || (objc > 3)) {
@@ -2195,9 +2214,14 @@ Tcl_JoinObjCmd(
* pointer to its array of element pointers.
*/
- if (TclListObjGetElementsM(interp, objv[1], &listLen,
+ if (TclHasInternalRep(objv[1],&tclArithSeriesType)) {
+ isArithSeries = 1;
+ listLen = TclArithSeriesObjLength(objv[1]);
+ } else {
+ if (TclListObjGetElementsM(interp, objv[1], &listLen,
&elemPtrs) != TCL_OK) {
- return TCL_ERROR;
+ return TCL_ERROR;
+ }
}
if (listLen == 0) {
@@ -2206,7 +2230,15 @@ Tcl_JoinObjCmd(
}
if (listLen == 1) {
/* One element; return it */
- Tcl_SetObjResult(interp, elemPtrs[0]);
+ if (isArithSeries) {
+ Tcl_Obj *valueObj;
+ if (TclArithSeriesObjIndex(objv[1], 0, &valueObj) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, valueObj);
+ } else {
+ Tcl_SetObjResult(interp, elemPtrs[0]);
+ }
return TCL_OK;
}
@@ -2220,19 +2252,41 @@ Tcl_JoinObjCmd(
int i;
TclNewObj(resObjPtr);
- for (i = 0; i < listLen; i++) {
- if (i > 0) {
+ if (isArithSeries) {
+ Tcl_Obj *valueObj;
+ for (i = 0; i < listLen; i++) {
+ if (i > 0) {
+
+ /*
+ * NOTE: This code is relying on Tcl_AppendObjToObj() **NOT**
+ * to shimmer joinObjPtr. If it did, then the case where
+ * objv[1] and objv[2] are the same value would not be safe.
+ * Accessing elemPtrs would crash.
+ */
+
+ Tcl_AppendObjToObj(resObjPtr, joinObjPtr);
+ }
+ if (TclArithSeriesObjIndex(objv[1], i, &valueObj) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_AppendObjToObj(resObjPtr, valueObj);
+ Tcl_DecrRefCount(valueObj);
+ }
+ } else {
+ for (i = 0; i < listLen; i++) {
+ if (i > 0) {
- /*
- * NOTE: This code is relying on Tcl_AppendObjToObj() **NOT**
- * to shimmer joinObjPtr. If it did, then the case where
- * objv[1] and objv[2] are the same value would not be safe.
- * Accessing elemPtrs would crash.
- */
+ /*
+ * NOTE: This code is relying on Tcl_AppendObjToObj() **NOT**
+ * to shimmer joinObjPtr. If it did, then the case where
+ * objv[1] and objv[2] are the same value would not be safe.
+ * Accessing elemPtrs would crash.
+ */
- Tcl_AppendObjToObj(resObjPtr, joinObjPtr);
+ Tcl_AppendObjToObj(resObjPtr, joinObjPtr);
+ }
+ Tcl_AppendObjToObj(resObjPtr, elemPtrs[i]);
}
- Tcl_AppendObjToObj(resObjPtr, elemPtrs[i]);
}
}
Tcl_DecrRefCount(joinObjPtr);
@@ -2689,7 +2743,11 @@ Tcl_LrangeObjCmd(
return result;
}
- Tcl_SetObjResult(interp, TclListObjRange(objv[1], first, last));
+ if (TclHasInternalRep(objv[1],&tclArithSeriesType)) {
+ Tcl_SetObjResult(interp, TclArithSeriesObjRange(objv[1], first, last));
+ } else {
+ Tcl_SetObjResult(interp, TclListObjRange(objv[1], first, last));
+ }
return TCL_OK;
}
@@ -3073,6 +3131,17 @@ Tcl_LreverseObjCmd(
Tcl_WrongNumArgs(interp, 1, objv, "list");
return TCL_ERROR;
}
+
+ /*
+ * Handle ArithSeries special case - don't shimmer a series into a list
+ * just to reverse it.
+ */
+ if (TclHasInternalRep(objv[1],&tclArithSeriesType)) {
+ Tcl_SetObjResult(interp, TclArithSeriesObjReverse(objv[1]));
+ return TCL_OK;
+ } /* end ArithSeries */
+
+ /* True List */
if (TclListObjGetElementsM(interp, objv[1], &elemc, &elemv) != TCL_OK) {
return TCL_ERROR;
}
@@ -3973,6 +4042,407 @@ Tcl_LsetObjCmd(
/*
*----------------------------------------------------------------------
*
+ * SequenceIdentifyArgument --
+ * (for [lseq] command)
+ *
+ * Given a Tcl_Obj, identify if it is a keyword or a number
+ *
+ * Return Value
+ * 0 - failure, unexpected value
+ * 1 - value is a number
+ * 2 - value is an operand keyword
+ * 3 - value is a by keyword
+ *
+ * The decoded value will be assigned to the appropriate
+ * pointer, if supplied.
+ */
+
+static SequenceDecoded
+SequenceIdentifyArgument(
+ Tcl_Interp *interp, /* for error reporting */
+ Tcl_Obj *argPtr, /* Argument to decode */
+ Tcl_Obj **numValuePtr, /* Return numeric value */
+ int *keywordIndexPtr) /* Return keyword enum */
+{
+ int status;
+ SequenceOperators opmode;
+ SequenceByMode bymode;
+ union {
+ Tcl_WideInt i;
+ double d;
+ } nvalue;
+
+ status = TclGetNumberFromObj(NULL, argPtr, (ClientData*)&nvalue, keywordIndexPtr);
+ if (status == TCL_OK) {
+ if (numValuePtr) {
+ *numValuePtr = argPtr;
+ }
+ return NumericArg;
+ } else {
+ /* Check for an index expression */
+ long value;
+ double dvalue;
+ Tcl_Obj *exprValueObj;
+ int keyword;
+ Tcl_InterpState savedstate;
+ savedstate = Tcl_SaveInterpState(interp, status);
+ if (Tcl_ExprLongObj(interp, argPtr, &value) != TCL_OK) {
+ status = Tcl_RestoreInterpState(interp, savedstate);
+ exprValueObj = argPtr;
+ } else {
+ // Determine if expression is double or int
+ if (Tcl_ExprDoubleObj(interp, argPtr, &dvalue) != TCL_OK) {
+ keyword = TCL_NUMBER_INT;
+ exprValueObj = argPtr;
+ } else {
+ if (floor(dvalue) == dvalue) {
+ exprValueObj = Tcl_NewWideIntObj(value);
+ keyword = TCL_NUMBER_INT;
+ } else {
+ exprValueObj = Tcl_NewDoubleObj(dvalue);
+ keyword = TCL_NUMBER_DOUBLE;
+ }
+ }
+ status = Tcl_RestoreInterpState(interp, savedstate);
+ if (numValuePtr) {
+ *numValuePtr = exprValueObj;
+ }
+ if (keywordIndexPtr) {
+ *keywordIndexPtr = keyword ;// type of expression result
+ }
+ return NumericArg;
+ }
+ }
+
+ status = Tcl_GetIndexFromObj(NULL, argPtr, seq_operations,
+ "range operation", 0, &opmode);
+ if (status == TCL_OK) {
+ if (keywordIndexPtr) {
+ *keywordIndexPtr = opmode;
+ }
+ return RangeKeywordArg;
+ }
+
+ status = Tcl_GetIndexFromObj(NULL, argPtr, seq_step_keywords,
+ "step keyword", 0, &bymode);
+ if (status == TCL_OK) {
+ if (keywordIndexPtr) {
+ *keywordIndexPtr = bymode;
+ }
+ return ByKeywordArg;
+ }
+ return NoneArg;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LseqObjCmd --
+ *
+ * This procedure is invoked to process the "lseq" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Enumerated possible argument patterns:
+ *
+ * 1:
+ * lseq n
+ * 2:
+ * lseq n n
+ * 3:
+ * lseq n n n
+ * lseq n 'to' n
+ * lseq n 'count' n
+ * lseq n 'by' n
+ * 4:
+ * lseq n 'to' n n
+ * lseq n n 'by' n
+ * lseq n 'count' n n
+ * 5:
+ * lseq n 'to' n 'by' n
+ * lseq n 'count' n 'by' n
+ *
+ * Results:
+ * A standard Tcl object result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_LseqObjCmd(
+ TCL_UNUSED(ClientData),
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* The argument objects. */
+{
+ Tcl_Obj *elementCount = NULL;
+ Tcl_Obj *start = NULL, *end = NULL, *step = NULL;
+ Tcl_WideInt values[5];
+ Tcl_Obj *numValues[5];
+ Tcl_Obj *numberObj;
+ int status, keyword, useDoubles = 0;
+ Tcl_Obj *arithSeriesPtr;
+ SequenceOperators opmode;
+ SequenceDecoded decoded;
+ int i, arg_key = 0, value_i = 0;
+ // Default constants
+ Tcl_Obj *zero = Tcl_NewIntObj(0);
+ Tcl_Obj *one = Tcl_NewIntObj(1);
+
+ /*
+ * Create a decoding key by looping through the arguments and identify
+ * what kind of argument each one is. Encode each argument as a decimal
+ * digit.
+ */
+ if (objc > 6) {
+ /* Too many arguments */
+ arg_key=0;
+ } else for (i=1; i<objc; i++) {
+ arg_key = (arg_key * 10);
+ numValues[value_i] = NULL;
+ decoded = SequenceIdentifyArgument(interp, objv[i], &numberObj, &keyword);
+ switch (decoded) {
+
+ case NoneArg:
+ /*
+ * Unrecognizable argument
+ * Reproduce operation error message
+ */
+ status = Tcl_GetIndexFromObj(interp, objv[i], seq_operations,
+ "operation", 0, &opmode);
+ goto done;
+
+ case NumericArg:
+ arg_key += NumericArg;
+ numValues[value_i] = numberObj;
+ Tcl_IncrRefCount(numValues[value_i]);
+ values[value_i] = keyword; // This is the TCL_NUMBER_* value
+ useDoubles = useDoubles ? useDoubles : keyword == TCL_NUMBER_DOUBLE;
+ value_i++;
+ break;
+
+ case RangeKeywordArg:
+ arg_key += RangeKeywordArg;
+ values[value_i] = keyword;
+ value_i++;
+ break;
+
+ case ByKeywordArg:
+ arg_key += ByKeywordArg;
+ values[value_i] = keyword;
+ value_i++;
+ break;
+
+ default:
+ arg_key += 9; // Error state
+ value_i++;
+ break;
+ }
+ }
+
+ /*
+ * The key encoding defines a valid set of arguments, or indicates an
+ * error condition; process the values accordningly.
+ */
+ switch (arg_key) {
+
+/* No argument */
+ case 0:
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "n ??op? n ??by? n??");
+ status = TCL_ERROR;
+ goto done;
+ break;
+
+/* range n */
+ case 1:
+ start = zero;
+ elementCount = numValues[0];
+ end = NULL;
+ step = one;
+ break;
+
+/* range n n */
+ case 11:
+ start = numValues[0];
+ end = numValues[1];
+ break;
+
+/* range n n n */
+ case 111:
+ start = numValues[0];
+ end = numValues[1];
+ step = numValues[2];
+ break;
+
+/* range n 'to' n */
+/* range n 'count' n */
+/* range n 'by' n */
+ case 121:
+ opmode = (SequenceOperators)values[1];
+ switch (opmode) {
+ case LSEQ_DOTS:
+ case LSEQ_TO:
+ start = numValues[0];
+ end = numValues[2];
+ break;
+ case LSEQ_BY:
+ start = zero;
+ elementCount = numValues[0];
+ step = numValues[2];
+ break;
+ case LSEQ_COUNT:
+ start = numValues[0];
+ elementCount = numValues[2];
+ step = one;
+ break;
+ default:
+ status = TCL_ERROR;
+ goto done;
+ }
+ break;
+
+/* range n 'to' n n */
+/* range n 'count' n n */
+ case 1211:
+ opmode = (SequenceOperators)values[1];
+ switch (opmode) {
+ case LSEQ_DOTS:
+ case LSEQ_TO:
+ start = numValues[0];
+ end = numValues[2];
+ step = numValues[3];
+ break;
+ case LSEQ_COUNT:
+ start = numValues[0];
+ elementCount = numValues[2];
+ step = numValues[3];
+ break;
+ case LSEQ_BY:
+ /* Error case */
+ status = TCL_ERROR;
+ goto done;
+ break;
+ default:
+ status = TCL_ERROR;
+ goto done;
+ break;
+ }
+ break;
+
+/* range n n 'by' n */
+ case 1121:
+ start = numValues[0];
+ end = numValues[1];
+ opmode = (SequenceOperators)values[2];
+ switch (opmode) {
+ case LSEQ_BY:
+ step = numValues[3];
+ break;
+ case LSEQ_DOTS:
+ case LSEQ_TO:
+ case LSEQ_COUNT:
+ default:
+ status = TCL_ERROR;
+ goto done;
+ break;
+ }
+ break;
+
+/* range n 'to' n 'by' n */
+/* range n 'count' n 'by' n */
+ case 12121:
+ start = numValues[0];
+ opmode = (SequenceOperators)values[3];
+ switch (opmode) {
+ case LSEQ_BY:
+ step = numValues[4];
+ break;
+ default:
+ status = TCL_ERROR;
+ goto done;
+ break;
+ }
+ opmode = (SequenceOperators)values[1];
+ switch (opmode) {
+ case LSEQ_DOTS:
+ case LSEQ_TO:
+ start = numValues[0];
+ end = numValues[2];
+ break;
+ case LSEQ_COUNT:
+ start = numValues[0];
+ elementCount = numValues[2];
+ break;
+ default:
+ status = TCL_ERROR;
+ goto done;
+ break;
+ }
+ break;
+
+/* Error cases: incomplete arguments */
+ case 12:
+ opmode = (SequenceOperators)values[1]; goto KeywordError; break;
+ case 112:
+ opmode = (SequenceOperators)values[2]; goto KeywordError; break;
+ case 1212:
+ opmode = (SequenceOperators)values[3]; goto KeywordError; break;
+ KeywordError:
+ status = TCL_ERROR;
+ switch (opmode) {
+ case LSEQ_DOTS:
+ case LSEQ_TO:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "missing \"to\" value."));
+ break;
+ case LSEQ_COUNT:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "missing \"count\" value."));
+ break;
+ case LSEQ_BY:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "missing \"by\" value."));
+ break;
+ }
+ status = TCL_ERROR;
+ goto done;
+ break;
+
+/* All other argument errors */
+ default:
+ Tcl_WrongNumArgs(interp, 1, objv, "n ??op? n ??by? n??");
+ status = TCL_ERROR;
+ goto done;
+ break;
+ }
+
+ /*
+ * Success! Now lets create the series object.
+ */
+ arithSeriesPtr = TclNewArithSeriesObj(useDoubles, start, end, step, elementCount);
+
+ Tcl_SetObjResult(interp, arithSeriesPtr);
+ status = TCL_OK;
+
+ done:
+ // Free number arguments.
+ while (--value_i>=0) {
+ if (numValues[value_i]) Tcl_DecrRefCount(numValues[value_i]);
+ }
+
+ // Free constants
+ Tcl_DecrRefCount(zero);
+ Tcl_DecrRefCount(one);
+
+ return status;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_LsortObjCmd --
*
* This procedure is invoked to process the "lsort" Tcl command. See the
@@ -4238,8 +4708,13 @@ Tcl_LsortObjCmd(
sortInfo.compareCmdPtr = newCommandPtr;
}
- sortInfo.resultCode = TclListObjGetElementsM(interp, listObj,
+ if (TclHasInternalRep(listObj,&tclArithSeriesType)) {
+ sortInfo.resultCode = TclArithSeriesGetElements(interp,
+ listObj, &length, &listObjPtrs);
+ } else {
+ sortInfo.resultCode = TclListObjGetElementsM(interp, listObj,
&length, &listObjPtrs);
+ }
if (sortInfo.resultCode != TCL_OK || length <= 0) {
goto done;
}
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 8aa3bb2..f8d5493 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -19,6 +19,7 @@
#include "tclCompile.h"
#include "tclOOInt.h"
#include "tclTomMath.h"
+#include "tclArithSeries.h"
#include <math.h>
#include <assert.h>
@@ -4868,6 +4869,23 @@ TEBCresume(
valuePtr = OBJ_UNDER_TOS;
TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
+
+ /* special case for ArithSeries */
+ if (TclHasInternalRep(valuePtr,&tclArithSeriesType)) {
+ length = TclArithSeriesObjLength(valuePtr);
+ if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) {
+ CACHE_STACK_INFO();
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ if (TclArithSeriesObjIndex(valuePtr, index, &objResultPtr) != TCL_OK) {
+ CACHE_STACK_INFO();
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ goto lindexDone;
+ }
+
/*
* Extract the desired list element.
*/
@@ -4889,6 +4907,8 @@ TEBCresume(
}
objResultPtr = TclLindexList(interp, valuePtr, value2Ptr);
+
+ lindexDone:
if (!objResultPtr) {
TRACE_ERROR(interp);
goto gotError;
@@ -4912,6 +4932,28 @@ TEBCresume(
opnd = TclGetInt4AtPtr(pc+1);
TRACE(("\"%.30s\" %d => ", O2S(valuePtr), opnd));
+ /* special case for ArithSeries */
+ if (TclHasInternalRep(valuePtr,&tclArithSeriesType)) {
+ length = TclArithSeriesObjLength(valuePtr);
+
+ /* Decode end-offset index values. */
+
+ index = TclIndexDecode(opnd, length);
+
+ /* Compute value @ index */
+ if (index >= 0 && index < length) {
+ if (TclArithSeriesObjIndex(valuePtr, index, &objResultPtr) != TCL_OK) {
+ CACHE_STACK_INFO();
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ } else {
+ TclNewObj(objResultPtr);
+ }
+ pcAdjustment = 5;
+ goto lindexFastPath2;
+ }
+
/*
* Get the contents of the list, making sure that it really is a list
* in the process.
@@ -4934,6 +4976,8 @@ TEBCresume(
TclNewObj(objResultPtr);
}
+ lindexFastPath2:
+
TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
NEXT_INST_F(pcAdjustment, 1, 1);
@@ -5109,7 +5153,11 @@ TEBCresume(
fromIdx = TclIndexDecode(fromIdx, objc - 1);
- objResultPtr = TclListObjRange(valuePtr, fromIdx, toIdx);
+ if (TclHasInternalRep(valuePtr,&tclArithSeriesType)) {
+ objResultPtr = TclArithSeriesObjRange(valuePtr, fromIdx, toIdx);
+ } else {
+ objResultPtr = TclListObjRange(valuePtr, fromIdx, toIdx);
+ }
TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
NEXT_INST_F(9, 1, 1);
@@ -5129,7 +5177,7 @@ TEBCresume(
if (length > 0) {
int i = 0;
Tcl_Obj *o;
-
+ int isArithSeries = TclHasInternalRep(value2Ptr,&tclArithSeriesType);
/*
* An empty list doesn't match anything.
*/
@@ -5145,6 +5193,9 @@ TEBCresume(
if (s1len == s2len) {
match = (memcmp(s1, s2, s1len) == 0);
}
+ if (isArithSeries) {
+ TclDecrRefCount(o);
+ }
i++;
} while (i < length && match == 0);
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 09f22d3..0959741 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2922,6 +2922,7 @@ MODULE_SCOPE const Tcl_ObjType tclByteCodeType;
MODULE_SCOPE const Tcl_ObjType tclDoubleType;
MODULE_SCOPE const Tcl_ObjType tclIntType;
MODULE_SCOPE const Tcl_ObjType tclListType;
+MODULE_SCOPE const Tcl_ObjType tclArithSeriesType;
MODULE_SCOPE const Tcl_ObjType tclDictType;
MODULE_SCOPE const Tcl_ObjType tclProcBodyType;
MODULE_SCOPE const Tcl_ObjType tclStringType;
@@ -3725,6 +3726,9 @@ MODULE_SCOPE int Tcl_LreverseObjCmd(void *clientData,
MODULE_SCOPE int Tcl_LsearchObjCmd(void *clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tcl_LseqObjCmd(void *clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_LsetObjCmd(void *clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 7a702e0..5034174 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -9,8 +9,9 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-#include "tclInt.h"
#include <assert.h>
+#include "tclInt.h"
+#include "tclArithSeries.h"
/*
* TODO - memmove is fast. Measure at what size we should prefer memmove
@@ -1663,6 +1664,10 @@ Tcl_ListObjGetElements(
{
ListRep listRep;
+ if (TclHasInternalRep(objPtr,&tclArithSeriesType)) {
+ return TclArithSeriesGetElements(interp, objPtr, objcPtr, objvPtr);
+ }
+
if (TclListObjGetRep(interp, objPtr, &listRep) != TCL_OK)
return TCL_ERROR;
ListRepElements(&listRep, *objcPtr, *objvPtr);
@@ -1938,6 +1943,10 @@ Tcl_ListObjIndex(
Tcl_Obj **elemObjs;
ListSizeT numElems;
+ if (TclHasInternalRep(listObj,&tclArithSeriesType)) {
+ return TclArithSeriesObjIndex(listObj, index, objPtrPtr);
+ }
+
/*
* TODO
* Unlike the original list code, this does not optimize for lindex'ing
@@ -1968,7 +1977,7 @@ Tcl_ListObjIndex(
* convert it to one.
*
* Results:
- * The return value is normally TCL_OK; in this case *intPtr will be set
+ * The return value is normally TCL_OK; in this case *lenPtr will be set
* to the integer count of list elements. If listPtr does not refer to a
* list object and the object can not be converted to one, TCL_ERROR is
* returned and an error message will be left in the interpreter's result
@@ -1989,6 +1998,11 @@ Tcl_ListObjLength(
{
ListRep listRep;
+ if (TclHasInternalRep(listObj,&tclArithSeriesType)) {
+ *lenPtr = TclArithSeriesObjLength(listObj);
+ return TCL_OK;
+ }
+
/*
* TODO
* Unlike the original list code, this does not optimize for lindex'ing
@@ -2616,6 +2630,27 @@ TclLindexFlat(
{
ListSizeT i;
+ /* Handle ArithSeries as special case */
+ if (TclHasInternalRep(listObj,&tclArithSeriesType)) {
+ ListSizeT index, listLen = TclArithSeriesObjLength(listObj);
+ Tcl_Obj *elemObj = NULL;
+ for (i=0 ; i<indexCount && listObj ; i++) {
+ if (TclGetIntForIndexM(interp, indexArray[i], /*endValue*/ listLen-1,
+ &index) == TCL_OK) {
+ }
+ if (i==0) {
+ TclArithSeriesObjIndex(listObj, index, &elemObj);
+ Tcl_IncrRefCount(elemObj);
+ } else if (index > 0) {
+ Tcl_DecrRefCount(elemObj);
+ TclNewObj(elemObj);
+ Tcl_IncrRefCount(elemObj);
+ break;
+ }
+ }
+ return elemObj;
+ }
+
Tcl_IncrRefCount(listObj);
for (i=0 ; i<indexCount && listObj ; i++) {
@@ -3243,6 +3278,34 @@ SetListFromAny(
Tcl_IncrRefCount(valuePtr);
Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done);
}
+ } else if (TclHasInternalRep(objPtr,&tclArithSeriesType)) {
+ /*
+ * Convertion from Arithmetic Series is a special case
+ * because it can be done an order of magnitude faster
+ * and may occur frequently.
+ */
+ ListSizeT j, size = TclArithSeriesObjLength(objPtr);
+
+ /* TODO - leave space in front and/or back? */
+ if (ListRepInitAttempt(
+ interp, size > 0 ? size : 1, NULL, &listRep)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ LIST_ASSERT(listRep.spanPtr == NULL); /* Guard against future changes */
+ LIST_ASSERT(listRep.storePtr->firstUsed == 0);
+ LIST_ASSERT((listRep.storePtr->flags & LISTSTORE_CANONICAL) == 0);
+
+ listRep.storePtr->numUsed = size;
+ elemPtrs = listRep.storePtr->slots;
+ for (j = 0; j < size; j++) {
+ if (TclArithSeriesObjIndex(objPtr, j, &elemPtrs[j]) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_IncrRefCount(elemPtrs[j]);/* Since list now holds ref to it. */
+ }
+
} else {
ListSizeT estCount, length;
const char *limit, *nextElem = TclGetStringFromObj(objPtr, &length);
@@ -3432,6 +3495,7 @@ UpdateStringOfList(
ckfree(flagPtr);
}
}
+
/*
*------------------------------------------------------------------------
diff --git a/tests/lseq.test b/tests/lseq.test
new file mode 100644
index 0000000..ffb8a94
--- /dev/null
+++ b/tests/lseq.test
@@ -0,0 +1,482 @@
+# Commands covered: lseq
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands. Sourcing this file into Tcl runs the tests and
+# generates output for errors. No output means no errors were found.
+#
+# Copyright © 2003 Simon Geard.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
+}
+
+testConstraint arithSeriesDouble 1
+testConstraint arithSeriesShimmer 1
+testConstraint arithSeriesShimmerOk 0
+
+## Arg errors
+test lseq-1.1 {error cases} -body {
+ lseq
+} \
+ -returnCodes 1 \
+ -result {wrong # args: should be "lseq n ??op? n ??by? n??"}
+
+
+test lseq-1.2 {step magnitude} {
+ lseq 10 .. 1 by -2 ;# or this could be an error - or not
+} {10 8 6 4 2}
+
+test lseq-1.3 {synergy between int and double} {
+ set rl [lseq 25. to 5. by -5]
+ set il [lseq 25 to 5 by -5]
+ lmap r $rl i $il { if {$r ne "" && $i ne ""} {expr {int($r) == $i}} else {list $r $i} }
+} {1 1 1 1 1}
+
+test lseq-1.4 {integer decreasing} {
+ lseq 10 .. 1
+} {10 9 8 7 6 5 4 3 2 1}
+
+test lseq-1.5 {integer increasing} {
+ lseq 1 .. 10
+} {1 2 3 4 5 6 7 8 9 10}
+
+test lseq-1.6 {integer decreasing with step} {
+ lseq 10 .. 1 by -2
+} {10 8 6 4 2}
+
+test lseq-1.7 {real increasing lseq} arithSeriesDouble {
+ lseq 5.0 to 15.
+} {5.0 6.0 7.0 8.0 9.0 10.0 11.0 12.0 13.0 14.0 15.0}
+
+test lseq-1.8 {real increasing lseq with step} arithSeriesDouble {
+ lseq 5.0 to 25. by 5
+} {5.0 10.0 15.0 20.0 25.0}
+
+test lseq-1.9 {real decreasing with step} arithSeriesDouble {
+ lseq 25. to 5. by -5
+} {25.0 20.0 15.0 10.0 5.0}
+
+# note, 10 cannot be in such a list, but allowed
+test lseq-1.10 {integer lseq with step} {
+ lseq 1 to 10 by 2
+} {1 3 5 7 9}
+
+test lseq-1.11 {error case: increasing wrong step direction} {
+ lseq 1 to 10 by -2
+} {}
+
+test lseq-1.12 {decreasing lseq with step} arithSeriesDouble {
+ lseq 25. to -25. by -5
+} {25.0 20.0 15.0 10.0 5.0 0.0 -5.0 -10.0 -15.0 -20.0 -25.0}
+
+test lseq-1.13 {count operation} {
+ -body {
+ lseq 5 count 5
+ }
+ -result {5 6 7 8 9}
+}
+
+test lseq-1.14 {count with step} {
+ -body {
+ lseq 5 count 5 by 2
+ }
+ -result {5 7 9 11 13}
+}
+
+test lseq-1.15 {count with decreasing step} {
+ -body {
+ lseq 5 count 5 by -2
+ }
+ -result {5 3 1 -1 -3}
+}
+
+test lseq-1.16 {large numbers} {
+ -body {
+ lseq [expr {int(1e6)}] [expr {int(2e6)}] [expr {int(1e5)}]
+ }
+ -result {1000000 1100000 1200000 1300000 1400000 1500000 1600000 1700000 1800000 1900000 2000000}
+}
+
+test lseq-1.17 {too many arguments} -body {
+ lseq 12 to 24 by 2 with feeling
+} -returnCodes 1 -result {wrong # args: should be "lseq n ??op? n ??by? n??"}
+
+test lseq-1.18 {too many arguments extra valid keyword} -body {
+ lseq 12 to 24 by 2 count
+} -returnCodes 1 -result {wrong # args: should be "lseq n ??op? n ??by? n??"}
+
+test lseq-1.19 {too many arguments extra numeric value} -body {
+ lseq 12 to 24 by 2 7
+} -returnCodes 1 -result {wrong # args: should be "lseq n ??op? n ??by? n??"}
+
+test lseq-1.20 {bug: wrong length computed} {
+ lseq 1 to 10 -1
+} {}
+
+test lseq-1.21 {n n by n} {
+ lseq 66 84 by 3
+} {66 69 72 75 78 81 84}
+
+test lseq-1.22 {n n by -n} {
+ lseq 84 66 by -3
+} {84 81 78 75 72 69 66}
+
+#
+# Short-hand use cases
+#
+test lseq-2.2 {step magnitude} {
+ lseq 10 1 2 ;# this is an empty case since step has wrong sign
+} {}
+
+test lseq-2.3 {step wrong sign} arithSeriesDouble {
+ lseq 25. 5. 5 ;# ditto - empty list
+} {}
+
+test lseq-2.4 {integer decreasing} {
+ lseq 10 1
+} {10 9 8 7 6 5 4 3 2 1}
+
+test lseq-2.5 {integer increasing} {
+ lseq 1 10
+} {1 2 3 4 5 6 7 8 9 10}
+
+test lseq-2.6 {integer decreasing with step} {
+ lseq 10 1 by -2
+} {10 8 6 4 2}
+
+test lseq-2.7 {real increasing lseq} arithSeriesDouble {
+ lseq 5.0 15.
+} {5.0 6.0 7.0 8.0 9.0 10.0 11.0 12.0 13.0 14.0 15.0}
+
+
+test lseq-2.8 {real increasing lseq with step} arithSeriesDouble {
+ lseq 5.0 25. 5
+} {5.0 10.0 15.0 20.0 25.0}
+
+
+test lseq-2.9 {real decreasing with step} arithSeriesDouble {
+ lseq 25. 5. -5
+} {25.0 20.0 15.0 10.0 5.0}
+
+test lseq-2.10 {integer lseq with step} {
+ lseq 1 10 2
+} {1 3 5 7 9}
+
+test lseq-2.11 {error case: increasing wrong step direction} {
+ lseq 1 10 -2
+} {}
+
+test lseq-2.12 {decreasing lseq with step} arithSeriesDouble {
+ lseq 25. -25. -5
+} {25.0 20.0 15.0 10.0 5.0 0.0 -5.0 -10.0 -15.0 -20.0 -25.0}
+
+test lseq-2.13 {count only operation} {
+ lseq 5
+} {0 1 2 3 4}
+
+test lseq-2.14 {count with step} {
+ lseq 5 count 5 2
+} {5 7 9 11 13}
+
+test lseq-2.15 {count with decreasing step} {
+ lseq 5 count 5 -2
+} {5 3 1 -1 -3}
+
+test lseq-2.16 {large numbers} {
+ lseq 1e6 2e6 1e5
+} {1000000.0 1100000.0 1200000.0 1300000.0 1400000.0 1500000.0 1600000.0 1700000.0 1800000.0 1900000.0 2000000.0}
+
+test lseq-2.17 {large numbers} arithSeriesDouble {
+ lseq 1e6 2e6 1e5
+} {1000000.0 1100000.0 1200000.0 1300000.0 1400000.0 1500000.0 1600000.0 1700000.0 1800000.0 1900000.0 2000000.0}
+
+# Covered: {10 1 2 } {1 10 2} {1 10 -2} {1 1 1} {1 1 1} {-5 17 3}
+# Missing: {- - +} {- - -} {- + -} {+ - -} {- - +} {+ + -}
+test lseq-2.18 {signs} {
+ list [lseq -10 -1 2] \
+ [lseq -10 -1 -1] \
+ [lseq -10 1 -3] \
+ [lseq 10 -1 -4] \
+ [lseq -10 -1 3] \
+ [lseq 10 1 -5]
+
+} {{-10 -8 -6 -4 -2} {} {} {10 6 2} {-10 -7 -4 -1} {10 5}}
+
+test lseq-3.1 {experiement} {
+ set ans {}
+ foreach factor [lseq 2.0 10.0] {
+ set start 1
+ set end 10
+ for {set step 1} {$step < 1e8} {} {
+ set l [lseq $start to $end by $step]
+ if {[llength $l] != 10} {
+ lappend ans $factor $step [llength $l] $l
+ }
+ set step [expr {$step * $factor}]
+ set end [expr {$end * $factor}]
+ }
+ }
+ if {$ans eq {}} {
+ set ans OK
+ }
+ set ans
+} {OK}
+
+test lseq-3.2 {error case} -body {
+ lseq foo
+} -returnCodes 1 -result {bad operation "foo": must be .., to, count, or by}
+
+test lseq-3.3 {error case} -body {
+ lseq 10 foo
+} -returnCodes 1 -result {bad operation "foo": must be .., to, count, or by}
+
+test lseq-3.4 {error case} -body {
+ lseq 25 or 6
+} -returnCodes 1 -result {bad operation "or": must be .., to, count, or by}
+
+test lseq-3.5 {simple count and step arguments} {
+ set s [lseq 25 by 6]
+ list $s length=[llength $s]
+} {{0 6 12 18 24 30 36 42 48 54 60 66 72 78 84 90 96 102 108 114 120 126 132 138 144} length=25}
+
+test lseq-3.6 {error case} -body {
+ lseq 1 7 or 3
+} -returnCodes 1 -result {bad operation "or": must be .., to, count, or by}
+
+test lseq-3.7 {lmap lseq} {
+ lmap x [lseq 5] { expr {$x * $x} }
+} {0 1 4 9 16}
+
+test lseq-3.8 {lrange lseq} {
+ set r [lrange [lseq 1 100] 10 20]
+ lindex [tcl::unsupported::representation $r] 3
+} {arithseries}
+
+test lseq-3.9 {lassign lseq} arithSeriesShimmer {
+ set r [lseq 15]
+ set r2 [lassign $r a b]
+ list [lindex [tcl::unsupported::representation $r] 3] $a $b \
+ [lindex [tcl::unsupported::representation $r2] 3]
+} {arithseries 0 1 arithseries}
+
+test lseq-3.10 {lsearch lseq must shimmer?} arithSeriesShimmer {
+ set r [lseq 15 0]
+ set a [lsearch $r 9]
+ list [lindex [tcl::unsupported::representation $r] 3] $a
+} {arithseries 6}
+
+test lseq-3.11 {lreverse lseq} {
+ set r [lseq 15 0]
+ set a [lreverse $r]
+ join [list \
+ [lindex [tcl::unsupported::representation $r] 3] \
+ $r \
+ [lindex [tcl::unsupported::representation $a] 3] \
+ $a] \n
+} {arithseries
+15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0
+arithseries
+0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15}
+
+test lseq-3.12 {in operator} {
+ set r [lseq 9]
+ set i [expr {7 in $r}]
+ set j [expr {10 ni $r}]
+ set k [expr {-1 in $r}]
+ set l [expr {4 ni $r}]
+ list $i $j $k $l [lindex [tcl::unsupported::representation $r] 3]
+} {1 1 0 0 arithseries}
+
+test lseq-3.13 {lmap lseq shimmer} arithSeriesShimmer {
+ set r [lseq 15]
+ set rep-before [lindex [tcl::unsupported::representation $r] 3]
+ set m [lmap i $r { expr {$i * 7} }]
+ set rep-after [lindex [tcl::unsupported::representation $r] 3]
+ set rep-m [lindex [tcl::unsupported::representation $m] 3]
+ list $r ${rep-before} ${rep-after} ${rep-m} $m
+} {{0 1 2 3 4 5 6 7 8 9 10 11 12 13 14} arithseries arithseries list {0 7 14 21 28 35 42 49 56 63 70 77 84 91 98}}
+
+test lseq-3.14 {array for shimmer} arithSeriesShimmerOk {
+ array set testarray {a Test for This great Function}
+ set vars [lseq 2]
+ set vars-rep [lindex [tcl::unsupported::representation $vars] 3]
+ array for $vars testarray {
+ lappend keys $0
+ lappend vals $1
+ }
+ # Since hash order is not guaranteed, have to validate content ignoring order
+ set valk [lmap k $keys {expr {$k in {a for great}}}]
+ set valv [lmap v $vals {expr {$v in {Test This Function}}}]
+ set vars-after [lindex [tcl::unsupported::representation $vars] 3]
+ list ${vars-rep} $valk $valv ${vars-after}
+} {arithseries {1 1 1} {1 1 1} arithseries}
+
+test lseq-3.15 {join for shimmer} arithSeriesShimmer {
+ set r [lseq 3]
+ set rep-before [lindex [tcl::unsupported::representation $r] 3]
+ set str [join $r :]
+ set rep-after [lindex [tcl::unsupported::representation $r] 3]
+ list ${rep-before} $str ${rep-after}
+} {arithseries 0:1:2 arithseries}
+
+test lseq-3.16 {error case} -body {
+ lseq 16 to
+} -returnCodes 1 -result {missing "to" value.}
+
+test lseq-3.17 {error case} -body {
+ lseq 17 to 13 by
+} -returnCodes 1 -result {missing "by" value.}
+
+test lseq-3.18 {error case} -body {
+ lseq 18 count
+} -returnCodes 1 -result {missing "count" value.}
+
+test lseq-3.19 {edge case} -body {
+ lseq 1 count 5 by 0
+} -result {}
+# 1 1 1 1 1
+
+# My thought is that this is likely a user error, since they can always use lrepeat for this.
+
+test lseq-3.20 {edge case} -body {
+ lseq 1 to 1 by 0
+} -result {}
+
+# hmmm, I guess this is right, in a way, so...
+
+test lseq-3.21 {edge case} {
+ lseq 1 to 1 by 1
+} {1}
+
+test lseq-3.22 {edge case} {
+ lseq 1 1 1
+} {1}
+
+test lseq-3.23 {edge case} {
+ llength [lseq 1 1 1]
+} {1}
+
+test lseq-3.24 {edge case} {
+ llength [lseq 1 to 1 1]
+} {1}
+
+test lseq-3.25 {edge case} {
+ llength [lseq 1 to 1 by 1]
+} {1}
+
+test lseq-3.26 {lsort shimmer} arithSeriesShimmer {
+ set r [lseq 15 0]
+ set rep-before [lindex [tcl::unsupported::representation $r] 3]
+ set lexical_sort [lsort $r]
+ set rep-after [lindex [tcl::unsupported::representation $r] 3]
+ list ${rep-before} $lexical_sort ${rep-after}
+} {arithseries {0 1 10 11 12 13 14 15 2 3 4 5 6 7 8 9} arithseries}
+
+test lseq-3.27 {lreplace shimmer} arithSeriesShimmer {
+ set r [lseq 15 0]
+ set rep-before [lindex [tcl::unsupported::representation $r] 3]
+ set lexical_sort [lreplace $r 3 5 A B C]
+ set rep-after [lindex [tcl::unsupported::representation $r] 3]
+ list ${rep-before} $lexical_sort ${rep-after}
+} {arithseries {15 14 13 A B C 9 8 7 6 5 4 3 2 1 0} arithseries}
+
+test lseq-3.28 {lreverse bug in ArithSeries} {} {
+ set r [lseq -5 17 3]
+ set rr [lreverse $r]
+ list $r $rr [string equal $r [lreverse $rr]]
+} {{-5 -2 1 4 7 10 13 16} {16 13 10 7 4 1 -2 -5} 1}
+
+test lseq-3.29 {edge case: negative count} {
+ lseq -15
+} {}
+
+test lseq-3.30 {lreverse with double values} arithSeriesDouble {
+ set r [lseq 3.5 18.5 1.5]
+ set a [lreverse $r]
+ join [list \
+ [lindex [tcl::unsupported::representation $r] 3] \
+ $r \
+ [lindex [tcl::unsupported::representation $a] 3] \
+ $a] \n
+} {arithseries
+3.5 5.0 6.5 8.0 9.5 11.0 12.5 14.0 15.5 17.0 18.5
+arithseries
+18.5 17.0 15.5 14.0 12.5 11.0 9.5 8.0 6.5 5.0 3.5}
+
+test lseq-3.31 {lreverse inplace with doubles} arithSeriesDouble {
+ lreverse [lseq 1.1 29.9 0.3]
+} {29.9 29.599999999999998 29.299999999999997 29.0 28.7 28.4 28.099999999999998 27.799999999999997 27.5 27.2 26.9 26.599999999999998 26.299999999999997 26.0 25.7 25.4 25.099999999999998 24.799999999999997 24.5 24.2 23.9 23.599999999999998 23.299999999999997 23.0 22.7 22.4 22.099999999999998 21.799999999999997 21.5 21.2 20.9 20.6 20.299999999999997 20.0 19.7 19.4 19.1 18.799999999999997 18.5 18.2 17.9 17.6 17.299999999999997 17.0 16.7 16.4 16.1 15.799999999999999 15.5 15.2 14.899999999999999 14.6 14.299999999999999 14.0 13.7 13.399999999999999 13.099999999999998 12.8 12.5 12.2 11.899999999999999 11.599999999999998 11.3 11.0 10.7 10.399999999999999 10.099999999999998 9.8 9.5 9.2 8.899999999999999 8.599999999999998 8.3 8.0 7.699999999999999 7.399999999999999 7.099999999999998 6.800000000000001 6.5 6.199999999999999 5.899999999999999 5.599999999999998 5.300000000000001 5.0 4.699999999999999 4.399999999999999 4.099999999999998 3.8000000000000007 3.5 3.1999999999999993 2.8999999999999986 2.599999999999998 2.3000000000000007 2.0 1.6999999999999993 1.3999999999999986 1.1000000000000014}
+
+test lseq-4.1 {end expressions} {
+ set start 7
+ lseq $start $start+11
+} {7 8 9 10 11 12 13 14 15 16 17 18}
+
+test lseq-4.2 {start expressions} {
+ set base [clock seconds]
+ set tl [lseq $base-60 $base 10]
+ lmap t $tl {expr {$t - $base + 60}}
+} {0 10 20 30 40 50 60}
+
+## lseq 1 to 10 by -2
+## # -> lseq: invalid step = -2 with a = 1 and b = 10
+
+test lseq-4.3 {TIP examples} {
+ set examples {# Examples from TIP-629
+ # --- Begin ---
+ lseq 10 .. 1
+ # -> 10 9 8 7 6 5 4 3 2 1
+ lseq 1 .. 10
+ # -> 1 2 3 4 5 6 7 8 9 10
+ lseq 10 .. 1 by 2
+ # ->
+ lseq 10 .. 1 by -2
+ # -> 10 8 6 4 2
+ lseq 5.0 to 15.
+ # -> 5.0 6.0 7.0 8.0 9.0 10.0 11.0 12.0 13.0 14.0 15.0
+ lseq 5.0 to 25. by 5
+ # -> 5.0 10.0 15.0 20.0 25.0
+ lseq 25. to 5. by 5
+ # ->
+ lseq 25. to 5. by -5
+ # -> 25.0 20.0 15.0 10.0 5.0
+ lseq 1 to 10 by 2
+ # -> 1 3 5 7 9
+ lseq 25. to -25. by -5
+ # -> 25.0 20.0 15.0 10.0 5.0 0.0 -5.0 -10.0 -15.0 -20.0 -25.0
+ lseq 5 5
+ # -> 5
+ lseq 5 5 2
+ # -> 5
+ lseq 5 5 -2
+ # -> 5
+ }
+
+ foreach {cmd expect} [split $examples \n] {
+ if {[string trim $cmd] ne ""} {
+ set cmd [string trimleft $cmd]
+ if {[string match {\#*} $cmd]} continue
+ set status [catch $cmd ans]
+ lappend res $ans
+ if {[regexp {\# -> (.*)$} $expect -> expected]} {
+ if {$expected ne $ans} {
+ lappend res [list Mismatch: $cmd -> $ans ne $expected]
+ }
+ }
+ }
+ }
+ set res
+} {{10 9 8 7 6 5 4 3 2 1} {1 2 3 4 5 6 7 8 9 10} {} {10 8 6 4 2} {5.0 6.0 7.0 8.0 9.0 10.0 11.0 12.0 13.0 14.0 15.0} {5.0 10.0 15.0 20.0 25.0} {} {25.0 20.0 15.0 10.0 5.0} {1 3 5 7 9} {25.0 20.0 15.0 10.0 5.0 0.0 -5.0 -10.0 -15.0 -20.0 -25.0} 5 5 5}
+
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/range.test b/tests/range.test
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/tests/range.test
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 30d9462..1769aa4 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -299,8 +299,8 @@ XTTEST_OBJS = xtTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \
tclThreadTest.o tclUnixTest.o tclXtNotify.o tclXtTest.o
GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \
- tclAssembly.o tclAsync.o tclBasic.o tclBinary.o tclCkalloc.o \
- tclClock.o tclCmdAH.o tclCmdIL.o tclCmdMZ.o \
+ tclArithSeries.o tclAssembly.o tclAsync.o tclBasic.o tclBinary.o \
+ tclCkalloc.o tclClock.o tclCmdAH.o tclCmdIL.o tclCmdMZ.o \
tclCompCmds.o tclCompCmdsGR.o tclCompCmdsSZ.o tclCompExpr.o \
tclCompile.o tclConfig.o tclDate.o tclDictObj.o tclDisassemble.o \
tclEncoding.o tclEnsemble.o \
@@ -393,7 +393,8 @@ GENERIC_HDRS = \
$(GENERIC_DIR)/tclPatch.h \
$(GENERIC_DIR)/tclPlatDecls.h \
$(GENERIC_DIR)/tclPort.h \
- $(GENERIC_DIR)/tclRegexp.h
+ $(GENERIC_DIR)/tclRegexp.h \
+ $(GENERIC_DIR)/tclArithSeries.h
GENERIC_SRCS = \
$(GENERIC_DIR)/regcomp.c \
@@ -401,6 +402,7 @@ GENERIC_SRCS = \
$(GENERIC_DIR)/regfree.c \
$(GENERIC_DIR)/regerror.c \
$(GENERIC_DIR)/tclAlloc.c \
+ $(GENERIC_DIR)/tclArithSeries.c \
$(GENERIC_DIR)/tclAssembly.c \
$(GENERIC_DIR)/tclAsync.c \
$(GENERIC_DIR)/tclBasic.c \
@@ -1250,6 +1252,9 @@ tclAppInit.o: $(UNIX_DIR)/tclAppInit.c
tclAlloc.o: $(GENERIC_DIR)/tclAlloc.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAlloc.c
+tclArithSeries.o: $(GENERIC_DIR)/tclArithSeries.c $(COMPILEHDR)
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclArithSeries.c
+
tclAssembly.o: $(GENERIC_DIR)/tclAssembly.c $(COMPILEHDR)
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAssembly.c
diff --git a/win/Makefile.in b/win/Makefile.in
index 4e14ddc..7b9440e 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -278,6 +278,7 @@ GENERIC_OBJS = \
regfree.$(OBJEXT) \
regerror.$(OBJEXT) \
tclAlloc.$(OBJEXT) \
+ tclArithSeries.$(OBJEXT) \
tclAssembly.$(OBJEXT) \
tclAsync.$(OBJEXT) \
tclBasic.$(OBJEXT) \
diff --git a/win/makefile.vc b/win/makefile.vc
index 7c61580..f9c9242 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -238,6 +238,7 @@ COREOBJS = \
$(TMP_DIR)\regexec.obj \
$(TMP_DIR)\regfree.obj \
$(TMP_DIR)\tclAlloc.obj \
+ $(TMP_DIR)\tclArithSeries.obj \
$(TMP_DIR)\tclAssembly.obj \
$(TMP_DIR)\tclAsync.obj \
$(TMP_DIR)\tclBasic.obj \
generated by cgit v0.12 at 2024-11-13 06:12:25 (GMT)