Tcl Source Code

Changes On Branch tip-636-tcl9
Login
Bounty program for improvements to Tcl and certain Tcl packages.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Changes In Branch tip-636-tcl9 Excluding Merge-Ins

This is equivalent to a diff from 4014e2a164 to db4e5a6372

2022-11-06
20:27
Update Tcl_Filesystem documentation check-in: 6b3203fd37 user: jan.nijtmans tags: trunk, main
11:19
Rebase TIP #626 to latest 9.0. Change Tcl version number from 9.0 to 9.1a0 check-in: efcf7c37fe user: jan.nijtmans tags: tip-626
05:20
Sync with trunk check-in: 6a10d9194c user: griffin tags: tip-636-tcl9-644
2022-11-05
23:35
Sync with trunk Closed-Leaf check-in: db4e5a6372 user: griffin tags: tip-636-tcl9
11:49
Merge 8.7. lreplace4 bcc instruction and FLT_MAX fix check-in: 4014e2a164 user: apnadkarni tags: trunk, main
10:28
Add lreplace4 BCC instruction. Rewrite linsert, lreplace to use it. check-in: 7541ec8fb1 user: apnadkarni tags: core-8-branch
2022-11-03
12:26
Bug [0f98bce669]. Fix limits for string replace. check-in: 997d8c2052 user: apnadkarni tags: trunk, main
2022-11-02
22:33
TIP 636 for Tcl 9 check-in: b78cb72678 user: griffin tags: tip-636-tcl9

Added doc/AbstractListObj.3.





























































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
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

Changes to doc/lseq.n.

17
18
19
20
21
22
23
24
25

26
27





















28
29

30
31
32
33
34
35
36
37
38
39
\fBlseq \fICount\fR ?\fBby \fIStep\fR?
.BE
.SH DESCRIPTION
.PP
The \fBlseq\fR command creates a sequence of numeric values using the given
parameters \fIStart\fR, \fIEnd\fR, and \fIStep\fR. The \fIoperation\fR
argument ".." or "to" defines an inclusive range. The "count" option is used
to define a count of the number of elements in the list. The short form with a

single count value will create a range from 0 to count-1.






















The numeric arguments, \fIStart\fR, \fIEnd\fR, \fIStep\fR, and \fICount\fR,
can also be a valid expression. the lseq command will evaluate the expression

and use the numeric result, or return an error as with any invalid argument
value. A valid expression is a valid [expr] expression, however, the result
must be numeric; a non-numeric string will result in an error.

.SH EXAMPLES
.CS
.\"

 lseq 3
 \(-> 0 1 2






|
|
>
|

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

|
>
|
<
<







17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53


54
55
56
57
58
59
60
\fBlseq \fICount\fR ?\fBby \fIStep\fR?
.BE
.SH DESCRIPTION
.PP
The \fBlseq\fR command creates a sequence of numeric values using the given
parameters \fIStart\fR, \fIEnd\fR, and \fIStep\fR. The \fIoperation\fR
argument ".." or "to" defines 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,
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
.\"

 lseq 3
 \(-> 0 1 2
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
 \(-> l(5)=-5
    l(4)=-4
    l(3)=-3
    l(2)=-2
    l(1)=-1
    l(0)=0

 set i 17
 \(-> 17
 if {$i in [lseq 0 50]} { # equivalent to: (0 <= $i && $i < 50)
     puts "Ok"
 } else {
     puts "outside :("
 }
 \(-> Ok

 set sqrs [lmap i [lseq 1 10] {expr $i*$i}]
 \(-> 1 4 9 16 25 36 49 64 81 100
.\"
.CE
.SH "SEE ALSO"
foreach(n), list(n), lappend(n), lassign(n), ledit(n), lindex(n), linsert(n),
llength(n), lmap(n), lpop(n), lrange(n), lremove(n), lreplace(n),
lreverse(n), lsearch(n), lset(n), lsort(n)
.SH KEYWORDS
element, index, list
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:






<
<
<
<
<
<
<
<
<





|
|







84
85
86
87
88
89
90









91
92
93
94
95
96
97
98
99
100
101
102
103
104
 \(-> l(5)=-5
    l(4)=-4
    l(3)=-3
    l(2)=-2
    l(1)=-1
    l(0)=0










 set sqrs [lmap i [lseq 1 10] {expr $i*$i}]
 \(-> 1 4 9 16 25 36 49 64 81 100
.\"
.CE
.SH "SEE ALSO"
foreach(n), list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n),
lmap(n), lpop(n), lrange(n), lremove(n), lreplace(n),
lreverse(n), lsearch(n), lset(n), lsort(n)
.SH KEYWORDS
element, index, list
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to generic/tcl.decls.

2606
2607
2608
2609
2610
2611
2612
































2613
2614
2615
2616
2617
2618
2619
    int Tcl_RemoveChannelMode(Tcl_Interp *interp, Tcl_Channel chan, int mode)
}

# TIP 643
declare 683 {
   int Tcl_GetEncodingNulLength(Tcl_Encoding encoding)
}

































# ----- BASELINE -- FOR -- 8.7.0 ----- #

##############################################################################

# Define the platform specific public Tcl interface. These functions are only
# available on the designated platform.






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
    int Tcl_RemoveChannelMode(Tcl_Interp *interp, Tcl_Channel chan, int mode)
}

# TIP 643
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 ----- #

##############################################################################

# Define the platform specific public Tcl interface. These functions are only
# available on the designated platform.

Changes to generic/tcl.h.

689
690
691
692
693
694
695








































































































696
697
698
699
700
701
702
				 * corresponds to the type of the object's
				 * internal rep. NULL indicates the object has
				 * no internal rep (has no type). */
    Tcl_ObjInternalRep internalRep;	/* The internal representation: */
} Tcl_Obj;










































































































/*
 *----------------------------------------------------------------------------
 * The following definitions support Tcl's namespace facility. Note: the first
 * five fields must match exactly the fields in a Namespace structure (see
 * tclInt.h).
 */







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
				 * corresponds to the type of the object's
				 * internal rep. NULL indicates the object has
				 * no internal rep (has no type). */
    Tcl_ObjInternalRep internalRep;	/* The internal representation: */
} 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
 * tclInt.h).
 */

Added generic/tclAbstractList.c.





















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
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:
 */

Added generic/tclAbstractList.h.















































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
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:
 */

Changes to generic/tclArithSeries.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72




























73

74
75
76






77
78

79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109

110
111
112

















113





114







































115
116
117
118
119
120
121
/*
 * tclArithSeries.c --
 *
 *     This file contains the ArithSeries concrete abstract list
 *     implementation. It implements the inner workings of the lseq command.
 *
 * Copyright © 2022 Brian S. Griffin.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclArithSeries.h"
#include <assert.h>

/* -------------------------- ArithSeries object ---------------------------- */


#define ArithSeriesRepPtr(arithSeriesObjPtr) \
    (ArithSeries *) ((arithSeriesObjPtr)->internalRep.twoPtrValue.ptr1)

#define ArithSeriesIndexM(arithSeriesRepPtr, index) \
    ((arithSeriesRepPtr)->isDouble ?					\
     (((ArithSeriesDbl*)(arithSeriesRepPtr))->start+((index) * ((ArithSeriesDbl*)(arithSeriesRepPtr))->step)) \
     :									\
     ((arithSeriesRepPtr)->start+((index) * arithSeriesRepPtr->step)))

#define ArithSeriesGetInternalRep(objPtr, arithRepPtr)		\
    do {								\
	const Tcl_ObjInternalRep *irPtr;				\
	irPtr = TclFetchInternalRep((objPtr), &tclArithSeriesType);	\
	(arithRepPtr) = irPtr ? (ArithSeries *)irPtr->twoPtrValue.ptr1 : NULL;	\
    } while (0)


/*
 * Prototypes for procedures defined later in this file:
 */

static void		DupArithSeriesInternalRep (Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static void		FreeArithSeriesInternalRep (Tcl_Obj *listPtr);
static int		SetArithSeriesFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr);
static void		UpdateStringOfArithSeries (Tcl_Obj *listPtr);

/*
 * The structure below defines the arithmetic series Tcl object type by
 * means of procedures that can be invoked by generic object code.
 *
 * The arithmetic series object is a special case of Tcl list representing
 * an interval of an arithmetic series in constant space.
 *
 * The arithmetic series is internally represented with three integers,
 * *start*, *end*, and *step*, Where the length is calculated with
 * the following algorithm:
 *
 * if RANGE == 0 THEN
 *   ERROR
 * if RANGE > 0
 *   LEN is (((END-START)-1)/STEP) + 1
 * else if RANGE < 0
 *   LEN is (((END-START)-1)/STEP) - 1
 *
 * And where the equivalent's list I-th element is calculated
 * as:
 *
 * LIST[i] = START+(STEP*i)
 *
 * Zero elements ranges, like in the case of START=10 END=10 STEP=1
 * are valid and will be equivalent to the empty list.
 */





























const Tcl_ObjType tclArithSeriesType = {

    "arithseries",			/* name */
    FreeArithSeriesInternalRep,		/* freeIntRepProc */
    DupArithSeriesInternalRep,		/* dupIntRepProc */






    UpdateStringOfArithSeries,		/* updateStringProc */
    SetArithSeriesFromAny		/* setFromAnyProc */

};

/*
 *----------------------------------------------------------------------
 *
 * ArithSeriesLen --
 *
 * 	Compute the length of the equivalent list where
 * 	every element is generated starting from *start*,
 * 	and adding *step* to generate every successive element
 * 	that's < *end* for positive steps, or > *end* for negative
 * 	steps.
 *
 * Results:
 *
 * 	The length of the list generated by the given range,
 * 	that may be zero.
 * 	The function returns -1 if the list is of length infinite.
 *
 * Side effects:
 *
 * 	None.
 *
 *----------------------------------------------------------------------
 */
static Tcl_WideInt
ArithSeriesLen(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step)
{
    Tcl_WideInt len;

    if (step == 0) {

	return 0;
    }
    len = 1 + ((end-start)/step);

















    return (len < 0) ? -1 : len;





}








































/*
 *----------------------------------------------------------------------
 *
 * TclNewArithSeriesInt --
 *
 *	Creates a new ArithSeries object. The returned object has











|
|
|
|
<

|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<

<
<
<
<
<
<
<
<
<
|
|

|
|












|








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
|
|
|
>
>
>
>
>
>
|
|
>





|











|












|
>
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

17
18

















19









20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
/*
 * tclArithSeries.c --
 *
 *     This file contains the ArithSeries concrete abstract list
 *     implementation. It implements the inner workings of the lseq command.
 *
 * Copyright © 2022 Brian S. Griffin.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include <assert.h>
#include "tcl.h"
#include "tclInt.h"
#include "tclArithSeries.h"




















/*









 * 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 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
 * the following algorithm:
 *
 * if RANGE == 0 THEN
 *   ERROR
 * if RANGE > 0
 *   LEN is (((END-START)-1)/STEP) + 1
 * else if RANGE < 0
 *   LEN is (((END-START)-1)/STEP) - 1
 *
 * And where the list's I-th element is calculated
 * as:
 *
 * LIST[i] = START+(STEP*i)
 *
 * Zero elements ranges, like in the case of START=10 END=10 STEP=1
 * are valid and will be equivalent to the empty list.
 */

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 --
 *
 * 	Compute the length of the equivalent list where
 * 	every element is generated starting from *start*,
 * 	and adding *step* to generate every successive element
 * 	that's < *end* for positive steps, or > *end* for negative
 * 	steps.
 *
 * Results:
 *
 * 	The length of the list generated by the given range,
 * 	that may be zero.
 * 	The function returns -1 if the list is of length infiite.
 *
 * Side effects:
 *
 * 	None.
 *
 *----------------------------------------------------------------------
 */
static Tcl_WideInt
ArithSeriesLen(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step)
{
    Tcl_WideInt len;

    if (step == 0) return 0;
    len = (step ? (1 + (((end-start))/step)) : 0);
    return (len < 0) ? -1 : len;
}

/*
 *----------------------------------------------------------------------
 *
 * 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);
    }
}


/*
 *----------------------------------------------------------------------
 *
 * TclNewArithSeriesInt --
 *
 *	Creates a new ArithSeries object. The returned object has
131
132
133
134
135
136
137
138
139
140
141
142
143

144
145
146
147
148
149
150
151
152
153
154
155

156
157
158
159
160
161
162
163
164
165
166
167
 * 	None.
 *----------------------------------------------------------------------
 */
Tcl_Obj *
TclNewArithSeriesInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step, Tcl_WideInt len)
{
    Tcl_WideInt length = (len>=0 ? len : ArithSeriesLen(start, end, step));
    Tcl_Obj *arithSeriesPtr;
    ArithSeries *arithSeriesRepPtr;

    TclNewObj(arithSeriesPtr);

    if (length <= 0) {

	return arithSeriesPtr;
    }

    arithSeriesRepPtr = (ArithSeries*) Tcl_Alloc(sizeof (ArithSeries));
    arithSeriesRepPtr->isDouble = 0;
    arithSeriesRepPtr->start = start;
    arithSeriesRepPtr->end = end;
    arithSeriesRepPtr->step = step;
    arithSeriesRepPtr->len = length;
    arithSeriesRepPtr->elements = NULL;
    arithSeriesPtr->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr;
    arithSeriesPtr->internalRep.twoPtrValue.ptr2 = NULL;

    arithSeriesPtr->typePtr = &tclArithSeriesType;
    if (length > 0)
    	Tcl_InvalidateStringRep(arithSeriesPtr);

    return arithSeriesPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclNewArithSeriesDbl --
 *






|


<
<

>
|









|
|
>
|

|

|







202
203
204
205
206
207
208
209
210
211


212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
 * 	None.
 *----------------------------------------------------------------------
 */
Tcl_Obj *
TclNewArithSeriesInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step, Tcl_WideInt len)
{
    Tcl_WideInt length = (len>=0 ? len : ArithSeriesLen(start, end, step));
    Tcl_Obj *arithSeriesObj;
    ArithSeries *arithSeriesRepPtr;



    if (length <= 0) {
	TclNewObj(arithSeriesObj);
	return arithSeriesObj;
    }

    arithSeriesRepPtr = (ArithSeries*) Tcl_Alloc(sizeof (ArithSeries));
    arithSeriesRepPtr->isDouble = 0;
    arithSeriesRepPtr->start = start;
    arithSeriesRepPtr->end = end;
    arithSeriesRepPtr->step = step;
    arithSeriesRepPtr->len = length;
    arithSeriesRepPtr->elements = NULL;

    arithSeriesObj = Tcl_AbstractListObjNew(NULL, &arithSeriesType);
    Tcl_AbstractListSetConcreteRep(arithSeriesObj, arithSeriesRepPtr);

    if (length > 0)
    	Tcl_InvalidateStringRep(arithSeriesObj);

    return arithSeriesObj;
}

/*
 *----------------------------------------------------------------------
 *
 * TclNewArithSeriesDbl --
 *
178
179
180
181
182
183
184
185
186
187
188
189
190

191
192
193
194
195
196
197
198
199
200
201
202

203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229


230


231



232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
 * 	None.
 *----------------------------------------------------------------------
 */
Tcl_Obj *
TclNewArithSeriesDbl(double start, double end, double step, Tcl_WideInt len)
{
    Tcl_WideInt length = (len>=0 ? len : ArithSeriesLen(start, end, step));
    Tcl_Obj *arithSeriesPtr;
    ArithSeriesDbl *arithSeriesRepPtr;

    TclNewObj(arithSeriesPtr);

    if (length <= 0) {

	return arithSeriesPtr;
    }

    arithSeriesRepPtr = (ArithSeriesDbl*) Tcl_Alloc(sizeof (ArithSeriesDbl));
    arithSeriesRepPtr->isDouble = 1;
    arithSeriesRepPtr->start = start;
    arithSeriesRepPtr->end = end;
    arithSeriesRepPtr->step = step;
    arithSeriesRepPtr->len = length;
    arithSeriesRepPtr->elements = NULL;
    arithSeriesPtr->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr;
    arithSeriesPtr->internalRep.twoPtrValue.ptr2 = NULL;

    arithSeriesPtr->typePtr = &tclArithSeriesType;
    if (length > 0)
    	Tcl_InvalidateStringRep(arithSeriesPtr);

    return arithSeriesPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * assignNumber --
 *
 *	Create the appropriate Tcl_Obj value for the given numeric values.
 *      Used locally only for decoding [lseq] numeric arguments.
 *	refcount = 0.
 *
 * Results:
 *
 * 	A Tcl_Obj pointer.
 *      No assignment on error.
 *
 * Side Effects:
 *
 * 	None.
 *----------------------------------------------------------------------
 */
static void


assignNumber(int useDoubles, Tcl_WideInt *intNumberPtr, double *dblNumberPtr, Tcl_Obj *numberObj)


{



    void *clientData;
    int tcl_number_type;

    if (Tcl_GetNumberFromObj(NULL, numberObj, &clientData, &tcl_number_type) != TCL_OK
	    || tcl_number_type == TCL_NUMBER_BIG) {
	return;
    }
    if (useDoubles) {
	if (tcl_number_type != TCL_NUMBER_INT) {
	    *dblNumberPtr = *(double *)clientData;
	} else {
	    *dblNumberPtr = (double)*(Tcl_WideInt *)clientData;
	}
    } else {
	if (tcl_number_type == TCL_NUMBER_INT) {
	    *intNumberPtr = *(Tcl_WideInt *)clientData;
	} else {
	    *intNumberPtr = (Tcl_WideInt)*(double *)clientData;
	}
    }
}

/*
 *----------------------------------------------------------------------
 *






|


<
<

>
|









|
|
>
|

|

|







|














>
>
|
>
>

>
>
>
|


|




|
|

|



|

|







249
250
251
252
253
254
255
256
257
258


259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
 * 	None.
 *----------------------------------------------------------------------
 */
Tcl_Obj *
TclNewArithSeriesDbl(double start, double end, double step, Tcl_WideInt len)
{
    Tcl_WideInt length = (len>=0 ? len : ArithSeriesLen(start, end, step));
    Tcl_Obj *arithSeriesObj;
    ArithSeriesDbl *arithSeriesRepPtr;



    if (length <= 0) {
	TclNewObj(arithSeriesObj);
	return arithSeriesObj;
    }

    arithSeriesRepPtr = (ArithSeriesDbl*) Tcl_Alloc(sizeof (ArithSeriesDbl));
    arithSeriesRepPtr->isDouble = 1;
    arithSeriesRepPtr->start = start;
    arithSeriesRepPtr->end = end;
    arithSeriesRepPtr->step = step;
    arithSeriesRepPtr->len = length;
    arithSeriesRepPtr->elements = NULL;

    arithSeriesObj = Tcl_AbstractListObjNew(NULL, &arithSeriesType);
    Tcl_AbstractListSetConcreteRep(arithSeriesObj, arithSeriesRepPtr);

    if (length > 0)
    	Tcl_InvalidateStringRep(arithSeriesObj);

    return arithSeriesObj;
}

/*
 *----------------------------------------------------------------------
 *
 * assignNumber --
 *
 *	Create the approprite Tcl_Obj value for the given numeric values.
 *      Used locally only for decoding [lseq] numeric arguments.
 *	refcount = 0.
 *
 * Results:
 *
 * 	A Tcl_Obj pointer.
 *      No assignment on error.
 *
 * Side Effects:
 *
 * 	None.
 *----------------------------------------------------------------------
 */
static void
assignNumber(
    int useDoubles,
    Tcl_WideInt *intNumberPtr,
    double *dblNumberPtr,
    Tcl_Obj *numberObj)
{
    union {
	double d;
	Tcl_WideInt i;
    } *number;
    int tcl_number_type;

    if (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_DOUBLE) {
	    *dblNumberPtr = number->d;
	} else {
	    *dblNumberPtr = (double)number->i;
	}
    } else {
	if (tcl_number_type == TCL_NUMBER_INT) {
	    *intNumberPtr = number->i;
	} else {
	    *intNumberPtr = (Tcl_WideInt)number->d;
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
266
267
268
269
270
271
272

273
274
275
276
277
278

279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
 * 	An empty Tcl_Obj if the range is invalid.
 *
 * Side Effects:
 *
 * 	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 */
{
    double dstart, dend, dstep;
    Tcl_WideInt start, end, step;
    Tcl_WideInt len;

    if (startObj) {
	assignNumber(useDoubles, &start, &dstart, startObj);
    } else {
	start = 0;
	dstart = start;
    }
    if (stepObj) {
	assignNumber(useDoubles, &step, &dstep, stepObj);
	if (useDoubles) {
	    step = dstep;
	} else {
	    dstep = step;
	}
	if (dstep == 0) {
	    *arithSeriesObj = Tcl_NewObj();
	    return TCL_OK;
	}
    }
    if (endObj) {
	assignNumber(useDoubles, &end, &dend, endObj);
    }
    if (lenObj) {
	if (TCL_OK != Tcl_GetWideIntFromObj(interp, lenObj, &len)) {






>


|
|
|
<
>
|
|
|
|




















|







344
345
346
347
348
349
350
351
352
353
354
355
356

357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
 * 	An empty Tcl_Obj if the range is invalid.
 *
 * Side Effects:
 *
 * 	None.
 *----------------------------------------------------------------------
 */

int
TclNewArithSeriesObj(
    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;
    Tcl_WideInt len;

    if (startObj) {
	assignNumber(useDoubles, &start, &dstart, startObj);
    } else {
	start = 0;
	dstart = start;
    }
    if (stepObj) {
	assignNumber(useDoubles, &step, &dstep, stepObj);
	if (useDoubles) {
	    step = dstep;
	} else {
	    dstep = step;
	}
	if (dstep == 0) {
	    *arithSeriesObj = Tcl_NewObj();
            return TCL_OK;
	}
    }
    if (endObj) {
	assignNumber(useDoubles, &end, &dend, endObj);
    }
    if (lenObj) {
	if (TCL_OK != Tcl_GetWideIntFromObj(interp, lenObj, &len)) {
357
358
359
360
361
362
363




































































364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673

674

675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *




































































 * TclArithSeriesObjStep --
 *
 *	Return a Tcl_Obj with the step value from the give ArithSeries Obj.
 *	refcount = 0.
 *
 * Results:
 *
 * 	A Tcl_Obj pointer to the created ArithSeries object.
 * 	A NULL pointer of the range is invalid.
 *
 * Side Effects:
 *
 * 	None.
 *----------------------------------------------------------------------
 */
/*
 * TclArithSeriesObjStep --
 */
int
TclArithSeriesObjStep(
    Tcl_Obj *arithSeriesPtr,
    Tcl_Obj **stepObj)
{
    ArithSeries *arithSeriesRepPtr;

    if (arithSeriesPtr->typePtr != &tclArithSeriesType) {
        Tcl_Panic("TclArithSeriesObjIndex called with a not ArithSeries Obj.");
    }
    arithSeriesRepPtr = ArithSeriesRepPtr(arithSeriesPtr);
    if (arithSeriesRepPtr->isDouble) {
	*stepObj = Tcl_NewDoubleObj(((ArithSeriesDbl*)(arithSeriesRepPtr))->step);
    } else {
	*stepObj = Tcl_NewWideIntObj(arithSeriesRepPtr->step);
    }
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * TclArithSeriesObjIndex --
 *
 *	Returns the element with the specified index in the list
 *	represented by the specified Arithmetic Sequence object.
 *	If the index is out of range, TCL_ERROR is returned,
 *	otherwise TCL_OK is returned and the integer value of the
 *	element is stored in *element.
 *
 * Results:
 *
 * 	TCL_OK on success, TCL_ERROR on index out of range.
 *
 * Side Effects:
 *
 * 	On success, the integer pointed by *element is modified.
 *
 *----------------------------------------------------------------------
 */

int
TclArithSeriesObjIndex(Tcl_Obj *arithSeriesPtr, Tcl_WideInt index, Tcl_Obj **elementObj)
{
    ArithSeries *arithSeriesRepPtr;

    if (arithSeriesPtr->typePtr != &tclArithSeriesType) {
	Tcl_Panic("TclArithSeriesObjIndex called with a not ArithSeries Obj.");
    }
    arithSeriesRepPtr = ArithSeriesRepPtr(arithSeriesPtr);
    if (index < 0 || index >= arithSeriesRepPtr->len) {
	return TCL_ERROR;
    }
    /* List[i] = Start + (Step * index) */
    if (arithSeriesRepPtr->isDouble) {
	*elementObj = Tcl_NewDoubleObj(ArithSeriesIndexM(arithSeriesRepPtr, index));
    } else {
	*elementObj = Tcl_NewWideIntObj(ArithSeriesIndexM(arithSeriesRepPtr, index));
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclArithSeriesObjLength
 *
 *	Returns the length of the arithmetic series.
 *
 * Results:
 *
 * 	The length of the series as Tcl_WideInt.
 *
 * Side Effects:
 *
 * 	None.
 *
 *----------------------------------------------------------------------
 */
Tcl_WideInt TclArithSeriesObjLength(Tcl_Obj *arithSeriesPtr)
{
    ArithSeries *arithSeriesRepPtr = (ArithSeries*)
	    arithSeriesPtr->internalRep.twoPtrValue.ptr1;
    return arithSeriesRepPtr->len;
}

/*
 *----------------------------------------------------------------------
 *
 * FreeArithSeriesInternalRep --
 *
 *	Deallocate the storage associated with an arithseries object's
 *	internal representation.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Frees arithSeriesPtr's ArithSeries* internal representation and
 *	sets listPtr's	internalRep.twoPtrValue.ptr1 to NULL.
 *
 *----------------------------------------------------------------------
 */

static void
FreeArithSeriesInternalRep(Tcl_Obj *arithSeriesPtr)
{
    ArithSeries *arithSeriesRepPtr =
	    (ArithSeries *) arithSeriesPtr->internalRep.twoPtrValue.ptr1;
    if (arithSeriesRepPtr->elements) {
	Tcl_WideInt i;
	Tcl_Obj**elmts = arithSeriesRepPtr->elements;
	for(i=0; i<arithSeriesRepPtr->len; i++) {
	    if (elmts[i]) {
		Tcl_DecrRefCount(elmts[i]);
	    }
	}
	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)
{
    ArithSeries *arithSeriesRepPtr =
	    (ArithSeries*) arithSeriesPtr->internalRep.twoPtrValue.ptr1;
    char *elem, *p;
    Tcl_Obj *elemObj;
    Tcl_WideInt i;
    Tcl_WideInt length = 0;
    int slen;

    /*
     * Pass 1: estimate space.
     */
    for (i = 0; i < arithSeriesRepPtr->len; i++) {
	TclArithSeriesObjIndex(arithSeriesPtr, i, &elemObj);
	elem = TclGetStringFromObj(elemObj, &slen);
	Tcl_DecrRefCount(elemObj);
	slen += 1; /* + 1 is for the space or the nul-term */
	length += slen;
    }

    /*
     * Pass 2: generate the string repr.
     */

    p = Tcl_InitStringRep(arithSeriesPtr, NULL, length);
    for (i = 0; i < arithSeriesRepPtr->len; i++) {
	TclArithSeriesObjIndex(arithSeriesPtr, i, &elemObj);
	elem = TclGetStringFromObj(elemObj, &slen);
	strcpy(p, elem);
	p[slen] = ' ';
	p += slen+1;
	Tcl_DecrRefCount(elemObj);
    }
    if (length > 0) arithSeriesPtr->bytes[length-1] = '\0';
    arithSeriesPtr->length = length-1;
}

/*
 *----------------------------------------------------------------------
 *
 * SetArithSeriesFromAny --
 *
 * 	The Arithmetic Series object is just an way to optimize
 * 	Lists space complexity, so no one should try to convert
 * 	a string to an Arithmetic Series object.
 *
 * 	This function is here just to populate the Type structure.
 *
 * Results:
 *
 * 	The result is always TCL_ERROR. But see Side Effects.
 *
 * Side effects:
 *
 * 	Tcl Panic if called.
 *
 *----------------------------------------------------------------------
 */

static int
SetArithSeriesFromAny(
    TCL_UNUSED(Tcl_Interp *),		/* Used for error reporting if not NULL. */
    TCL_UNUSED(Tcl_Obj *))		/* The object to convert. */
{
    Tcl_Panic("SetArithSeriesFromAny: should never be called");
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclArithSeriesObjCopy --
 *
 *	Makes a "pure arithSeries" copy of an ArithSeries value. This provides for the C
 *	level a counterpart of the [lrange $list 0 end] command, while using
 *	internals details to be as efficient as possible.
 *
 * Results:
 *
 *	Normally returns a pointer to a new Tcl_Obj, that contains the same
 *	arithSeries value as *arithSeriesPtr does. The returned Tcl_Obj has a
 *	refCount of zero. If *arithSeriesPtr does not hold an arithSeries,
 *	NULL is returned, and if interp is non-NULL, an error message is
 *	recorded there.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclArithSeriesObjCopy(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *arithSeriesPtr)	/* List object for which an element array is
				 * to be returned. */
{
    Tcl_Obj *copyPtr;
    ArithSeries *arithSeriesRepPtr;

    ArithSeriesGetInternalRep(arithSeriesPtr, arithSeriesRepPtr);

    if (NULL == arithSeriesRepPtr) {

	if (SetArithSeriesFromAny(interp, arithSeriesPtr) != TCL_OK) {
	    /* We know this is going to panic, but it's the message we want */
	    return NULL;
	}
    }

    TclNewObj(copyPtr);
    TclInvalidateStringRep(copyPtr);
    DupArithSeriesInternalRep(arithSeriesPtr, copyPtr);
    return copyPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclArithSeriesObjRange --
 *






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>















|
<
<





|
<
<
<
<
<







|
<



|

<
|
<
<
|



<
<
<
<
<
<
<
<
|
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




|
<
<
<

|
<
|
<
>
|
>
|
<
|
|
<
<
<
<
<
|







436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526


527
528
529
530
531
532





533
534
535
536
537
538
539
540

541
542
543
544
545

546


547
548
549
550








551




552


























553
554
555
556










































































































































































































557
558
559
560
561



562
563

564

565
566
567
568

569
570





571
572
573
574
575
576
577
578
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclArithSeriesObjLength
 *
 *	Returns the length of the arithmentic series.
 *
 * Results:
 *
 * 	The length of the series as Tcl_WideInt.
 *
 * Side Effects:
 *
 * 	None.
 *
 *----------------------------------------------------------------------
 */
Tcl_WideInt TclArithSeriesObjLength(Tcl_Obj *arithSeriesObj)
{
    ArithSeries *arithSeriesRepPtr = (ArithSeries *)Tcl_AbstractListGetConcreteRep(arithSeriesObj);
    return arithSeriesRepPtr->len;
}

/*
 *----------------------------------------------------------------------
 *
 * TclArithSeriesObjIndex --
 *
 *	Returns the element with the specified index in the list
 *	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 succes, TCL_ERROR on index out of range.
 *
 * Side Effects:
 *
 * 	On success, the integer pointed by *element is modified.
 *
 *----------------------------------------------------------------------
 */

int
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 = (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 {
	TclNewObj(*elemObj); // empty value
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclArithSeriesObjStep --
 *
 *	Return a Tcl_Obj with the step value from the give ArithSeries Obj.
 *	refcount = 0.
 *
 * Results:
 *
 * 	A Tcl_Obj pointer to the created ArithSeries object.
 * 	A NULL pointer of the range is invalid.
 *
 * Side Effects:
 *
 * 	None.
 *----------------------------------------------------------------------
 */



int
TclArithSeriesObjStep(
    Tcl_Obj *arithSeriesPtr,
    Tcl_Obj **stepObj)
{
    ArithSeries *arithSeriesRepPtr = (ArithSeries *)Tcl_AbstractListGetConcreteRep(arithSeriesPtr);





    if (arithSeriesRepPtr->isDouble) {
	*stepObj = Tcl_NewDoubleObj(((ArithSeriesDbl*)(arithSeriesRepPtr))->step);
    } else {
	*stepObj = Tcl_NewWideIntObj(arithSeriesRepPtr->step);
    }
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_NewArithSeriesObj --
 *

 *	Creates a new ArithSeries object. The returned object has


 *	refcount = 0.
 *
 * Results:
 *








 * 	A Tcl_Obj pointer to the created ArithSeries object.




 * 	A NULL pointer of the range is invalid.


























 *
 * Side Effects:
 *
 * 	None.










































































































































































































 *----------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_NewArithSeriesObj(Tcl_Size objc, Tcl_Obj * const objv[])



{
    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;
    }





    return arithSeriesObj;
}

/*
 *----------------------------------------------------------------------
 *
 * TclArithSeriesObjRange --
 *
699
700
701
702
703
704
705
706

707
708
709
710
711

712
713
714
715

716

717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743

744
745
746
747



748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
 * Side effects:
 *	?The possible conversion of the object referenced by listPtr?
 *	?to a list object.?
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *

TclArithSeriesObjRange(
    Tcl_Interp *interp,         /* For error message(s) */
    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. */

{
    ArithSeries *arithSeriesRepPtr;
    Tcl_Obj *startObj, *endObj, *stepObj;


    ArithSeriesGetInternalRep(arithSeriesPtr, arithSeriesRepPtr);


    if (fromIdx == TCL_INDEX_NONE) {
	fromIdx = 0;
    }
    if (fromIdx > toIdx) {
	Tcl_Obj *obj;
	TclNewObj(obj);
	return obj;
    }

    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;
    }
    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;
    }



    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;
    }

    /*
     * In-place is possible.
     */

    /*
     * Even if nothing below causes any changes, we still want the
     * string-canonizing effect of [lrange 0 end].
     */

    TclInvalidateStringRep(arithSeriesPtr);

    if (arithSeriesRepPtr->isDouble) {
	ArithSeriesDbl *arithSeriesDblRepPtr = (ArithSeriesDbl*)arithSeriesPtr;






<
>

|


|
>




>
|
>




<
<
<
<
|
|
<
<
<
<
<
|
<
|
<
|
<
<
|
<
<
<
|
>
|
|
<
|
>
>
>






<
|
|
<
<
|
|
|
|
|







|







586
587
588
589
590
591
592

593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610




611
612





613

614

615


616



617
618
619
620

621
622
623
624
625
626
627
628
629
630

631
632


633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
 * Side effects:
 *	?The possible conversion of the object referenced by listPtr?
 *	?to a list object.?
 *
 *----------------------------------------------------------------------
 */


int
TclArithSeriesObjRange(
    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_Obj **newObjPtr)        /* return value */
{
    ArithSeries *arithSeriesRepPtr;
    Tcl_Obj *startObj, *endObj, *stepObj;

    (void)interp; /* silence compiler */

    arithSeriesRepPtr = (ArithSeries *)Tcl_AbstractListGetConcreteRep(arithSeriesPtr);

    if (fromIdx == TCL_INDEX_NONE) {
	fromIdx = 0;
    }





    if (toIdx >= arithSeriesRepPtr->len) {





	toIdx = arithSeriesRepPtr->len-1;

    }




    if (fromIdx > toIdx ||



	fromIdx >= arithSeriesRepPtr->len) {
	TclNewObj(*newObjPtr);
	return TCL_OK;
    }


    TclArithSeriesObjIndex(interp, arithSeriesPtr, fromIdx, &startObj);
    Tcl_IncrRefCount(startObj);
    TclArithSeriesObjIndex(interp, arithSeriesPtr, toIdx, &endObj);
    Tcl_IncrRefCount(endObj);
    TclArithSeriesObjStep(arithSeriesPtr, &stepObj);
    Tcl_IncrRefCount(stepObj);

    if (Tcl_IsShared(arithSeriesPtr) ||
	    ((arithSeriesPtr->refCount > 1))) {

        int status = TclNewArithSeriesObj(NULL, newObjPtr,
		         arithSeriesRepPtr->isDouble, startObj, endObj, stepObj, NULL);



        Tcl_DecrRefCount(startObj);
        Tcl_DecrRefCount(endObj);
        Tcl_DecrRefCount(stepObj);
	return status;
    }

    /*
     * In-place is possible.
     */

    /*
     * Even if nothing below cause any changes, we still want the
     * string-canonizing effect of [lrange 0 end].
     */

    TclInvalidateStringRep(arithSeriesPtr);

    if (arithSeriesRepPtr->isDouble) {
	ArithSeriesDbl *arithSeriesDblRepPtr = (ArithSeriesDbl*)arithSeriesPtr;
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923

924
925
926
927
928
929
930
931

932





933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956




957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
	arithSeriesRepPtr->elements = NULL;
    }

    Tcl_DecrRefCount(startObj);
    Tcl_DecrRefCount(endObj);
    Tcl_DecrRefCount(stepObj);

    return arithSeriesPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclArithSeriesGetElements --
 *
 *	This function returns an (objc,objv) array of the elements in a list
 *	object.
 *
 * Results:
 *	The return value is normally TCL_OK; in this case *objcPtr is set to
 *	the count of list elements and *objvPtr is set to a pointer to an
 *	array of (*objcPtr) pointers to each list element. If listPtr does not
 *	refer to an Abstract List object and the object can not be converted
 *	to one, TCL_ERROR is returned and an error message will be left in the
 *	interpreter's result if interp is not NULL.
 *
 *	The objects referenced by the returned array should be treated as
 *	readonly and their ref counts are _not_ incremented; the caller must
 *	do that if it holds on to a reference. Furthermore, the pointer and
 *	length returned by this function may change as soon as any function is
 *	called on the list object; be careful about retaining the pointer in a
 *	local data structure.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclArithSeriesGetElements(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *objPtr,		/* AbstractList object for which an element
				 * array is to be returned. */
    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;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclArithSeriesObjReverse --
 *
 *	Reverse the order of the ArithSeries value.
 *      *arithSeriesPtr must be known to be a valid list.
 *
 * Results:
 *	Returns a pointer to the reordered series.
 *      This may be a new object or the same object if not shared.
 *
 * Side effects:
 *	?The possible conversion of the object referenced by listPtr?
 *	?to a list object.?
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclArithSeriesObjReverse(
    Tcl_Interp *interp,         /* For error message(s) */
    Tcl_Obj *arithSeriesPtr)	/* List object to reverse. */

{
    ArithSeries *arithSeriesRepPtr;
    Tcl_Obj *startObj, *endObj, *stepObj;
    Tcl_Obj *resultObj;
    Tcl_WideInt start, end, step, len;
    double dstart, dend, dstep;
    int isDouble;


    ArithSeriesGetInternalRep(arithSeriesPtr, arithSeriesRepPtr);






    isDouble = arithSeriesRepPtr->isDouble;
    len = arithSeriesRepPtr->len;

    TclArithSeriesObjIndex(arithSeriesPtr, (len-1), &startObj);
    Tcl_IncrRefCount(startObj);
    TclArithSeriesObjIndex(arithSeriesPtr, 0, &endObj);
    Tcl_IncrRefCount(endObj);
    TclArithSeriesObjStep(arithSeriesPtr, &stepObj);
    Tcl_IncrRefCount(stepObj);

    if (isDouble) {
	Tcl_GetDoubleFromObj(NULL, startObj, &dstart);
	Tcl_GetDoubleFromObj(NULL, endObj, &dend);
	Tcl_GetDoubleFromObj(NULL, stepObj, &dstep);
	dstep = -dstep;
	TclSetDoubleObj(stepObj, dstep);
    } else {
	Tcl_GetWideIntFromObj(NULL, startObj, &start);
	Tcl_GetWideIntFromObj(NULL, endObj, &end);
	Tcl_GetWideIntFromObj(NULL, stepObj, &step);
	step = -step;
	TclSetIntObj(stepObj, step);
    }





    if (Tcl_IsShared(arithSeriesPtr) ||
	    ((arithSeriesPtr->refCount > 1))) {
	Tcl_Obj *lenObj = Tcl_NewWideIntObj(len);
	if (TclNewArithSeriesObj(interp, &resultObj,
		 isDouble, startObj, endObj, stepObj, lenObj) != TCL_OK) {
	    resultObj = NULL;
	}
	Tcl_DecrRefCount(lenObj);
    } else {

	/*
	 * In-place is possible.
	 */

	TclInvalidateStringRep(arithSeriesPtr);






|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




<
<
|
<
|
<
<
<
<
<
<
<
<
<
<
<

|
<

|
|
>








>
|
>
>
>
>
>




|

|

















>
>
>
>




|
|
|
|
|







672
673
674
675
676
677
678
679




























































































680
681
682
683


684

685











686
687

688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
	arithSeriesRepPtr->elements = NULL;
    }

    Tcl_DecrRefCount(startObj);
    Tcl_DecrRefCount(endObj);
    Tcl_DecrRefCount(stepObj);

    *newObjPtr = arithSeriesPtr;




























































































    return TCL_OK;
}

/*


 *  Handle ArithSeries special case - don't shimmer a series into a list

 *  just to reverse it.











 */
int

TclArithSeriesObjReverse(
    Tcl_Interp *interp,         /* For error messages */
    Tcl_Obj *arithSeriesPtr,	/* List object to reverse. */
    Tcl_Obj **newObjPtr)
{
    ArithSeries *arithSeriesRepPtr;
    Tcl_Obj *startObj, *endObj, *stepObj;
    Tcl_Obj *resultObj;
    Tcl_WideInt start, end, step, len;
    double dstart, dend, dstep;
    int isDouble;

    (void)interp;

    if (newObjPtr == NULL) {
	return TCL_ERROR;
    }

    arithSeriesRepPtr = (ArithSeries *)Tcl_AbstractListGetConcreteRep(arithSeriesPtr);

    isDouble = arithSeriesRepPtr->isDouble;
    len = arithSeriesRepPtr->len;

    TclArithSeriesObjIndex(NULL, arithSeriesPtr, (len-1), &startObj);
    Tcl_IncrRefCount(startObj);
    TclArithSeriesObjIndex(NULL, arithSeriesPtr, 0, &endObj);
    Tcl_IncrRefCount(endObj);
    TclArithSeriesObjStep(arithSeriesPtr, &stepObj);
    Tcl_IncrRefCount(stepObj);

    if (isDouble) {
	Tcl_GetDoubleFromObj(NULL, startObj, &dstart);
	Tcl_GetDoubleFromObj(NULL, endObj, &dend);
	Tcl_GetDoubleFromObj(NULL, stepObj, &dstep);
	dstep = -dstep;
	TclSetDoubleObj(stepObj, dstep);
    } else {
	Tcl_GetWideIntFromObj(NULL, startObj, &start);
	Tcl_GetWideIntFromObj(NULL, endObj, &end);
	Tcl_GetWideIntFromObj(NULL, stepObj, &step);
	step = -step;
	TclSetIntObj(stepObj, step);
    }

    Tcl_IncrRefCount(startObj);
    Tcl_IncrRefCount(endObj);
    Tcl_IncrRefCount(stepObj);

    if (Tcl_IsShared(arithSeriesPtr) ||
	    ((arithSeriesPtr->refCount > 1))) {
	Tcl_Obj *lenObj = Tcl_NewWideIntObj(len);
	if (TclNewArithSeriesObj(NULL, &resultObj, isDouble,
                                 startObj, endObj, stepObj, lenObj) != TCL_OK) {
            resultObj = NULL;
        }
        Tcl_DecrRefCount(lenObj);
    } else {

	/*
	 * In-place is possible.
	 */

	TclInvalidateStringRep(arithSeriesPtr);
994
995
996
997
998
999
1000
















































































1001
1002



































	resultObj = arithSeriesPtr;
    }

    Tcl_DecrRefCount(startObj);
    Tcl_DecrRefCount(endObj);
    Tcl_DecrRefCount(stepObj);

















































































    return resultObj;
}









































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
	resultObj = arithSeriesPtr;
    }

    Tcl_DecrRefCount(startObj);
    Tcl_DecrRefCount(endObj);
    Tcl_DecrRefCount(stepObj);

    *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:
 */

Changes to generic/tclArithSeries.h.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25

26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57








/*
 * tclArithSeries.h --
 *
 *     This file contains the ArithSeries concrete abstract list
 *     implementation. It implements the inner workings of the lseq command.
 *
 * Copyright © 2022 Brian S. Griffin.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * The structure used for the ArithSeries internal representation.
 * Note that the len can in theory be always computed by start,end,step
 * but it's faster to cache it inside the internal representation.
 */
typedef struct ArithSeries {
    Tcl_WideInt start;
    Tcl_WideInt end;
    Tcl_WideInt step;
    Tcl_WideInt len;
    Tcl_Obj **elements;
    int isDouble;
} ArithSeries;

typedef struct ArithSeriesDbl {
    double start;
    double end;
    double step;
    Tcl_WideInt len;
    Tcl_Obj **elements;
    int isDouble;
} ArithSeriesDbl;


MODULE_SCOPE Tcl_Obj *	TclArithSeriesObjCopy(Tcl_Interp *interp,
			    Tcl_Obj *arithSeriesPtr);
MODULE_SCOPE int	TclArithSeriesObjStep(Tcl_Obj *arithSeriesPtr,
			    Tcl_Obj **stepObj);
MODULE_SCOPE int	TclArithSeriesObjIndex(Tcl_Obj *arithSeriesPtr,
			    Tcl_WideInt index, Tcl_Obj **elementObj);
MODULE_SCOPE Tcl_WideInt TclArithSeriesObjLength(Tcl_Obj *arithSeriesPtr);
MODULE_SCOPE Tcl_Obj *	TclArithSeriesObjRange(Tcl_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);




















|







|



>




|




<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
|
|
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35



















36

37
38
39
40
41
42
43
44
45
46
/*
 * tclArithSeries.h --
 *
 *     This file contains the ArithSeries concrete abstract list
 *     implementation. It implements the inner workings of the lseq command.
 *
 * Copyright © 2022 Brian S. Griffin.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * The structure used for the 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.
 */
typedef struct ArithSeries {
    Tcl_WideInt start;
    Tcl_WideInt end;
    Tcl_WideInt step;
    Tcl_Size len;
    Tcl_Obj **elements;
    int isDouble;
} ArithSeries;

typedef struct ArithSeriesDbl {
    double start;
    double end;
    double step;
    Tcl_Size len;
    Tcl_Obj **elements;
    int isDouble;
} ArithSeriesDbl;




















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:
 */

Changes to generic/tclBasic.c.

306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
    {"lpop",		Tcl_LpopObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"lrange",		Tcl_LrangeObjCmd,	TclCompileLrangeCmd,	NULL,	CMD_IS_SAFE},
    {"lremove", 	Tcl_LremoveObjCmd,	NULL,           	NULL,	CMD_IS_SAFE},
    {"lrepeat",		Tcl_LrepeatObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"lreplace",	Tcl_LreplaceObjCmd,	TclCompileLreplaceCmd,	NULL,	CMD_IS_SAFE},
    {"lreverse",	Tcl_LreverseObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"lsearch",		Tcl_LsearchObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"lseq",		Tcl_LseqObjCmd,         NULL,                   NULL,   CMD_IS_SAFE},
    {"lset",		Tcl_LsetObjCmd,		TclCompileLsetCmd,	NULL,	CMD_IS_SAFE},
    {"lsort",		Tcl_LsortObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"package",		Tcl_PackageObjCmd,	NULL,			TclNRPackageObjCmd,	CMD_IS_SAFE},
    {"proc",		procObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"regexp",		Tcl_RegexpObjCmd,	TclCompileRegexpCmd,	NULL,	CMD_IS_SAFE},
    {"regsub",		Tcl_RegsubObjCmd,	TclCompileRegsubCmd,	NULL,	CMD_IS_SAFE},
    {"rename",		Tcl_RenameObjCmd,	NULL,			NULL,	CMD_IS_SAFE},






|







306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
    {"lpop",		Tcl_LpopObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"lrange",		Tcl_LrangeObjCmd,	TclCompileLrangeCmd,	NULL,	CMD_IS_SAFE},
    {"lremove", 	Tcl_LremoveObjCmd,	NULL,           	NULL,	CMD_IS_SAFE},
    {"lrepeat",		Tcl_LrepeatObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"lreplace",	Tcl_LreplaceObjCmd,	TclCompileLreplaceCmd,	NULL,	CMD_IS_SAFE},
    {"lreverse",	Tcl_LreverseObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"lsearch",		Tcl_LsearchObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"lseq",		Tcl_LseqObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"lset",		Tcl_LsetObjCmd,		TclCompileLsetCmd,	NULL,	CMD_IS_SAFE},
    {"lsort",		Tcl_LsortObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"package",		Tcl_PackageObjCmd,	NULL,			TclNRPackageObjCmd,	CMD_IS_SAFE},
    {"proc",		procObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"regexp",		Tcl_RegexpObjCmd,	TclCompileRegexpCmd,	NULL,	CMD_IS_SAFE},
    {"regsub",		Tcl_RegsubObjCmd,	TclCompileRegsubCmd,	NULL,	CMD_IS_SAFE},
    {"rename",		Tcl_RenameObjCmd,	NULL,			NULL,	CMD_IS_SAFE},

Changes to generic/tclCmdAH.c.

8
9
10
11
12
13
14

15
16
17
18
19
20
21
22
23
24
25
 * Copyright © 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

#ifdef _WIN32
#   include "tclWinInt.h"
#endif
#include "tclArithSeries.h"

/*
 * The state structure used by [foreach]. Note that the actual structure has
 * all its working arrays appended afterwards so they can be allocated and
 * freed in a single step.
 */







>



<







8
9
10
11
12
13
14
15
16
17
18

19
20
21
22
23
24
25
 * Copyright © 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclAbstractList.h"
#ifdef _WIN32
#   include "tclWinInt.h"
#endif


/*
 * The state structure used by [foreach]. Note that the actual structure has
 * all its working arrays appended afterwards so they can be allocated and
 * freed in a single step.
 */

2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
		(statePtr->resultList != NULL ? "LMAP" : "FOREACH"),
		"NEEDVARS", NULL);
	    result = TCL_ERROR;
	    goto done;
	}

	/* Values */
	if (TclHasInternalRep(objv[2+i*2],&tclArithSeriesType)) {
	    /* Special case for Arith Series */
	    statePtr->aCopyList[i] = TclArithSeriesObjCopy(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]);
	} else {
	    /* List values */
	    statePtr->aCopyList[i] = TclListObjCopy(interp, objv[2+i*2]);
	    if (statePtr->aCopyList[i] == NULL) {
		result = TCL_ERROR;
		goto done;
	    }
	    TclListObjGetElementsM(NULL, statePtr->aCopyList[i],
		&statePtr->argcList[i], &statePtr->argvList[i]);
	}
	/* account for variable <> value mismatch */
	j = statePtr->argcList[i] / statePtr->varcList[i];
	if ((statePtr->argcList[i] % statePtr->varcList[i]) != 0) {
	    j++;
	}
	if (j > statePtr->maxj) {






|
|
|





|

<






|







2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738

2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
		(statePtr->resultList != NULL ? "LMAP" : "FOREACH"),
		"NEEDVARS", NULL);
	    result = TCL_ERROR;
	    goto done;
	}

	/* Values */
	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] = Tcl_AbstractListObjLength(statePtr->aCopyList[i]);
	} else {

	    statePtr->aCopyList[i] = TclListObjCopy(interp, objv[2+i*2]);
	    if (statePtr->aCopyList[i] == NULL) {
		result = TCL_ERROR;
		goto done;
	    }
	    TclListObjGetElementsM(NULL, statePtr->aCopyList[i],
		    &statePtr->argcList[i], &statePtr->argvList[i]);
	}
	/* account for variable <> value mismatch */
	j = statePtr->argcList[i] / statePtr->varcList[i];
	if ((statePtr->argcList[i] % statePtr->varcList[i]) != 0) {
	    j++;
	}
	if (j > statePtr->maxj) {
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870

2871

2872
2873
2874
2875
2876

2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
static inline int
ForeachAssignments(
    Tcl_Interp *interp,
    struct ForeachState *statePtr)
{
    int i;
    size_t v, k;
    Tcl_Obj *valuePtr, *varValuePtr;

    for (i=0 ; i<statePtr->numLists ; i++) {

	int isarithseries = TclHasInternalRep(statePtr->aCopyList[i],&tclArithSeriesType);

	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) {

			Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
			"\n    (setting %s loop variable \"%s\")",
			(statePtr->resultList != NULL ? "lmap" : "foreach"),
			TclGetString(statePtr->varvList[i][v])));
			return TCL_ERROR;
		    }
		} else {
		    valuePtr = statePtr->argvList[i][k];
		}
	    } else {
		TclNewObj(valuePtr);	/* Empty string */






|



>
|
>



|
|
>

|
|
|







2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
static inline int
ForeachAssignments(
    Tcl_Interp *interp,
    struct ForeachState *statePtr)
{
    int i;
    Tcl_Size v, k;
    Tcl_Obj *valuePtr, *varValuePtr;

    for (i=0 ; i<statePtr->numLists ; i++) {
	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 (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])));
			return TCL_ERROR;
		    }
		} else {
		    valuePtr = statePtr->argvList[i][k];
		}
	    } else {
		TclNewObj(valuePtr);	/* Empty string */

Changes to generic/tclCmdIL.c.

13
14
15
16
17
18
19

20
21
22
23
24
25
26
27
28
29
30
 * Copyright © 2001 Kevin B. Kenny. All rights reserved.
 * Copyright © 2005 Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */


#include "tclInt.h"
#include "tclRegexp.h"
#include "tclArithSeries.h"
#include <math.h>
#include <assert.h>

/*
 * During execution of the "lsort" command, structures of the following type
 * are used to arrange the objects being sorted into a collection of linked
 * lists.
 */






>


|
|







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
 * Copyright © 2001 Kevin B. Kenny. All rights reserved.
 * Copyright © 2005 Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * 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 <assert.h>

/*
 * During execution of the "lsort" command, structures of the following type
 * are used to arrange the objects being sorted into a collection of linked
 * lists.
 */
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
#define SORTMODE_ASCII		0
#define SORTMODE_INTEGER	1
#define SORTMODE_REAL		2
#define SORTMODE_COMMAND	3
#define SORTMODE_DICTIONARY	4
#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:
 */

static int		DictionaryCompare(const char *left, const char *right);
static Tcl_NRPostProc	IfConditionCallback;
static Tcl_ObjCmdProc	InfoArgsCmd;






<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







93
94
95
96
97
98
99

















100
101
102
103
104
105
106
#define SORTMODE_ASCII		0
#define SORTMODE_INTEGER	1
#define SORTMODE_REAL		2
#define SORTMODE_COMMAND	3
#define SORTMODE_DICTIONARY	4
#define SORTMODE_ASCII_NC	8


















/*
 * Forward declarations for procedures defined in this file:
 */

static int		DictionaryCompare(const char *left, const char *right);
static Tcl_NRPostProc	IfConditionCallback;
static Tcl_ObjCmdProc	InfoArgsCmd;
177
178
179
180
181
182
183


















184
185
186
187
188
189
190
    {"procs",		   InfoProcsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"script",		   InfoScriptCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"sharedlibextension", InfoSharedlibCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"tclversion",	   InfoTclVersionCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"vars",		   TclInfoVarsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {NULL, NULL, NULL, NULL, NULL, 0}
};



















/*
 *----------------------------------------------------------------------
 *
 * Tcl_IfObjCmd --
 *
 *	This procedure is invoked to process the "if" Tcl command. See the






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
    {"procs",		   InfoProcsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"script",		   InfoScriptCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"sharedlibextension", InfoSharedlibCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"tclversion",	   InfoTclVersionCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"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;


/*
 *----------------------------------------------------------------------
 *
 * Tcl_IfObjCmd --
 *
 *	This procedure is invoked to process the "if" Tcl command. See the
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219

2220
2221
2222
2223
2224



2225
2226
2227
2228
2229
2230
2231
2232
2233


2234

2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
int
Tcl_JoinObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    size_t length, listLen;
    int isArithSeries = 0;
    Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs;

    if ((objc < 2) || (objc > 3)) {
	Tcl_WrongNumArgs(interp, 1, objv, "list ?joinString?");
	return TCL_ERROR;
    }

    /*
     * Make sure the list argument is a list object and get its length and a
     * 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) {
	    return TCL_ERROR;
	}



    }

    if (listLen == 0) {
	/* No elements to join; default empty result is correct. */
	return TCL_OK;
    }
    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 {
	    Tcl_SetObjResult(interp, elemPtrs[0]);
	}
	return TCL_OK;
    }

    joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2];
    Tcl_IncrRefCount(joinObjPtr);

    (void) Tcl_GetStringFromObj(joinObjPtr, &length);
    if (length == 0) {
	resObjPtr = TclStringCat(interp, listLen, elemPtrs, 0);
    } else {
	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) {

		    /*
		     * 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_DecrRefCount(joinObjPtr);
    if (resObjPtr) {
	Tcl_SetObjResult(interp, resObjPtr);
	return TCL_OK;
    }






|
<












|
<
|
>
|
|
|


>
>
>








|
>
>
|
>
|
|
|
|
<
<














<
<
|
|

|
|
|
|
|
|

|
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<







2198
2199
2200
2201
2202
2203
2204
2205

2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218

2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245


2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259


2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271


















2272

2273
2274
2275
2276
2277
2278
2279
int
Tcl_JoinObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    size_t length, listLen, isAbstractList = 0;

    Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs;

    if ((objc < 2) || (objc > 3)) {
	Tcl_WrongNumArgs(interp, 1, objv, "list ?joinString?");
	return TCL_ERROR;
    }

    /*
     * Make sure the list argument is a list object and get its length and a
     * pointer to its array of element pointers.
     */

    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) {
	/* No elements to join; default empty result is correct. */
	return TCL_OK;
    }
    if (listLen == 1) {
	/* One element; return it */
	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;
    }

    joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2];
    Tcl_IncrRefCount(joinObjPtr);

    (void) Tcl_GetStringFromObj(joinObjPtr, &length);
    if (length == 0) {
	resObjPtr = TclStringCat(interp, listLen, elemPtrs, 0);
    } else {
	size_t i;

	resObjPtr = Tcl_NewObj();


	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);
	    }


















	    Tcl_AppendObjToObj(resObjPtr, elemPtrs[i]);

	}
    }
    Tcl_DecrRefCount(joinObjPtr);
    if (resObjPtr) {
	Tcl_SetObjResult(interp, resObjPtr);
	return TCL_OK;
    }
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])
				/* Argument objects. */
{
    int result;
    size_t listLen, first, last;
    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "list first last");
	return TCL_ERROR;
    }

    result = TclListObjLengthM(interp, objv[1], &listLen);
    if (result != TCL_OK) {






|







2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])
				/* Argument objects. */
{
    int result;
    Tcl_Size listLen, first, last;
    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "list first last");
	return TCL_ERROR;
    }

    result = TclListObjLengthM(interp, objv[1], &listLen);
    if (result != TCL_OK) {
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755

2756
2757
2758
2759
2760
2761
2762
    result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1,
	    &last);
    if (result != TCL_OK) {
	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;
	}

    } else {
	Tcl_SetObjResult(interp, TclListObjRange(objv[1], first, last));
    }
    return TCL_OK;
}

/*






|
|
|
|
|
<
<

>







2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736


2737
2738
2739
2740
2741
2742
2743
2744
2745
    result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1,
	    &last);
    if (result != TCL_OK) {
	return result;
    }

    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));
    }
    return TCL_OK;
}

/*
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149

3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
    Tcl_Obj **elemv;
    size_t elemc, i, j;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "list");
	return TCL_ERROR;
    }

    /*
     *  Handle ArithSeries special case - don't shimmer a series into a list
     *  just to reverse it.
     */
    if (TclHasInternalRep(objv[1],&tclArithSeriesType)) {
	Tcl_Obj *resObj = TclArithSeriesObjReverse(interp, objv[1]);
	if (resObj) {

	    Tcl_SetObjResult(interp, resObj);
	    return TCL_OK;
	} else {
	    return TCL_ERROR;
	}
    } /* end ArithSeries */

    /* True List */
    if (TclListObjGetElementsM(interp, objv[1], &elemc, &elemv) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * If the list is empty, just return it. [Bug 1876793]
     */






<

|
|

|
|
|
>
|

<
<

|

<







3118
3119
3120
3121
3122
3123
3124

3125
3126
3127
3128
3129
3130
3131
3132
3133
3134


3135
3136
3137

3138
3139
3140
3141
3142
3143
3144
    Tcl_Obj **elemv;
    size_t elemc, i, j;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "list");
	return TCL_ERROR;
    }

    /*
     *  Handle AbstractList special case - do not shimmer into a list, if it
     *  supports a private Reverse function, just to reverse it.
     */
    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;


	}
    } /* end Abstract List */


    if (TclListObjGetElementsM(interp, objv[1], &elemc, &elemv) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * If the list is empty, just return it. [Bug 1876793]
     */
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
4050
4051
4052
4053
4054
4055
4056
4057
4058
4059
4060
4061
4062
4063
4064
4065
4066
4067
4068
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * 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)
 *
 *  Given a Tcl_Obj, identify if it is a keyword or a number
 *
 *  Return Value
 *    0 - failure, unexpected value






<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







3950
3951
3952
3953
3954
3955
3956





















































































3957
3958
3959
3960
3961
3962
3963
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *





















































































 * SequenceIdentifyArgument --
 *   (for [lseq] command)
 *
 *  Given a Tcl_Obj, identify if it is a keyword or a number
 *
 *  Return Value
 *    0 - failure, unexpected value
4080
4081
4082
4083
4084
4085
4086



4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
     Tcl_Obj *argPtr,           /* Argument to decode   */
     Tcl_Obj **numValuePtr,     /* Return numeric value */
     int *keywordIndexPtr)      /* Return keyword enum  */
{
    int status;
    SequenceOperators opmode;
    SequenceByMode bymode;



    void *clientData;

    status = Tcl_GetNumberFromObj(NULL, argPtr, &clientData, keywordIndexPtr);
    if (status == TCL_OK) {
	if (numValuePtr) {
	    *numValuePtr = argPtr;
	}
	return NumericArg;
    } else {
	/* Check for an index expression */






>
>
>
|

|







3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
     Tcl_Obj *argPtr,           /* Argument to decode   */
     Tcl_Obj **numValuePtr,     /* Return numeric value */
     int *keywordIndexPtr)      /* Return keyword enum  */
{
    int status;
    SequenceOperators opmode;
    SequenceByMode bymode;
    union {
	Tcl_WideInt i;
	double d;
    } *nvalue;

    status = Tcl_GetNumberFromObj(NULL, argPtr, (void**)&nvalue, keywordIndexPtr);
    if (status == TCL_OK) {
	if (numValuePtr) {
	    *numValuePtr = argPtr;
	}
	return NumericArg;
    } else {
	/* Check for an index expression */
4192
4193
4194
4195
4196
4197
4198
4199
4200
4201
4202
4203
4204
4205
4206
    Tcl_Obj *const objv[]) /* The argument objects. */
{
    Tcl_Obj *elementCount = NULL;
    Tcl_Obj *start = NULL, *end = NULL, *step = NULL;
    Tcl_WideInt values[5];
    Tcl_Obj *numValues[5];
    Tcl_Obj *numberObj;
    int status, keyword, useDoubles = 0;
    Tcl_Obj *arithSeriesPtr;
    SequenceOperators opmode;
    SequenceDecoded decoded;
    int i, arg_key = 0, value_i = 0;
    // Default constants
    Tcl_Obj *zero = Tcl_NewIntObj(0);
    Tcl_Obj *one = Tcl_NewIntObj(1);






|







4090
4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
4102
4103
4104
    Tcl_Obj *const objv[]) /* The argument objects. */
{
    Tcl_Obj *elementCount = NULL;
    Tcl_Obj *start = NULL, *end = NULL, *step = NULL;
    Tcl_WideInt values[5];
    Tcl_Obj *numValues[5];
    Tcl_Obj *numberObj;
    int status = TCL_ERROR, keyword, useDoubles = 0;
    Tcl_Obj *arithSeriesPtr;
    SequenceOperators opmode;
    SequenceDecoded decoded;
    int i, arg_key = 0, value_i = 0;
    // Default constants
    Tcl_Obj *zero = Tcl_NewIntObj(0);
    Tcl_Obj *one = Tcl_NewIntObj(1);
4262
4263
4264
4265
4266
4267
4268
4269
4270
4271
4272
4273
4274
4275
4276
4277
4278
4279
4280
4281
4282
4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
4300
4301
4302
4303
4304
4305
4306
4307
4308
4309
4310
4311
4312
4313
4314
4315
4316
4317
4318
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457





























































































4458
4459
4460
4461
4462
4463
4464
     */
    switch (arg_key) {

/*    No argument */
    case 0:
	 Tcl_WrongNumArgs(interp, 1, objv,
	     "n ??op? n ??by? n??");
	 status = TCL_ERROR;
	 goto done;
	 break;

/*    range n */
    case 1:
	start = zero;
	elementCount = numValues[0];
	end = NULL;
	step = one;
	break;

/*    range n n */
    case 11:
	start = numValues[0];
	end = numValues[1];
	break;

/*    range n n n */
    case 111:
	start = numValues[0];
	end = numValues[1];
	step = numValues[2];
	break;

/*    range n 'to' n    */
/*    range n 'count' n */
/*    range n 'by' n    */
    case 121:
	opmode = (SequenceOperators)values[1];
	switch (opmode) {
	case LSEQ_DOTS:
	case LSEQ_TO:
	    start = numValues[0];
	    end = numValues[2];
	    break;
	case LSEQ_BY:
	    start = zero;
	    elementCount = numValues[0];
	    step = numValues[2];
	    break;
	case LSEQ_COUNT:
	    start = numValues[0];
	    elementCount = numValues[2];
	    step = one;
	    break;
	default:
	    status = TCL_ERROR;
	    goto done;
	}
	break;

/*    range n 'to' n n    */
/*    range n 'count' n n */
    case 1211:
	opmode = (SequenceOperators)values[1];
	switch (opmode) {
	case LSEQ_DOTS:
	case LSEQ_TO:
	    start = numValues[0];
	    end = numValues[2];
	    step = numValues[3];
	    break;
	case LSEQ_COUNT:
	    start = numValues[0];
	    elementCount = numValues[2];
	    step = numValues[3];
	    break;
	case LSEQ_BY:
	    /* Error case */
	    status = TCL_ERROR;
	    goto done;
	    break;
	default:
	    status = TCL_ERROR;
	    goto done;
	    break;
	}
	break;

/*    range n n 'by' n */
    case 1121:
	start = numValues[0];
	end = numValues[1];
	opmode = (SequenceOperators)values[2];
	switch (opmode) {
	case LSEQ_BY:
	    step = numValues[3];
	    break;
	case LSEQ_DOTS:
	case LSEQ_TO:
	case LSEQ_COUNT:
	default:
	    status = TCL_ERROR;
	    goto done;
	    break;
	}
	break;

/*    range n 'to' n 'by' n    */
/*    range n 'count' n 'by' n */
    case 12121:
	start = numValues[0];
	opmode = (SequenceOperators)values[3];
	switch (opmode) {
	case LSEQ_BY:
	    step = numValues[4];
	    break;
	default:
	    status = TCL_ERROR;
	    goto done;
	    break;
	}
	opmode = (SequenceOperators)values[1];
	switch (opmode) {
	case LSEQ_DOTS:
	case LSEQ_TO:
	    start = numValues[0];
	    end = numValues[2];
	    break;
	case LSEQ_COUNT:
	    start = numValues[0];
	    elementCount = numValues[2];
	    break;
	default:
	    status = TCL_ERROR;
	    goto done;
	    break;
	}
	break;

/*    Error cases: incomplete arguments */
    case 12:
	 opmode = (SequenceOperators)values[1]; goto KeywordError; break;
    case 112:
	 opmode = (SequenceOperators)values[2]; goto KeywordError; break;
    case 1212:
	 opmode = (SequenceOperators)values[3]; goto KeywordError; break;
    KeywordError:
	 status = TCL_ERROR;
	 switch (opmode) {
	 case LSEQ_DOTS:
	 case LSEQ_TO:
	      Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		  "missing \"to\" value."));
	      break;
	 case LSEQ_COUNT:
	      Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		  "missing \"count\" value."));
	      break;
	 case LSEQ_BY:
	      Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		  "missing \"by\" value."));
	      break;
	 }
	 status = TCL_ERROR;
	 goto done;
	 break;

/*    All other argument errors */
    default:
	 Tcl_WrongNumArgs(interp, 1, objv, "n ??op? n ??by? n??");
	 status = TCL_ERROR;
	 goto done;
	 break;
    }

    /*
     * Success!  Now lets create the series object.
     */
    status = TclNewArithSeriesObj(interp, &arithSeriesPtr,
		  useDoubles, start, end, step, elementCount);

    if (status == TCL_OK) {
	Tcl_SetObjResult(interp, arithSeriesPtr);
    }

 done:
    // Free number arguments.
    while (--value_i>=0) {
	if (numValues[value_i]) Tcl_DecrRefCount(numValues[value_i]);
    }

    // Free constants
    Tcl_DecrRefCount(zero);
    Tcl_DecrRefCount(one);

    return status;
}






























































































/*
 *----------------------------------------------------------------------
 *
 * Tcl_LsortObjCmd --
 *
 *	This procedure is invoked to process the "lsort" Tcl command. See the






<



|







|





|






|
|
|



















<




|
|
















<



<





|












<





|
|








<















<













<















<






<







|
<
<

|














>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







4160
4161
4162
4163
4164
4165
4166

4167
4168
4169
4170
4171
4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186
4187
4188
4189
4190
4191
4192
4193
4194
4195
4196
4197
4198
4199
4200
4201
4202
4203
4204
4205
4206
4207
4208
4209
4210
4211
4212

4213
4214
4215
4216
4217
4218
4219
4220
4221
4222
4223
4224
4225
4226
4227
4228
4229
4230
4231
4232
4233
4234

4235
4236
4237

4238
4239
4240
4241
4242
4243
4244
4245
4246
4247
4248
4249
4250
4251
4252
4253
4254
4255

4256
4257
4258
4259
4260
4261
4262
4263
4264
4265
4266
4267
4268
4269
4270

4271
4272
4273
4274
4275
4276
4277
4278
4279
4280
4281
4282
4283
4284
4285

4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298

4299
4300
4301
4302
4303
4304
4305
4306
4307
4308
4309
4310
4311
4312
4313

4314
4315
4316
4317
4318
4319

4320
4321
4322
4323
4324
4325
4326
4327


4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
     */
    switch (arg_key) {

/*    No argument */
    case 0:
	 Tcl_WrongNumArgs(interp, 1, objv,
	     "n ??op? n ??by? n??");

	 goto done;
	 break;

/*    lseq n */
    case 1:
	start = zero;
	elementCount = numValues[0];
	end = NULL;
	step = one;
	break;

/*    lseq n n */
    case 11:
	start = numValues[0];
	end = numValues[1];
	break;

/*    lseq n n n */
    case 111:
	start = numValues[0];
	end = numValues[1];
	step = numValues[2];
	break;

/*    lseq n 'to' n    */
/*    lseq n 'count' n */
/*    lseq n 'by' n    */
    case 121:
	opmode = (SequenceOperators)values[1];
	switch (opmode) {
	case LSEQ_DOTS:
	case LSEQ_TO:
	    start = numValues[0];
	    end = numValues[2];
	    break;
	case LSEQ_BY:
	    start = zero;
	    elementCount = numValues[0];
	    step = numValues[2];
	    break;
	case LSEQ_COUNT:
	    start = numValues[0];
	    elementCount = numValues[2];
	    step = one;
	    break;
	default:

	    goto done;
	}
	break;

/*    lseq n 'to' n n    */
/*    lseq n 'count' n n */
    case 1211:
	opmode = (SequenceOperators)values[1];
	switch (opmode) {
	case LSEQ_DOTS:
	case LSEQ_TO:
	    start = numValues[0];
	    end = numValues[2];
	    step = numValues[3];
	    break;
	case LSEQ_COUNT:
	    start = numValues[0];
	    elementCount = numValues[2];
	    step = numValues[3];
	    break;
	case LSEQ_BY:
	    /* Error case */

	    goto done;
	    break;
	default:

	    goto done;
	    break;
	}
	break;

/*    lseq n n 'by' n */
    case 1121:
	start = numValues[0];
	end = numValues[1];
	opmode = (SequenceOperators)values[2];
	switch (opmode) {
	case LSEQ_BY:
	    step = numValues[3];
	    break;
	case LSEQ_DOTS:
	case LSEQ_TO:
	case LSEQ_COUNT:
	default:

	    goto done;
	    break;
	}
	break;

/*    lseq n 'to' n 'by' n    */
/*    lseq n 'count' n 'by' n */
    case 12121:
	start = numValues[0];
	opmode = (SequenceOperators)values[3];
	switch (opmode) {
	case LSEQ_BY:
	    step = numValues[4];
	    break;
	default:

	    goto done;
	    break;
	}
	opmode = (SequenceOperators)values[1];
	switch (opmode) {
	case LSEQ_DOTS:
	case LSEQ_TO:
	    start = numValues[0];
	    end = numValues[2];
	    break;
	case LSEQ_COUNT:
	    start = numValues[0];
	    elementCount = numValues[2];
	    break;
	default:

	    goto done;
	    break;
	}
	break;

/*    Error cases: incomplete arguments */
    case 12:
	 opmode = (SequenceOperators)values[1]; goto KeywordError; break;
    case 112:
	 opmode = (SequenceOperators)values[2]; goto KeywordError; break;
    case 1212:
	 opmode = (SequenceOperators)values[3]; goto KeywordError; break;
    KeywordError:

	 switch (opmode) {
	 case LSEQ_DOTS:
	 case LSEQ_TO:
	      Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		  "missing \"to\" value."));
	      break;
	 case LSEQ_COUNT:
	      Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		  "missing \"count\" value."));
	      break;
	 case LSEQ_BY:
	      Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		  "missing \"by\" value."));
	      break;
	 }

	 goto done;
	 break;

/*    All other argument errors */
    default:
	 Tcl_WrongNumArgs(interp, 1, objv, "n ??op? n ??by? n??");

	 goto done;
	 break;
    }

    /*
     * Success!  Now lets create the series object.
     */
    status = TclNewArithSeriesObj(interp, &arithSeriesPtr, useDoubles, start, end, step, elementCount);


    if (status == TCL_OK) {
        Tcl_SetObjResult(interp, arithSeriesPtr);
    }

 done:
    // Free number arguments.
    while (--value_i>=0) {
	if (numValues[value_i]) Tcl_DecrRefCount(numValues[value_i]);
    }

    // Free constants
    Tcl_DecrRefCount(zero);
    Tcl_DecrRefCount(one);

    return status;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_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
4723
4724
4725
4726
4727
4728
4729
4730
4731
4732
4733
4734
4735
4736
4737
4738
4739
	    sortInfo.resultCode = TCL_ERROR;
	    goto done;
	}
	Tcl_ListObjAppendElement(interp, newCommandPtr, Tcl_NewObj());
	sortInfo.compareCmdPtr = newCommandPtr;
    }

    if (TclHasInternalRep(listObj,&tclArithSeriesType)) {
	sortInfo.resultCode = TclArithSeriesGetElements(interp,
	    listObj, &length, &listObjPtrs);
    } else {
	sortInfo.resultCode = TclListObjGetElementsM(interp, listObj,
	    &length, &listObjPtrs);
    }
    if (sortInfo.resultCode != TCL_OK || length <= 0) {
	goto done;
    }






|
|
|







4702
4703
4704
4705
4706
4707
4708
4709
4710
4711
4712
4713
4714
4715
4716
4717
4718
	    sortInfo.resultCode = TCL_ERROR;
	    goto done;
	}
	Tcl_ListObjAppendElement(interp, newCommandPtr, Tcl_NewObj());
	sortInfo.compareCmdPtr = newCommandPtr;
    }

    if (TclAbstractListHasProc(objv[1], TCL_ABSL_GETELEMENTS)) {
	sortInfo.resultCode =
	    Tcl_AbstractListObjGetElements(interp, listObj, &length, &listObjPtrs);
    } else {
	sortInfo.resultCode = TclListObjGetElementsM(interp, listObj,
	    &length, &listObjPtrs);
    }
    if (sortInfo.resultCode != TCL_OK || length <= 0) {
	goto done;
    }

Changes to generic/tclDecls.h.

1846
1847
1848
1849
1850
1851
1852

































1853
1854
1855
1856
1857
1858
1859
				size_t numBytes, void **clientDataPtr,
				int *typePtr);
/* 682 */
EXTERN int		Tcl_RemoveChannelMode(Tcl_Interp *interp,
				Tcl_Channel chan, int mode);
/* 683 */
EXTERN int		Tcl_GetEncodingNulLength(Tcl_Encoding encoding);


































typedef struct {
    const struct TclPlatStubs *tclPlatStubs;
    const struct TclIntStubs *tclIntStubs;
    const struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
				size_t numBytes, void **clientDataPtr,
				int *typePtr);
/* 682 */
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;
    const struct TclIntStubs *tclIntStubs;
    const struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;

2541
2542
2543
2544
2545
2546
2547










2548
2549
2550
2551
2552
2553
2554
    Tcl_Trace (*tcl_CreateObjTrace2) (Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc2 *objProc2, void *clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 677 */
    Tcl_Command (*tcl_NRCreateCommand2) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc, Tcl_ObjCmdProc2 *nreProc2, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 678 */
    int (*tcl_NRCallObjProc2) (Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc2, void *clientData, size_t objc, Tcl_Obj *const objv[]); /* 679 */
    int (*tcl_GetNumberFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, void **clientDataPtr, int *typePtr); /* 680 */
    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 */










} TclStubs;

extern const TclStubs *tclStubsPtr;

#ifdef __cplusplus
}
#endif






>
>
>
>
>
>
>
>
>
>







2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
    Tcl_Trace (*tcl_CreateObjTrace2) (Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc2 *objProc2, void *clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 677 */
    Tcl_Command (*tcl_NRCreateCommand2) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc, Tcl_ObjCmdProc2 *nreProc2, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 678 */
    int (*tcl_NRCallObjProc2) (Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc2, void *clientData, size_t objc, Tcl_Obj *const objv[]); /* 679 */
    int (*tcl_GetNumberFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, void **clientDataPtr, int *typePtr); /* 680 */
    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;

#ifdef __cplusplus
}
#endif
3861
3862
3863
3864
3865
3866
3867




















3868
3869
3870
3871
3872
3873
3874
	(tclStubsPtr->tcl_GetNumberFromObj) /* 680 */
#define Tcl_GetNumber \
	(tclStubsPtr->tcl_GetNumber) /* 681 */
#define Tcl_RemoveChannelMode \
	(tclStubsPtr->tcl_RemoveChannelMode) /* 682 */
#define Tcl_GetEncodingNulLength \
	(tclStubsPtr->tcl_GetEncodingNulLength) /* 683 */





















#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#ifdef _WIN32
#   undef Tcl_CreateFileHandler






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
	(tclStubsPtr->tcl_GetNumberFromObj) /* 680 */
#define Tcl_GetNumber \
	(tclStubsPtr->tcl_GetNumber) /* 681 */
#define Tcl_RemoveChannelMode \
	(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) */

/* !END!: Do not edit above this line. */

#ifdef _WIN32
#   undef Tcl_CreateFileHandler

Changes to generic/tclExecute.c.

15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"
#include "tclOOInt.h"
#include "tclTomMath.h"
#include "tclArithSeries.h"
#include <math.h>
#include <assert.h>

/*
 * Hack to determine whether we may expect IEEE floating point. The hack is
 * formally incorrect in that non-IEEE platforms might have the same precision
 * and range, but VAX, IBM, and Cray do not; are there any other floating






|







15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"
#include "tclOOInt.h"
#include "tclTomMath.h"
#include "tclAbstractList.h"
#include <math.h>
#include <assert.h>

/*
 * Hack to determine whether we may expect IEEE floating point. The hack is
 * formally incorrect in that non-IEEE platforms might have the same precision
 * and range, but VAX, IBM, and Cray do not; are there any other floating
4653
4654
4655
4656
4657
4658
4659
4660
4661
4662
4663
4664
4665
4666
4667
4668
4669
4670
4671
4672
4673
4674
4675
4676
4677
4678
4679
4680
4681

4682
4683
4684
4685
4686
4687
4688
	NEXT_INST_F(1, 1, 1);

    case INST_LIST_INDEX:	/* lindex with objc == 3 */
	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;
	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));


	/* special case for ArithSeries */
	if (TclHasInternalRep(valuePtr,&tclArithSeriesType)) {
	    length = TclArithSeriesObjLength(valuePtr);
	    if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) {
		CACHE_STACK_INFO();
		TRACE_ERROR(interp);
		goto gotError;
	    }
	    if (TclArithSeriesObjIndex(valuePtr, index, &objResultPtr) != TCL_OK) {
		CACHE_STACK_INFO();
		TRACE_ERROR(interp);
		goto gotError;
	    }
	    Tcl_IncrRefCount(objResultPtr); // reference held here
	    goto lindexDone;
	}

	/*
	 * Extract the desired list element.
	 */


	if ((TclListObjGetElementsM(interp, valuePtr, &objc, &objv) == TCL_OK)
		&& !TclHasInternalRep(value2Ptr, &tclListType)) {
	    int code;

	    DECACHE_STACK_INFO();
	    code = TclGetIntForIndexM(interp, value2Ptr, objc-1, &index);
	    CACHE_STACK_INFO();






<
|
|
|





|












>







4653
4654
4655
4656
4657
4658
4659

4660
4661
4662
4663
4664
4665
4666
4667
4668
4669
4670
4671
4672
4673
4674
4675
4676
4677
4678
4679
4680
4681
4682
4683
4684
4685
4686
4687
4688
	NEXT_INST_F(1, 1, 1);

    case INST_LIST_INDEX:	/* lindex with objc == 3 */
	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;
	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));


	/* 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 (Tcl_AbstractListObjIndex(interp, valuePtr, index, &objResultPtr)!=TCL_OK) {
		CACHE_STACK_INFO();
		TRACE_ERROR(interp);
		goto gotError;
	    }
	    Tcl_IncrRefCount(objResultPtr); // reference held here
	    goto lindexDone;
	}

	/*
	 * Extract the desired list element.
	 */

	/* TODO: handle AbstractList here? */
	if ((TclListObjGetElementsM(interp, valuePtr, &objc, &objv) == TCL_OK)
		&& !TclHasInternalRep(value2Ptr, &tclListType)) {
	    int code;

	    DECACHE_STACK_INFO();
	    code = TclGetIntForIndexM(interp, value2Ptr, objc-1, &index);
	    CACHE_STACK_INFO();
4717
4718
4719
4720
4721
4722
4723





4724
4725
4726
4727
4728
4729
4730
4731
4732
4733
4734
4735
4736
4737
4738
4739
4740
4741
4742
4743
4744
4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
4755
4756
4757
	 * Pop the list and get the index.
	 */

	valuePtr = OBJ_AT_TOS;
	opnd = TclGetInt4AtPtr(pc+1);
	TRACE(("\"%.30s\" %d => ", O2S(valuePtr), opnd));






	/* special case for ArithSeries */
	if (TclHasInternalRep(valuePtr,&tclArithSeriesType)) {
	    length = TclArithSeriesObjLength(valuePtr);

	    /* Decode end-offset index values. */

	    index = TclIndexDecode(opnd, length-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);
	    }
	    pcAdjustment = 5;
	    goto lindexFastPath2;
	}

	/*
	 * Get the contents of the list, making sure that it really is a list
	 * in the process.
	 */

	if (TclListObjGetElementsM(interp, valuePtr, &objc, &objv) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}

	/* Decode end-offset index values. */







>
>
>
>
>
|
|
|


<



<
|
|
|
|
|
<
<
|




<
<
<
<
|







4717
4718
4719
4720
4721
4722
4723
4724
4725
4726
4727
4728
4729
4730
4731
4732
4733

4734
4735
4736

4737
4738
4739
4740
4741


4742
4743
4744
4745
4746




4747
4748
4749
4750
4751
4752
4753
4754
	 * Pop the list and get the index.
	 */

	valuePtr = OBJ_AT_TOS;
	opnd = TclGetInt4AtPtr(pc+1);
	TRACE(("\"%.30s\" %d => ", O2S(valuePtr), opnd));

	/*
	 * Get the contents of the list, making sure that it really is a list
	 * in the process.
	 */

	/* 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 (Tcl_AbstractListObjIndex(interp, valuePtr, index, &objResultPtr)!=TCL_OK) {
		CACHE_STACK_INFO();
		TRACE_ERROR(interp);
		goto gotError;
	    }



	    pcAdjustment = 5;
	    goto lindexFastPath2;
	}





	/* List case */
	if (TclListObjGetElementsM(interp, valuePtr, &objc, &objv) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}

	/* Decode end-offset index values. */

4816
4817
4818
4819
4820
4821
4822





4823
4824

4825
4826
4827
4828
4829
4830
4831
	valuePtr = POP_OBJECT();
	Tcl_DecrRefCount(valuePtr); /* This one should be done here */

	/*
	 * Compute the new variable value.
	 */






	objResultPtr = TclLsetFlat(interp, valuePtr, numIndices,
		&OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS);

	if (!objResultPtr) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}

	/*
	 * Set result.






>
>
>
>
>
|

>







4813
4814
4815
4816
4817
4818
4819
4820
4821
4822
4823
4824
4825
4826
4827
4828
4829
4830
4831
4832
4833
4834
	valuePtr = POP_OBJECT();
	Tcl_DecrRefCount(valuePtr); /* This one should be done here */

	/*
	 * Compute the new variable value.
	 */

	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;
	}

	/*
	 * Set result.
4938
4939
4940
4941
4942
4943
4944
4945
4946
4947
4948
4949
4950
4951
4952
4953
4954
	 */
	if (fromIdx == TCL_INDEX_NONE) {
	    fromIdx = TCL_INDEX_START;
	}

	fromIdx = TclIndexDecode(fromIdx, objc - 1);

	if (TclHasInternalRep(valuePtr,&tclArithSeriesType)) {
	    objResultPtr = TclArithSeriesObjRange(interp, valuePtr, fromIdx, toIdx);
	    if (objResultPtr == NULL) {
		TRACE_ERROR(interp);
		goto gotError;
	    }
	} else {
	    objResultPtr = TclListObjRange(valuePtr, fromIdx, toIdx);
	}







|
|
<







4941
4942
4943
4944
4945
4946
4947
4948
4949

4950
4951
4952
4953
4954
4955
4956
	 */
	if (fromIdx == TCL_INDEX_NONE) {
	    fromIdx = TCL_INDEX_START;
	}

	fromIdx = TclIndexDecode(fromIdx, objc - 1);

	if (TclAbstractListHasProc(valuePtr, TCL_ABSL_SLICE)) {
	    if (Tcl_AbstractListObjRange(interp, valuePtr, fromIdx, toIdx, &objResultPtr) != TCL_OK) {

		TRACE_ERROR(interp);
		goto gotError;
	    }
	} else {
	    objResultPtr = TclListObjRange(valuePtr, fromIdx, toIdx);
	}

4966
4967
4968
4969
4970
4971
4972
4973

4974
4975
4976
4977
4978
4979
4980



4981
4982
4983
4984
4985
4986
4987
4988
4989
4990
4991
4992
4993
4994
4995
4996
4997
4998
4999
5000
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	match = 0;
	if (length > 0) {
	    size_t i = 0;
	    Tcl_Obj *o;
	    int isArithSeries = TclHasInternalRep(value2Ptr,&tclArithSeriesType);

	    /*
	     * An empty list doesn't match anything.
	     */

	    do {
		if (isArithSeries) {
		    TclArithSeriesObjIndex(value2Ptr, i, &o);



		} else {
		    Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
		}
		if (o != NULL) {
		    s2 = Tcl_GetStringFromObj(o, &s2len);
		} else {
		    s2 = "";
		    s2len = 0;
		}
		if (s1len == s2len) {
		    match = (memcmp(s1, s2, s1len) == 0);
		}
		if (isArithSeries) {
		    TclDecrRefCount(o);
		}
		i++;
	    } while (i < length && match == 0);
	}

	if (*pc == INST_LIST_NOT_IN) {






|
>





|
|
>
>
>












|







4968
4969
4970
4971
4972
4973
4974
4975
4976
4977
4978
4979
4980
4981
4982
4983
4984
4985
4986
4987
4988
4989
4990
4991
4992
4993
4994
4995
4996
4997
4998
4999
5000
5001
5002
5003
5004
5005
5006
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	match = 0;
	if (length > 0) {
	    size_t i = 0;
	    Tcl_Obj *o;
	    int isAbstractList = TclHasInternalRep(value2Ptr,&tclAbstractListType);

	    /*
	     * An empty list doesn't match anything.
	     */

	    do {
		if (isAbstractList) {
		    if (Tcl_AbstractListObjIndex(interp, value2Ptr, i, &o) != TCL_OK) {
			TRACE_ERROR(interp);
			goto gotError;
		    }
		} else {
		    Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
		}
		if (o != NULL) {
		    s2 = Tcl_GetStringFromObj(o, &s2len);
		} else {
		    s2 = "";
		    s2len = 0;
		}
		if (s1len == s2len) {
		    match = (memcmp(s1, s2, s1len) == 0);
		}
		if (isAbstractList) {
		    TclDecrRefCount(o);
		}
		i++;
	    } while (i < length && match == 0);
	}

	if (*pc == INST_LIST_NOT_IN) {

Changes to generic/tclInt.h.

2628
2629
2630
2631
2632
2633
2634













2635
2636
2637
2638
2639
2640
2641
    (((listObj_)->typePtr == &tclListType)                   \
	 ? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK) \
	 : Tcl_ListObjLength((interp_), (listObj_), (lenPtr_)))

#define TclListObjIsCanonical(listObj_) \
    (((listObj_)->typePtr == &tclListType) ? ListObjIsCanonical((listObj_)) : 0)














/*
 * Modes for collecting (or not) in the implementations of TclNRForeachCmd,
 * TclNRLmapCmd and their compilations.
 */

#define TCL_EACH_KEEP_NONE  0	/* Discard iteration result like [foreach] */
#define TCL_EACH_COLLECT    1	/* Collect iteration result like [lmap] */






>
>
>
>
>
>
>
>
>
>
>
>
>







2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
    (((listObj_)->typePtr == &tclListType)                   \
	 ? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK) \
	 : Tcl_ListObjLength((interp_), (listObj_), (lenPtr_)))

#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.
 */

#define TCL_EACH_KEEP_NONE  0	/* Discard iteration result like [foreach] */
#define TCL_EACH_COLLECT    1	/* Collect iteration result like [lmap] */
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
MODULE_SCOPE const Tcl_ObjType tclBignumType;
MODULE_SCOPE const Tcl_ObjType tclBooleanType;
MODULE_SCOPE const Tcl_ObjType tclByteCodeType;
MODULE_SCOPE const Tcl_ObjType tclDoubleType;
MODULE_SCOPE const Tcl_ObjType tclIntType;
MODULE_SCOPE const Tcl_ObjType tclListType;
MODULE_SCOPE const Tcl_ObjType tclArithSeriesType;
MODULE_SCOPE const Tcl_ObjType tclDictType;
MODULE_SCOPE const Tcl_ObjType tclProcBodyType;
MODULE_SCOPE const Tcl_ObjType tclStringType;
MODULE_SCOPE const Tcl_ObjType tclEnsembleCmdType;
MODULE_SCOPE const Tcl_ObjType tclRegexpType;
MODULE_SCOPE Tcl_ObjType tclCmdNameType;

/*






|
|







2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
MODULE_SCOPE const Tcl_ObjType tclBignumType;
MODULE_SCOPE const Tcl_ObjType tclBooleanType;
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 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;
MODULE_SCOPE const Tcl_ObjType tclRegexpType;
MODULE_SCOPE Tcl_ObjType tclCmdNameType;

/*
4667
4668
4669
4670
4671
4672
4673




































4674
4675
4676
4677
4678
4679
4680
#define TclIsPureDict(objPtr) \
	(((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclDictType))
#define TclHasInternalRep(objPtr, type) \
	((objPtr)->typePtr == (type))
#define TclFetchInternalRep(objPtr, type) \
	(TclHasInternalRep((objPtr), (type)) ? &((objPtr)->internalRep) : NULL)






































/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to compare Unicode strings. On big-endian
 * systems we can use the more efficient memcmp, but this would not be
 * lexically correct on little-endian systems. The ANSI C "prototype" for
 * this macro is:






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







4680
4681
4682
4683
4684
4685
4686
4687
4688
4689
4690
4691
4692
4693
4694
4695
4696
4697
4698
4699
4700
4701
4702
4703
4704
4705
4706
4707
4708
4709
4710
4711
4712
4713
4714
4715
4716
4717
4718
4719
4720
4721
4722
4723
4724
4725
4726
4727
4728
4729
#define TclIsPureDict(objPtr) \
	(((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclDictType))
#define TclHasInternalRep(objPtr, type) \
	((objPtr)->typePtr == (type))
#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;
}



/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to compare Unicode strings. On big-endian
 * systems we can use the more efficient memcmp, but this would not be
 * lexically correct on little-endian systems. The ANSI C "prototype" for
 * this macro is:
4726
4727
4728
4729
4730
4731
4732

4733
4734
4735
4736
4737
4738
4739
 */

MODULE_SCOPE Tcl_LibraryInitProc TclplatformtestInit;
MODULE_SCOPE Tcl_LibraryInitProc TclObjTest_Init;
MODULE_SCOPE Tcl_LibraryInitProc TclThread_Init;
MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_Init;
MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;


/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to check whether a pattern has any characters
 * special to [string match]. The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE int	TclMatchIsTrivial(const char *pattern);






>







4775
4776
4777
4778
4779
4780
4781
4782
4783
4784
4785
4786
4787
4788
4789
 */

MODULE_SCOPE Tcl_LibraryInitProc TclplatformtestInit;
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;

/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to check whether a pattern has any characters
 * special to [string match]. The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE int	TclMatchIsTrivial(const char *pattern);

Changes to generic/tclListObj.c.

1
2
3
4
5
6
7
8
9
10
11

12
13
14
15
16
17
18
19
20
21
/*
 * tclListObj.c --
 *
 *	This file contains functions that implement the Tcl list object type.
 *
 * Copyright © 2022 Ashok P. Nadkarni.  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 <assert.h>
#include "tclInt.h"
#include "tclArithSeries.h"

/*
 * TODO - memmove is fast. Measure at what size we should prefer memmove
 * (for unshared objects only) in lieu of range operations. On the other
 * hand, more cache dirtied?
 */











>


<







1
2
3
4
5
6
7
8
9
10
11
12
13
14

15
16
17
18
19
20
21
/*
 * tclListObj.c --
 *
 *	This file contains functions that implement the Tcl list object type.
 *
 * Copyright © 2022 Ashok P. Nadkarni.  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 "tclAbstractList.h"
#include <assert.h>
#include "tclInt.h"


/*
 * TODO - memmove is fast. Measure at what size we should prefer memmove
 * (for unshared objects only) in lieu of range operations. On the other
 * hand, more cache dirtied?
 */

1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *listObj)		/* List object for which an element array is
				 * to be returned. */
{
    Tcl_Obj *copyObj;

    if (!TclHasInternalRep(listObj, &tclListType)) {
	if (TclHasInternalRep(listObj,&tclArithSeriesType)) {
	    return TclArithSeriesObjCopy(interp, listObj);
	}
	if (SetListFromAny(interp, listObj) != TCL_OK) {
	    return NULL;
	}
    }

    TclNewObj(copyObj);






|
|







1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *listObj)		/* List object for which an element array is
				 * to be returned. */
{
    Tcl_Obj *copyObj;

    if (!TclHasInternalRep(listObj, &tclListType)) {
	if (TclHasInternalRep(listObj,&tclAbstractListType)) {
	    return Tcl_AbstractListObjCopy(interp, listObj);
	}
	if (SetListFromAny(interp, listObj) != TCL_OK) {
	    return NULL;
	}
    }

    TclNewObj(copyObj);
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669







1670

1671
1672
1673
1674
1675
1676
1677
    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. */
{
    ListRep listRep;

    if (TclHasInternalRep(objPtr,&tclArithSeriesType)) {
	return TclArithSeriesGetElements(interp, objPtr, objcPtr, objvPtr);
    }

    if (TclListObjGetRep(interp, objPtr, &listRep) != TCL_OK)







	return TCL_ERROR;

    ListRepElements(&listRep, *objcPtr, *objvPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *






|
|
<
|
|
>
>
>
>
>
>
>
|
>







1658
1659
1660
1661
1662
1663
1664
1665
1666

1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
    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. */
{
    ListRep listRep;

    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;
    }
    ListRepElements(&listRep, *objcPtr, *objvPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
1988
1989
1990
1991
1992
1993
1994

1995

1996
1997
1998
1999
2000
2001
2002
2003
Tcl_ListObjLength(
    Tcl_Interp *interp,	/* Used to report errors if not NULL. */
    Tcl_Obj *listObj,	/* List object whose #elements to return. */
    Tcl_Size *lenPtr)	/* The resulting int is stored here. */
{
    ListRep listRep;


    if (TclHasInternalRep(listObj,&tclArithSeriesType)) {

	*lenPtr = TclArithSeriesObjLength(listObj);
	return TCL_OK;
    }

    /*
     * TODO
     * Unlike the original list code, this does not optimize for lindex'ing
     * an empty string when the internal rep is not already a list. On the






>
|
>
|







1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
Tcl_ListObjLength(
    Tcl_Interp *interp,	/* Used to report errors if not NULL. */
    Tcl_Obj *listObj,	/* List object whose #elements to return. */
    Tcl_Size *lenPtr)	/* The resulting int is stored here. */
{
    ListRep listRep;

    /* Handle AbstractList before attempting SetListFromAny */
    if (!TclHasInternalRep(listObj, &tclListType) &&
	TclHasInternalRep(listObj, &tclAbstractListType)) {
	*lenPtr = Tcl_AbstractListObjLength(listObj);
	return TCL_OK;
    }

    /*
     * TODO
     * Unlike the original list code, this does not optimize for lindex'ing
     * an empty string when the internal rep is not already a list. On the
2067
2068
2069
2070
2071
2072
2073





2074
2075
2076
2077
2078
2079
2080
    ptrdiff_t tailShift;
    Tcl_Obj **listObjs;
    int favor;

    if (Tcl_IsShared(listObj)) {
	Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace");
    }






    if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK)
	return TCL_ERROR; /* Cannot be converted to a list */

    /* TODO - will need modification if Tcl9 sticks to unsigned indices */

    /* Make limits sane */






>
>
>
>
>







2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
    ptrdiff_t tailShift;
    Tcl_Obj **listObjs;
    int favor;

    if (Tcl_IsShared(listObj)) {
	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 */

    /* TODO - will need modification if Tcl9 sticks to unsigned indices */

    /* Make limits sane */
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637


2638

2639
2640
2641
2642
2643
2644
2645
2646
    Tcl_Obj *listObj,		/* Tcl object representing the list. */
    Tcl_Size indexCount,		/* Count of indices. */
    Tcl_Obj *const indexArray[])/* Array of pointers to Tcl objects that
				 * represent the indices in the list. */
{
    Tcl_Size i;

    /* Handle ArithSeries as special case */
    if (TclHasInternalRep(listObj,&tclArithSeriesType)) {
	Tcl_WideInt listLen = TclArithSeriesObjLength(listObj);
	Tcl_Size index;
	Tcl_Obj *elemObj = NULL;
	for (i=0 ; i<indexCount && listObj ; i++) {
	    if (TclGetIntForIndexM(interp, indexArray[i], /*endValue*/ listLen-1,
				   &index) == TCL_OK) {
	    }
	    if (i==0) {
		TclArithSeriesObjIndex(listObj, index, &elemObj);


	    } else if (index > 0) {

		/* ArithSeries cannot be a list of lists */
		Tcl_DecrRefCount(elemObj);
		TclNewObj(elemObj);
		break;
	    }
	}
	Tcl_IncrRefCount(elemObj);
	return elemObj;






|
|
|







|
>
>

>
|







2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
    Tcl_Obj *listObj,		/* Tcl object representing the list. */
    Tcl_Size indexCount,		/* Count of indices. */
    Tcl_Obj *const indexArray[])/* Array of pointers to Tcl objects that
				 * represent the indices in the list. */
{
    Tcl_Size i;

    /* 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++) {
	    if (TclGetIntForIndexM(interp, indexArray[i], /*endValue*/ listLen-1,
				   &index) == TCL_OK) {
	    }
	    if (i==0) {
		if (Tcl_AbstractListObjIndex(interp, listObj, index, &elemObj) != TCL_OK) {
		    return NULL;
		}
	    } else if (index > 0) {
		// TODO: support nested lists
		// For now, only support 1 index, which is all an ArithSeries has
		Tcl_DecrRefCount(elemObj);
		TclNewObj(elemObj);
		break;
	    }
	}
	Tcl_IncrRefCount(elemObj);
	return elemObj;
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748









2749
2750
2751
2752
2753




2754

2755
2756
2757
2758
2759

2760
2761




2762
2763
2764
2765
2766
2767
2768
2769
2770

2771


2772
2773
2774
2775
2776
2777
2778
    /*
     * Determine whether the index arg designates a list or a single index.
     * We have to be careful about the order of the checks to avoid repeated
     * shimmering; see TIP #22 and #23 for details.
     */

    if (!TclHasInternalRep(indexArgObj, &tclListType)
	&& TclGetIntForIndexM(NULL, indexArgObj, ListSizeT_MAX - 1, &index)
	       == TCL_OK) {









	/* 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 */
	return TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj);
    }





    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);

    /*
     * Let TclLsetFlat handle the actual lset'ting.
     */

    retValueObj = TclLsetFlat(interp, listObj, indexCount, indices, valueObj);


    Tcl_DecrRefCount(indexListCopy);


    return retValueObj;
}

/*
 *----------------------------------------------------------------------
 *
 * TclLsetFlat --






|
|
|
>
>
>
>
>
>
>
>
>

|

|
|
>
>
>
>

>





>
|
|
>
>
>
>
|
|
|
<
<
<



>
|
>
>







2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800



2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
    /*
     * Determine whether the index arg designates a list or a single index.
     * We have to be careful about the order of the checks to avoid repeated
     * shimmering; see TIP #22 and #23 for details.
     */

    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 */
	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.
	 */
	indexCount = 1;
	indices = &indexArgObj;

    } else {
	/*
	 * Expand list into indicies array
	 */
	LIST_ASSERT_TYPE(indexListCopy);
	ListObjGetElements(indexListCopy, indexCount, indices);
    }




    retValueObj = TclLsetFlat(interp, listObj, indexCount, indices, valueObj);

    if (indexListCopy) {
	Tcl_DecrRefCount(indexListCopy);
    }

    return retValueObj;
}

/*
 *----------------------------------------------------------------------
 *
 * TclLsetFlat --
3269
3270
3271
3272
3273
3274
3275
3276

3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297


3298
3299
3300

3301




3302
3303
3304
3305
3306
3307
3308
	while (!done) {
	    *elemPtrs++ = keyPtr;
	    *elemPtrs++ = valuePtr;
	    Tcl_IncrRefCount(keyPtr);
	    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);

	/* TODO - leave space in front and/or back? */
	if (ListRepInitAttempt(
		interp, size > 0 ? size : 1, NULL, &listRep)
	    != TCL_OK) {
	    return TCL_ERROR;
	}

	LIST_ASSERT(listRep.spanPtr == NULL); /* Guard against future changes */
	LIST_ASSERT(listRep.storePtr->firstUsed == 0);
	LIST_ASSERT((listRep.storePtr->flags & LISTSTORE_CANONICAL) == 0);

	listRep.storePtr->numUsed = size;
	elemPtrs = listRep.storePtr->slots;
	for (j = 0; j < size; j++) {


	    if (TclArithSeriesObjIndex(objPtr, j, &elemPtrs[j]) != TCL_OK) {
		return TCL_ERROR;
	    }

	}





    } else {
	Tcl_Size estCount, length;
	const char *limit, *nextElem = Tcl_GetStringFromObj(objPtr, &length);

	/*
	 * Allocate enough space to hold a (Tcl_Obj *) for each






|
>
|
<
<
<
<
|

<
|
<
<





<

<

|
>
>
|
|
|
>

>
>
>
>







3305
3306
3307
3308
3309
3310
3311
3312
3313
3314




3315
3316

3317


3318
3319
3320
3321
3322

3323

3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
	while (!done) {
	    *elemPtrs++ = keyPtr;
	    *elemPtrs++ = valuePtr;
	    Tcl_IncrRefCount(keyPtr);
	    Tcl_IncrRefCount(valuePtr);
	    Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done);
	}
    } else if (TclHasInternalRep(objPtr,&tclAbstractListType)) {
	Tcl_Size elemCount, i;





	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);



	elemPtrs = listRep.storePtr->slots;

	/* 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((Tcl_Size)(elemPtrs - listRep.storePtr->slots) == elemCount);

	listRep.storePtr->numUsed = elemCount;

    } else {
	Tcl_Size estCount, length;
	const char *limit, *nextElem = Tcl_GetStringFromObj(objPtr, &length);

	/*
	 * Allocate enough space to hold a (Tcl_Obj *) for each

Changes to generic/tclObj.c.

12
13
14
15
16
17
18

19
20
21
22
23
24
25
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclTomMath.h"

#include <math.h>
#include <assert.h>

/*
 * Table of all object types.
 */







>







12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclTomMath.h"
#include "tclAbstractList.h"
#include <math.h>
#include <assert.h>

/*
 * Table of all object types.
 */

365
366
367
368
369
370
371











372
373
374
375
376
377
378
    Tcl_RegisterObjType(&tclListType);
    Tcl_RegisterObjType(&tclDictType);
    Tcl_RegisterObjType(&tclByteCodeType);
    Tcl_RegisterObjType(&tclCmdNameType);
    Tcl_RegisterObjType(&tclRegexpType);
    Tcl_RegisterObjType(&tclProcBodyType);












#ifdef TCL_COMPILE_STATS
    Tcl_MutexLock(&tclObjMutex);
    tclObjsAlloced = 0;
    tclObjsFreed = 0;
    {
	int i;







>
>
>
>
>
>
>
>
>
>
>







366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
    Tcl_RegisterObjType(&tclListType);
    Tcl_RegisterObjType(&tclDictType);
    Tcl_RegisterObjType(&tclByteCodeType);
    Tcl_RegisterObjType(&tclCmdNameType);
    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;
    tclObjsFreed = 0;
    {
	int i;

4409
4410
4411
4412
4413
4414
4415

4416
4417
4418
4419
4420






4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
Tcl_RepresentationCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *descObj;


    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "value");
	return TCL_ERROR;
    }







    /*
     * Value is a bignum with a refcount of 14, object pointer at 0x12345678,
     * internal representation 0x45671234:0x98765432, string representation
     * "1872361827361287"
     */

    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]->refCount, objv[1]);

    if (objv[1]->typePtr) {
	if (objv[1]->typePtr == &tclDoubleType) {
	    Tcl_AppendPrintfToObj(descObj, ", internal representation %g",
		    objv[1]->internalRep.doubleValue);
	} else {






>





>
>
>
>
>
>









|







4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
Tcl_RepresentationCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    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
     * "1872361827361287"
     */

    descObj = Tcl_ObjPrintf("value is a %s with a refcount of %" TCL_Z_MODIFIER "u,"
	    " object pointer at %p",
	    objv[1]->typePtr ? typeName : "pure string",
	    objv[1]->refCount, objv[1]);

    if (objv[1]->typePtr) {
	if (objv[1]->typePtr == &tclDoubleType) {
	    Tcl_AppendPrintfToObj(descObj, ", internal representation %g",
		    objv[1]->internalRep.doubleValue);
	} else {

Changes to generic/tclStubInit.c.

1483
1484
1485
1486
1487
1488
1489










1490
1491
1492
    Tcl_CreateObjTrace2, /* 677 */
    Tcl_NRCreateCommand2, /* 678 */
    Tcl_NRCallObjProc2, /* 679 */
    Tcl_GetNumberFromObj, /* 680 */
    Tcl_GetNumber, /* 681 */
    Tcl_RemoveChannelMode, /* 682 */
    Tcl_GetEncodingNulLength, /* 683 */










};

/* !END!: Do not edit above this line. */






>
>
>
>
>
>
>
>
>
>



1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
    Tcl_CreateObjTrace2, /* 677 */
    Tcl_NRCreateCommand2, /* 678 */
    Tcl_NRCallObjProc2, /* 679 */
    Tcl_GetNumberFromObj, /* 680 */
    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. */

Changes to generic/tclTest.c.

732
733
734
735
736
737
738




739
740
741
742
743
744
745
	return TCL_ERROR;
    }
#if TCL_THREADS
    if (TclThread_Init(interp) != TCL_OK) {
	return TCL_ERROR;
    }
#endif





    /*
     * Check for special options used in ../tests/main.test
     */

    objPtr = Tcl_GetVar2Ex(interp, "argv", NULL, TCL_GLOBAL_ONLY);
    if (objPtr != NULL) {






>
>
>
>







732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
	return TCL_ERROR;
    }
#if TCL_THREADS
    if (TclThread_Init(interp) != TCL_OK) {
	return TCL_ERROR;
    }
#endif

    if (Tcl_ABSListTest_Init(interp) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Check for special options used in ../tests/main.test
     */

    objPtr = Tcl_GetVar2Ex(interp, "argv", NULL, TCL_GLOBAL_ONLY);
    if (objPtr != NULL) {
8295
8296
8297
8298
8299
8300
8301
8302
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * indent-tabs-mode: nil
 * End:
 */







<
8299
8300
8301
8302
8303
8304
8305

 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * indent-tabs-mode: nil
 * End:
 */

Added generic/tclTestABSList.c.











































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
// Tcl Abstract List test command: "lstring"

#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS
#endif
#include <string.h>
#include <limits.h>
#include "tclInt.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;
}

Added tests/abstractlist.test.

















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
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 lstring} {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 lstring} {l is a lstring}}

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

Changes to tests/lseq.test.

533
534
535
536
537
538
539
540

541






542
543
544
545
546
547
548
549
    lrange [lseq 1 5] fred ginger
} -returnCodes 1 \
    -result {bad index "fred": must be integer?[+-]integer? or end?[+-]integer?}

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}

# Panic when using variable value?
test lseq-4.10 {panic using variable index} {
    set i 0
    lindex [lseq 10] $i
} {0}







|
>
|
>
>
>
>
>
>
|







533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
    lrange [lseq 1 5] fred ginger
} -returnCodes 1 \
    -result {bad index "fred": must be integer?[+-]integer? or end?[+-]integer?}

test lseq-4.9 {error case lrange} -body {
    set fred 7
    set ginger 8
    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} {
    set i 0
    lindex [lseq 10] $i
} {0}

Changes to unix/Makefile.in.

289
290
291
292
293
294
295
296
297
298
299

300
301

302
303
304
305
306
307
308
309
DEPEND_SWITCHES	= ${CFLAGS} -I${UNIX_DIR} -I${GENERIC_DIR} \
	${AC_FLAGS} ${EXTRA_CFLAGS} @[email protected]

TCLSH_OBJS = tclAppInit.o

TCLTEST_OBJS = tclTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \
	tclThreadTest.o tclUnixTest.o

XTTEST_OBJS = xtTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \
	tclThreadTest.o tclUnixTest.o tclXtNotify.o tclXtTest.o


GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \

	tclArithSeries.o tclAssembly.o tclAsync.o tclBasic.o tclBinary.o \
	tclCkalloc.o tclClock.o tclCmdAH.o tclCmdIL.o tclCmdMZ.o \
	tclCompCmds.o tclCompCmdsGR.o tclCompCmdsSZ.o tclCompExpr.o \
	tclCompile.o tclConfig.o tclDate.o tclDictObj.o tclDisassemble.o \
	tclEncoding.o tclEnsemble.o \
	tclEnv.o tclEvent.o tclExecute.o tclFCmd.o tclFileName.o tclGet.o \
	tclHash.o tclHistory.o tclIndexObj.o tclInterp.o tclIO.o tclIOCmd.o \
	tclIORChan.o tclIORTrans.o tclIOGT.o tclIOSock.o tclIOUtil.o \






|


|
>

|
>
|







289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
DEPEND_SWITCHES	= ${CFLAGS} -I${UNIX_DIR} -I${GENERIC_DIR} \
	${AC_FLAGS} ${EXTRA_CFLAGS} @[email protected]

TCLSH_OBJS = tclAppInit.o

TCLTEST_OBJS = tclTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.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 \
	tclTestABSList.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 \
	tclEncoding.o tclEnsemble.o \
	tclEnv.o tclEvent.o tclExecute.o tclFCmd.o tclFileName.o tclGet.o \
	tclHash.o tclHistory.o tclIndexObj.o tclInterp.o tclIO.o tclIOCmd.o \
	tclIORChan.o tclIORTrans.o tclIOGT.o tclIOSock.o tclIOUtil.o \
378
379
380
381
382
383
384


385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407

408
409
410
411
412
413
414
	$(GENERIC_DIR)/tcl.decls \
	$(GENERIC_DIR)/tclInt.decls \
	$(GENERIC_DIR)/tclOO.decls \
	$(GENERIC_DIR)/tclTomMath.decls

GENERIC_HDRS = \
	$(GENERIC_DIR)/tcl.h \


	$(GENERIC_DIR)/tclDecls.h \
	$(GENERIC_DIR)/tclInt.h \
	$(GENERIC_DIR)/tclIntDecls.h \
	$(GENERIC_DIR)/tclIntPlatDecls.h \
	$(GENERIC_DIR)/tclTomMath.h \
	$(GENERIC_DIR)/tclTomMathDecls.h \
	$(GENERIC_DIR)/tclOO.h \
	$(GENERIC_DIR)/tclOODecls.h \
	$(GENERIC_DIR)/tclOOInt.h \
	$(GENERIC_DIR)/tclOOIntDecls.h \
	$(GENERIC_DIR)/tclPatch.h \
	$(GENERIC_DIR)/tclPlatDecls.h \
	$(GENERIC_DIR)/tclPort.h \
	$(GENERIC_DIR)/tclRegexp.h \
	$(GENERIC_DIR)/tclArithSeries.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)/tclArithSeries.c \

	$(GENERIC_DIR)/tclAssembly.c \
	$(GENERIC_DIR)/tclAsync.c \
	$(GENERIC_DIR)/tclBasic.c \
	$(GENERIC_DIR)/tclBinary.c \
	$(GENERIC_DIR)/tclCkalloc.c \
	$(GENERIC_DIR)/tclClock.c \
	$(GENERIC_DIR)/tclCmdAH.c \






>
>













<
|






|

>







380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401

402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
	$(GENERIC_DIR)/tcl.decls \
	$(GENERIC_DIR)/tclInt.decls \
	$(GENERIC_DIR)/tclOO.decls \
	$(GENERIC_DIR)/tclTomMath.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 \
	$(GENERIC_DIR)/tclIntPlatDecls.h \
	$(GENERIC_DIR)/tclTomMath.h \
	$(GENERIC_DIR)/tclTomMathDecls.h \
	$(GENERIC_DIR)/tclOO.h \
	$(GENERIC_DIR)/tclOODecls.h \
	$(GENERIC_DIR)/tclOOInt.h \
	$(GENERIC_DIR)/tclOOIntDecls.h \
	$(GENERIC_DIR)/tclPatch.h \
	$(GENERIC_DIR)/tclPlatDecls.h \
	$(GENERIC_DIR)/tclPort.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)/tclAbstractList.c \
	$(GENERIC_DIR)/tclArithSeries.c \
	$(GENERIC_DIR)/tclAlloc.c \
	$(GENERIC_DIR)/tclAssembly.c \
	$(GENERIC_DIR)/tclAsync.c \
	$(GENERIC_DIR)/tclBasic.c \
	$(GENERIC_DIR)/tclBinary.c \
	$(GENERIC_DIR)/tclCkalloc.c \
	$(GENERIC_DIR)/tclClock.c \
	$(GENERIC_DIR)/tclCmdAH.c \
464
465
466
467
468
469
470

471
472
473
474
475
476
477
	$(GENERIC_DIR)/tclResolve.c \
	$(GENERIC_DIR)/tclResult.c \
	$(GENERIC_DIR)/tclScan.c \
	$(GENERIC_DIR)/tclStubInit.c \
	$(GENERIC_DIR)/tclStringObj.c \
	$(GENERIC_DIR)/tclStrToD.c \
	$(GENERIC_DIR)/tclTest.c \

	$(GENERIC_DIR)/tclTestObj.c \
	$(GENERIC_DIR)/tclTestProcBodyObj.c \
	$(GENERIC_DIR)/tclThread.c \
	$(GENERIC_DIR)/tclThreadAlloc.c \
	$(GENERIC_DIR)/tclThreadJoin.c \
	$(GENERIC_DIR)/tclThreadStorage.c \
	$(GENERIC_DIR)/tclTimer.c \






>







468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
	$(GENERIC_DIR)/tclResolve.c \
	$(GENERIC_DIR)/tclResult.c \
	$(GENERIC_DIR)/tclScan.c \
	$(GENERIC_DIR)/tclStubInit.c \
	$(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 \
	$(GENERIC_DIR)/tclThreadAlloc.c \
	$(GENERIC_DIR)/tclThreadJoin.c \
	$(GENERIC_DIR)/tclThreadStorage.c \
	$(GENERIC_DIR)/tclTimer.c \
1246
1247
1248
1249
1250
1251
1252






1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
regfree.o: $(REGHDRS) $(GENERIC_DIR)/regfree.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/regfree.c

regerror.o: $(REGHDRS) $(GENERIC_DIR)/regerrs.h $(GENERIC_DIR)/regerror.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/regerror.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

tclAsync.o: $(GENERIC_DIR)/tclAsync.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAsync.c

tclBasic.o: $(GENERIC_DIR)/tclBasic.c $(COMPILEHDR) $(MATHHDRS) $(NREHDR)






>
>
>
>
>
>






<
<
<







1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269



1270
1271
1272
1273
1274
1275
1276
regfree.o: $(REGHDRS) $(GENERIC_DIR)/regfree.c
	$(CC) -c $(CC_SWITCHES) $(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




tclAssembly.o: $(GENERIC_DIR)/tclAssembly.c $(COMPILEHDR)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAssembly.c

tclAsync.o: $(GENERIC_DIR)/tclAsync.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAsync.c

tclBasic.o: $(GENERIC_DIR)/tclBasic.c $(COMPILEHDR) $(MATHHDRS) $(NREHDR)
1533
1534
1535
1536
1537
1538
1539



1540
1541
1542
1543
1544
1545
1546
		-DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\"" \
		-DCFG_RUNTIME_LIBDIR="\"$(libdir)\"" \
		-I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip \
		$(GENERIC_DIR)/tclZipfs.c

tclTest.o: $(GENERIC_DIR)/tclTest.c $(IOHDR) $(TCLREHDRS) tclUuid.h
	$(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTest.c




tclTestObj.o: $(GENERIC_DIR)/tclTestObj.c $(MATHHDRS)
	$(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTestObj.c

tclTestProcBodyObj.o: $(GENERIC_DIR)/tclTestProcBodyObj.c
	$(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTestProcBodyObj.c







>
>
>







1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
		-DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\"" \
		-DCFG_RUNTIME_LIBDIR="\"$(libdir)\"" \
		-I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip \
		$(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

tclTestProcBodyObj.o: $(GENERIC_DIR)/tclTestProcBodyObj.c
	$(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTestProcBodyObj.c

Changes to win/Makefile.in.

268
269
270
271
272
273
274
275

276
277
278
279
280
281
282
283

284
285
286
287
288
289
290
${AC_FLAGS} ${COMPILE_DEBUG_FLAGS}

TCLTEST_OBJS = \
	tclTest.$(OBJEXT) \
	tclTestObj.$(OBJEXT) \
	tclTestProcBodyObj.$(OBJEXT) \
	tclThreadTest.$(OBJEXT) \
	tclWinTest.$(OBJEXT)


GENERIC_OBJS = \
	regcomp.$(OBJEXT) \
	regexec.$(OBJEXT) \
	regfree.$(OBJEXT) \
	regerror.$(OBJEXT) \
	tclAlloc.$(OBJEXT) \
	tclArithSeries.$(OBJEXT) \

	tclAssembly.$(OBJEXT) \
	tclAsync.$(OBJEXT) \
	tclBasic.$(OBJEXT) \
	tclBinary.$(OBJEXT) \
	tclCkalloc.$(OBJEXT) \
	tclClock.$(OBJEXT) \
	tclCmdAH.$(OBJEXT) \






|
>






|

>







268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
${AC_FLAGS} ${COMPILE_DEBUG_FLAGS}

TCLTEST_OBJS = \
	tclTest.$(OBJEXT) \
	tclTestObj.$(OBJEXT) \
	tclTestProcBodyObj.$(OBJEXT) \
	tclThreadTest.$(OBJEXT) \
	tclWinTest.$(OBJEXT) \
	tclTestABSList.$(OBJEXT)

GENERIC_OBJS = \
	regcomp.$(OBJEXT) \
	regexec.$(OBJEXT) \
	regfree.$(OBJEXT) \
	regerror.$(OBJEXT) \
	tclAbstractList.$(OBJEXT) \
	tclArithSeries.$(OBJEXT) \
	tclAlloc.$(OBJEXT) \
	tclAssembly.$(OBJEXT) \
	tclAsync.$(OBJEXT) \
	tclBasic.$(OBJEXT) \
	tclBinary.$(OBJEXT) \
	tclCkalloc.$(OBJEXT) \
	tclClock.$(OBJEXT) \
	tclCmdAH.$(OBJEXT) \

Changes to win/makefile.vc.

221
222
223
224
225
226
227

228
229
230
231
232
233
234
235
236
237
238
239

240
241
242
243
244
245
246
TCLTESTOBJS = \
	$(TMP_DIR)\tclTest.obj \
	$(TMP_DIR)\tclTestObj.obj \
	$(TMP_DIR)\tclTestProcBodyObj.obj \
	$(TMP_DIR)\tclThreadTest.obj \
	$(TMP_DIR)\tclWinTest.obj \

!if !$(STATIC_BUILD)
	$(OUT_DIR)\tommath.lib \
!endif
	$(TMP_DIR)\testMain.obj

COREOBJS = \
	$(TMP_DIR)\regcomp.obj \
	$(TMP_DIR)\regerror.obj \
	$(TMP_DIR)\regexec.obj \
	$(TMP_DIR)\regfree.obj \
	$(TMP_DIR)\tclAlloc.obj \
	$(TMP_DIR)\tclArithSeries.obj \

	$(TMP_DIR)\tclAssembly.obj \
	$(TMP_DIR)\tclAsync.obj \
	$(TMP_DIR)\tclBasic.obj \
	$(TMP_DIR)\tclBinary.obj \
	$(TMP_DIR)\tclCkalloc.obj \
	$(TMP_DIR)\tclClock.obj \
	$(TMP_DIR)\tclCmdAH.obj \






>










|

>







221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
TCLTESTOBJS = \
	$(TMP_DIR)\tclTest.obj \
	$(TMP_DIR)\tclTestObj.obj \
	$(TMP_DIR)\tclTestProcBodyObj.obj \
	$(TMP_DIR)\tclThreadTest.obj \
	$(TMP_DIR)\tclWinTest.obj \
	$(TMP_DIR)\tclTestABSList.obj \
!if !$(STATIC_BUILD)
	$(OUT_DIR)\tommath.lib \
!endif
	$(TMP_DIR)\testMain.obj

COREOBJS = \
	$(TMP_DIR)\regcomp.obj \
	$(TMP_DIR)\regerror.obj \
	$(TMP_DIR)\regexec.obj \
	$(TMP_DIR)\regfree.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 \
	$(TMP_DIR)\tclBinary.obj \
	$(TMP_DIR)\tclCkalloc.obj \
	$(TMP_DIR)\tclClock.obj \
	$(TMP_DIR)\tclCmdAH.obj \
822
823
824
825
826
827
828



829
830
831
832
833
834
835
$(TMP_DIR)\tclTest.obj: $(GENERICDIR)\tclTest.c $(TMP_DIR)\tclUuid.h
	$(cc32) $(appcflags) -I$(TMP_DIR) \
	    [email protected] $(GENERICDIR)\tclTest.c

$(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
	$(cc32) $(appcflags) [email protected] $?




$(TMP_DIR)\tclWinTest.obj: $(WIN_DIR)\tclWinTest.c
	$(CCAPPCMD) $?

$(TMP_DIR)\tclZipfs.obj: $(GENERICDIR)\tclZipfs.c
	$(cc32) $(pkgcflags) \
	-I$(COMPATDIR)\zlib -I$(COMPATDIR)\zlib\contrib\minizip \






>
>
>







824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
$(TMP_DIR)\tclTest.obj: $(GENERICDIR)\tclTest.c $(TMP_DIR)\tclUuid.h
	$(cc32) $(appcflags) -I$(TMP_DIR) \
	    [email protected] $(GENERICDIR)\tclTest.c

$(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
	$(cc32) $(appcflags) [email protected] $?

$(TMP_DIR)\tclTestABSList.obj: $(GENERICDIR)\tclTestABSList.c
	$(cc32) $(appcflags) [email protected] $?

$(TMP_DIR)\tclWinTest.obj: $(WIN_DIR)\tclWinTest.c
	$(CCAPPCMD) $?

$(TMP_DIR)\tclZipfs.obj: $(GENERICDIR)\tclZipfs.c
	$(cc32) $(pkgcflags) \
	-I$(COMPATDIR)\zlib -I$(COMPATDIR)\zlib\contrib\minizip \