summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/AbstractListObj.3319
-rw-r--r--doc/lseq.n48
-rw-r--r--generic/tcl.decls32
-rw-r--r--generic/tcl.h104
-rw-r--r--generic/tclAbstractList.c747
-rw-r--r--generic/tclAbstractList.h56
-rwxr-xr-xgeneric/tclArithSeries.c877
-rw-r--r--generic/tclArithSeries.h41
-rw-r--r--generic/tclBasic.c2
-rw-r--r--generic/tclCmdAH.c30
-rw-r--r--generic/tclCmdIL.c377
-rw-r--r--generic/tclDecls.h63
-rw-r--r--generic/tclExecute.c68
-rw-r--r--generic/tclInt.h52
-rw-r--r--generic/tclListObj.c123
-rw-r--r--generic/tclObj.c21
-rw-r--r--generic/tclStringObj.c6
-rw-r--r--generic/tclStubInit.c10
-rw-r--r--generic/tclTest.c5
-rw-r--r--generic/tclTestABSList.c835
-rw-r--r--tests/abstractlist.test537
-rw-r--r--tests/lseq.test13
-rw-r--r--unix/Makefile.in31
-rw-r--r--win/Makefile.in6
-rw-r--r--win/makefile.vc7
25 files changed, 3563 insertions, 847 deletions
diff --git a/doc/AbstractListObj.3 b/doc/AbstractListObj.3
new file mode 100644
index 0000000..ff3329c
--- /dev/null
+++ b/doc/AbstractListObj.3
@@ -0,0 +1,319 @@
+'\"
+'\" Copyright (c) 2022 Brian Griffin. 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 Tcl_AbstractListType 3 8.7 Tcl "Tcl Library Procedures"
+.so man.macros
+.BS
+.SH NAME
+Tcl_AbstractListObjNew,
+Tcl_AbsstractListObjCopy,
+Tcl_AbstractListGetConcreteRep,
+Tcl_AbstractListGetElements,
+Tcl_AbstractListGetType,
+Tcl_AbstractListObjIndex,
+Tcl_AbstractListObjLength,
+Tcl_AbstractListObjRange,
+Tcl_AbstractListObjReverse,
+Tcl_AbstractListSetConcreteRep,
+\- manipulate Tcl values as abstract lists.
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+Tcl_Obj *
+\fBTcl_AbstractListObjNew\fR(\fIinterp, abstractListType\fR)
+Tcl_AbstractListType *
+\fBTcl_AbstractListGetType\fR(\fIlistPtr\fR)
+void
+\fBTcl_AbstractListSetConcreteRep\fR(\fIlistPtr, repPtr\fR)
+void *
+\fBTcl_AbstractListGetConcreteRep\fR(\fIlistPtr\fR)
+Tcl_WideInt
+\fBTcl_AbstractListObjLength\fR(\fIlistPtr\fR)
+int
+\fBTcl_AbstractListObjIndex\fR(\fIinterp\fR, \fIlistPtr, index\fR, \fIelemObjPtr*\fR)
+int
+\fBTcl_AbstractListObjRange\fR(\fIinterp\fR, \fIlistPtr, fromIdx, toIdx\fR, \fInewObjPtr\fR)
+int
+\fBTcl_AbstractListObjReverse(\fIinterp\fR, \fIlistPtr\fR, \fInewObjPtr\fR)
+int
+\fBTcl_AbstraceListObjGetElements\fR(\fIinterp\fR, \fIlistPtr\fR, \fIobjcPtr\fR, \fIobjvPtr\fR)
+Tcl_Obj *
+\fBTcl_AbstractListObjCopy\fR(\fIinterp\fR, \fIlistPtr\fR);
+typedef Tcl_Obj* (Tcl_ALNewObjProc) (int objc, Tcl_Obj * const objv[]);
+typedef void (Tcl_ALDupRepProc) (Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
+typedef Tcl_WideInt (Tcl_ALLengthProc) (Tcl_Obj *listPtr);
+typedef int (Tcl_ALIndexProc) (Tcl_Interp *interp, Tcl_Obj *listPtr,
+ Tcl_WideInt index, Tcl_Obj** elemObj);
+typedef int (Tcl_ALSliceProc) (Tcl_Interp *interp, Tcl_Obj *listPtr,
+ Tcl_WideInt fromIdx, Tcl_WideInt toIdx,
+ Tcl_Obj **newObjPtr);
+typedef int (Tcl_ALReverseProc) (Tcl_Interp *interp, Tcl_Obj *listPtr,
+ Tcl_Obj **newObjPtr);
+typedef int (Tcl_ALGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr,
+ int *objcptr, Tcl_Obj ***objvptr);
+typedef void (Tcl_ALFreeConcreteRep) (Tcl_Obj *listPtr);
+typedef void (Tcl_ALToStringRep) (Tcl_Obj *listPtr);
+.SH ARGUMENTS
+.AS
+.AP Tcl_Interp *interp in
+If an error occurs while converting a value to be a list value,
+an error message is left in the interpreter's result value
+unless \fIinterp\fR is NULL.
+.AP Tcl_AbstractListType *abstractListType in
+This structure defines the behavior for the \fBAbstractList\fR for a
+given concrete \fBAbstractList\fR type. The struct provides the name
+plus a collection of functions that implement the various List
+operations on the AbstractType value. \fBTcl_AbstractListObjNew\fR
+call creates a new Tcl_Obj based on a preinitilized AbstractList
+struct.
+.AP Tcl_Obj *listPtr in/out
+A Tcl_Obj of type AbstractList. Use to read or modify the type or
+value content an AbstractList type.
+.AP void *repPtr in
+A reference to the concrete type representation storage. Specific
+concrete types allocate and use this space to store whatever details
+of value are needed.
+.AP Tcl_WideInt index in
+Index of the list element that \fBTcl_AbstractListObjIndex\fR
+is to return.
+The first element has index 0.
+.AP Tcl_Obj **elemObjPtr
+A location where the returned reference to an element Obj is to be
+stored.
+.AP Tcl_WideInt fromIdx in
+The starting index of the list element for the slice that
+\fBTcl_AbstractListObjRange\fR is to return.
+.AP Tcl_WideInt toIdx in
+The ending index of the list element for the slice that
+\fBTcl_AbstractListObjRange\fR is to return.
+.AP Tcl_Obj **newObjPtr in
+A location where the new slice or reversed Obj reference is to be
+stored.
+.AP (Tcl_ALNewObjProc) in
+Function pointer for a function used to create new instances of the
+custom AbstractList listPtr.
+.AP (Tcl_ALDupRepProc) in
+Function pointer for a function used to duplicate (make a copy) of the
+custom AbstractList listPtr.
+.AP (Tcl_ALLengthProc) in
+Function pointer for a function used to return the length of the
+custom AbstractList.
+.AP (Tcl_ALIndexProc) in
+Function pointer for a function used to return an element listPtr for
+the given index value.
+.AP (Tcl_ALSliceProc) in
+Function pointer for a function used to create a new slice from an
+existing AbstractList.
+.AP (Tcl_ALReverseProc) in
+Function pointer for a function used to create a new AbstractList with
+the element order reversed.
+.BE
+
+.SH DESCRIPTION
+.PP
+The AbstractList type provides an interface for creating new List type
+representations. An AbstractList behaves like a List when using script
+level list commands. How the values are stored or produced is up to
+the implementation. A simple example of an AbstractList is the [lseq]
+command which produces a list of numeric values in sequence. The
+underlying implementation does not store a list of numeric values.
+Instead, it produces values on demand based on the index using an
+arithmetic expression: "value = start + (step * index)".
+.PP
+An AbstractList is created by defining an internal storage
+representation for the list along with a set of functions that manage
+and manipulate the list value(s). These functions provide
+"List" like results from the List family of commands.
+
+.SH ABSTRACTLIST C API
+.PP
+\fBTcl_AbstractListObjNew\fR returns a new Tcl_Obj based on the
+concrete type definition given. The caller must then complete the
+initialization of the Obj by setting the concrete represtation. (see
+\fBTcl_AbstractListSetConcreteRep\fR())
+
+\fBTcl_AbstractListGetType\fR returns the Tcl_AbstractList struct for
+the given Obj. This function is used internally to access the
+implementation functions. It can also be used in a specific
+implementation to confirm that the Obj is of the expected AbstractList
+type.
+
+\fBTcl_AbstractListSetConcreteRep\fR is called when creating an
+instance of an AbstractList. It stores the repPtr, to the allocated
+value Representation, in the Tcl_Obj.
+
+\fBTcl_AbstractListGetConcreteRep\fR returns the previously stored
+repPtr for a given Obj value.
+
+\fBTcl_AbstractListObjLength\fR returns the list length, i.e., number
+of elements in the given AbstractList. This function is typically used
+internally by when evaluating various List operations. It would not
+typically be used by an AbstractList concrete implementaion since the
+internal representation is readily available within the
+implementation, presumably.
+
+\fBTcl_AbstractListObjIndex\fR returns the element Tcl_Obj for a given
+index location.
+
+\fBTcl_AbstractListObjRange\fR returns a new Obj value constructed
+from a slice of the original AbstractList value, ranging from
+\fIfromIdx\fR to the \fItoIdx\fR. If this function is not provided,
+the default behavior will be to construct a traditional List using the
+Index function.
+
+\fBTcl_AbstractListObjReverse\fR returns a new Obj value constructed by
+reversing the index order. If this function is not provided, the
+default behavior will be to construct a traditional List using the
+Index function.
+
+\fBTcl_AbstraceListObjGetElements\fR returns an objv array containing
+all elements of the AbstractList. (*** need words about memory
+ownership ***)
+
+\fBTcl_AbstractListObjCopy\fR returns a duplicate Obj from the original.
+
+.SH ABSTRACTLIST IMPLEMENTATION FUNCTIONS
+The following functions are to be defined by a specific implementation
+to provide full or parcial List compatible behavior. The Length and
+Index functions are required, and the rest are optional.
+Unimplemented functions will either use a default implementation that
+relies on Length and Index functions, or, the AbstractList will
+"shimmer" into a formal List value.
+.PP
+.CS
+typedef Tcl_Obj* (Tcl_ALNewObjProc) (int objc, Tcl_Obj * const objv[]);
+typedef void (Tcl_ALDupRepProc) (Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
+typedef Tcl_WideInt (Tcl_ALLengthProc) (Tcl_Obj *listPtr);
+typedef int (Tcl_ALIndexProc) (Tcl_Interp *interp, Tcl_Obj *listPtr,
+ Tcl_WideInt index, Tcl_Obj** elemObj);
+typedef int (Tcl_ALSliceProc) (Tcl_Interp *interp, Tcl_Obj *listPtr,
+ Tcl_WideInt fromIdx, Tcl_WideInt toIdx,
+ Tcl_Obj **newObjPtr);
+typedef int (Tcl_ALReverseProc) (Tcl_Interp *interp, Tcl_Obj *listPtr,
+ Tcl_Obj **newObjPtr);
+typedef int (Tcl_ALGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr,
+ int *objcptr, Tcl_Obj ***objvptr);
+typedef void (Tcl_ALFreeConcreteRep) (Tcl_Obj *listPtr);
+typedef void (Tcl_ALToStringRep) (Tcl_Obj *listPtr);
+.CE
+.PP
+.SH AbstractList Example
+.PP
+\fBTcl_AbstractListObjNew\fR is used to create an object with a custom
+List representation.
+.PP
+.CS
+/*
+** Define the AbstractList type callbacks
+*/
+static \fBTcl_AbstractListType\fR arithSeriesType = {
+ TCL_ABSTRACTLIST_VERSION_1,
+ "arithseries",
+ Tcl_NewArithSeriesObj,
+ DupArithSeriesRep,
+ TclArithSeriesObjLength,
+ TclArithSeriesObjIndex,
+ TclArithSeriesObjRange,
+ TclArithSeriesObjReverse,
+ TclArithSeriesGetElements,
+ FreeArithSeriesRep,
+ UpdateStringOfArithSeries
+};
+.CE
+.PP
+The Index and Length procs must be defined. The others are optional.
+If an optional proc is not defined, it may use a default routine that
+makes use of Length and Index, or the value will be converted to a
+List, and then the operation will proceed normally, and note: this
+will permanently change the value representation to a \fBList\fR
+representation.
+.PP
+.CS
+/*
+** Define the concrete representation for the ArithSeries type
+*/
+typedef struct ArithSeries {
+ int start,
+ int end,
+ int step,
+ int length
+} ArithSeries;
+
+/*
+** Allocate and initialize the concrete repdresentation.
+*/
+arithSeriesRepPtr = (ArithSeries*)\fBTcl_Alloc\fR(sizeof (ArithSeries));
+arithSeriesRepPtr->isDouble = 0;
+arithSeriesRepPtr->start = 0;
+arithSeriesRepPtr->end = 15;
+arithSeriesRepPtr->step = 1;
+arithSeriesRepPtr->len = 15;
+arithSeriesRepPtr->elements = NULL;
+
+/*
+** Create an instance Tcl_Obj
+*/
+\fBTcl_Obj\fR *arithObj = \fBTcl_AbstractListObjNew\fR(interp, &arithSeriesType);
+
+/*
+** Set the concrete value for the Obj.
+*/
+\fBTcl_AbstractListSetConcreteRep\fR(arithObj, arithSeriesRepPtr);
+
+return arithObj;
+.CE
+.PP
+If any List operation is used to modify the AbstractList, for example
+[lset $abstraceList 3 17], it will first be converted to a List before
+completing the change.
+.PP
+.CS
+/* Example functions */
+Tcl_Obj*
+ArithSeriesObjIndex(Tcl_Obj *arithSeriesObjPtr, Tcl_WideInt index)
+{
+ ArithSeries *arithSeriesRepPtr;
+ Tcl_WideInt element;
+ if (arithSeriesObjPtr->typePtr != &tclAbstractListType) {
+ Tcl_Panic("ArithSeriesObjIndex called with a not ArithSeries Obj.");
+ }
+ arithSeriesRepPtr = ArithSeriesRepPtr(arithSeriesObjPtr);
+
+ if (index < 0 || index >= arithSeriesRepPtr->length) {
+ return NULL;
+ }
+
+ /* List[i] = Start + (Step * i) */
+ element = (arithSeriesRepPtr->start + (index) * arithSeriesRepPtr->step);
+
+ return Tcl_NewWideIntObj(element);
+}
+
+Tcl_WideInt ArithSeriesObjLength(Tcl_Obj *arithSeriesObjPtr)
+{
+ ArithSeries *arithSeriesRepPtr = ArithSeriesRepPtr(arithSeriesObjPtr);
+ return arithSeriesRepPtr->length;
+}
+
+.CE
+.PP
+The functions \fBTcl_AbstractListObjLength\fR,
+\fBTcl_AbstractListObjIndex\fR, \fBTcl_AbstractListObjRange\fR, and
+\fBTcl_AbstractListObjReverse\fR can be used to interact with a known
+AbstatractList Tcl_Obj value, as well as \fBTcl_ListObjLength\fR,
+\fBTcl_ListObjIndex\fR, without causing the obj value to converted to
+a \fBList\fR. Tcl_ListObjGetElements can also be used on an
+AbstractList, just note that this call may result in new element
+objects being created for every element in the abstract list. Since
+an abstract list can be arbitrarily large and not consume space, this
+call may have undesired consequences.
+.PP
+.SH "SEE ALSO"
+Tcl_NewListObj(3), Tcl_NewObj(3), Tcl_DecrRefCount(3), Tcl_IncrRefCount(3), Tcl_GetObjResult(3)
+.SH KEYWORDS
+index, internal representation, length, list, list value,
+list type, value, value type, replace, string representation
diff --git a/doc/lseq.n b/doc/lseq.n
index df8a8bc..e6ba7a6 100644
--- a/doc/lseq.n
+++ b/doc/lseq.n
@@ -21,15 +21,36 @@ lseq \- Build a numeric sequence returned as a list
.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.
+argument ".." or "to" defines the range. The "count" option is used
+to define a count of the number of elements in the list. A short form use of
+the command, with a
+single count value, will create a range from 0 to count-1.
+
+The \fBlseq\fR command can produce both increasing and decreasing sequences. When
+both Start and End are provided without a Step value, then if Start <= End,
+the sequence will be increasing and if Start > End it will be decreasing. If a
+Step vale is included, it's sign should agree with the direction of the
+sequence (descending -> negative and ascending -> positive), otherwise an
+empty list is returned. For example:
+
+.CS \"
+ % lseq 1 to 5 ;# increasing
+ 1 2 3 4 5
+
+ % lseq 5 to 1 ;# decreasing
+ 5 4 3 2 1
+
+ % lseq 6 to 1 by 2 ;# decreasing, step wrong sign, empty list
+
+ % lseq 1 to 5 by 0 ;# all step sizes of 0 produce an empty list
+
+.\"
+.CE
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.
+may also be a valid expression. The expression will be evaluate and the
+numeric result be used. An expression that does not evaluate to a number will
+produce an invalid argument error.
.SH EXAMPLES
.CS
@@ -67,22 +88,13 @@ must be numeric; a non-numeric string will result in an error.
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), ledit(n), lindex(n), linsert(n),
-llength(n), lmap(n), lpop(n), lrange(n), lremove(n), lreplace(n),
+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
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 0def57e..e7e6214 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -2611,6 +2611,38 @@ declare 683 {
int Tcl_GetEncodingNulLength(Tcl_Encoding encoding)
}
+# TIP #636
+declare 684 {
+ Tcl_AbstractListType * Tcl_AbstractListGetType(Tcl_Obj *objPtr)
+}
+declare 685 {
+ Tcl_Obj *Tcl_AbstractListObjNew(Tcl_Interp *interp, const Tcl_AbstractListType* vTablePtr)
+}
+declare 686 {
+ Tcl_WideInt Tcl_AbstractListObjLength(Tcl_Obj *abstractListPtr)
+}
+declare 687 {
+ int Tcl_AbstractListObjIndex(Tcl_Interp *interp, Tcl_Obj *abstractListPtr, Tcl_Size index, Tcl_Obj **elemObjPtr)
+}
+declare 688 {
+ int Tcl_AbstractListObjRange(Tcl_Interp *interp, Tcl_Obj *abstractListPtr, Tcl_Size fromIdx, Tcl_Size toIdx, Tcl_Obj **newObjPtr)
+}
+declare 689 {
+ int Tcl_AbstractListObjReverse(Tcl_Interp *interp, Tcl_Obj *abstractListPtr, Tcl_Obj **newObjPtr)
+}
+declare 690 {
+ int Tcl_AbstractListObjGetElements(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size *objcPtr, Tcl_Obj ***objvPtr)
+}
+declare 691 {
+ Tcl_Obj *Tcl_AbstractListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr)
+}
+declare 692 {
+ void *Tcl_AbstractListGetConcreteRep(Tcl_Obj *objPtr)
+}
+declare 693 {
+ Tcl_Obj *Tcl_AbstractListSetElement(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size indexCount, Tcl_Obj *const indexArray[], Tcl_Obj *valueObj)
+}
+
# ----- BASELINE -- FOR -- 8.7.0 ----- #
##############################################################################
diff --git a/generic/tcl.h b/generic/tcl.h
index 706c5f1..d352234 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -694,6 +694,110 @@ typedef struct Tcl_Obj {
/*
+ * Abstract List
+ *
+ * This structure provides the functions used in List operations to emulate a
+ * List for AbstractList types.
+ */
+
+/* Abstract List functions */
+typedef struct Tcl_Obj* (Tcl_ALNewObjProc) (Tcl_Size objc, struct Tcl_Obj * const objv[]);
+typedef void (Tcl_ALDupRepProc) (struct Tcl_Obj *srcPtr, struct Tcl_Obj *copyPtr);
+typedef Tcl_WideInt (Tcl_ALLengthProc) (struct Tcl_Obj *listPtr);
+typedef int (Tcl_ALIndexProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
+ Tcl_Size index, struct Tcl_Obj** elemObj);
+typedef int (Tcl_ALSliceProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
+ Tcl_Size fromIdx, Tcl_Size toIdx,
+ struct Tcl_Obj **newObjPtr);
+typedef int (Tcl_ALReverseProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
+ struct Tcl_Obj **newObjPtr);
+typedef int (Tcl_ALGetElements) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
+ Tcl_Size *objcptr, struct Tcl_Obj ***objvptr);
+typedef void (Tcl_ALFreeConcreteRep) (struct Tcl_Obj *listPtr);
+typedef void (Tcl_ALToStringRep) (struct Tcl_Obj *listPtr);
+typedef struct Tcl_Obj* (Tcl_ALSetElement) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
+ Tcl_Size indexCount,
+ struct Tcl_Obj *const indexArray[],
+ struct Tcl_Obj *valueObj);
+typedef int (Tcl_ALReplaceProc) (Tcl_Interp *interp, struct Tcl_Obj *listObj,
+ Tcl_Size first, Tcl_Size numToDelete,
+ Tcl_Size numToInsert,
+ struct Tcl_Obj *const insertObjs[]);
+
+typedef enum {
+ TCL_ABSL_NEW, TCL_ABSL_DUPREP, TCL_ABSL_LENGTH, TCL_ABSL_INDEX,
+ TCL_ABSL_SLICE, TCL_ABSL_REVERSE, TCL_ABSL_GETELEMENTS, TCL_ABSL_FREEREP,
+ TCL_ABSL_TOSTRING, TCL_ABSL_SETELEMENT, TCL_ABSL_REPLACE
+} Tcl_AbstractListProcType;
+
+typedef struct Tcl_AbstractListVersion_ *Tcl_AbstractListVersion;
+
+
+#define TCL_ABSTRACTLIST_VERSION_1 ((Tcl_AbstractListVersion) 0x1)
+
+/* Virtual function dispatch a la Tcl_ObjType but for AbstractList */
+typedef struct Tcl_AbstractListType {
+ Tcl_AbstractListVersion version;/* Structure version */
+ const char *typeName; /* Custom value reference */
+
+ /* List emulation functions */
+ Tcl_ALNewObjProc *newObjProc; /* How to create a new Tcl_Obj of this
+ ** custom type */
+ Tcl_ALDupRepProc *dupRepProc; /* How to duplicate a internal rep of this
+ ** custom type */
+ Tcl_ALLengthProc *lengthProc; /* Return the [llength] of the
+ ** AbstractList */
+ Tcl_ALIndexProc *indexProc; /* Return a value (Tcl_Obj) for
+ ** [lindex $al $index] */
+ Tcl_ALSliceProc *sliceProc; /* Return an AbstractList for
+ ** [lrange $al $start $end] */
+ Tcl_ALReverseProc *reverseProc; /* Return an AbstractList for
+ ** [lreverse $al] */
+ Tcl_ALGetElements *getElementsProc; /* Return an objv[] of all elements in
+ ** the list */
+ Tcl_ALFreeConcreteRep *freeRepProc; /* Free ConcreteRep internals if
+ ** necessary */
+ Tcl_ALToStringRep *toStringProc; /* Optimized "to-string" conversion
+ ** for updating the string rep */
+ Tcl_ALSetElement *setElementProc; /* Replace the element at the indicie
+ ** with the given valueObj. */
+ Tcl_ALReplaceProc *replaceProc; /* Replace subset with subset */
+
+} Tcl_AbstractListType;
+
+/*
+ * Sets the storage used by the concrete abstract list type
+ * Caller has to ensure type is AbstractList. Existing rep will be
+ * overwritten so caller has to free previous rep if necessary.
+ */
+static inline void Tcl_AbstractListSetConcreteRep(
+ Tcl_Obj *objPtr, /* Object of type AbstractList */
+ void *repPtr) /* New representation */
+{
+ /* assert(objPtr->typePtr == &tclAbstractListType); */
+ objPtr->internalRep.twoPtrValue.ptr1 = repPtr;
+}
+
+/*
+ *----------------------------------------------------------------------------
+ * The following structure contains the state needed by Tcl_SaveResult. No-one
+ * outside of Tcl should access any of these fields. This structure is
+ * typically allocated on the stack.
+ */
+
+#ifndef TCL_NO_DEPRECATED
+typedef struct Tcl_SavedResult {
+ char *result;
+ Tcl_FreeProc *freeProc;
+ Tcl_Obj *objResultPtr;
+ char *appendResult;
+ int appendAvl;
+ int appendUsed;
+ char resultSpace[200+1];
+} Tcl_SavedResult;
+#endif
+
+/*
*----------------------------------------------------------------------------
* The following definitions support Tcl's namespace facility. Note: the first
* five fields must match exactly the fields in a Namespace structure (see
diff --git a/generic/tclAbstractList.c b/generic/tclAbstractList.c
new file mode 100644
index 0000000..7c053da
--- /dev/null
+++ b/generic/tclAbstractList.c
@@ -0,0 +1,747 @@
+/*
+ * tclAbstractList.h --
+ *
+ * The AbstractList Obj Type -- a psuedo List
+ *
+ * Copyright © 2022 by Brian Griffin. All rights reserved.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tcl.h"
+#include "tclAbstractList.h"
+
+
+/* -------------------------- AbstractList object ---------------------------- */
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static void DupAbstractListInternalRep (Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
+static void FreeAbstractListInternalRep (Tcl_Obj *listPtr);
+static int SetAbstractListFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr);
+static void UpdateStringOfAbstractList (Tcl_Obj *listPtr);
+
+/*
+ * The structure below defines the AbstractList Tcl object type by means of
+ * procedures that can be invoked by generic object code.
+ *
+ * The abstract list object is a special case of Tcl list represented by a set
+ * of functions.
+ *
+ */
+
+const Tcl_ObjType tclAbstractListType = {
+ "abstractlist", /* name */
+ FreeAbstractListInternalRep, /* freeIntRepProc */
+ DupAbstractListInternalRep, /* dupIntRepProc */
+ UpdateStringOfAbstractList, /* updateStringProc */
+ SetAbstractListFromAny /* setFromAnyProc */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AbstractListLen --
+ *
+ * Compute the length of the equivalent list
+ *
+ * Results:
+ *
+ * The length of the list generated by the given range,
+ * that may be zero.
+ *
+ * Side effects:
+ *
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+Tcl_WideInt
+Tcl_AbstractListObjLength(Tcl_Obj *abstractListObjPtr)
+{
+ return AbstractListObjLength(abstractListObjPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AbstractListObjNew()
+ *
+ * Creates a new AbstractList object. The returned object has
+ * refcount = 0.
+ *
+ * Results:
+ *
+ * A Tcl_Obj pointer to the created AbstractList object.
+ * A NULL pointer of the range is invalid.
+ *
+ * Side Effects:
+ *
+ * None.
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj*
+Tcl_AbstractListObjNew(Tcl_Interp *interp, const Tcl_AbstractListType* vTablePtr)
+{
+ Tcl_Obj *objPtr;
+ Tcl_ObjInternalRep itr;
+ (void)interp;
+ TclNewObj(objPtr);
+ Tcl_StoreInternalRep(objPtr, &tclAbstractListType, &itr);
+ Tcl_AbstractListSetType(objPtr, (void*)vTablePtr); /* dispatch table for concrete type */
+ Tcl_AbstractListSetConcreteRep(objPtr, NULL);
+ Tcl_InvalidateStringRep(objPtr);
+ return objPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AbstractListObjIndex --
+ *
+ * Returns the element with the specified index in the list
+ * represented by the specified Abstract List 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:
+ *
+ * Element Tcl_Obj is returned on succes, NULL on index out of range.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_AbstractListObjIndex(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ Tcl_Obj *abstractListObjPtr, /* List obj */
+ Tcl_Size index, /* index to element of interest */
+ Tcl_Obj **elemObjPtr) /* Return value */
+{
+ Tcl_AbstractListType *typePtr;
+
+ typePtr = Tcl_AbstractListGetType(abstractListObjPtr);
+ /*
+ * The general assumption is that the obj is assumed first to be a List,
+ * and only ends up here because it has been determinded to be an
+ * AbstractList. If that's not the case, then a mistake has been made. To
+ * attempt to try a List call (e.g. shimmer) could potentially loop(?)
+ * So: if called from List code, then something has gone wrong; if called
+ * from user code, then user has made a mistake.
+ */
+ if (typePtr == NULL) {
+ if (interp) {
+ Tcl_SetObjResult(
+ interp,
+ Tcl_NewStringObj("Tcl_AbstractListObjIndex called without and AbstractList Obj.", -1));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "UNKNOWN", NULL);
+ return TCL_ERROR;
+ }
+ }
+ return typePtr->indexProc(interp, abstractListObjPtr, index, elemObjPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeAbstractListInternalRep --
+ *
+ * Deallocate the storage associated with an abstract list object's
+ * internal representation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees abstractListPtr's AbstractList* internal representation and
+ * sets listPtr's internalRep.twoPtrValue.ptr2 to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+FreeAbstractListInternalRep(Tcl_Obj *abstractListObjPtr)
+{
+ Tcl_AbstractListType *typePtr = Tcl_AbstractListGetType(abstractListObjPtr);
+
+ if (TclAbstractListHasProc(abstractListObjPtr, TCL_ABSL_FREEREP)) {
+ /* call the free callback for the concrete rep */
+ typePtr->freeRepProc(abstractListObjPtr);
+ }
+ abstractListObjPtr->internalRep.twoPtrValue.ptr2 = NULL;
+ abstractListObjPtr->internalRep.twoPtrValue.ptr1 = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupAbstractListInternalRep --
+ *
+ * Initialize the internal representation of a AbstractList Tcl_Obj to a
+ * copy of the internal representation of an existing abstractlist object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * We set "copyPtr"s internal rep to a pointer to a
+ * newly allocated AbstractList structure.
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupAbstractListInternalRep(
+ Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
+ Tcl_Obj *copyPtr) /* Object with internal rep to set.
+ * Internal rep must be clear, it is stomped */
+{
+ Tcl_AbstractListType *typePtr;
+ typePtr = Tcl_AbstractListGetType(srcPtr);
+ Tcl_AbstractListSetType(copyPtr, typePtr);
+ Tcl_AbstractListSetConcreteRep(copyPtr, NULL);
+
+ /* Now do concrete type dup. It is responsible for calling
+ Tcl_AbstractListSetConcreteRep to initialize ptr2 */
+
+ if (typePtr->dupRepProc) {
+ typePtr->dupRepProc(srcPtr, copyPtr);
+ } else {
+ /* TODO - or set it to NULL instead? */
+ Tcl_AbstractListSetConcreteRep
+ (copyPtr, Tcl_AbstractListGetConcreteRep(srcPtr));
+ }
+
+ copyPtr->typePtr = &tclAbstractListType;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfAbstractList --
+ *
+ * Update the string representation for an abstractlist 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
+ * listlike-to-string conversion. This string will be empty if the
+ * AbstractList is empty.
+ *
+ * Notes:
+ * This simple approach is costly in that it forces a string rep for each
+ * element, which is then tossed. Improving the performance here may
+ * require implementing a custom size-calculation function for each
+ * subtype of AbstractList.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfAbstractList(Tcl_Obj *abstractListObjPtr)
+{
+# define LOCAL_SIZE 64
+ char localFlags[LOCAL_SIZE], *flagPtr = NULL;
+ Tcl_AbstractListType *typePtr;
+ char *p;
+ int bytesNeeded = 0;
+ int llen, i;
+
+ /*
+ * TODO - this function essentially adapts the UpdateStringOfList function
+ * for native lists. Both functions allocate temporary storage for
+ * localFlags. I'm not sure if that is the best strategy for performance
+ * as well as memory for large list sizes. Revisit to see if growing
+ * the allocation on the fly would be better. Essentially combine the
+ * TclScanElement and TclConvertElement into one loop, growing the
+ * destination allocation if necessary.
+ */
+
+ typePtr = Tcl_AbstractListGetType(abstractListObjPtr);
+
+ /*
+ * If concrete type has a better way to generate the string,
+ * let it do it.
+ */
+ if (TclAbstractListHasProc(abstractListObjPtr, TCL_ABSL_TOSTRING)) {
+ typePtr->toStringProc(abstractListObjPtr);
+ return;
+ }
+
+ /*
+ * TODO - do we need a AbstractList method to mark the list as canonical?
+ * Or perhaps are abstract lists always canonical?
+ * Mark the list as being canonical; although it will now have a string
+ * rep, it is one we derived through proper "canonical" quoting and so
+ * it's known to be free from nasties relating to [concat] and [eval].
+ * listRepPtr->canonicalFlag = 1;
+ */
+
+
+ /*
+ * Handle empty list case first, so rest of the routine is simpler.
+ */
+ llen = typePtr->lengthProc(abstractListObjPtr);
+ if (llen <= 0) {
+ Tcl_InitStringRep(abstractListObjPtr, NULL, 0);
+ return;
+ }
+
+ /*
+ * Pass 1: estimate space.
+ */
+ if (llen <= LOCAL_SIZE) {
+ flagPtr = localFlags;
+ } else {
+ /* We know numElems <= LIST_MAX, so this is safe. */
+ flagPtr = (char *) Tcl_Alloc(llen);
+ }
+ for (bytesNeeded = 0, i = 0; i < llen; i++) {
+ Tcl_Obj *elemObj;
+ const char *elemStr;
+ int elemLen;
+ flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0);
+ typePtr->indexProc(NULL, abstractListObjPtr, i, &elemObj);
+ Tcl_IncrRefCount(elemObj);
+ elemStr = TclGetStringFromObj(elemObj, &elemLen);
+ /* Note TclScanElement updates flagPtr[i] */
+ bytesNeeded += TclScanElement(elemStr, elemLen, flagPtr+i);
+ if (bytesNeeded < 0) {
+ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+ }
+ Tcl_DecrRefCount(elemObj);
+ }
+ if (bytesNeeded > INT_MAX - llen + 1) {
+ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+ }
+ bytesNeeded += llen; /* Separating spaces and terminating nul */
+
+ /*
+ * Pass 2: generate the string repr.
+ */
+ abstractListObjPtr->bytes = (char *) Tcl_Alloc(bytesNeeded);
+ p = abstractListObjPtr->bytes;
+ for (i = 0; i < llen; i++) {
+ Tcl_Obj *elemObj;
+ const char *elemStr;
+ int elemLen;
+ flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0);
+ typePtr->indexProc(NULL, abstractListObjPtr, i, &elemObj);
+ Tcl_IncrRefCount(elemObj);
+ elemStr = TclGetStringFromObj(elemObj, &elemLen);
+ p += TclConvertElement(elemStr, elemLen, p, flagPtr[i]);
+ *p++ = ' ';
+ Tcl_DecrRefCount(elemObj);
+ }
+ p[-1] = '\0'; /* Overwrite last space added */
+
+ /* Length of generated string */
+ abstractListObjPtr->length = p - 1 - abstractListObjPtr->bytes;
+
+ if (flagPtr != localFlags) {
+ Tcl_Free(flagPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetAbstractListFromAny --
+ *
+ * The AbstractList object is just a way to optimize
+ * Lists space complexity, so no one should try to convert
+ * a string to an AbstractList 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
+SetAbstractListFromAny(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr) /* The object to convert. */
+{
+ (void)interp;
+ (void)objPtr;
+ /* TODO - at some future point, should just shimmer to a traditional
+ * Tcl list (but only when those are implemented under the AbstractList)
+ * interface.
+ */
+ Tcl_Panic("SetAbstractListFromAny: should never be called");
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AbstractListObjCopy --
+ *
+ * Makes a "pure AbstractList" copy of an AbstractList 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
+ * abstractList value as *abstractListPtr does. The returned Tcl_Obj has a
+ * refCount of zero. If *abstractListPtr does not hold an AbstractList,
+ * NULL is returned, and if interp is non-NULL, an error message is
+ * recorded there.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_AbstractListObjCopy(
+ Tcl_Interp *interp, /* Used to report errors if not NULL. */
+ Tcl_Obj *abstractListObjPtr) /* List object for which an element array is
+ * to be returned. */
+{
+ Tcl_Obj *copyPtr;
+
+ if (!TclHasInternalRep(abstractListObjPtr, &tclAbstractListType)) {
+ if (SetAbstractListFromAny(interp, abstractListObjPtr) != TCL_OK) {
+ /* We know this is going to panic, but it's the message we want */
+ return NULL;
+ }
+ }
+
+ TclNewObj(copyPtr);
+ TclInvalidateStringRep(copyPtr);
+ DupAbstractListInternalRep(abstractListObjPtr, copyPtr);
+ return copyPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AbstractListObjRange --
+ *
+ * Makes a slice of an AbstractList value.
+ * *abstractListObjPtr must be known to be a valid AbstractList.
+ *
+ * Results:
+ * Returns a pointer to the sliced array.
+ * This may be a new object or the same object if not shared.
+ *
+ * Side effects:
+ *
+ * ?The possible conversion of the object referenced by
+ * abstractListObjPtr to a list object.?
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_AbstractListObjRange(
+ Tcl_Interp *interp, /* For error messages. */
+ Tcl_Obj *abstractListObjPtr, /* List object to take a range from. */
+ Tcl_Size fromIdx, /* Index of first element to include. */
+ Tcl_Size toIdx, /* Index of last element to include. */
+ Tcl_Obj **newObjPtr) /* return value */
+{
+ Tcl_AbstractListType *typePtr;
+ if (!TclHasInternalRep(abstractListObjPtr, &tclAbstractListType)) {
+ if (interp) {
+ Tcl_SetObjResult(
+ interp,
+ Tcl_NewStringObj("Not an AbstractList.", -1));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "UNKNOWN", NULL);
+ }
+ return TCL_ERROR;
+ }
+ typePtr = Tcl_AbstractListGetType(abstractListObjPtr);
+ /*
+ * sliceProc can be NULL, then revert to List. Note: [lrange]
+ * command also checks for NULL sliceProc, and won't call AbstractList
+ */
+ if (typePtr->sliceProc) {
+ return typePtr->sliceProc(interp, abstractListObjPtr, fromIdx, toIdx, newObjPtr);
+ } else {
+ /* TODO ?shimmer avoided? */
+ Tcl_Obj *newObj = TclListObjCopy(NULL, abstractListObjPtr);
+ *newObjPtr = (newObj ? TclListObjRange(newObj, (Tcl_Size)fromIdx, (Tcl_Size)toIdx) : NULL);
+ return (newObj ? TCL_OK : TCL_ERROR);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AbstractListObjReverse --
+ *
+ * Reverses the order of an AbstractList value.
+ * *abstractListObjPtr must be known to be a valid AbstractList.
+ *
+ * Results:
+ * Returns a pointer to the reversed array.
+ * This may be a new object or the same object if not shared.
+ *
+ * Side effects:
+ *
+ * ?The possible conversion of the object referenced by
+ * abstractListObjPtr to a list object.?
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_AbstractListObjReverse(
+ Tcl_Interp *interp, /* for reporting errors. */
+ Tcl_Obj *abstractListObjPtr, /* List object to take a range from. */
+ Tcl_Obj **newObjPtr) /* New AbstractListObj */
+{
+ Tcl_AbstractListType *typePtr;
+
+ if (!TclHasInternalRep(abstractListObjPtr, &tclAbstractListType)) {
+ if (interp) {
+ Tcl_SetObjResult(
+ interp,
+ Tcl_NewStringObj("Not an AbstractList.", -1));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "UNKNOWN", NULL);
+ }
+ return TCL_ERROR;
+ }
+ if (!TclAbstractListHasProc(abstractListObjPtr, TCL_ABSL_REVERSE)) {
+ if (interp) {
+ Tcl_SetObjResult(
+ interp,
+ Tcl_NewStringObj("lreverse not supported!", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREVERSE", NULL);
+ }
+ return TCL_ERROR;
+ }
+ typePtr = Tcl_AbstractListGetType(abstractListObjPtr);
+ return typePtr->reverseProc(interp, abstractListObjPtr, newObjPtr);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AbstractListObjGetElements --
+ *
+ * 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
+Tcl_AbstractListObjGetElements(
+ Tcl_Interp *interp, /* Used to report errors if not NULL. */
+ Tcl_Obj *objPtr, /* AbstractList object for which an element
+ * array is to be returned. */
+ Tcl_Size *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,&tclAbstractListType)) {
+ Tcl_AbstractListType *typePtr = Tcl_AbstractListGetType(objPtr);
+
+ if (TclAbstractListHasProc(objPtr, TCL_ABSL_GETELEMENTS)) {
+ int status = typePtr->getElementsProc(interp, objPtr, objcPtr, objvPtr);
+ return status;
+ } else {
+ if (interp) {
+ Tcl_SetObjResult(
+ interp,
+ Tcl_NewStringObj("GetElements not supported!", -1));
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+ }
+ }
+ return TCL_ERROR;
+ } else {
+ if (interp != NULL) {
+ Tcl_SetObjResult(
+ interp,
+ Tcl_ObjPrintf("value is not an abstract list"));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "UNKNOWN", NULL);
+ }
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ * Returns pointer to the concrete type or NULL if not AbstractList or
+ * not abstract list of the same type as concrete type
+ */
+Tcl_AbstractListType *
+Tcl_AbstractListGetType(
+ Tcl_Obj *objPtr) /* Object of type AbstractList */
+{
+ if (objPtr->typePtr != &tclAbstractListType) {
+ return NULL;
+ }
+ return (Tcl_AbstractListType *) objPtr->internalRep.twoPtrValue.ptr2;
+}
+
+/* Returns the storage used by the concrete abstract list type */
+void* Tcl_AbstractListGetConcreteRep(
+ Tcl_Obj *objPtr) /* Object of type AbstractList */
+{
+ /* Public function, must check for NULL */
+ if (objPtr == NULL || objPtr->typePtr != &tclAbstractListType) {
+ return NULL;
+ }
+ return objPtr->internalRep.twoPtrValue.ptr1;
+}
+
+/* Replace or add the element in the list @indicies with the given new value
+ */
+Tcl_Obj *
+Tcl_AbstractListSetElement(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr,
+ Tcl_Size indexCount,
+ Tcl_Obj *const indexArray[],
+ Tcl_Obj *valueObj)
+{
+ Tcl_Obj *returnObj = NULL;
+
+ if (TclHasInternalRep(objPtr,&tclAbstractListType)) {
+ Tcl_AbstractListType *typePtr = Tcl_AbstractListGetType(objPtr);
+ if (TclAbstractListHasProc(objPtr, TCL_ABSL_SETELEMENT)) {
+ returnObj = typePtr->setElementProc(interp, objPtr, indexCount, indexArray, valueObj);
+ } else {
+ if (interp) {
+ Tcl_SetObjResult(
+ interp,
+ Tcl_NewStringObj("SetElement not supported!", -1));
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+ }
+ returnObj = NULL;
+ }
+ } else {
+ if (interp != NULL) {
+ Tcl_SetObjResult(
+ interp,
+ Tcl_ObjPrintf("value is not an abstract list"));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "UNKNOWN", NULL);
+ }
+ returnObj = NULL;
+ }
+ return returnObj;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AbstractListObjReplace --
+ *
+ * This function mimics the Tcl_ListObjReplace operation, iff the
+ * concrete abstract list type supports the Replace operation, and if
+ * not, it will return with an error.
+ *
+ * This function replaces zero or more elements of the abstract list
+ * referenced by listObj with the objects from an (objc,objv) array. The
+ * objc elements of the array referenced by objv replace the count
+ * elements in listPtr starting at first.
+ *
+ * If the argument first is zero or negative, it refers to the first
+ * element. If first is greater than or equal to the number of elements
+ * in the list, then no elements are deleted; the new elements are
+ * appended to the list. Count gives the number of elements to replace.
+ * If count is zero or negative then no elements are deleted; the new
+ * elements are simply inserted before first.
+ *
+ * The argument objv refers to an array of objc pointers to the new
+ * elements to be added to listPtr in place of those that were deleted.
+ * If objv is NULL, no new elements are added.
+ *
+ * Results:
+ * The return value is normally TCL_OK. If listPtr does not support the
+ * Replace opration then TCL_ERROR is returned and an error message will
+ * be left in the interpreter's result if interp is not NULL.
+ *
+ * Side effects:
+ * The ref counts of the objc elements in objv maybe incremented iff the
+ * concrete type retains a reference to the element(s), otherwise there
+ * will be no change to the ref counts. Similarly, the ref counts for
+ * replaced objects are decremented. listObj's old string representation,
+ * if any, is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+int Tcl_AbstractListObjReplace(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr, /* List object whose elements to replace. */
+ Tcl_Size first, /* Index of first element to replace. */
+ Tcl_Size numToDelete, /* Number of elements to replace. */
+ Tcl_Size numToInsert, /* Number of objects to insert. */
+ Tcl_Obj *const insertObjs[]) /* Tcl objects to insert */
+{
+ int status;
+ if (TclHasInternalRep(objPtr,&tclAbstractListType)) {
+ Tcl_AbstractListType *typePtr = Tcl_AbstractListGetType(objPtr);
+ if (TclAbstractListHasProc(objPtr, TCL_ABSL_REPLACE)) {
+ status = typePtr->replaceProc(interp, objPtr, first, numToDelete, numToInsert, insertObjs);
+ } else {
+ if (interp) {
+ Tcl_SetObjResult(
+ interp,
+ Tcl_NewStringObj("Replace not supported!", -1));
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+ }
+ status = TCL_ERROR;
+ }
+ } else {
+ if (interp != NULL) {
+ Tcl_SetObjResult(
+ interp,
+ Tcl_ObjPrintf("value is not an abstract list"));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "UNKNOWN", NULL);
+ }
+ status = TCL_ERROR;
+ }
+ return status;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclAbstractList.h b/generic/tclAbstractList.h
new file mode 100644
index 0000000..1c19f9c
--- /dev/null
+++ b/generic/tclAbstractList.h
@@ -0,0 +1,56 @@
+/*
+ * tclAbstractList.h --
+ *
+ * The AbstractList Obj Type -- a psuedo List
+ *
+ * Copyright © 2022 by Brian Griffin. All rights reserved.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#ifndef _TCLABSTRACTLIST
+#define _TCLABSTRACTLIST
+
+#include "tclInt.h"
+
+static inline const char*
+Tcl_AbstractListTypeName(
+ Tcl_Obj *objPtr) /* Should be of type AbstractList */
+{
+ Tcl_AbstractListType *typePtr;
+ typePtr = Tcl_AbstractListGetType(objPtr);
+ if (typePtr && typePtr->typeName) {
+ return typePtr->typeName;
+ } else {
+ return "abstractlist";
+ }
+}
+
+Tcl_Obj * Tcl_AbstractListObjNew(Tcl_Interp *interp, const Tcl_AbstractListType *vTablePtr);
+Tcl_WideInt Tcl_AbstractListObjLength(Tcl_Obj *abstractListPtr);
+int Tcl_AbstractListObjIndex(Tcl_Interp *interp, Tcl_Obj *abstractListPtr,
+ Tcl_Size index, Tcl_Obj **elemObj);
+int Tcl_AbstractListObjRange(Tcl_Interp *interp, Tcl_Obj *abstractListPtr,
+ Tcl_Size fromIdx, Tcl_Size toIdx, Tcl_Obj **newObjPtr);
+int Tcl_AbstractListObjReverse(Tcl_Interp *interp, Tcl_Obj *abstractListPtr,
+ Tcl_Obj **newObjPtr);
+int Tcl_AbstractListObjGetElements(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size *objcPtr,
+ Tcl_Obj ***objvPtr);
+Tcl_Obj * Tcl_AbstractListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr);
+void * Tcl_AbstractListGetConcreteRep(Tcl_Obj *objPtr);
+Tcl_Obj * Tcl_AbstractListSetElement(Tcl_Interp *interp, Tcl_Obj *listPtr,
+ Tcl_Size indexCount, Tcl_Obj *const indexArray[], Tcl_Obj *valueObj);
+int Tcl_AbstractListObjReplace(Tcl_Interp *interp, Tcl_Obj *listObj,
+ Tcl_Size first, Tcl_Size numToDelete, Tcl_Size numToInsert,
+ Tcl_Obj *const insertObjs[]);
+
+#endif
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c
index 8a84bea..6679783 100755
--- a/generic/tclArithSeries.c
+++ b/generic/tclArithSeries.c
@@ -10,45 +10,18 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
+#include <assert.h>
+#include "tcl.h"
#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 structure below defines the arithmetic series Tcl Obj 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 object is a Tcl_AbstractList 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
@@ -61,7 +34,7 @@ static void UpdateStringOfArithSeries (Tcl_Obj *listPtr);
* else if RANGE < 0
* LEN is (((END-START)-1)/STEP) - 1
*
- * And where the equivalent's list I-th element is calculated
+ * And where the list's I-th element is calculated
* as:
*
* LIST[i] = START+(STEP*i)
@@ -70,18 +43,54 @@ static void UpdateStringOfArithSeries (Tcl_Obj *listPtr);
* are valid and will be equivalent to the empty list.
*/
-const Tcl_ObjType tclArithSeriesType = {
- "arithseries", /* name */
- FreeArithSeriesInternalRep, /* freeIntRepProc */
- DupArithSeriesInternalRep, /* dupIntRepProc */
- UpdateStringOfArithSeries, /* updateStringProc */
- SetArithSeriesFromAny /* setFromAnyProc */
+static inline double ArithSeriesIndexDbl(ArithSeriesDbl *repPtr, double index)
+{
+ return (repPtr->start + (index * repPtr->step));
+}
+static inline Tcl_WideInt ArithSeriesIndexInt(ArithSeries *repPtr, Tcl_Size index)
+{
+ return (repPtr->start + (index * repPtr->step));
+}
+
+static int TclArithSeriesObjStep(Tcl_Obj *arithSeriesPtr, Tcl_Obj **stepObj);
+static int TclArithSeriesObjIndex(Tcl_Interp *interp, Tcl_Obj *arithSeriesPtr,
+ Tcl_Size index, Tcl_Obj **elemObj);
+static Tcl_WideInt TclArithSeriesObjLength(Tcl_Obj *arithSeriesObj);
+static int TclArithSeriesObjRange(Tcl_Interp *interp, Tcl_Obj *arithSeriesPtr,
+ Tcl_Size fromIdx, Tcl_Size toIdx, Tcl_Obj **newObjPtr);
+static int TclArithSeriesObjReverse(Tcl_Interp *interp, Tcl_Obj *arithSeriesPtr, Tcl_Obj **newObjPtr);
+static int TclArithSeriesGetElements(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, Tcl_Size *objcPtr, Tcl_Obj ***objvPtr);
+static Tcl_Obj *TclNewArithSeriesInt(Tcl_WideInt start,
+ Tcl_WideInt end, Tcl_WideInt step,
+ Tcl_WideInt len);
+static Tcl_Obj *TclNewArithSeriesDbl(double start, double end,
+ double step, Tcl_WideInt len);
+static void DupArithSeriesRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
+static void FreeArithSeriesRep(Tcl_Obj *arithSeriesObjPtr);
+static void UpdateStringOfArithSeries(Tcl_Obj *arithSeriesObjPtr);
+static Tcl_Obj *Tcl_NewArithSeriesObj(Tcl_Size objc, Tcl_Obj * const objv[]);
+
+static Tcl_AbstractListType arithSeriesType = {
+ TCL_ABSTRACTLIST_VERSION_1,
+ "arithseries",
+ Tcl_NewArithSeriesObj,
+ DupArithSeriesRep,
+ TclArithSeriesObjLength,
+ TclArithSeriesObjIndex,
+ TclArithSeriesObjRange,
+ TclArithSeriesObjReverse,
+ TclArithSeriesGetElements,
+ FreeArithSeriesRep,
+ UpdateStringOfArithSeries,
+ NULL, // SetElement
+ NULL // Replace
};
/*
*----------------------------------------------------------------------
*
- * ArithSeriesLen --
+ * Arithserieslen --
*
* Compute the length of the equivalent list where
* every element is generated starting from *start*,
@@ -93,7 +102,7 @@ const Tcl_ObjType tclArithSeriesType = {
*
* 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.
+ * The function returns -1 if the list is of length infiite.
*
* Side effects:
*
@@ -106,12 +115,74 @@ ArithSeriesLen(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step)
{
Tcl_WideInt len;
- if (step == 0) {
- return 0;
- }
- len = 1 + ((end-start)/step);
+ if (step == 0) return 0;
+ len = (step ? (1 + (((end-start))/step)) : 0);
return (len < 0) ? -1 : len;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupArithSeriesRep --
+ *
+ * Initialize the internal representation of a ArithSeries abstract list
+ * 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 AbstractList structure.
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupArithSeriesRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr)
+{
+ ArithSeries *srcArithSeries = (ArithSeries*)Tcl_AbstractListGetConcreteRep(srcPtr);
+ ArithSeries *copyArithSeries = (ArithSeries *)Tcl_Alloc(sizeof(ArithSeries));
+
+ *copyArithSeries = *srcArithSeries;
+
+ /* Note: we do not have to be worry about existing internal rep because
+ copyPtr is supposed to be freshly initialized */
+ Tcl_AbstractListSetConcreteRep(copyPtr, copyArithSeries);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeArithSeriesRep --
+ *
+ * Free any allocated memory in the ArithSeries Rep
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+FreeArithSeriesRep(Tcl_Obj *arithSeriesObjPtr) /* Free any allocated memory */
+{
+ ArithSeries *arithSeriesPtr = (ArithSeries*)Tcl_AbstractListGetConcreteRep(arithSeriesObjPtr);
+ if (arithSeriesPtr) {
+ if (arithSeriesPtr->elements) {
+ Tcl_WideInt i, len = arithSeriesPtr->len;
+ for (i=0; i<len; i++) {
+ Tcl_DecrRefCount(arithSeriesPtr->elements[i]);
+ }
+ Tcl_Free((char*)arithSeriesPtr->elements);
+ arithSeriesPtr->elements = NULL;
+ }
+ Tcl_Free((char*)arithSeriesPtr);
+ }
+}
+
/*
*----------------------------------------------------------------------
@@ -135,13 +206,12 @@ 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;
+ Tcl_Obj *arithSeriesObj;
ArithSeries *arithSeriesRepPtr;
- TclNewObj(arithSeriesPtr);
-
if (length <= 0) {
- return arithSeriesPtr;
+ TclNewObj(arithSeriesObj);
+ return arithSeriesObj;
}
arithSeriesRepPtr = (ArithSeries*) Tcl_Alloc(sizeof (ArithSeries));
@@ -151,13 +221,14 @@ TclNewArithSeriesInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step, Tcl_W
arithSeriesRepPtr->step = step;
arithSeriesRepPtr->len = length;
arithSeriesRepPtr->elements = NULL;
- arithSeriesPtr->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr;
- arithSeriesPtr->internalRep.twoPtrValue.ptr2 = NULL;
- arithSeriesPtr->typePtr = &tclArithSeriesType;
+
+ arithSeriesObj = Tcl_AbstractListObjNew(NULL, &arithSeriesType);
+ Tcl_AbstractListSetConcreteRep(arithSeriesObj, arithSeriesRepPtr);
+
if (length > 0)
- Tcl_InvalidateStringRep(arithSeriesPtr);
+ Tcl_InvalidateStringRep(arithSeriesObj);
- return arithSeriesPtr;
+ return arithSeriesObj;
}
/*
@@ -182,13 +253,12 @@ 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;
+ Tcl_Obj *arithSeriesObj;
ArithSeriesDbl *arithSeriesRepPtr;
- TclNewObj(arithSeriesPtr);
-
if (length <= 0) {
- return arithSeriesPtr;
+ TclNewObj(arithSeriesObj);
+ return arithSeriesObj;
}
arithSeriesRepPtr = (ArithSeriesDbl*) Tcl_Alloc(sizeof (ArithSeriesDbl));
@@ -198,13 +268,14 @@ TclNewArithSeriesDbl(double start, double end, double step, Tcl_WideInt len)
arithSeriesRepPtr->step = step;
arithSeriesRepPtr->len = length;
arithSeriesRepPtr->elements = NULL;
- arithSeriesPtr->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr;
- arithSeriesPtr->internalRep.twoPtrValue.ptr2 = NULL;
- arithSeriesPtr->typePtr = &tclArithSeriesType;
+
+ arithSeriesObj = Tcl_AbstractListObjNew(NULL, &arithSeriesType);
+ Tcl_AbstractListSetConcreteRep(arithSeriesObj, arithSeriesRepPtr);
+
if (length > 0)
- Tcl_InvalidateStringRep(arithSeriesPtr);
+ Tcl_InvalidateStringRep(arithSeriesObj);
- return arithSeriesPtr;
+ return arithSeriesObj;
}
/*
@@ -212,7 +283,7 @@ TclNewArithSeriesDbl(double start, double end, double step, Tcl_WideInt len)
*
* assignNumber --
*
- * Create the appropriate Tcl_Obj value for the given numeric values.
+ * Create the approprite Tcl_Obj value for the given numeric values.
* Used locally only for decoding [lseq] numeric arguments.
* refcount = 0.
*
@@ -227,26 +298,33 @@ TclNewArithSeriesDbl(double start, double end, double step, Tcl_WideInt len)
*----------------------------------------------------------------------
*/
static void
-assignNumber(int useDoubles, Tcl_WideInt *intNumberPtr, double *dblNumberPtr, Tcl_Obj *numberObj)
+assignNumber(
+ int useDoubles,
+ Tcl_WideInt *intNumberPtr,
+ double *dblNumberPtr,
+ Tcl_Obj *numberObj)
{
- void *clientData;
+ union {
+ double d;
+ Tcl_WideInt i;
+ } *number;
int tcl_number_type;
- if (Tcl_GetNumberFromObj(NULL, numberObj, &clientData, &tcl_number_type) != TCL_OK
+ if (Tcl_GetNumberFromObj(NULL, numberObj, (void**)&number, &tcl_number_type) != TCL_OK
|| tcl_number_type == TCL_NUMBER_BIG) {
return;
}
if (useDoubles) {
- if (tcl_number_type != TCL_NUMBER_INT) {
- *dblNumberPtr = *(double *)clientData;
+ if (tcl_number_type == TCL_NUMBER_DOUBLE) {
+ *dblNumberPtr = number->d;
} else {
- *dblNumberPtr = (double)*(Tcl_WideInt *)clientData;
+ *dblNumberPtr = (double)number->i;
}
} else {
if (tcl_number_type == TCL_NUMBER_INT) {
- *intNumberPtr = *(Tcl_WideInt *)clientData;
+ *intNumberPtr = number->i;
} else {
- *intNumberPtr = (Tcl_WideInt)*(double *)clientData;
+ *intNumberPtr = (Tcl_WideInt)number->d;
}
}
}
@@ -270,16 +348,17 @@ assignNumber(int useDoubles, Tcl_WideInt *intNumberPtr, double *dblNumberPtr, Tc
* None.
*----------------------------------------------------------------------
*/
+
int
TclNewArithSeriesObj(
- Tcl_Interp *interp, /* For error reporting */
- Tcl_Obj **arithSeriesObj, /* return value */
- int useDoubles, /* Flag indicates values start,
- ** end, step, are treated as doubles */
- Tcl_Obj *startObj, /* Starting value */
- Tcl_Obj *endObj, /* Ending limit */
- Tcl_Obj *stepObj, /* increment value */
- Tcl_Obj *lenObj) /* Number of elements */
+ Tcl_Interp *interp, /* For error reporting */
+ Tcl_Obj **arithSeriesObj, /* return value */
+ int useDoubles, /* Promote values to double when true,
+ * int otherwise */
+ Tcl_Obj *startObj, /* First value in list */
+ Tcl_Obj *endObj, /* Upper bound value of list */
+ Tcl_Obj *stepObj, /* Increment amount */
+ Tcl_Obj *lenObj) /* Number of elements */
{
double dstart, dend, dstep;
Tcl_WideInt start, end, step;
@@ -300,7 +379,7 @@ TclNewArithSeriesObj(
}
if (dstep == 0) {
*arithSeriesObj = Tcl_NewObj();
- return TCL_OK;
+ return TCL_OK;
}
}
if (endObj) {
@@ -361,43 +440,25 @@ TclNewArithSeriesObj(
/*
*----------------------------------------------------------------------
*
- * TclArithSeriesObjStep --
+ * TclArithSeriesObjLength
*
- * Return a Tcl_Obj with the step value from the give ArithSeries Obj.
- * refcount = 0.
+ * Returns the length of the arithmentic series.
*
* Results:
*
- * A Tcl_Obj pointer to the created ArithSeries object.
- * A NULL pointer of the range is invalid.
+ * The length of the series as Tcl_WideInt.
*
* Side Effects:
*
* None.
+ *
*----------------------------------------------------------------------
*/
-/*
- * TclArithSeriesObjStep --
- */
-int
-TclArithSeriesObjStep(
- Tcl_Obj *arithSeriesPtr,
- Tcl_Obj **stepObj)
+Tcl_WideInt TclArithSeriesObjLength(Tcl_Obj *arithSeriesObj)
{
- 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;
+ ArithSeries *arithSeriesRepPtr = (ArithSeries *)Tcl_AbstractListGetConcreteRep(arithSeriesObj);
+ return arithSeriesRepPtr->len;
}
-
/*
*----------------------------------------------------------------------
@@ -405,14 +466,14 @@ TclArithSeriesObjStep(
* TclArithSeriesObjIndex --
*
* Returns the element with the specified index in the list
- * represented by the specified Arithmetic Sequence object.
+ * represented by the specified Arithmentic 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.
+ * TCL_OK on succes, TCL_ERROR on index out of range.
*
* Side Effects:
*
@@ -422,266 +483,92 @@ TclArithSeriesObjStep(
*/
int
-TclArithSeriesObjIndex(Tcl_Obj *arithSeriesPtr, Tcl_WideInt index, Tcl_Obj **elementObj)
+TclArithSeriesObjIndex(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ Tcl_Obj *arithSeriesPtr, /* List obj */
+ Tcl_Size index, /* index to element of interest */
+ Tcl_Obj **elemObj) /* Return value */
{
- 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));
+ ArithSeries *arithSeriesRepPtr = (ArithSeries *)Tcl_AbstractListGetConcreteRep(arithSeriesPtr);
+ (void)interp; // quiet compiler
+ if (index < arithSeriesRepPtr->len) {
+ /* List[i] = Start + (Step * index) */
+ if (arithSeriesRepPtr->isDouble) {
+ *elemObj = Tcl_NewDoubleObj(ArithSeriesIndexDbl((ArithSeriesDbl*)arithSeriesRepPtr, index));
+ } else {
+ *elemObj = Tcl_NewWideIntObj(ArithSeriesIndexInt(arithSeriesRepPtr, index));
+ }
} else {
- *elementObj = Tcl_NewWideIntObj(ArithSeriesIndexM(arithSeriesRepPtr, index));
+ TclNewObj(*elemObj); // empty value
}
+
return TCL_OK;
}
-
+
/*
*----------------------------------------------------------------------
*
- * TclArithSeriesObjLength
+ * TclArithSeriesObjStep --
*
- * Returns the length of the arithmetic series.
+ * Return a Tcl_Obj with the step value from the give ArithSeries Obj.
+ * refcount = 0.
*
* Results:
*
- * The length of the series as Tcl_WideInt.
+ * A Tcl_Obj pointer to the created ArithSeries object.
+ * A NULL pointer of the range is invalid.
*
* 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]);
- }
- }
- Tcl_Free((char *) arithSeriesRepPtr->elements);
- }
- Tcl_Free((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*) Tcl_Alloc(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)
+int
+TclArithSeriesObjStep(
+ Tcl_Obj *arithSeriesPtr,
+ Tcl_Obj **stepObj)
{
- 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);
+ ArithSeries *arithSeriesRepPtr = (ArithSeries *)Tcl_AbstractListGetConcreteRep(arithSeriesPtr);
+ if (arithSeriesRepPtr->isDouble) {
+ *stepObj = Tcl_NewDoubleObj(((ArithSeriesDbl*)(arithSeriesRepPtr))->step);
+ } else {
+ *stepObj = Tcl_NewWideIntObj(arithSeriesRepPtr->step);
}
- 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;
+ return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * TclArithSeriesObjCopy --
+ * Tcl_NewArithSeriesObj --
*
- * 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.
+ * Creates a new ArithSeries object. The returned object has
+ * refcount = 0.
*
* 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.
+ * A Tcl_Obj pointer to the created ArithSeries object.
+ * A NULL pointer of the range is invalid.
*
- * Side effects:
- * None.
+ * 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_NewArithSeriesObj(Tcl_Size objc, Tcl_Obj * const objv[])
{
- 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;
- }
+ Tcl_Obj *arithSeriesObj;
+ if (objc != 4) return NULL;
+ // TODO: Define this use model!
+ if (TclNewArithSeriesObj(NULL, &arithSeriesObj, 0/*TODO: int vs double support */,
+ objv[0]/*start*/, objv[1]/*end*/,
+ objv[2]/*step*/, objv[3]/*len*/) != TCL_OK) {
+ arithSeriesObj = NULL;
}
-
- TclNewObj(copyPtr);
- TclInvalidateStringRep(copyPtr);
- DupArithSeriesInternalRep(arithSeriesPtr, copyPtr);
- return copyPtr;
+ return arithSeriesObj;
}
/*
@@ -703,64 +590,51 @@ TclArithSeriesObjCopy(
*----------------------------------------------------------------------
*/
-Tcl_Obj *
+int
TclArithSeriesObjRange(
- Tcl_Interp *interp, /* For error message(s) */
+ Tcl_Interp *interp, /* for error messages. */
Tcl_Obj *arithSeriesPtr, /* List object to take a range from. */
Tcl_Size fromIdx, /* Index of first element to include. */
- Tcl_Size toIdx) /* Index of last element to include. */
+ Tcl_Size toIdx, /* Index of last element to include. */
+ Tcl_Obj **newObjPtr) /* return value */
{
ArithSeries *arithSeriesRepPtr;
Tcl_Obj *startObj, *endObj, *stepObj;
- ArithSeriesGetInternalRep(arithSeriesPtr, arithSeriesRepPtr);
+ (void)interp; /* silence compiler */
+
+ arithSeriesRepPtr = (ArithSeries *)Tcl_AbstractListGetConcreteRep(arithSeriesPtr);
if (fromIdx == TCL_INDEX_NONE) {
fromIdx = 0;
}
- if (fromIdx > toIdx) {
- Tcl_Obj *obj;
- TclNewObj(obj);
- return obj;
+
+ if (toIdx >= arithSeriesRepPtr->len) {
+ toIdx = arithSeriesRepPtr->len-1;
}
- if (TclArithSeriesObjIndex(arithSeriesPtr, fromIdx, &startObj) != TCL_OK) {
- if (interp) {
- Tcl_SetObjResult(
- interp,
- Tcl_ObjPrintf("index %" TCL_Z_MODIFIER "u is out of bounds 0 to %"
- TCL_LL_MODIFIER "d", fromIdx, (arithSeriesRepPtr->len-1)));
- Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
- }
- return NULL;
+ if (fromIdx > toIdx ||
+ fromIdx >= arithSeriesRepPtr->len) {
+ TclNewObj(*newObjPtr);
+ return TCL_OK;
}
+
+ TclArithSeriesObjIndex(interp, arithSeriesPtr, fromIdx, &startObj);
Tcl_IncrRefCount(startObj);
- if (TclArithSeriesObjIndex(arithSeriesPtr, toIdx, &endObj) != TCL_OK) {
- if (interp) {
- Tcl_SetObjResult(
- interp,
- Tcl_ObjPrintf("index %" TCL_Z_MODIFIER "u is out of bounds 0 to %"
- TCL_LL_MODIFIER "d", fromIdx, (arithSeriesRepPtr->len-1)));
- Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
- }
- return NULL;
- }
+ TclArithSeriesObjIndex(interp, arithSeriesPtr, toIdx, &endObj);
Tcl_IncrRefCount(endObj);
TclArithSeriesObjStep(arithSeriesPtr, &stepObj);
Tcl_IncrRefCount(stepObj);
if (Tcl_IsShared(arithSeriesPtr) ||
((arithSeriesPtr->refCount > 1))) {
- Tcl_Obj *newSlicePtr;
- if (TclNewArithSeriesObj(interp, &newSlicePtr,
- arithSeriesRepPtr->isDouble, startObj, endObj,
- stepObj, NULL) != TCL_OK) {
- newSlicePtr = NULL;
- }
- Tcl_DecrRefCount(startObj);
- Tcl_DecrRefCount(endObj);
- Tcl_DecrRefCount(stepObj);
- return newSlicePtr;
+ int status = TclNewArithSeriesObj(NULL, newObjPtr,
+ arithSeriesRepPtr->isDouble, startObj, endObj, stepObj, NULL);
+
+ Tcl_DecrRefCount(startObj);
+ Tcl_DecrRefCount(endObj);
+ Tcl_DecrRefCount(stepObj);
+ return status;
}
/*
@@ -768,7 +642,7 @@ TclArithSeriesObjRange(
*/
/*
- * Even if nothing below causes any changes, we still want the
+ * Even if nothing below cause any changes, we still want the
* string-canonizing effect of [lrange 0 end].
*/
@@ -802,125 +676,19 @@ TclArithSeriesObjRange(
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. */
- Tcl_Size *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 **)Tcl_Alloc(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;
- }
+ *newObjPtr = arithSeriesPtr;
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.?
- *
- *----------------------------------------------------------------------
+ * Handle ArithSeries special case - don't shimmer a series into a list
+ * just to reverse it.
*/
-
-Tcl_Obj *
+int
TclArithSeriesObjReverse(
- Tcl_Interp *interp, /* For error message(s) */
- Tcl_Obj *arithSeriesPtr) /* List object to reverse. */
+ Tcl_Interp *interp, /* For error messages */
+ Tcl_Obj *arithSeriesPtr, /* List object to reverse. */
+ Tcl_Obj **newObjPtr)
{
ArithSeries *arithSeriesRepPtr;
Tcl_Obj *startObj, *endObj, *stepObj;
@@ -929,14 +697,20 @@ TclArithSeriesObjReverse(
double dstart, dend, dstep;
int isDouble;
- ArithSeriesGetInternalRep(arithSeriesPtr, arithSeriesRepPtr);
+ (void)interp;
+
+ if (newObjPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ arithSeriesRepPtr = (ArithSeries *)Tcl_AbstractListGetConcreteRep(arithSeriesPtr);
isDouble = arithSeriesRepPtr->isDouble;
len = arithSeriesRepPtr->len;
- TclArithSeriesObjIndex(arithSeriesPtr, (len-1), &startObj);
+ TclArithSeriesObjIndex(NULL, arithSeriesPtr, (len-1), &startObj);
Tcl_IncrRefCount(startObj);
- TclArithSeriesObjIndex(arithSeriesPtr, 0, &endObj);
+ TclArithSeriesObjIndex(NULL, arithSeriesPtr, 0, &endObj);
Tcl_IncrRefCount(endObj);
TclArithSeriesObjStep(arithSeriesPtr, &stepObj);
Tcl_IncrRefCount(stepObj);
@@ -955,14 +729,18 @@ TclArithSeriesObjReverse(
TclSetIntObj(stepObj, step);
}
+ Tcl_IncrRefCount(startObj);
+ Tcl_IncrRefCount(endObj);
+ Tcl_IncrRefCount(stepObj);
+
if (Tcl_IsShared(arithSeriesPtr) ||
((arithSeriesPtr->refCount > 1))) {
Tcl_Obj *lenObj = Tcl_NewWideIntObj(len);
- if (TclNewArithSeriesObj(interp, &resultObj,
- isDouble, startObj, endObj, stepObj, lenObj) != TCL_OK) {
- resultObj = NULL;
- }
- Tcl_DecrRefCount(lenObj);
+ if (TclNewArithSeriesObj(NULL, &resultObj, isDouble,
+ startObj, endObj, stepObj, lenObj) != TCL_OK) {
+ resultObj = NULL;
+ }
+ Tcl_DecrRefCount(lenObj);
} else {
/*
@@ -998,5 +776,120 @@ TclArithSeriesObjReverse(
Tcl_DecrRefCount(endObj);
Tcl_DecrRefCount(stepObj);
- return resultObj;
+ *newObjPtr = resultObj;
+
+ return TCL_OK;
+}
+
+/*
+** Handle ArithSeries GetElements call
+*/
+
+int
+TclArithSeriesGetElements(
+ Tcl_Interp *interp, /* Used to report errors if not NULL. */
+ Tcl_Obj *arithSeriesObjPtr, /* ArithSeries object for which an element
+ * array is to be returned. */
+ Tcl_Size *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. */
+{
+ ArithSeries *arithSeriesRepPtr =
+ (ArithSeries*)Tcl_AbstractListGetConcreteRep(arithSeriesObjPtr);
+ Tcl_Obj **objv;
+ int i, objc;
+
+ objc = arithSeriesRepPtr->len;
+
+ if (objvPtr == NULL) {
+ if (objcPtr) {
+ *objcPtr = objc;
+ return TCL_OK;
+ }
+ return TCL_ERROR;
+ }
+
+ if (objc && objvPtr && arithSeriesRepPtr->elements) {
+ objv = arithSeriesRepPtr->elements;
+ } else if (objc > 0) {
+ objv = (Tcl_Obj **)Tcl_Alloc(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;
+ }
+ for (i = 0; i < objc; i++) {
+ if (TclArithSeriesObjIndex(interp, arithSeriesObjPtr, i, &objv[i]) == TCL_OK) {
+ Tcl_IncrRefCount(objv[i]);
+ } else {
+ // TODO: some cleanup needed here
+ return TCL_ERROR;
+ }
+ }
+ } else {
+ objv = NULL;
+ }
+ arithSeriesRepPtr->elements = objv;
+ *objvPtr = objv;
+ *objcPtr = objc;
+ return TCL_OK;
}
+
+static void
+UpdateStringOfArithSeries(Tcl_Obj *arithSeriesObjPtr)
+{
+ ArithSeries *arithSeriesRepPtr = (ArithSeries*)Tcl_AbstractListGetConcreteRep(arithSeriesObjPtr);
+ char *p, *str;
+ Tcl_Obj *eleObj;
+ Tcl_WideInt length = 0;
+ int llen, slen, i;
+
+
+ /*
+ * Pass 1: estimate space.
+ */
+ llen = arithSeriesRepPtr->len;
+ if (llen <= 0) {
+ Tcl_InitStringRep(arithSeriesObjPtr, NULL, 0);
+ return;
+ }
+ for (i = 0; i < llen; i++) {
+ if (TclArithSeriesObjIndex(NULL, arithSeriesObjPtr, i, &eleObj) == TCL_OK) {
+ Tcl_GetStringFromObj(eleObj, &slen);
+ length += slen + 1; /* one more for the space char */
+ Tcl_DecrRefCount(eleObj);
+ } else {
+ // TODO: report error?
+ }
+ }
+
+ /*
+ * Pass 2: generate the string repr.
+ */
+
+ p = Tcl_InitStringRep(arithSeriesObjPtr, NULL, length);
+ for (i = 0; i < llen; i++) {
+ if (TclArithSeriesObjIndex(NULL, arithSeriesObjPtr, i, &eleObj) == TCL_OK) {
+ str = Tcl_GetStringFromObj(eleObj, &slen);
+ strcpy(p, str);
+ p[slen] = ' ';
+ p += slen+1;
+ Tcl_DecrRefCount(eleObj);
+ } // else TODO: report error here?
+ }
+ if (length > 0) arithSeriesObjPtr->bytes[length-1] = '\0';
+ arithSeriesObjPtr->length = length-1;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclArithSeries.h b/generic/tclArithSeries.h
index af4777c..ba03f84 100644
--- a/generic/tclArithSeries.h
+++ b/generic/tclArithSeries.h
@@ -11,7 +11,7 @@
*/
/*
- * The structure used for the ArithSeries internal representation.
+ * The structure used for the AirthSeries 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.
*/
@@ -19,39 +19,28 @@ typedef struct ArithSeries {
Tcl_WideInt start;
Tcl_WideInt end;
Tcl_WideInt step;
- Tcl_WideInt len;
+ Tcl_Size len;
Tcl_Obj **elements;
int isDouble;
} ArithSeries;
+
typedef struct ArithSeriesDbl {
double start;
double end;
double step;
- Tcl_WideInt len;
+ Tcl_Size 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_Interp *interp,
- Tcl_Obj *arithSeriesPtr, Tcl_Size fromIdx, Tcl_Size toIdx);
-MODULE_SCOPE Tcl_Obj * TclArithSeriesObjReverse(Tcl_Interp *interp,
- Tcl_Obj *arithSeriesPtr);
-MODULE_SCOPE int TclArithSeriesGetElements(Tcl_Interp *interp,
- Tcl_Obj *objPtr, Tcl_Size *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 int TclNewArithSeriesObj(Tcl_Interp *interp,
- Tcl_Obj **arithSeriesObj, int useDoubles,
- Tcl_Obj *startObj, Tcl_Obj *endObj,
- Tcl_Obj *stepObj, Tcl_Obj *lenObj);
+MODULE_SCOPE int TclNewArithSeriesObj(Tcl_Interp *interp, Tcl_Obj **arithSeriesPtr,
+ int useDoubles, Tcl_Obj *startObj, Tcl_Obj *endObj,
+ Tcl_Obj *stepObj, Tcl_Obj *lenObj);
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 5ab12d4..00ef885 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -309,7 +309,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},
+ {"lseq", Tcl_LseqObjCmd, NULL, NULL, CMD_IS_SAFE},
{"lset", Tcl_LsetObjCmd, TclCompileLsetCmd, NULL, CMD_IS_SAFE},
{"lsort", Tcl_LsortObjCmd, NULL, NULL, CMD_IS_SAFE},
{"ledit", Tcl_LeditObjCmd, NULL, NULL, CMD_IS_SAFE},
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index aa898ea..10ea93d 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -12,10 +12,10 @@
*/
#include "tclInt.h"
+#include "tclAbstractList.h"
#ifdef _WIN32
# include "tclWinInt.h"
#endif
-#include "tclArithSeries.h"
/*
* The state structure used by [foreach]. Note that the actual structure has
@@ -2726,24 +2726,23 @@ EachloopCmd(
}
/* Values */
- if (TclHasInternalRep(objv[2+i*2],&tclArithSeriesType)) {
- /* Special case for Arith Series */
- statePtr->aCopyList[i] = TclArithSeriesObjCopy(interp, objv[2+i*2]);
+ if (TclHasInternalRep(objv[2+i*2],&tclAbstractListType)) {
+ /* Special case for Abstract List */
+ statePtr->aCopyList[i] = Tcl_AbstractListObjCopy(interp, objv[2+i*2]);
if (statePtr->aCopyList[i] == NULL) {
result = TCL_ERROR;
goto done;
}
/* Don't compute values here, wait until the last momement */
- statePtr->argcList[i] = TclArithSeriesObjLength(statePtr->aCopyList[i]);
+ statePtr->argcList[i] = Tcl_AbstractListObjLength(statePtr->aCopyList[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]);
+ &statePtr->argcList[i], &statePtr->argvList[i]);
}
/* account for variable <> value mismatch */
j = statePtr->argcList[i] / statePtr->varcList[i];
@@ -2864,20 +2863,23 @@ ForeachAssignments(
struct ForeachState *statePtr)
{
int i;
- size_t v, k;
+ Tcl_Size v, k;
Tcl_Obj *valuePtr, *varValuePtr;
for (i=0 ; i<statePtr->numLists ; i++) {
- int isarithseries = TclHasInternalRep(statePtr->aCopyList[i],&tclArithSeriesType);
+ int isAbstractList =
+ TclHasInternalRep(statePtr->aCopyList[i],&tclAbstractListType);
+
for (v=0 ; v<statePtr->varcList[i] ; v++) {
k = statePtr->index[i]++;
if (k < statePtr->argcList[i]) {
- if (isarithseries) {
- if (TclArithSeriesObjIndex(statePtr->aCopyList[i], k, &valuePtr) != TCL_OK) {
+ if (isAbstractList) {
+ if (Tcl_AbstractListObjIndex(interp, statePtr->aCopyList[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])));
+ "\n (setting %s loop variable \"%s\")",
+ (statePtr->resultList != NULL ? "lmap" : "foreach"),
+ TclGetString(statePtr->varvList[i][v])));
return TCL_ERROR;
}
} else {
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 3e297f6..86d3c36 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -17,10 +17,11 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
+#include <math.h>
#include "tclInt.h"
#include "tclRegexp.h"
+#include "tclAbstractList.h"
#include "tclArithSeries.h"
-#include <math.h>
#include <assert.h>
/*
@@ -97,23 +98,6 @@ 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:
*/
@@ -181,6 +165,24 @@ static const EnsembleImplMap defaultInfoMap[] = {
{"vars", TclInfoVarsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
{NULL, NULL, NULL, NULL, NULL, 0}
};
+
+/*
+ * 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;
+
/*
*----------------------------------------------------------------------
@@ -2200,8 +2202,7 @@ Tcl_JoinObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
- size_t length, listLen;
- int isArithSeries = 0;
+ size_t length, listLen, isAbstractList = 0;
Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs;
if ((objc < 2) || (objc > 3)) {
@@ -2214,14 +2215,17 @@ Tcl_JoinObjCmd(
* pointer to its array of element pointers.
*/
- if (TclHasInternalRep(objv[1],&tclArithSeriesType)) {
- isArithSeries = 1;
- listLen = TclArithSeriesObjLength(objv[1]);
- } else {
- if (TclListObjGetElementsM(interp, objv[1], &listLen,
- &elemPtrs) != TCL_OK) {
+ if (TclAbstractListHasProc(objv[1], TCL_ABSL_GETELEMENTS)) {
+ listLen = Tcl_AbstractListObjLength(objv[1]);
+ isAbstractList = (listLen ? 1 : 0);
+ if (listLen > 1 &&
+ Tcl_AbstractListObjGetElements(interp, objv[1], &listLen, &elemPtrs)
+ != TCL_OK) {
return TCL_ERROR;
}
+ } else if (TclListObjGetElementsM(interp, objv[1], &listLen,
+ &elemPtrs) != TCL_OK) {
+ return TCL_ERROR;
}
if (listLen == 0) {
@@ -2230,14 +2234,15 @@ Tcl_JoinObjCmd(
}
if (listLen == 1) {
/* One element; return it */
- if (isArithSeries) {
- Tcl_Obj *valueObj;
- if (TclArithSeriesObjIndex(objv[1], 0, &valueObj) != TCL_OK) {
- return TCL_ERROR;
- }
- Tcl_SetObjResult(interp, valueObj);
- } else {
+ if (!isAbstractList) {
Tcl_SetObjResult(interp, elemPtrs[0]);
+ } else {
+ Tcl_Obj *elemObj;
+ if (Tcl_AbstractListObjIndex(interp, objv[1], 0, &elemObj)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, elemObj);
}
return TCL_OK;
}
@@ -2252,40 +2257,19 @@ Tcl_JoinObjCmd(
size_t i;
resObjPtr = Tcl_NewObj();
- 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);
- }
- } else {
- for (i = 0; i < listLen; i++) {
- if (i > 0) {
+ 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, elemPtrs[i]);
+ Tcl_AppendObjToObj(resObjPtr, joinObjPtr);
}
+ Tcl_AppendObjToObj(resObjPtr, elemPtrs[i]);
}
}
Tcl_DecrRefCount(joinObjPtr);
@@ -2722,7 +2706,7 @@ Tcl_LrangeObjCmd(
/* Argument objects. */
{
int result;
- size_t listLen, first, last;
+ Tcl_Size listLen, first, last;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv, "list first last");
return TCL_ERROR;
@@ -2745,14 +2729,13 @@ Tcl_LrangeObjCmd(
return result;
}
- if (TclHasInternalRep(objv[1],&tclArithSeriesType)) {
- Tcl_Obj *rangeObj;
- rangeObj = TclArithSeriesObjRange(interp, objv[1], first, last);
- if (rangeObj) {
- Tcl_SetObjResult(interp, rangeObj);
- } else {
- return TCL_ERROR;
+ if (TclAbstractListHasProc(objv[1], TCL_ABSL_SLICE)) {
+ Tcl_Obj *resultObj;
+ int status = Tcl_AbstractListObjRange(interp, objv[1], first, last, &resultObj);
+ if (status == TCL_OK) {
+ Tcl_SetObjResult(interp, resultObj);
}
+ return status;
} else {
Tcl_SetObjResult(interp, TclListObjRange(objv[1], first, last));
}
@@ -3139,22 +3122,19 @@ 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.
+ * Handle AbstractList special case - do not shimmer into a list, if it
+ * supports a private Reverse function, just to reverse it.
*/
- if (TclHasInternalRep(objv[1],&tclArithSeriesType)) {
- Tcl_Obj *resObj = TclArithSeriesObjReverse(interp, objv[1]);
- if (resObj) {
- Tcl_SetObjResult(interp, resObj);
+ if (TclAbstractListHasProc(objv[1], TCL_ABSL_REVERSE)) {
+ Tcl_Obj *resultObj;
+
+ if (Tcl_AbstractListObjReverse(interp, objv[1], &resultObj) == TCL_OK) {
+ Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
- } else {
- return TCL_ERROR;
}
- } /* end ArithSeries */
+ } /* end Abstract List */
- /* True List */
if (TclListObjGetElementsM(interp, objv[1], &elemc, &elemv) != TCL_OK) {
return TCL_ERROR;
}
@@ -3974,91 +3954,6 @@ Tcl_LsearchObjCmd(
/*
*----------------------------------------------------------------------
*
- * Tcl_LsetObjCmd --
- *
- * This procedure is invoked to process the "lset" Tcl command. See the
- * user documentation for details on what it does.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_LsetObjCmd(
- TCL_UNUSED(void *),
- Tcl_Interp *interp, /* Current interpreter. */
- int objc, /* Number of arguments. */
- Tcl_Obj *const objv[]) /* Argument values. */
-{
- Tcl_Obj *listPtr; /* Pointer to the list being altered. */
- Tcl_Obj *finalValuePtr; /* Value finally assigned to the variable. */
-
- /*
- * Check parameter count.
- */
-
- if (objc < 3) {
- Tcl_WrongNumArgs(interp, 1, objv,
- "listVar ?index? ?index ...? value");
- return TCL_ERROR;
- }
-
- /*
- * Look up the list variable's value.
- */
-
- listPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
- if (listPtr == NULL) {
- return TCL_ERROR;
- }
-
- /*
- * Substitute the value in the value. Return either the value or else an
- * unshared copy of it.
- */
-
- if (objc == 4) {
- finalValuePtr = TclLsetList(interp, listPtr, objv[2], objv[3]);
- } else {
- finalValuePtr = TclLsetFlat(interp, listPtr, objc-3, objv+2,
- objv[objc-1]);
- }
-
- /*
- * If substitution has failed, bail out.
- */
-
- if (finalValuePtr == NULL) {
- return TCL_ERROR;
- }
-
- /*
- * Finally, update the variable so that traces fire.
- */
-
- listPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, finalValuePtr,
- TCL_LEAVE_ERR_MSG);
- Tcl_DecrRefCount(finalValuePtr);
- if (listPtr == NULL) {
- return TCL_ERROR;
- }
-
- /*
- * Return the new value of the variable as the interpreter result.
- */
-
- Tcl_SetObjResult(interp, listPtr);
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* SequenceIdentifyArgument --
* (for [lseq] command)
*
@@ -4084,9 +3979,12 @@ SequenceIdentifyArgument(
int status;
SequenceOperators opmode;
SequenceByMode bymode;
- void *clientData;
+ union {
+ Tcl_WideInt i;
+ double d;
+ } *nvalue;
- status = Tcl_GetNumberFromObj(NULL, argPtr, &clientData, keywordIndexPtr);
+ status = Tcl_GetNumberFromObj(NULL, argPtr, (void**)&nvalue, keywordIndexPtr);
if (status == TCL_OK) {
if (numValuePtr) {
*numValuePtr = argPtr;
@@ -4196,7 +4094,7 @@ Tcl_LseqObjCmd(
Tcl_WideInt values[5];
Tcl_Obj *numValues[5];
Tcl_Obj *numberObj;
- int status, keyword, useDoubles = 0;
+ int status = TCL_ERROR, keyword, useDoubles = 0;
Tcl_Obj *arithSeriesPtr;
SequenceOperators opmode;
SequenceDecoded decoded;
@@ -4266,11 +4164,10 @@ Tcl_LseqObjCmd(
case 0:
Tcl_WrongNumArgs(interp, 1, objv,
"n ??op? n ??by? n??");
- status = TCL_ERROR;
goto done;
break;
-/* range n */
+/* lseq n */
case 1:
start = zero;
elementCount = numValues[0];
@@ -4278,22 +4175,22 @@ Tcl_LseqObjCmd(
step = one;
break;
-/* range n n */
+/* lseq n n */
case 11:
start = numValues[0];
end = numValues[1];
break;
-/* range n n n */
+/* lseq 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 */
+/* lseq n 'to' n */
+/* lseq n 'count' n */
+/* lseq n 'by' n */
case 121:
opmode = (SequenceOperators)values[1];
switch (opmode) {
@@ -4313,13 +4210,12 @@ Tcl_LseqObjCmd(
step = one;
break;
default:
- status = TCL_ERROR;
goto done;
}
break;
-/* range n 'to' n n */
-/* range n 'count' n n */
+/* lseq n 'to' n n */
+/* lseq n 'count' n n */
case 1211:
opmode = (SequenceOperators)values[1];
switch (opmode) {
@@ -4336,17 +4232,15 @@ Tcl_LseqObjCmd(
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 */
+/* lseq n n 'by' n */
case 1121:
start = numValues[0];
end = numValues[1];
@@ -4359,14 +4253,13 @@ Tcl_LseqObjCmd(
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 */
+/* lseq n 'to' n 'by' n */
+/* lseq n 'count' n 'by' n */
case 12121:
start = numValues[0];
opmode = (SequenceOperators)values[3];
@@ -4375,7 +4268,6 @@ Tcl_LseqObjCmd(
step = numValues[4];
break;
default:
- status = TCL_ERROR;
goto done;
break;
}
@@ -4391,7 +4283,6 @@ Tcl_LseqObjCmd(
elementCount = numValues[2];
break;
default:
- status = TCL_ERROR;
goto done;
break;
}
@@ -4405,7 +4296,6 @@ Tcl_LseqObjCmd(
case 1212:
opmode = (SequenceOperators)values[3]; goto KeywordError; break;
KeywordError:
- status = TCL_ERROR;
switch (opmode) {
case LSEQ_DOTS:
case LSEQ_TO:
@@ -4421,14 +4311,12 @@ Tcl_LseqObjCmd(
"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;
}
@@ -4436,11 +4324,9 @@ Tcl_LseqObjCmd(
/*
* Success! Now lets create the series object.
*/
- status = TclNewArithSeriesObj(interp, &arithSeriesPtr,
- useDoubles, start, end, step, elementCount);
-
+ status = TclNewArithSeriesObj(interp, &arithSeriesPtr, useDoubles, start, end, step, elementCount);
if (status == TCL_OK) {
- Tcl_SetObjResult(interp, arithSeriesPtr);
+ Tcl_SetObjResult(interp, arithSeriesPtr);
}
done:
@@ -4459,6 +4345,99 @@ Tcl_LseqObjCmd(
/*
*----------------------------------------------------------------------
*
+ * Tcl_LsetObjCmd --
+ *
+ * This procedure is invoked to process the "lset" Tcl command. See the
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_LsetObjCmd(
+ TCL_UNUSED(ClientData),
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument values. */
+{
+ Tcl_Obj *listPtr; /* Pointer to the list being altered. */
+ Tcl_Obj *finalValuePtr; /* Value finally assigned to the variable. */
+
+ /*
+ * Check parameter count.
+ */
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "listVar ?index? ?index ...? value");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Look up the list variable's value.
+ */
+
+ listPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
+ if (listPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Substitute the value in the value. Return either the value or else an
+ * unshared copy of it.
+ */
+
+ if (objc == 4) {
+ finalValuePtr = TclLsetList(interp, listPtr, objv[2], objv[3]);
+ } else {
+ if (TclAbstractListHasProc(listPtr, TCL_ABSL_SETELEMENT)) {
+ finalValuePtr = Tcl_AbstractListSetElement(interp, listPtr,
+ objc-3, objv+2, objv[objc-1]);
+ if (finalValuePtr) {
+ Tcl_IncrRefCount(finalValuePtr);
+ }
+ } else {
+ finalValuePtr = TclLsetFlat(interp, listPtr, objc-3, objv+2,
+ objv[objc-1]);
+ }
+ }
+
+ /*
+ * If substitution has failed, bail out.
+ */
+
+ if (finalValuePtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Finally, update the variable so that traces fire.
+ */
+
+ listPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, finalValuePtr,
+ TCL_LEAVE_ERR_MSG);
+ Tcl_DecrRefCount(finalValuePtr);
+ if (listPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Return the new value of the variable as the interpreter result.
+ */
+
+ Tcl_SetObjResult(interp, listPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_LsortObjCmd --
*
* This procedure is invoked to process the "lsort" Tcl command. See the
@@ -4727,9 +4706,9 @@ Tcl_LsortObjCmd(
sortInfo.compareCmdPtr = newCommandPtr;
}
- if (TclHasInternalRep(listObj,&tclArithSeriesType)) {
- sortInfo.resultCode = TclArithSeriesGetElements(interp,
- listObj, &length, &listObjPtrs);
+ if (TclAbstractListHasProc(objv[1], TCL_ABSL_GETELEMENTS)) {
+ sortInfo.resultCode =
+ Tcl_AbstractListObjGetElements(interp, listObj, &length, &listObjPtrs);
} else {
sortInfo.resultCode = TclListObjGetElementsM(interp, listObj,
&length, &listObjPtrs);
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 8040adf..526e06d 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -1850,6 +1850,39 @@ EXTERN int Tcl_RemoveChannelMode(Tcl_Interp *interp,
Tcl_Channel chan, int mode);
/* 683 */
EXTERN int Tcl_GetEncodingNulLength(Tcl_Encoding encoding);
+/* 684 */
+EXTERN Tcl_AbstractListType * Tcl_AbstractListGetType(Tcl_Obj *objPtr);
+/* 685 */
+EXTERN Tcl_Obj * Tcl_AbstractListObjNew(Tcl_Interp *interp,
+ const Tcl_AbstractListType*vTablePtr);
+/* 686 */
+EXTERN Tcl_WideInt Tcl_AbstractListObjLength(Tcl_Obj *abstractListPtr);
+/* 687 */
+EXTERN int Tcl_AbstractListObjIndex(Tcl_Interp *interp,
+ Tcl_Obj *abstractListPtr, Tcl_Size index,
+ Tcl_Obj **elemObjPtr);
+/* 688 */
+EXTERN int Tcl_AbstractListObjRange(Tcl_Interp *interp,
+ Tcl_Obj *abstractListPtr, Tcl_Size fromIdx,
+ Tcl_Size toIdx, Tcl_Obj **newObjPtr);
+/* 689 */
+EXTERN int Tcl_AbstractListObjReverse(Tcl_Interp *interp,
+ Tcl_Obj *abstractListPtr,
+ Tcl_Obj **newObjPtr);
+/* 690 */
+EXTERN int Tcl_AbstractListObjGetElements(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, Tcl_Size *objcPtr,
+ Tcl_Obj ***objvPtr);
+/* 691 */
+EXTERN Tcl_Obj * Tcl_AbstractListObjCopy(Tcl_Interp *interp,
+ Tcl_Obj *listPtr);
+/* 692 */
+EXTERN void * Tcl_AbstractListGetConcreteRep(Tcl_Obj *objPtr);
+/* 693 */
+EXTERN Tcl_Obj * Tcl_AbstractListSetElement(Tcl_Interp *interp,
+ Tcl_Obj *listPtr, Tcl_Size indexCount,
+ Tcl_Obj *const indexArray[],
+ Tcl_Obj *valueObj);
typedef struct {
const struct TclPlatStubs *tclPlatStubs;
@@ -2545,6 +2578,16 @@ typedef struct TclStubs {
int (*tcl_GetNumber) (Tcl_Interp *interp, const char *bytes, size_t numBytes, void **clientDataPtr, int *typePtr); /* 681 */
int (*tcl_RemoveChannelMode) (Tcl_Interp *interp, Tcl_Channel chan, int mode); /* 682 */
int (*tcl_GetEncodingNulLength) (Tcl_Encoding encoding); /* 683 */
+ Tcl_AbstractListType * (*tcl_AbstractListGetType) (Tcl_Obj *objPtr); /* 684 */
+ Tcl_Obj * (*tcl_AbstractListObjNew) (Tcl_Interp *interp, const Tcl_AbstractListType*vTablePtr); /* 685 */
+ Tcl_WideInt (*tcl_AbstractListObjLength) (Tcl_Obj *abstractListPtr); /* 686 */
+ int (*tcl_AbstractListObjIndex) (Tcl_Interp *interp, Tcl_Obj *abstractListPtr, Tcl_Size index, Tcl_Obj **elemObjPtr); /* 687 */
+ int (*tcl_AbstractListObjRange) (Tcl_Interp *interp, Tcl_Obj *abstractListPtr, Tcl_Size fromIdx, Tcl_Size toIdx, Tcl_Obj **newObjPtr); /* 688 */
+ int (*tcl_AbstractListObjReverse) (Tcl_Interp *interp, Tcl_Obj *abstractListPtr, Tcl_Obj **newObjPtr); /* 689 */
+ int (*tcl_AbstractListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size *objcPtr, Tcl_Obj ***objvPtr); /* 690 */
+ Tcl_Obj * (*tcl_AbstractListObjCopy) (Tcl_Interp *interp, Tcl_Obj *listPtr); /* 691 */
+ void * (*tcl_AbstractListGetConcreteRep) (Tcl_Obj *objPtr); /* 692 */
+ Tcl_Obj * (*tcl_AbstractListSetElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size indexCount, Tcl_Obj *const indexArray[], Tcl_Obj *valueObj); /* 693 */
} TclStubs;
extern const TclStubs *tclStubsPtr;
@@ -3865,6 +3908,26 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_RemoveChannelMode) /* 682 */
#define Tcl_GetEncodingNulLength \
(tclStubsPtr->tcl_GetEncodingNulLength) /* 683 */
+#define Tcl_AbstractListGetType \
+ (tclStubsPtr->tcl_AbstractListGetType) /* 684 */
+#define Tcl_AbstractListObjNew \
+ (tclStubsPtr->tcl_AbstractListObjNew) /* 685 */
+#define Tcl_AbstractListObjLength \
+ (tclStubsPtr->tcl_AbstractListObjLength) /* 686 */
+#define Tcl_AbstractListObjIndex \
+ (tclStubsPtr->tcl_AbstractListObjIndex) /* 687 */
+#define Tcl_AbstractListObjRange \
+ (tclStubsPtr->tcl_AbstractListObjRange) /* 688 */
+#define Tcl_AbstractListObjReverse \
+ (tclStubsPtr->tcl_AbstractListObjReverse) /* 689 */
+#define Tcl_AbstractListObjGetElements \
+ (tclStubsPtr->tcl_AbstractListObjGetElements) /* 690 */
+#define Tcl_AbstractListObjCopy \
+ (tclStubsPtr->tcl_AbstractListObjCopy) /* 691 */
+#define Tcl_AbstractListGetConcreteRep \
+ (tclStubsPtr->tcl_AbstractListGetConcreteRep) /* 692 */
+#define Tcl_AbstractListSetElement \
+ (tclStubsPtr->tcl_AbstractListSetElement) /* 693 */
#endif /* defined(USE_TCL_STUBS) */
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 444f9aa..4e708ff 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -19,7 +19,7 @@
#include "tclCompile.h"
#include "tclOOInt.h"
#include "tclTomMath.h"
-#include "tclArithSeries.h"
+#include "tclAbstractList.h"
#include <math.h>
#include <assert.h>
@@ -4657,16 +4657,15 @@ TEBCresume(
valuePtr = OBJ_UNDER_TOS;
TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
-
- /* special case for ArithSeries */
- if (TclHasInternalRep(valuePtr,&tclArithSeriesType)) {
- length = TclArithSeriesObjLength(valuePtr);
+ /* special case for AbstractList */
+ if (TclHasInternalRep(valuePtr,&tclAbstractListType)) {
+ length = Tcl_AbstractListObjLength(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) {
+ if (Tcl_AbstractListObjIndex(interp, valuePtr, index, &objResultPtr)!=TCL_OK) {
CACHE_STACK_INFO();
TRACE_ERROR(interp);
goto gotError;
@@ -4679,6 +4678,7 @@ TEBCresume(
* Extract the desired list element.
*/
+ /* TODO: handle AbstractList here? */
if ((TclListObjGetElementsM(interp, valuePtr, &objc, &objv) == TCL_OK)
&& !TclHasInternalRep(value2Ptr, &tclListType)) {
int code;
@@ -4721,33 +4721,30 @@ TEBCresume(
opnd = TclGetInt4AtPtr(pc+1);
TRACE(("\"%.30s\" %d => ", O2S(valuePtr), opnd));
- /* special case for ArithSeries */
- if (TclHasInternalRep(valuePtr,&tclArithSeriesType)) {
- length = TclArithSeriesObjLength(valuePtr);
+ /*
+ * Get the contents of the list, making sure that it really is a list
+ * in the process.
+ */
- /* Decode end-offset index values. */
+ /* special case for AbstractList */
+ if (TclHasInternalRep(valuePtr,&tclAbstractListType)) {
+ length = Tcl_AbstractListObjLength(valuePtr);
+ /* Decode end-offset index values. */
index = TclIndexDecode(opnd, length-1);
/* Compute value @ index */
- if (index < length) {
- if (TclArithSeriesObjIndex(valuePtr, index, &objResultPtr) != TCL_OK) {
- CACHE_STACK_INFO();
- TRACE_ERROR(interp);
- goto gotError;
- }
- } else {
- TclNewObj(objResultPtr);
+ if (Tcl_AbstractListObjIndex(interp, valuePtr, index, &objResultPtr)!=TCL_OK) {
+ CACHE_STACK_INFO();
+ TRACE_ERROR(interp);
+ goto gotError;
}
+
pcAdjustment = 5;
goto lindexFastPath2;
}
- /*
- * Get the contents of the list, making sure that it really is a list
- * in the process.
- */
-
+ /* List case */
if (TclListObjGetElementsM(interp, valuePtr, &objc, &objv) != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
@@ -4820,8 +4817,14 @@ TEBCresume(
* Compute the new variable value.
*/
- objResultPtr = TclLsetFlat(interp, valuePtr, numIndices,
+ if (TclAbstractListHasProc(valuePtr, TCL_ABSL_SLICE)) {
+ objResultPtr = Tcl_AbstractListSetElement(interp,
+ valuePtr, numIndices,
+ &OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS);
+ } else {
+ objResultPtr = TclLsetFlat(interp, valuePtr, numIndices,
&OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS);
+ }
if (!objResultPtr) {
TRACE_ERROR(interp);
goto gotError;
@@ -4942,9 +4945,8 @@ TEBCresume(
fromIdx = TclIndexDecode(fromIdx, objc - 1);
- if (TclHasInternalRep(valuePtr,&tclArithSeriesType)) {
- objResultPtr = TclArithSeriesObjRange(interp, valuePtr, fromIdx, toIdx);
- if (objResultPtr == NULL) {
+ if (TclAbstractListHasProc(valuePtr, TCL_ABSL_SLICE)) {
+ if (Tcl_AbstractListObjRange(interp, valuePtr, fromIdx, toIdx, &objResultPtr) != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
}
@@ -4970,14 +4972,18 @@ TEBCresume(
if (length > 0) {
size_t i = 0;
Tcl_Obj *o;
- int isArithSeries = TclHasInternalRep(value2Ptr,&tclArithSeriesType);
+ int isAbstractList = TclHasInternalRep(value2Ptr,&tclAbstractListType);
+
/*
* An empty list doesn't match anything.
*/
do {
- if (isArithSeries) {
- TclArithSeriesObjIndex(value2Ptr, i, &o);
+ if (isAbstractList) {
+ if (Tcl_AbstractListObjIndex(interp, value2Ptr, i, &o) != TCL_OK) {
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
} else {
Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
}
@@ -4990,7 +4996,7 @@ TEBCresume(
if (s1len == s2len) {
match = (memcmp(s1, s2, s1len) == 0);
}
- if (isArithSeries) {
+ if (isAbstractList) {
TclDecrRefCount(o);
}
i++;
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 39ddef2..cf65bcf 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2631,6 +2631,19 @@ typedef struct ListRep {
#define TclListObjIsCanonical(listObj_) \
(((listObj_)->typePtr == &tclListType) ? ListObjIsCanonical((listObj_)) : 0)
+
+static inline void Tcl_AbstractListSetType(Tcl_Obj* abstractListObjPtr, void* ptr)
+{
+ abstractListObjPtr->internalRep.twoPtrValue.ptr2 = ptr;
+}
+
+static inline Tcl_WideInt
+AbstractListObjLength(Tcl_Obj* abstractListObjPtr)
+{
+ Tcl_AbstractListType *typePtr = Tcl_AbstractListGetType(abstractListObjPtr);
+ return typePtr->lengthProc(abstractListObjPtr);
+}
+
/*
* Modes for collecting (or not) in the implementations of TclNRForeachCmd,
* TclNRLmapCmd and their compilations.
@@ -2881,8 +2894,8 @@ 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 tclAbstractListType;
MODULE_SCOPE const Tcl_ObjType tclProcBodyType;
MODULE_SCOPE const Tcl_ObjType tclStringType;
MODULE_SCOPE const Tcl_ObjType tclEnsembleCmdType;
@@ -4670,6 +4683,42 @@ MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr);
#define TclFetchInternalRep(objPtr, type) \
(TclHasInternalRep((objPtr), (type)) ? &((objPtr)->internalRep) : NULL)
+static inline int
+TclAbstractListHasProc(Tcl_Obj* abstractListObjPtr, Tcl_AbstractListProcType ptype)
+{
+ Tcl_AbstractListType *typePtr;
+ if ( ! TclHasInternalRep(abstractListObjPtr,&tclAbstractListType)) {
+ return 0;
+ }
+ typePtr = Tcl_AbstractListGetType(abstractListObjPtr);
+ switch (ptype) {
+ case TCL_ABSL_NEW:
+ return (typePtr->newObjProc != NULL);
+ case TCL_ABSL_DUPREP:
+ return (typePtr->dupRepProc != NULL);
+ case TCL_ABSL_LENGTH:
+ return (typePtr->lengthProc != NULL);
+ case TCL_ABSL_INDEX:
+ return (typePtr->indexProc != NULL);
+ case TCL_ABSL_SLICE:
+ return (typePtr->sliceProc != NULL);
+ case TCL_ABSL_REVERSE:
+ return (typePtr->reverseProc != NULL);
+ case TCL_ABSL_GETELEMENTS:
+ return (typePtr->getElementsProc != NULL);
+ case TCL_ABSL_FREEREP:
+ return (typePtr->freeRepProc != NULL);
+ case TCL_ABSL_TOSTRING:
+ return (typePtr->toStringProc != NULL);
+ case TCL_ABSL_SETELEMENT:
+ return (typePtr->setElementProc != NULL);
+ case TCL_ABSL_REPLACE:
+ return (typePtr->replaceProc != NULL);
+ }
+ return 0;
+}
+
+
/*
*----------------------------------------------------------------
@@ -4729,6 +4778,7 @@ MODULE_SCOPE Tcl_LibraryInitProc TclObjTest_Init;
MODULE_SCOPE Tcl_LibraryInitProc TclThread_Init;
MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_Init;
MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
+MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init;
/*
*----------------------------------------------------------------
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index ccd23a1..e7bc3ab 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -9,9 +9,9 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
+#include "tclAbstractList.h"
#include <assert.h>
#include "tclInt.h"
-#include "tclArithSeries.h"
/*
* TODO - memmove is fast. Measure at what size we should prefer memmove
@@ -1366,8 +1366,8 @@ TclListObjCopy(
Tcl_Obj *copyObj;
if (!TclHasInternalRep(listObj, &tclListType)) {
- if (TclHasInternalRep(listObj,&tclArithSeriesType)) {
- return TclArithSeriesObjCopy(interp, listObj);
+ if (TclHasInternalRep(listObj,&tclAbstractListType)) {
+ return Tcl_AbstractListObjCopy(interp, listObj);
}
if (SetListFromAny(interp, listObj) != TCL_OK) {
return NULL;
@@ -1662,12 +1662,19 @@ Tcl_ListObjGetElements(
{
ListRep listRep;
- if (TclHasInternalRep(objPtr,&tclArithSeriesType)) {
- return TclArithSeriesGetElements(interp, objPtr, objcPtr, objvPtr);
+ if (TclAbstractListHasProc(objPtr, TCL_ABSL_GETELEMENTS) &&
+ Tcl_AbstractListObjGetElements(interp, objPtr, objcPtr, objvPtr) == TCL_OK) {
+ return TCL_OK;
+ } else if (TclListObjGetRep(interp, objPtr, &listRep) != TCL_OK) {
+ int length;
+ (void) Tcl_GetStringFromObj(objPtr, &length);
+ if (length == 0) {
+ *objcPtr = 0;
+ *objvPtr = NULL;
+ return TCL_OK;
+ }
+ return TCL_ERROR;
}
-
- if (TclListObjGetRep(interp, objPtr, &listRep) != TCL_OK)
- return TCL_ERROR;
ListRepElements(&listRep, *objcPtr, *objvPtr);
return TCL_OK;
}
@@ -1992,8 +1999,10 @@ Tcl_ListObjLength(
{
ListRep listRep;
- if (TclHasInternalRep(listObj,&tclArithSeriesType)) {
- *lenPtr = TclArithSeriesObjLength(listObj);
+ /* Handle AbstractList before attempting SetListFromAny */
+ if (!TclHasInternalRep(listObj, &tclListType) &&
+ TclHasInternalRep(listObj, &tclAbstractListType)) {
+ *lenPtr = Tcl_AbstractListObjLength(listObj);
return TCL_OK;
}
@@ -2072,6 +2081,11 @@ Tcl_ListObjReplace(
Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace");
}
+ if (TclAbstractListHasProc(listObj, TCL_ABSL_REPLACE)) {
+ return Tcl_AbstractListObjReplace(interp, listObj, first,
+ numToDelete, numToInsert, insertObjs);
+ }
+
if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK)
return TCL_ERROR; /* Cannot be converted to a list */
@@ -2624,9 +2638,9 @@ TclLindexFlat(
{
Tcl_Size i;
- /* Handle ArithSeries as special case */
- if (TclHasInternalRep(listObj,&tclArithSeriesType)) {
- Tcl_WideInt listLen = TclArithSeriesObjLength(listObj);
+ /* Handle AbstractList as special case */
+ if (TclHasInternalRep(listObj,&tclAbstractListType)) {
+ Tcl_WideInt listLen = Tcl_AbstractListObjLength(listObj);
Tcl_Size index;
Tcl_Obj *elemObj = NULL;
for (i=0 ; i<indexCount && listObj ; i++) {
@@ -2634,9 +2648,12 @@ TclLindexFlat(
&index) == TCL_OK) {
}
if (i==0) {
- TclArithSeriesObjIndex(listObj, index, &elemObj);
+ if (Tcl_AbstractListObjIndex(interp, listObj, index, &elemObj) != TCL_OK) {
+ return NULL;
+ }
} else if (index > 0) {
- /* ArithSeries cannot be a list of lists */
+ // TODO: support nested lists
+ // For now, only support 1 index, which is all an ArithSeries has
Tcl_DecrRefCount(elemObj);
TclNewObj(elemObj);
break;
@@ -2743,32 +2760,51 @@ TclLsetList(
* shimmering; see TIP #22 and #23 for details.
*/
- if (!TclHasInternalRep(indexArgObj, &tclListType)
- && TclGetIntForIndexM(NULL, indexArgObj, ListSizeT_MAX - 1, &index)
- == TCL_OK) {
+ if (!TclHasInternalRep(indexArgObj, &tclListType) &&
+ TclGetIntForIndexM(NULL, indexArgObj, ListSizeT_MAX - 1, &index)
+ == TCL_OK) {
+
+ if (TclAbstractListHasProc(listObj, TCL_ABSL_SETELEMENT)) {
+ indices = &indexArgObj;
+ Tcl_Obj *returnValue =
+ Tcl_AbstractListSetElement(interp, listObj, 1, indices, valueObj);
+ if (returnValue) Tcl_IncrRefCount(returnValue);
+ return returnValue;
+ }
+
/* indexArgPtr designates a single index. */
- /* T:listrep-1.{2.1,12.1,15.1,19.1},2.{2.3,9.3,10.1,13.1,16.1}, 3.{4,5,6}.3 */
+ /* T:listrep-1.{2.1,12.1,15.1,19.1},2.{2.3,9.3,10.1,13.1,16.1}, 3.{4,5,6}.3 */
return TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj);
+
}
+ /*
+ * Make copy to not shimmer index argument
+ */
indexListCopy = TclListObjCopy(NULL, indexArgObj);
+
if (indexListCopy == NULL) {
/*
* indexArgPtr designates something that is neither an index nor a
* well formed list. Report the error via TclLsetFlat.
*/
- return TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj);
- }
- LIST_ASSERT_TYPE(indexListCopy);
- ListObjGetElements(indexListCopy, indexCount, indices);
+ indexCount = 1;
+ indices = &indexArgObj;
- /*
- * Let TclLsetFlat handle the actual lset'ting.
- */
+ } else {
+ /*
+ * Expand list into indicies array
+ */
+ LIST_ASSERT_TYPE(indexListCopy);
+ ListObjGetElements(indexListCopy, indexCount, indices);
+ }
retValueObj = TclLsetFlat(interp, listObj, indexCount, indices, valueObj);
- Tcl_DecrRefCount(indexListCopy);
+ if (indexListCopy) {
+ Tcl_DecrRefCount(indexListCopy);
+ }
+
return retValueObj;
}
@@ -3273,33 +3309,32 @@ 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.
- */
- Tcl_Size j, size = TclArithSeriesObjLength(objPtr);
+ } else if (TclHasInternalRep(objPtr,&tclAbstractListType)) {
+ Tcl_Size elemCount, i;
- /* TODO - leave space in front and/or back? */
- if (ListRepInitAttempt(
- interp, size > 0 ? size : 1, NULL, &listRep)
- != TCL_OK) {
+ elemCount = Tcl_AbstractListObjLength(objPtr);
+
+ if (ListRepInitAttempt(interp, elemCount, 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;
- }
+
+ /* Each iteration, store a list element */
+ for (i = 0; i < elemCount; i++) {
+ if (Tcl_AbstractListObjIndex(interp, objPtr, i, elemPtrs) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_IncrRefCount(*elemPtrs++);/* Since list now holds ref to it. */
}
+ LIST_ASSERT((elemPtrs - listRep.storePtr->slots) == elemCount);
+
+ listRep.storePtr->numUsed = elemCount;
+
} else {
Tcl_Size estCount, length;
const char *limit, *nextElem = Tcl_GetStringFromObj(objPtr, &length);
diff --git a/generic/tclObj.c b/generic/tclObj.c
index d385ed0..23de33e 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -16,6 +16,7 @@
#include "tclInt.h"
#include "tclTomMath.h"
+#include "tclAbstractList.h"
#include <math.h>
#include <assert.h>
@@ -369,6 +370,17 @@ TclInitObjSubsystem(void)
Tcl_RegisterObjType(&tclRegexpType);
Tcl_RegisterObjType(&tclProcBodyType);
+ /* For backward compatibility only ... */
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
+ Tcl_RegisterObjType(&tclIntType);
+#if !defined(TCL_WIDE_INT_IS_LONG)
+ Tcl_RegisterObjType(&oldIntType);
+#endif
+ Tcl_RegisterObjType(&oldBooleanType);
+#endif
+
+ Tcl_RegisterObjType(&tclAbstractListType);
+
#ifdef TCL_COMPILE_STATS
Tcl_MutexLock(&tclObjMutex);
tclObjsAlloced = 0;
@@ -4413,12 +4425,19 @@ Tcl_RepresentationCmd(
Tcl_Obj *const objv[])
{
Tcl_Obj *descObj;
+ const char *typeName;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "value");
return TCL_ERROR;
}
+ typeName = (TclHasInternalRep(objv[1],&tclAbstractListType)
+ ? Tcl_AbstractListTypeName(objv[1])
+ : (objv[1]->typePtr
+ ? objv[1]->typePtr->name
+ : "pure string"));
+
/*
* Value is a bignum with a refcount of 14, object pointer at 0x12345678,
* internal representation 0x45671234:0x98765432, string representation
@@ -4427,7 +4446,7 @@ Tcl_RepresentationCmd(
descObj = Tcl_ObjPrintf("value is a %s with a refcount of %" TCL_Z_MODIFIER "u,"
" object pointer at %p",
- objv[1]->typePtr ? objv[1]->typePtr->name : "pure string",
+ objv[1]->typePtr ? typeName : "pure string",
objv[1]->refCount, objv[1]);
if (objv[1]->typePtr) {
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 008ece9..f8b795e 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -2979,8 +2979,8 @@ TclStringRepeat(
if (interp) {
Tcl_SetObjResult(
interp,
- Tcl_ObjPrintf("max size for a Tcl value (%u" TCL_Z_MODIFIER
- " bytes) exceeded",
+ Tcl_ObjPrintf("max size for a Tcl value (%" TCL_Z_MODIFIER
+ "u bytes) exceeded",
TCL_SIZE_SMAX));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
@@ -3440,7 +3440,7 @@ TclStringCat(
overflow:
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "max size for a Tcl value (%u" TCL_Z_MODIFIER " bytes) exceeded", TCL_SIZE_SMAX));
+ "max size for a Tcl value (%" TCL_Z_MODIFIER "u bytes) exceeded", TCL_SIZE_SMAX));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
return NULL;
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 4b2fd30..5175d9f 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -1487,6 +1487,16 @@ const TclStubs tclStubs = {
Tcl_GetNumber, /* 681 */
Tcl_RemoveChannelMode, /* 682 */
Tcl_GetEncodingNulLength, /* 683 */
+ Tcl_AbstractListGetType, /* 684 */
+ Tcl_AbstractListObjNew, /* 685 */
+ Tcl_AbstractListObjLength, /* 686 */
+ Tcl_AbstractListObjIndex, /* 687 */
+ Tcl_AbstractListObjRange, /* 688 */
+ Tcl_AbstractListObjReverse, /* 689 */
+ Tcl_AbstractListObjGetElements, /* 690 */
+ Tcl_AbstractListObjCopy, /* 691 */
+ Tcl_AbstractListGetConcreteRep, /* 692 */
+ Tcl_AbstractListSetElement, /* 693 */
};
/* !END!: Do not edit above this line. */
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 5d76afd..1e16568 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -737,6 +737,10 @@ Tcltest_Init(
}
#endif
+ if (Tcl_ABSListTest_Init(interp) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
/*
* Check for special options used in ../tests/main.test
*/
@@ -8299,4 +8303,3 @@ int TestApplyLambdaObjCmd (
* indent-tabs-mode: nil
* End:
*/
-
diff --git a/generic/tclTestABSList.c b/generic/tclTestABSList.c
new file mode 100644
index 0000000..a672220
--- /dev/null
+++ b/generic/tclTestABSList.c
@@ -0,0 +1,835 @@
+// Tcl Abstract List test command: "lstring"
+#include <string.h>
+#include <limits.h>
+#include "tcl.h"
+#include "tclAbstractList.h"
+
+/*
+ * Forward references
+ */
+
+Tcl_Obj *myNewLStringObj(Tcl_WideInt start,
+ Tcl_WideInt length);
+static void freeRep(Tcl_Obj* alObj);
+static Tcl_Obj* my_LStringObjSetElem(Tcl_Interp *interp,
+ Tcl_Obj *listPtr,
+ Tcl_Size numIndcies,
+ Tcl_Obj *const indicies[],
+ Tcl_Obj *valueObj);
+static void DupLStringRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
+static Tcl_WideInt my_LStringObjLength(Tcl_Obj *lstringObjPtr);
+static int my_LStringObjIndex(Tcl_Interp *interp,
+ Tcl_Obj *lstringObj,
+ Tcl_Size index,
+ Tcl_Obj **charObjPtr);
+static int my_LStringObjRange(Tcl_Interp *interp, Tcl_Obj *lstringObj,
+ Tcl_Size fromIdx, Tcl_Size toIdx,
+ Tcl_Obj **newObjPtr);
+static int my_LStringObjReverse(Tcl_Interp *interp, Tcl_Obj *srcObj,
+ Tcl_Obj **newObjPtr);
+static int my_LStringReplace(Tcl_Interp *interp,
+ Tcl_Obj *listObj,
+ Tcl_Size first,
+ Tcl_Size numToDelete,
+ Tcl_Size numToInsert,
+ Tcl_Obj *const insertObjs[]);
+static int my_LStringGetElements(Tcl_Interp *interp,
+ Tcl_Obj *listPtr,
+ Tcl_Size *objcptr,
+ Tcl_Obj ***objvptr);
+
+/*
+ * Internal Representation of an lstring type value
+ */
+
+typedef struct LString {
+ char *string; // NULL terminated utf-8 string
+ Tcl_Size strlen; // num bytes in string
+ Tcl_Size allocated; // num bytes allocated
+ Tcl_Obj**elements; // elements array, allocated when GetElements is
+ // called
+} LString;
+
+/*
+ * AbstractList definition of an lstring type
+ */
+static Tcl_AbstractListType lstringTypes[12] = {
+ {
+ TCL_ABSTRACTLIST_VERSION_1,
+ "lstring",
+/**/ NULL, /*default NULL,*/
+ DupLStringRep,
+ my_LStringObjLength,
+ my_LStringObjIndex,
+ my_LStringObjRange,/*ObjRange*/
+ my_LStringObjReverse,
+ my_LStringGetElements,
+ freeRep,
+ NULL /*toString*/,
+ my_LStringObjSetElem, /* use default update string */
+ my_LStringReplace
+ },
+ {
+ TCL_ABSTRACTLIST_VERSION_1,
+ "lstring",
+ NULL,
+/**/ NULL, /*default DupLStringRep,*/
+ my_LStringObjLength,
+ my_LStringObjIndex,
+ my_LStringObjRange,/*ObjRange*/
+ my_LStringObjReverse,
+ my_LStringGetElements,
+ freeRep,
+ NULL /*toString*/,
+ my_LStringObjSetElem, /* use default update string */
+ my_LStringReplace
+ },
+ {
+ TCL_ABSTRACTLIST_VERSION_1,
+ "lstring",
+ NULL,
+ DupLStringRep,
+/**/ NULL, /*default my_LStringObjLength,*/
+ my_LStringObjIndex,
+ my_LStringObjRange,/*ObjRange*/
+ my_LStringObjReverse,
+ my_LStringGetElements,
+ freeRep,
+ NULL /*toString*/,
+ my_LStringObjSetElem, /* use default update string */
+ my_LStringReplace
+ },
+ {
+ TCL_ABSTRACTLIST_VERSION_1,
+ "lstring",
+ NULL,
+ DupLStringRep,
+ my_LStringObjLength,
+/**/ NULL, /*default my_LStringObjIndex,*/
+ my_LStringObjRange,/*ObjRange*/
+ my_LStringObjReverse,
+ my_LStringGetElements,
+ freeRep,
+ NULL /*toString*/,
+ my_LStringObjSetElem, /* use default update string */
+ my_LStringReplace
+ },
+ {
+ TCL_ABSTRACTLIST_VERSION_1,
+ "lstring",
+ NULL,
+ DupLStringRep,
+ my_LStringObjLength,
+ my_LStringObjIndex,
+/**/ NULL, /*default my_LStringObjRange,*/
+ my_LStringObjReverse,
+ my_LStringGetElements,
+ freeRep,
+ NULL /*toString*/,
+ my_LStringObjSetElem, /* use default update string */
+ my_LStringReplace
+ },
+ {
+ TCL_ABSTRACTLIST_VERSION_1,
+ "lstring",
+ NULL,
+ DupLStringRep,
+ my_LStringObjLength,
+ my_LStringObjIndex,
+ my_LStringObjRange,/*ObjRange*/
+/**/ NULL, /*defaults my_LStringObjReverse,*/
+ my_LStringGetElements,
+ freeRep,
+ NULL /*toString*/,
+ my_LStringObjSetElem, /* use default update string */
+ my_LStringReplace
+ },
+ {
+ TCL_ABSTRACTLIST_VERSION_1,
+ "lstring",
+ NULL,
+ DupLStringRep,
+ my_LStringObjLength,
+ my_LStringObjIndex,
+ my_LStringObjRange,/*ObjRange*/
+ my_LStringObjReverse,
+/**/ NULL, /*default NULL / *my_LStringGetElements,*/
+ freeRep,
+ NULL /*toString*/,
+ my_LStringObjSetElem, /* use default update string */
+ my_LStringReplace
+ },
+ {
+ TCL_ABSTRACTLIST_VERSION_1,
+ "lstring",
+ NULL,
+ DupLStringRep,
+ my_LStringObjLength,
+ my_LStringObjIndex,
+ my_LStringObjRange,/*ObjRange*/
+ my_LStringObjReverse,
+ my_LStringGetElements,
+/**/ NULL, /*default freeRep,*/
+ NULL /*toString*/,
+ my_LStringObjSetElem, /* use default update string */
+ my_LStringReplace
+ },
+ {
+ TCL_ABSTRACTLIST_VERSION_1,
+ "lstring",
+ NULL,
+ DupLStringRep,
+ my_LStringObjLength,
+ my_LStringObjIndex,
+ my_LStringObjRange,/*ObjRange*/
+ my_LStringObjReverse,
+ my_LStringGetElements,
+ freeRep,
+/**/ NULL, /*toString*/
+ my_LStringObjSetElem, /* use default update string */
+ my_LStringReplace
+ },
+ {
+ TCL_ABSTRACTLIST_VERSION_1,
+ "lstring",
+ NULL,
+ DupLStringRep,
+ my_LStringObjLength,
+ my_LStringObjIndex,
+ my_LStringObjRange,/*ObjRange*/
+ my_LStringObjReverse,
+ my_LStringGetElements,
+ freeRep,
+ NULL /*toString*/,
+/**/ NULL, /*default my_LStringObjSetElem, / * use default update string */
+ NULL, /*default my_LStringReplace*/
+ },
+ {
+ TCL_ABSTRACTLIST_VERSION_1,
+ "lstring",
+ NULL,
+ DupLStringRep,
+ my_LStringObjLength,
+ my_LStringObjIndex,
+ my_LStringObjRange,/*ObjRange*/
+ my_LStringObjReverse,
+ my_LStringGetElements,
+ freeRep,
+ NULL /*toString*/,
+ my_LStringObjSetElem, /* use default update string */
+/**/ NULL, /*default my_LStringReplace*/
+ },
+ {
+ TCL_ABSTRACTLIST_VERSION_1,
+ "lstring",
+ NULL,
+ DupLStringRep,
+ my_LStringObjLength,
+ my_LStringObjIndex,
+ my_LStringObjRange,/*ObjRange*/
+ my_LStringObjReverse,
+ my_LStringGetElements,
+ freeRep,
+ NULL /*toString*/,
+ my_LStringObjSetElem, /* use default update string */
+ my_LStringReplace
+ }
+};
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * my_LStringObjIndex --
+ *
+ * Implements the AbstractList Index function for the lstring type. The
+ * Index function returns the value at the index position given. Caller
+ * is resposible for freeing the Obj.
+ *
+ * Results:
+ * TCL_OK on success. Returns a new Obj, with a 0 refcount in the
+ * supplied charObjPtr location. Call has ownership of the Obj.
+ *
+ * Side effects:
+ * Obj allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+my_LStringObjIndex(
+ Tcl_Interp *interp,
+ Tcl_Obj *lstringObj,
+ Tcl_Size index,
+ Tcl_Obj **charObjPtr)
+{
+ LString *lstringRepPtr = (LString*)Tcl_AbstractListGetConcreteRep(lstringObj);
+
+ (void)interp;
+
+ if (index < lstringRepPtr->strlen) {
+ char cchar[2];
+ cchar[0] = lstringRepPtr->string[index];
+ cchar[1] = 0;
+ *charObjPtr = Tcl_NewStringObj(cchar,1);
+ } else {
+ *charObjPtr = Tcl_NewObj();
+ }
+
+ return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * my_LStringObjLength --
+ *
+ * Implements the AbstractList Length function for the lstring type.
+ * The Length function returns the number of elements in the list.
+ *
+ * Results:
+ * WideInt number of elements in the list.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_WideInt
+my_LStringObjLength(Tcl_Obj *lstringObjPtr)
+{
+ LString *lstringRepPtr = (LString *)Tcl_AbstractListGetConcreteRep(lstringObjPtr);
+ return lstringRepPtr->strlen;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupLStringRep --
+ *
+ * Replicates the internal representation of the src value, and storing
+ * it in the copy
+ *
+ * Results:
+ * void
+ *
+ * Side effects:
+ * Modifies the rep of the copyObj.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupLStringRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr)
+{
+ LString *srcLString = (LString*)Tcl_AbstractListGetConcreteRep(srcPtr);
+ LString *copyLString = (LString*)Tcl_Alloc(sizeof(LString));
+
+ memcpy(copyLString, srcLString, sizeof(LString));
+ copyLString->string = (char*)Tcl_Alloc(srcLString->allocated);
+ strcpy(copyLString->string, srcLString->string);
+ copyLString->elements = NULL;
+ Tcl_AbstractListSetConcreteRep(copyPtr,copyLString);
+
+ return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * my_LStringObjSetElem --
+ *
+ * Replace the element value at the given (nested) index with the
+ * valueObj provided. If the lstring obj is shared, a new list is
+ * created conntaining the modifed element.
+ *
+ * Results:
+ * The modifed lstring is returned, either new or original. If the
+ * index is invalid, NULL is returned, and an error is added to the
+ * interp, if provided.
+ *
+ * Side effects:
+ * A new obj may be created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj*
+my_LStringObjSetElem(
+ Tcl_Interp *interp,
+ Tcl_Obj *lstringObj,
+ Tcl_Size numIndicies,
+ Tcl_Obj *const indicies[],
+ Tcl_Obj *valueObj)
+{
+ LString *lstringRepPtr = (LString*)Tcl_AbstractListGetConcreteRep(lstringObj);
+ Tcl_Size index;
+ const char *newvalue;
+ int status;
+ Tcl_Obj *returnObj;
+
+ if (numIndicies > 1) {
+ Tcl_SetObjResult(interp,
+ Tcl_ObjPrintf("Multiple indicies not supported by lstring."));
+ return NULL;
+ }
+
+ status = Tcl_GetIntForIndex(interp, indicies[0], lstringRepPtr->strlen, &index);
+ if (status != TCL_OK) {
+ return NULL;
+ }
+
+ returnObj = Tcl_IsShared(lstringObj) ? Tcl_DuplicateObj(lstringObj) : lstringObj;
+ lstringRepPtr = (LString*)Tcl_AbstractListGetConcreteRep(returnObj);
+
+ if (index >= lstringRepPtr->strlen) {
+ index = lstringRepPtr->strlen;
+ lstringRepPtr->strlen++;
+ lstringRepPtr->string = (char*)Tcl_Realloc(lstringRepPtr->string, lstringRepPtr->strlen+1);
+ }
+
+ newvalue = Tcl_GetString(valueObj);
+ lstringRepPtr->string[index] = newvalue[0];
+
+ Tcl_InvalidateStringRep(returnObj);
+
+ return returnObj;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * my_LStringObjRange --
+ *
+ * Creates a new Obj with a slice of the src listPtr.
+ *
+ * Results:
+ * A new Obj is assigned to newObjPtr. Returns TCL_OK
+ *
+ * Side effects:
+ * A new Obj is created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int my_LStringObjRange(
+ Tcl_Interp *interp,
+ Tcl_Obj *lstringObj,
+ Tcl_Size fromIdx,
+ Tcl_Size toIdx,
+ Tcl_Obj **newObjPtr)
+{
+ Tcl_Obj *rangeObj;
+ LString *lstringRepPtr = (LString*)Tcl_AbstractListGetConcreteRep(lstringObj);
+ LString *rangeRep;
+ Tcl_WideInt len = toIdx - fromIdx + 1;
+
+ if (lstringRepPtr->strlen < fromIdx ||
+ lstringRepPtr->strlen < toIdx) {
+ Tcl_SetObjResult(interp,
+ Tcl_ObjPrintf("Range out of bounds "));
+ return TCL_ERROR;
+ }
+
+ if (len <= 0) {
+ // Return empty value;
+ *newObjPtr = Tcl_NewObj();
+ } else {
+ rangeRep = (LString*)Tcl_Alloc(sizeof(LString));
+ rangeRep->allocated = len+1;
+ rangeRep->strlen = len;
+ rangeRep->string = (char*)Tcl_Alloc(rangeRep->allocated);
+ strncpy(rangeRep->string,&lstringRepPtr->string[fromIdx],len);
+ rangeRep->string[len] = 0;
+ rangeRep->elements = NULL;
+ rangeObj = Tcl_AbstractListObjNew(interp, Tcl_AbstractListGetType(lstringObj));
+ Tcl_AbstractListSetConcreteRep(rangeObj, rangeRep);
+ *newObjPtr = rangeObj;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * my_LStringObjReverse --
+ *
+ * Creates a new Obj with the the order of the elements in the lstring
+ * value reversed, where first is last and last is first, etc.
+ *
+ * Results:
+ * A new Obj is assigned to newObjPtr. Returns TCL_OK
+ *
+ * Side effects:
+ * A new Obj is created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+my_LStringObjReverse(Tcl_Interp *interp, Tcl_Obj *srcObj, Tcl_Obj **newObjPtr)
+{
+ LString *srcRep = (LString*)Tcl_AbstractListGetConcreteRep(srcObj);
+ Tcl_Obj *revObj;
+ LString *revRep = (LString*)Tcl_Alloc(sizeof(LString));
+ Tcl_WideInt len;
+ char *srcp, *dstp, *endp;
+ len = srcRep->strlen;
+ revRep->strlen = len;
+ revRep->allocated = len+1;
+ revRep->string = (char*)Tcl_Alloc(revRep->allocated);
+ revRep->elements = NULL;
+ srcp = srcRep->string;
+ endp = &srcRep->string[len];
+ dstp = &revRep->string[len];
+ *dstp-- = 0;
+ while (srcp < endp) {
+ *dstp-- = *srcp++;
+ }
+ revObj = Tcl_AbstractListObjNew(interp, Tcl_AbstractListGetType(srcObj));
+ Tcl_AbstractListSetConcreteRep(revObj, revRep);
+ *newObjPtr = revObj;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * my_LStringReplace --
+ *
+ * Delete and/or Insert elements in the list, starting at index first.
+ * See more details in the comments below. This should not be called with
+ * a Shared Obj.
+ *
+ * Results:
+ * The value of the listObj is modified.
+ *
+ * Side effects:
+ * The string rep is invalidated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+my_LStringReplace(
+ Tcl_Interp *interp,
+ Tcl_Obj *listObj,
+ Tcl_Size first,
+ Tcl_Size numToDelete,
+ Tcl_Size numToInsert,
+ Tcl_Obj *const insertObjs[])
+{
+ LString *lstringRep = (LString*)Tcl_AbstractListGetConcreteRep(listObj);
+ Tcl_Size newLen;
+ Tcl_Size x, ix, kx;
+ char *newStr;
+ char *oldStr = lstringRep->string;
+ (void)interp;
+
+ newLen = lstringRep->strlen - numToDelete + numToInsert;
+
+ if (newLen >= lstringRep->allocated) {
+ lstringRep->allocated = newLen+1;
+ newStr = (char*)Tcl_Alloc(lstringRep->allocated);
+ newStr[newLen] = 0;
+ } else {
+ newStr = oldStr;
+ }
+
+ /* Tcl_ListObjReplace replaces zero or more elements of the list
+ * referenced by listPtr with the objc values in the array referenced by
+ * objv.
+ *
+ * If listPtr does not point to a list value, Tcl_ListObjReplace
+ * will attempt to convert it to one; if the conversion fails, it returns
+ * TCL_ERROR and leaves an error message in the interpreter's result value
+ * if interp is not NULL. Otherwise, it returns TCL_OK after replacing the
+ * values.
+ *
+ * * If objv is NULL, no new elements are added.
+ *
+ * * If the argument first is zero or negative, it refers to the first
+ * element.
+ *
+ * * If first is greater than or equal to the number of elements in the
+ * list, then no elements are deleted; the new elements are appended
+ * to the list. count gives the number of elements to replace.
+ *
+ * * If count is zero or negative then no elements are deleted; the new
+ * elements are simply inserted before the one designated by first.
+ * Tcl_ListObjReplace invalidates listPtr's old string representation.
+ *
+ * * The reference counts of any elements inserted from objv are
+ * incremented since the resulting list now refers to them. Similarly,
+ * the reference counts for any replaced values are decremented.
+ */
+
+ // copy 0 to first-1
+ if (newStr != oldStr) {
+ strncpy(newStr, oldStr, first);
+ }
+
+ // move front elements to keep
+ for(x=0, kx=0; x<newLen && kx<first; kx++, x++) {
+ newStr[x] = oldStr[kx];
+ }
+ // Insert new elements into new string
+ for(x=first, ix=0; ix<numToInsert; x++, ix++) {
+ char const *svalue = Tcl_GetString(insertObjs[ix]);
+ newStr[x] = svalue[0];
+ }
+ // Move remaining elements
+ if ((first+numToDelete) < newLen) {
+ for(/*x,*/ kx=first+numToDelete; (kx <lstringRep->strlen && x<newLen); x++, kx++) {
+ newStr[x] = oldStr[kx];
+ }
+ }
+
+ // Terminate new string.
+ newStr[newLen] = 0;
+
+
+ if (oldStr != newStr) {
+ Tcl_Free(oldStr);
+ }
+ lstringRep->string = newStr;
+ lstringRep->strlen = newLen;
+
+ /* Changes made to value, string rep no longer valid */
+ Tcl_InvalidateStringRep(listObj);
+
+ return TCL_OK;
+}
+
+static Tcl_AbstractListType *
+my_SetAbstractProc(Tcl_AbstractListProcType ptype)
+{
+ Tcl_AbstractListType *typePtr = &lstringTypes[11];
+ if (TCL_ABSL_NEW <= ptype && ptype <= TCL_ABSL_REPLACE) {
+ typePtr = &lstringTypes[ptype];
+ }
+ return typePtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * my_NewLStringObj --
+ *
+ * Creates a new lstring Obj using the string value of objv[0]
+ *
+ * Results:
+ * results
+ *
+ * Side effects:
+ * side effects
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+my_NewLStringObj(
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj * const objv[])
+{
+ LString *lstringRepPtr;
+ size_t repSize;
+ Tcl_Obj *lstringPtr;
+ const char *string;
+ static const char* procTypeNames[] = {
+ "NEW", "DUPREP", "LENGTH", "INDEX",
+ "SLICE", "REVERSE", "GETELEMENTS", "FREEREP",
+ "TOSTRING", "SETELEMENT", "REPLACE", NULL
+ };
+ int i = 0;
+ Tcl_AbstractListProcType ptype;
+ Tcl_AbstractListType *lstringTypePtr = &lstringTypes[11];
+
+ repSize = sizeof(LString);
+ lstringRepPtr = (LString*)Tcl_Alloc(repSize);
+
+ while (i<objc) {
+ const char *s = Tcl_GetString(objv[i]);
+ if (strcmp(s, "-not")==0) {
+ i++;
+ if (Tcl_GetIndexFromObj(interp, objv[i], procTypeNames, "proctype", 0, &ptype)==TCL_OK) {
+ lstringTypePtr = my_SetAbstractProc(ptype);
+ }
+ } else if (strcmp(s, "--") == 0) {
+ // End of options
+ i++;
+ break;
+ } else {
+ break;
+ }
+ i++;
+ }
+ if (i != objc-1) {
+ Tcl_WrongNumArgs(interp, 0, objv, "lstring string");
+ return NULL;
+ }
+ string = Tcl_GetString(objv[i]);
+
+ lstringPtr = Tcl_AbstractListObjNew(interp, lstringTypePtr);
+ lstringRepPtr->strlen = strlen(string);
+ lstringRepPtr->allocated = lstringRepPtr->strlen + 1;
+ lstringRepPtr->string = (char*)Tcl_Alloc(lstringRepPtr->allocated);
+ strcpy(lstringRepPtr->string, string);
+ lstringRepPtr->elements = NULL;
+ Tcl_AbstractListSetConcreteRep(lstringPtr, lstringRepPtr);
+ if (lstringRepPtr->strlen > 0) {
+ Tcl_InvalidateStringRep(lstringPtr);
+ } else {
+ Tcl_InitStringRep(lstringPtr, NULL, 0);
+ }
+
+ return lstringPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * freeRep --
+ *
+ * Free the value storage of the lstring Obj.
+ *
+ * Results:
+ * void
+ *
+ * Side effects:
+ * Memory free'd.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+freeRep(Tcl_Obj* lstringObj)
+{
+ LString *lstringRepPtr = (LString*)Tcl_AbstractListGetConcreteRep(lstringObj);
+ if (lstringRepPtr->string) {
+ Tcl_Free(lstringRepPtr->string);
+ }
+ if (lstringRepPtr->elements) {
+ Tcl_Obj **objptr = lstringRepPtr->elements;
+ while (objptr < &lstringRepPtr->elements[lstringRepPtr->strlen]) {
+ Tcl_DecrRefCount(*objptr++);
+ }
+ Tcl_Free((char*)lstringRepPtr->elements);
+ lstringRepPtr->elements = NULL;
+ }
+ Tcl_Free((char*)lstringRepPtr);
+ Tcl_AbstractListSetConcreteRep(lstringObj, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * my_LStringGetElements --
+ *
+ * Get the elements of the list in an array.
+ *
+ * Results:
+ * objc, objv return values
+ *
+ * Side effects:
+ * A Tcl_Obj is stored for every element of the abstract list
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int my_LStringGetElements(Tcl_Interp *interp,
+ Tcl_Obj *lstringObj,
+ Tcl_Size *objcptr,
+ Tcl_Obj ***objvptr)
+{
+ LString *lstringRepPtr = (LString*)Tcl_AbstractListGetConcreteRep(lstringObj);
+ Tcl_Obj **objPtr;
+ char *cptr = lstringRepPtr->string;
+ (void)interp;
+ if (lstringRepPtr->strlen == 0) {
+ *objcptr = 0;
+ *objvptr = NULL;
+ return TCL_OK;
+ }
+ if (lstringRepPtr->elements == NULL) {
+ lstringRepPtr->elements = (Tcl_Obj**)Tcl_Alloc(sizeof(Tcl_Obj*) * lstringRepPtr->strlen);
+ objPtr=lstringRepPtr->elements;
+ while (objPtr<&lstringRepPtr->elements[lstringRepPtr->strlen]) {
+ *objPtr = Tcl_NewStringObj(cptr++,1);
+ Tcl_IncrRefCount(*objPtr++);
+ }
+ }
+ *objvptr = lstringRepPtr->elements;
+ *objcptr = lstringRepPtr->strlen;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * lLStringObjCmd --
+ *
+ * Script level command that creats an lstring Obj value.
+ *
+ * Results:
+ * Returns and lstring Obj value in the interp results.
+ *
+ * Side effects:
+ * Interp results modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+lLStringObjCmd(
+ void *clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj * const objv[])
+{
+ Tcl_Obj *lstringObj;
+
+ (void)clientData;
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "string");
+ return TCL_ERROR;
+ }
+
+ lstringObj = my_NewLStringObj(interp, objc-1, &objv[1]);
+
+ if (lstringObj) {
+ Tcl_SetObjResult(interp, lstringObj);
+ return TCL_OK;
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Lstring_Init --
+ *
+ * DL load init function. Defines the "lstring" command.
+ *
+ * Results:
+ * "lstring" command added to the interp.
+ *
+ * Side effects:
+ * A new command is defined.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int Tcl_ABSListTest_Init(Tcl_Interp *interp) {
+ if (Tcl_InitStubs(interp, "8.7", 0) == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_CreateObjCommand(interp, "lstring", lLStringObjCmd, NULL, NULL);
+ Tcl_PkgProvide(interp, "abstractlisttest", "1.0.0");
+ return TCL_OK;
+}
diff --git a/tests/abstractlist.test b/tests/abstractlist.test
new file mode 100644
index 0000000..6c2312e
--- /dev/null
+++ b/tests/abstractlist.test
@@ -0,0 +1,537 @@
+# Exercise AbstractList API via the "lstring" command defined in tclTestABSList.c
+#
+# Copyright © 2022 Brian Griffin
+#
+# 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 testevalex [llength [info commands testevalex]]
+
+set abstractlisttestvars [info var *]
+
+proc value-isa {var {expected ""}} {
+ upvar $var v
+ set t [lindex [tcl::unsupported::representation $v] 3]
+ if {$expected ne "" && $expected ne $t} {
+ set fail " expecting: $expected"
+ } else {
+ set fail ""
+ }
+ return "$var is a $t$fail"
+}
+
+proc value-cmp {vara varb} {
+ upvar $vara a
+ upvar $varb b
+ set ta [tcl::unsupported::representation $a]
+ set tb [tcl::unsupported::representation $b]
+ return [string compare $ta $tb]
+}
+
+set str "My name is Inigo Montoya. You killed my father. Prepare to die!"
+set str2 "Vizzini: HE DIDN'T FALL? INCONCEIVABLE. Inigo Montoya: You keep using that word. I do not think it means what you think it means."
+
+test abstractlist-1.0 {error cases} -body {
+ lstring
+} \
+ -returnCodes 1 \
+ -result {wrong # args: should be "lstring string"}
+
+test abstractlist-1.1 {error cases} -body {
+ lstring a b c
+} -returnCodes 1 \
+ -result {wrong # args: should be "lstring string"}
+
+test abstractlist-2.0 {no shimmer llength} {
+ set l [lstring $str]
+ set l-isa [value-isa l]
+ set len [llength $l]
+ set l-isa2 [value-isa l]
+ list $l ${l-isa} ${len} ${l-isa2}
+} {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} {l is a lstring} 63 {l is a lstring}}
+
+test abstractlist-2.1 {no shimmer lindex} {
+ set l [lstring $str]
+ set l-isa [value-isa l]
+ set ele [lindex $l 22]
+ set l-isa2 [value-isa l]
+ list $l ${l-isa} ${ele} ${l-isa2}
+} {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} {l is a lstring} y {l is a lstring}}
+
+test abstractlist-2.2 {no shimmer lreverse} {
+ set l [lstring $str]
+ set l-isa [value-isa l]
+ set r [lreverse $l]
+ set r-isa [value-isa r]
+ set l-isa2 [value-isa l]
+ list $r ${l-isa} ${r-isa} ${l-isa2}
+} {{! e i d { } o t { } e r a p e r P { } . r e h t a f { } y m { } d e l l i k { } u o Y { } . a y o t n o M { } o g i n I { } s i { } e m a n { } y M} {l is a lstring} {r is a lstring} {l is a lstring}}
+
+test abstractlist-2.3 {no shimmer lrange} {
+ set l [lstring $str]
+ set l-isa [value-isa l]
+ set il [lsearch -all [lstring $str] { }]
+ set l-isa2 [value-isa l]
+ lappend il [llength $l]
+ set start 0
+ set words [lmap i $il {
+ set w [join [lrange $l $start $i-1] {} ]
+ set start [expr {$i+1}]
+ set w
+ }]
+ set l-isa3 [value-isa l]
+ list ${l-isa} $il ${l-isa2} ${l-isa3} $words
+} {{l is a lstring} {2 7 10 16 25 29 36 39 47 55 58 63} {l is a lstring} {l is a lstring} {My name is Inigo Montoya. You killed my father. Prepare to die!}}
+
+test abstractlist-2.4 {no shimmer foreach} {
+ set l [lstring $str]
+ set l-isa [value-isa l]
+ set word {}
+ set words {}
+ foreach c $l {
+ if {$c eq { }} {
+ lappend words $word
+ set word {}
+ } else {
+ append word $c
+ }
+ }
+ if {$word ne ""} {
+ lappend words $word
+ }
+ set l-isa2 [value-isa l]
+ list ${l-isa} ${l-isa2} $words
+} {{l is a lstring} {l is a lstring} {My name is Inigo Montoya. You killed my father. Prepare to die!}}
+
+#
+# The TBCE implements lreplace as a lrange + lappend operation, so, in this case, $m results is a list, not an lstring.
+#
+test abstractlist-2.5 {!no shimmer lreplace} {
+ set l [lstring $str2]
+ set l-isa [value-isa l]
+ set m [lreplace $l 18 23 { } f a i l ?]
+ set m-isa [value-isa m]
+ set l-isa1 [value-isa l]
+ list ${l-isa} $m ${m-isa} ${l-isa1}
+} {{l is a lstring} {V i z z i n i : { } H E { } D I D N ' T { } f a i l ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {m is a list} {l is a lstring}}
+
+test abstractlist-2.6 {no shimmer ledit} {
+ # "ledit m 9 8 S"
+ set l [lstring $str2]
+ set l-isa [value-isa l]
+ set e [ledit l 9 8 S]
+ set e-isa [value-isa e]
+ list ${l-isa} $e ${e-isa}
+} {{l is a lstring} {V i z z i n i : { } S H E { } D I D N ' T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {e is a lstring}}
+
+test abstractlist-2.7 {no shimmer linsert} {
+ # "ledit m 9 8 S"
+ set l [lstring $str2]
+ set l-isa [value-isa l]
+ set i [linsert $l 12 {*}[split "almost " {}]]
+ set i-isa [value-isa i]
+ set res [list ${l-isa} $i ${i-isa}]
+ set p [lpop i 23]
+ set p-isa [value-isa p]
+ set i-isa2 [value-isa i]
+ lappend res $p ${p-isa} $i ${i-isa2}
+} {{l is a lstring} {V i z z i n i : { } H E { } a l m o s t { } D I D N ' T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {i is a lstring} ' {p is a pure} {V i z z i n i : { } H E { } a l m o s t { } D I D N T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {i is a lstring}}
+
+test abstractlist-2.8 {shimmer lassign} {
+ set l [lstring Inconceivable]
+ set l-isa [value-isa l]
+ set l2 [lassign $l i n c]
+ set l-isa2 [value-isa l]
+ set l2-isa [value-isa l2]
+ list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
+} {{I n c o n c e i v a b l e} {l is a lstring} {o n c e i v a b l e} {l is a lstring} {l2 is a lstring}}
+
+test abstractlist-2.9 {no shimmer lremove} {
+ set l [lstring Inconceivable]
+ set l-isa [value-isa l]
+ set l2 [lremove $l 0 1]
+ set l-isa2 [value-isa l]
+ set l2-isa [value-isa l2]
+ list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
+} {{I n c o n c e i v a b l e} {l is a lstring} {c o n c e i v a b l e} {l is a lstring} {l2 is a lstring}}
+
+test abstractlist-2.10 {shimmer lreverse} {
+ set l [lstring Inconceivable]
+ set l-isa [value-isa l]
+ set l2 [lreverse $l]
+ set l-isa2 [value-isa l]
+ set l2-isa [value-isa l2]
+ list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
+} {{I n c o n c e i v a b l e} {l is a lstring} {e l b a v i e c n o c n I} {l is a lstring} {l2 is a lstring}}
+
+test abstractlist-2.11 {shimmer lset} {
+ set l [lstring Inconceivable]
+ set l-isa [value-isa l]
+ set m [lset l 2 k]
+ set m-isa [value-isa m]
+ list $l ${l-isa} $m ${m-isa} [value-cmp l m]
+} {{I n k o n c e i v a b l e} {l is a lstring} {I n k o n c e i v a b l e} {m is a lstring} 0}
+
+# lrepeat
+test abstractlist-2.12 {shimmer lrepeat} {
+ set l [lstring Inconceivable]
+ set l-isa [value-isa l]
+ set m [lrepeat 3 $l]
+ set m-isa [value-isa m]
+ set n [lindex $m 1]
+ list $l ${l-isa} $m ${m-isa} [value-isa n] [value-cmp l n]
+} {{I n c o n c e i v a b l e} {l is a lstring} {{I n c o n c e i v a b l e} {I n c o n c e i v a b l e} {I n c o n c e i v a b l e}} {m is a list} {n is a lstring} 0}
+
+test abstractlist-2.13 {no shimmer join llength==1} {
+ set l [lstring G]
+ set l-isa [value-isa l]
+ set j [join $l :]
+ set j-isa [value-isa j]
+ list ${l-isa} $l ${j-isa} $j
+} {{l is a lstring} G {j is a pure} G}
+
+test abstractlist-2.14 {error case lset multiple indicies} -body {
+ set l [lstring Inconceivable]
+ set l-isa [value-isa l]
+ set m [lset l 2 0 1 k]
+ set m-isa [value-isa m]
+ list $l ${l-isa} $m ${m-isa} [value-cmp l m]
+} -returnCodes 1 \
+ -result {Multiple indicies not supported by lstring.}
+
+# lsort
+
+test abstractlist-3.0 {no shimmer llength} {
+ set l [lstring -not SLICE $str]
+ set l-isa [value-isa l]
+ set len [llength $l]
+ set l-isa2 [value-isa l]
+ list $l ${l-isa} ${len} ${l-isa2}
+} {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} {l is a lstring} 63 {l is a lstring}}
+
+test abstractlist-3.1 {no shimmer lindex} {
+ set l [lstring -not SLICE $str]
+ set l-isa [value-isa l]
+ set n 22
+ set ele [lindex $l $n] ;# exercise INST_LIST_INDEX
+ set l-isa2 [value-isa l]
+ list $l ${l-isa} ${ele} ${l-isa2}
+} {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} {l is a lstring} y {l is a lstring}}
+
+test abstractlist-3.2 {no shimmer lreverse} {
+ set l [lstring -not SLICE $str]
+ set l-isa [value-isa l]
+ set r [lreverse $l]
+ set r-isa [value-isa r]
+ set l-isa2 [value-isa l]
+ list $r ${l-isa} ${r-isa} ${l-isa2}
+} {{! e i d { } o t { } e r a p e r P { } . r e h t a f { } y m { } d e l l i k { } u o Y { } . a y o t n o M { } o g i n I { } s i { } e m a n { } y M} {l is a lstring} {r is a lstring} {l is a lstring}}
+
+test abstractlist-3.3 {shimmer lrange} {
+ set l [lstring -not SLICE $str]
+ set l-isa [value-isa l]
+ set il [lsearch -all [lstring -not SLICE $str] { }]
+ set l-isa2 [value-isa l]
+ lappend il [llength $l]
+ set start 0
+ set words [lmap i $il {
+ set w [join [lrange $l $start $i-1] {} ]
+ set start [expr {$i+1}]
+ set w
+ }]
+ set l-isa3 [value-isa l]; # lrange defaults to list behavior
+ list ${l-isa} $il ${l-isa2} ${l-isa3} $words
+} {{l is a lstring} {2 7 10 16 25 29 36 39 47 55 58 63} {l is a lstring} {l is a list} {My name is Inigo Montoya. You killed my father. Prepare to die!}}
+
+test abstractlist-3.4 {no shimmer foreach} {
+ set l [lstring -not SLICE $str]
+ set l-isa [value-isa l]
+ set word {}
+ set words {}
+ foreach c $l {
+ if {$c eq { }} {
+ lappend words $word
+ set word {}
+ } else {
+ append word $c
+ }
+ }
+ if {$word ne ""} {
+ lappend words $word
+ }
+ set l-isa2 [value-isa l]
+ list ${l-isa} ${l-isa2} $words
+} {{l is a lstring} {l is a lstring} {My name is Inigo Montoya. You killed my father. Prepare to die!}}
+
+#
+# The TBCE implements lreplace as a lrange + lappend operation, so, in this case, $m results is a list, not an lstring.
+#
+test abstractlist-3.5 {!no shimmer lreplace} {
+ set l [lstring -not SLICE $str2]
+ set l-isa [value-isa l]
+ set m [lreplace $l 18 23 { } f a i l ?]
+ set m-isa [value-isa m]
+ set l-isa1 [value-isa l]
+ list ${l-isa} $m ${m-isa} ${l-isa1}
+} {{l is a lstring} {V i z z i n i : { } H E { } D I D N ' T { } f a i l ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {m is a list} {l is a list}}
+
+test abstractlist-3.6 {no shimmer ledit} {
+ # "ledit m 9 8 S"
+ set l [lstring -not SLICE $str2]
+ set l-isa [value-isa l]
+ set e [ledit l 9 8 S]
+ set e-isa [value-isa e]
+ list ${l-isa} $e ${e-isa}
+} {{l is a lstring} {V i z z i n i : { } S H E { } D I D N ' T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {e is a lstring}}
+
+test abstractlist-3.7 {no shimmer linsert} {
+ # "ledit m 9 8 S"
+ set res {}
+ set l [lstring -not SLICE $str2]
+ set l-isa [value-isa l]
+ set i [linsert $l 12 {*}[split "almost " {}]]
+ set i-isa [value-isa i]
+ set res [list ${l-isa} $i ${i-isa}]
+ set p [lpop i 23]
+ set p-isa [value-isa p]
+ set i-isa2 [value-isa i]
+ lappend res $p ${p-isa} $i ${i-isa2}
+} {{l is a lstring} {V i z z i n i : { } H E { } a l m o s t { } D I D N ' T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {i is a lstring} ' {p is a pure} {V i z z i n i : { } H E { } a l m o s t { } D I D N T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {i is a lstring}}
+
+test abstractlist-3.8 {shimmer lassign} {
+ set l [lstring -not SLICE Inconceivable]
+ set l-isa [value-isa l]
+ set l2 [lassign $l i n c] ;# must be using lrange internally
+ set l-isa2 [value-isa l]
+ set l2-isa [value-isa l2]
+ list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
+} {{I n c o n c e i v a b l e} {l is a lstring} {o n c e i v a b l e} {l is a list} {l2 is a list}}
+
+test abstractlist-3.9 {no shimmer lremove} {
+ set l [lstring -not SLICE Inconceivable]
+ set l-isa [value-isa l]
+ set l2 [lremove $l 0 1]
+ set l-isa2 [value-isa l]
+ set l2-isa [value-isa l2]
+ list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
+} {{I n c o n c e i v a b l e} {l is a lstring} {c o n c e i v a b l e} {l is a lstring} {l2 is a lstring}}
+
+test abstractlist-3.10 {shimmer lreverse} {
+ set l [lstring -not SLICE Inconceivable]
+ set l-isa [value-isa l]
+ set l2 [lreverse $l]
+ set l-isa2 [value-isa l]
+ set l2-isa [value-isa l2]
+ list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
+} {{I n c o n c e i v a b l e} {l is a lstring} {e l b a v i e c n o c n I} {l is a lstring} {l2 is a lstring}}
+
+test abstractlist-3.11 {shimmer lset} {
+ set l [lstring -not SLICE Inconceivable]
+ set l-isa [value-isa l]
+ set m [lset l 2 k]
+ set m-isa [value-isa m]
+ list $l ${l-isa} $m ${m-isa} [value-cmp l m]
+} {{I n k o n c e i v a b l e} {l is a lstring} {I n k o n c e i v a b l e} {m is a lstring} 0}
+
+# lrepeat
+test abstractlist-3.12 {shimmer lrepeat} {
+ set l [lstring -not SLICE Inconceivable]
+ set l-isa [value-isa l]
+ set m [lrepeat 3 $l]
+ set m-isa [value-isa m]
+ set n [lindex $m 1]
+ list $l ${l-isa} $m ${m-isa} [value-isa n] [value-cmp l n]
+} {{I n c o n c e i v a b l e} {l is a lstring} {{I n c o n c e i v a b l e} {I n c o n c e i v a b l e} {I n c o n c e i v a b l e}} {m is a list} {n is a lstring} 0}
+
+# lsort
+foreach not {{} REVERSE SLICE SETELEMENT REPLACE GETELEMENTS} {
+
+ testConstraint [format "%sShimmer" [string totitle $not]] [expr {$not eq ""}]
+ set options [expr {$not ne "" ? "-not $not" : ""}]
+
+test abstractlist-$not-4.0 {no shimmer llength} {
+ set l [lstring {*}$options $str]
+ set l-isa [value-isa l]
+ set len [llength $l]
+ set l-isa2 [value-isa l]
+ list $l ${l-isa} ${len} ${l-isa2}
+} {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} {l is a lstring} 63 {l is a lstring}}
+
+test abstractlist-$not-4.1 {no shimmer lindex} {
+ set l [lstring {*}$options $str]
+ set l-isa [value-isa l]
+ set ele [lindex $l 22]
+ set l-isa2 [value-isa l]
+ list $l ${l-isa} ${ele} ${l-isa2}
+} {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} {l is a lstring} y {l is a lstring}}
+
+test abstractlist-$not-4.2 {lreverse} ReverseShimmer {
+ set l [lstring {*}$options $str]
+ set l-isa [value-isa l]
+ set r [lreverse $l]
+ set r-isa [value-isa r]
+ set l-isa2 [value-isa l]
+ list $r ${l-isa} ${r-isa} ${l-isa2}
+} {{! e i d { } o t { } e r a p e r P { } . r e h t a f { } y m { } d e l l i k { } u o Y { } . a y o t n o M { } o g i n I { } s i { } e m a n { } y M} {l is a lstring} {r is a lstring} {l is a lstring}}
+
+test abstractlist-$not-4.3 {no shimmer lrange} RangeShimmer {
+ set l [lstring {*}$options $str]
+ set l-isa [value-isa l]
+ set il [lsearch -all [lstring {*}$options $str] { }]
+ set l-isa2 [value-isa l]
+ lappend il [llength $l]
+ set start 0
+ set words [lmap i $il {
+ set w [join [lrange $l $start $i-1] {} ]
+ set start [expr {$i+1}]
+ set w
+ }]
+ set l-isa3 [value-isa l]
+ list ${l-isa} $il ${l-isa2} ${l-isa3} $words
+} {{l is a lstring} {2 7 10 16 25 29 36 39 47 55 58 63} {l is a lstring} {l is a lstring} {My name is Inigo Montoya. You killed my father. Prepare to die!}}
+
+test abstractlist-$not-4.4 {no shimmer foreach} {
+ set l [lstring {*}$options $str]
+ set l-isa [value-isa l]
+ set word {}
+ set words {}
+ foreach c $l {
+ if {$c eq { }} {
+ lappend words $word
+ set word {}
+ } else {
+ append word $c
+ }
+ }
+ if {$word ne ""} {
+ lappend words $word
+ }
+ set l-isa2 [value-isa l]
+ list ${l-isa} ${l-isa2} $words
+} {{l is a lstring} {l is a lstring} {My name is Inigo Montoya. You killed my father. Prepare to die!}}
+
+#
+# The TBCE implements lreplace as a lrange + lappend operation, so, in this case, $m results is a list, not an lstring.
+#
+test abstractlist-$not-4.5 {!no shimmer lreplace} RangeShimmer {
+ set l [lstring {*}$options $str2]
+ set l-isa [value-isa l]
+ set m [lreplace $l 18 23 { } f a i l ?]
+ set m-isa [value-isa m]
+ set l-isa1 [value-isa l]
+ list ${l-isa} $m ${m-isa} ${l-isa1}
+} {{l is a lstring} {V i z z i n i : { } H E { } D I D N ' T { } f a i l ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {m is a list} {l is a lstring}}
+
+test abstractlist-$not-4.6 {no shimmer ledit} {SetelementShimmer ReplaceShimmer} {
+ # "ledit m 9 8 S"
+ set l [lstring {*}$options $str2]
+ set l-isa [value-isa l]
+ set e [ledit l 9 8 S]
+ set e-isa [value-isa e]
+ list ${l-isa} $e ${e-isa}
+} {{l is a lstring} {V i z z i n i : { } S H E { } D I D N ' T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {e is a lstring}}
+
+test abstractlist-$not-4.7 {no shimmer linsert} ReplaceShimmer {
+ # "ledit m 9 8 S"
+ set l [lstring {*}$options $str2]
+ set l-isa [value-isa l]
+ set i [linsert $l 12 {*}[split "almost " {}]]
+ set i-isa [value-isa i]
+ set res [list ${l-isa} $i ${i-isa}]
+ set p [lpop i 23]
+ set p-isa [value-isa p]
+ set i-isa2 [value-isa i]
+ lappend res $p ${p-isa} $i ${i-isa2}
+} {{l is a lstring} {V i z z i n i : { } H E { } a l m o s t { } D I D N ' T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {i is a lstring} ' {p is a pure} {V i z z i n i : { } H E { } a l m o s t { } D I D N T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {i is a list}}
+
+# lassign probably uses lrange internally
+test abstractlist-$not-4.8 {shimmer lassign} RangeShimmer {
+ set l [lstring {*}$options Inconceivable]
+ set l-isa [value-isa l]
+ set l2 [lassign $l i n c]
+ set l-isa2 [value-isa l]
+ set l2-isa [value-isa l2]
+ list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
+} {{I n c o n c e i v a b l e} {l is a lstring} {o n c e i v a b l e} {l is a lstring} {l2 is a lstring}}
+
+test abstractlist-$not-4.9 {no shimmer lremove} ReplaceShimmer {
+ set l [lstring {*}$options Inconceivable]
+ set l-isa [value-isa l]
+ set l2 [lremove $l 0 1]
+ set l-isa2 [value-isa l]
+ set l2-isa [value-isa l2]
+ list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
+} {{I n c o n c e i v a b l e} {l is a lstring} {c o n c e i v a b l e} {l is a lstring} {l2 is a lstring}}
+
+test abstractlist-$not-4.10 {shimmer lreverse} ReverseShimmer {
+ set l [lstring {*}$options Inconceivable]
+ set l-isa [value-isa l]
+ set l2 [lreverse $l]
+ set l-isa2 [value-isa l]
+ set l2-isa [value-isa l2]
+ list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
+} {{I n c o n c e i v a b l e} {l is a lstring} {e l b a v i e c n o c n I} {l is a lstring} {l2 is a lstring}}
+
+test abstractlist-$not-4.11 {shimmer lset} SetelementShimmer {
+ set l [lstring {*}$options Inconceivable]
+ set l-isa [value-isa l]
+ set m [lset l 2 k]
+ set m-isa [value-isa m]
+ list $l ${l-isa} $m ${m-isa} [value-cmp l m]
+} {{I n k o n c e i v a b l e} {l is a lstring} {I n k o n c e i v a b l e} {m is a lstring} 0}
+
+test abstractlist-$not-4.11x {lset not compiled} {SetelementShimmer testevalex} {
+ set l [lstring {*}$options Inconceivable]
+ set l-isa [value-isa l]
+ set m [testevalex {lset l 2 k}]
+ set m-isa [value-isa m]
+ list $l ${l-isa} $m ${m-isa} [value-cmp l m]
+} {{I n k o n c e i v a b l e} {l is a lstring} {I n k o n c e i v a b l e} {m is a lstring} 0}
+
+test abstractlist-$not-4.11e {error case lset multiple indicies} \
+ -constraints {SetelementShimmer testevalex} -body {
+ set l [lstring Inconceivable]
+ set l-isa [value-isa l]
+ set m [testevalex {lset l 2 0 1 k}]
+ set m-isa [value-isa m]
+ list $l ${l-isa} $m ${m-isa} [value-cmp l m]
+} -returnCodes 1 \
+ -result {Multiple indicies not supported by lstring.}
+
+# lrepeat
+test abstractlist-$not-4.12 {shimmer lrepeat} {
+ set l [lstring {*}$options Inconceivable]
+ set l-isa [value-isa l]
+ set m [lrepeat 3 $l]
+ set m-isa [value-isa m]
+ set n [lindex $m 1]
+ list $l ${l-isa} $m ${m-isa} [value-isa n] [value-cmp l n]
+} {{I n c o n c e i v a b l e} {l is a lstring} {{I n c o n c e i v a b l e} {I n c o n c e i v a b l e} {I n c o n c e i v a b l e}} {m is a list} {n is a lstring} 0}
+
+# Disable constraint
+testConstraint [format "%sShimmer" [string totitle $not]] 1
+
+}
+
+# lsort
+
+# cleanup
+::tcltest::cleanupTests
+
+proc my_abstl_cleanup {vars} {
+ set nowvars [uplevel info vars]
+ foreach var $nowvars {
+ if {$var ni $vars} {
+ uplevel unset $var
+ lappend clean-list $var
+ }
+ }
+ return ${clean-list}
+}
+
+my_abstl_cleanup $abstractlisttestvars
diff --git a/tests/lseq.test b/tests/lseq.test
index 3f68da4..04069fc 100644
--- a/tests/lseq.test
+++ b/tests/lseq.test
@@ -537,9 +537,16 @@ test lseq-4.8 {error case lrange} -body {
test lseq-4.9 {error case lrange} -body {
set fred 7
set ginger 8
- lrange [lseq 1 5] $fred $ginger
-} -returnCodes 1 \
- -result {index 7 is out of bounds 0 to 4}
+ lrange [lseq 1 10] $fred $ginger
+} -result {8 9}
+
+test lseq-4.10 {lset shimmer} -body {
+ set l [lseq 15]
+ lappend res $l [lindex [tcl::unsupported::representation $l] 3]
+ lset l 3 25
+ lappend res $l [lindex [tcl::unsupported::representation $l] 3]
+} -result {{0 1 2 3 4 5 6 7 8 9 10 11 12 13 14} arithseries {0 1 2 25 4 5 6 7 8 9 10 11 12 13 14} list}
+
# Panic when using variable value?
test lseq-4.10 {panic using variable index} {
diff --git a/unix/Makefile.in b/unix/Makefile.in
index a5f8b23..a818b4c 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -293,13 +293,15 @@ DEPEND_SWITCHES = ${CFLAGS} -I${UNIX_DIR} -I${GENERIC_DIR} \
TCLSH_OBJS = tclAppInit.o
TCLTEST_OBJS = tclTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \
- tclThreadTest.o tclUnixTest.o
+ tclThreadTest.o tclUnixTest.o tclTestABSList.o
XTTEST_OBJS = xtTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \
- tclThreadTest.o tclUnixTest.o tclXtNotify.o tclXtTest.o
+ tclThreadTest.o tclUnixTest.o tclXtNotify.o tclXtTest.o \
+ tclTestABSList.o
-GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \
- tclArithSeries.o tclAssembly.o tclAsync.o tclBasic.o tclBinary.o \
+GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o \
+ tclAbstractList.o tclArithSeries.o tclAlloc.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 \
@@ -382,6 +384,8 @@ TCL_DECLS = \
GENERIC_HDRS = \
$(GENERIC_DIR)/tcl.h \
+ $(GENERIC_DIR)/tclAbstractList.h \
+ $(GENERIC_DIR)/tclArithSeries.h \
$(GENERIC_DIR)/tclDecls.h \
$(GENERIC_DIR)/tclInt.h \
$(GENERIC_DIR)/tclIntDecls.h \
@@ -395,16 +399,16 @@ GENERIC_HDRS = \
$(GENERIC_DIR)/tclPatch.h \
$(GENERIC_DIR)/tclPlatDecls.h \
$(GENERIC_DIR)/tclPort.h \
- $(GENERIC_DIR)/tclRegexp.h \
- $(GENERIC_DIR)/tclArithSeries.h
+ $(GENERIC_DIR)/tclRegexp.h
GENERIC_SRCS = \
$(GENERIC_DIR)/regcomp.c \
$(GENERIC_DIR)/regexec.c \
$(GENERIC_DIR)/regfree.c \
$(GENERIC_DIR)/regerror.c \
- $(GENERIC_DIR)/tclAlloc.c \
+ $(GENERIC_DIR)/tclAbstractList.c \
$(GENERIC_DIR)/tclArithSeries.c \
+ $(GENERIC_DIR)/tclAlloc.c \
$(GENERIC_DIR)/tclAssembly.c \
$(GENERIC_DIR)/tclAsync.c \
$(GENERIC_DIR)/tclBasic.c \
@@ -468,6 +472,7 @@ GENERIC_SRCS = \
$(GENERIC_DIR)/tclStringObj.c \
$(GENERIC_DIR)/tclStrToD.c \
$(GENERIC_DIR)/tclTest.c \
+ $(GENERIC_DIR)/tclTestABSList.c \
$(GENERIC_DIR)/tclTestObj.c \
$(GENERIC_DIR)/tclTestProcBodyObj.c \
$(GENERIC_DIR)/tclThread.c \
@@ -1250,15 +1255,18 @@ regfree.o: $(REGHDRS) $(GENERIC_DIR)/regfree.c
regerror.o: $(REGHDRS) $(GENERIC_DIR)/regerrs.h $(GENERIC_DIR)/regerror.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/regerror.c
+tclAbstractList.o: $(GENERIC_DIR)/tclAbstractList.c $(COMPILEHDR)
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAbstractList.c
+
+tclArithSeries.o: $(GENERIC_DIR)/tclArithSeries.c $(COMPILEHDR)
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclArithSeries.c
+
tclAppInit.o: $(UNIX_DIR)/tclAppInit.c
$(CC) -c $(APP_CC_SWITCHES) $(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
@@ -1538,6 +1546,9 @@ tclZipfs.o: $(GENERIC_DIR)/tclZipfs.c
tclTest.o: $(GENERIC_DIR)/tclTest.c $(IOHDR) $(TCLREHDRS) tclUuid.h
$(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTest.c
+tclTestABSList.o: $(GENERIC_DIR)/tclTestABSList.c $(MATHHDRS)
+ $(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTestABSList.c
+
tclTestObj.o: $(GENERIC_DIR)/tclTestObj.c $(MATHHDRS)
$(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTestObj.c
diff --git a/win/Makefile.in b/win/Makefile.in
index a74808b..b6307e4 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -272,15 +272,17 @@ TCLTEST_OBJS = \
tclTestObj.$(OBJEXT) \
tclTestProcBodyObj.$(OBJEXT) \
tclThreadTest.$(OBJEXT) \
- tclWinTest.$(OBJEXT)
+ tclWinTest.$(OBJEXT) \
+ tclTestABSList.$(OBJEXT)
GENERIC_OBJS = \
regcomp.$(OBJEXT) \
regexec.$(OBJEXT) \
regfree.$(OBJEXT) \
regerror.$(OBJEXT) \
- tclAlloc.$(OBJEXT) \
+ tclAbstractList.$(OBJEXT) \
tclArithSeries.$(OBJEXT) \
+ tclAlloc.$(OBJEXT) \
tclAssembly.$(OBJEXT) \
tclAsync.$(OBJEXT) \
tclBasic.$(OBJEXT) \
diff --git a/win/makefile.vc b/win/makefile.vc
index 06d577c..e746875 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -225,6 +225,7 @@ TCLTESTOBJS = \
$(TMP_DIR)\tclTestProcBodyObj.obj \
$(TMP_DIR)\tclThreadTest.obj \
$(TMP_DIR)\tclWinTest.obj \
+ $(TMP_DIR)\tclTestABSList.obj \
!if !$(STATIC_BUILD)
$(OUT_DIR)\tommath.lib \
!endif
@@ -235,8 +236,9 @@ COREOBJS = \
$(TMP_DIR)\regerror.obj \
$(TMP_DIR)\regexec.obj \
$(TMP_DIR)\regfree.obj \
- $(TMP_DIR)\tclAlloc.obj \
+ $(TMP_DIR)\tclAbstractList.obj \
$(TMP_DIR)\tclArithSeries.obj \
+ $(TMP_DIR)\tclAlloc.obj \
$(TMP_DIR)\tclAssembly.obj \
$(TMP_DIR)\tclAsync.obj \
$(TMP_DIR)\tclBasic.obj \
@@ -827,6 +829,9 @@ $(TMP_DIR)\tclTest.obj: $(GENERICDIR)\tclTest.c $(TMP_DIR)\tclUuid.h
$(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
$(cc32) $(appcflags) -Fo$@ $?
+$(TMP_DIR)\tclTestABSList.obj: $(GENERICDIR)\tclTestABSList.c
+ $(cc32) $(appcflags) -Fo$@ $?
+
$(TMP_DIR)\tclWinTest.obj: $(WIN_DIR)\tclWinTest.c
$(CCAPPCMD) $?
generated by cgit v0.12 at 2024-11-16 23:42:15 (GMT)