'\"
'\" 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

\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.
argument ".." or "to" defines the range. The "count" option is used
to define a count of the number of elements in the list. A short form use of
the command, with a
single count value, will create a range from 0 to count-1.

The \fBlseq\fR command can produce both increasing and decreasing sequences. When
both Start and End are provided without a Step value, then if Start <= End,
the sequence will be increasing and if Start > End it will be decreasing. If a
Step vale is included, it's sign should agree with the direction of the
sequence (descending -> negative and ascending -> positive), otherwise an
empty list is returned.  For example:

.CS \"
    % lseq 1 to 5    ;# increasing
    1 2 3 4 5

    % lseq 5 to 1    ;# decreasing
    5 4 3 2 1

    % lseq 6 to 1 by 2   ;# decreasing, step wrong sign, empty list

    % lseq 1 to 5 by 0   ;# all step sizes of 0 produce an empty list

.\"
.CE

The numeric arguments, \fIStart\fR, \fIEnd\fR, \fIStep\fR, and \fICount\fR,
can also be a valid expression. the lseq command will evaluate the expression
and use the numeric result, or return an error as with any invalid argument
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.
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

 \(-> 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),
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:

    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_WideInt index, Tcl_Obj **elemObjPtr)
}
declare 688 {
    int Tcl_AbstractListObjRange(Tcl_Interp *interp, Tcl_Obj *abstractListPtr, Tcl_WideInt fromIdx, Tcl_WideInt 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, int *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.

				 * 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) (int 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_WideInt index, struct Tcl_Obj** elemObj);
typedef		   int	(Tcl_ALSliceProc)  (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
					    Tcl_WideInt fromIdx, Tcl_WideInt 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,
					     int *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_WideInt first, Tcl_WideInt numToDelete,
					    Tcl_WideInt 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.
 */

/*
 * 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_WideInt 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 *) ckalloc(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 *) ckalloc(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) {
	ckfree(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_WideInt fromIdx,	 /* Index of first element to include. */
    Tcl_WideInt 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. */
    int *objcPtr,		/* Where to store the count of objects
				 * referenced by objv. */
    Tcl_Obj ***objvPtr)		/* Where to store the pointer to an array of
				 * pointers to the list's objects. */
{

    if (TclHasInternalRep(objPtr,&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:
 */

/*
 * 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_WideInt index, Tcl_Obj **elemObj);
int	    Tcl_AbstractListObjRange(Tcl_Interp *interp, Tcl_Obj *abstractListPtr,
		Tcl_WideInt fromIdx, Tcl_WideInt 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, int *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:
 */

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

#include <assert.h>
#include "tcl.h"
#include "tclInt.h"
#include "tclArithSeries.h"
/* -------------------------- ArithSeries object ---------------------------- */


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

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

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


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

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

/*
 * The structure below defines the arithmetic series Tcl object type by
 * means of procedures that can be invoked by generic object code.
 * The structure below defines the arithmetic series Tcl Obj Type by means of
 * procedures that can be invoked by generic object code.
 *
 * The arithmetic series object is a special case of Tcl list representing
 * an interval of an arithmetic series in constant space.
 * The arithmetic series object is a Tcl_AbstractList representing an interval
 * of an arithmetic series in constant space.
 *
 * The arithmetic series is internally represented with three integers,
 * *start*, *end*, and *step*, Where the length is calculated with
 * 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
 * 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.
 */

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

static int TclArithSeriesObjStep(Tcl_Obj *arithSeriesPtr, Tcl_Obj **stepObj);
static int TclArithSeriesObjIndex(Tcl_Interp *interp, Tcl_Obj *arithSeriesPtr,
			    Tcl_WideInt index, Tcl_Obj **elemObj);
static Tcl_WideInt TclArithSeriesObjLength(Tcl_Obj *arithSeriesObj);
static int TclArithSeriesObjRange(Tcl_Interp *interp, Tcl_Obj *arithSeriesPtr,
			    Tcl_WideInt fromIdx, Tcl_WideInt 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[]);

const Tcl_ObjType tclArithSeriesType = {
    "arithseries",			/* name */
    FreeArithSeriesInternalRep,		/* freeIntRepProc */
    DupArithSeriesInternalRep,		/* dupIntRepProc */
    UpdateStringOfArithSeries,		/* updateStringProc */
    SetArithSeriesFromAny		/* setFromAnyProc */
static Tcl_AbstractListType arithSeriesType = {
	TCL_ABSTRACTLIST_VERSION_1,
	"arithseries",
	Tcl_NewArithSeriesObj,
	DupArithSeriesRep,
	TclArithSeriesObjLength,
	TclArithSeriesObjIndex,
	TclArithSeriesObjRange,
	TclArithSeriesObjReverse,
        TclArithSeriesGetElements,
        FreeArithSeriesRep,
	UpdateStringOfArithSeries,
	NULL, // SetElement
	NULL  // Replace
};

/*
 *----------------------------------------------------------------------
 *
 * ArithSeriesLen --
 * Arithserieslen --
 *
 * 	Compute the length of the equivalent list where
 * 	every element is generated starting from *start*,
 * 	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.
 * 	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 = 1 + ((end-start)/step);
    return (len < 0) ? -1 : 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 *)ckalloc(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]);
	    }
	    ckfree((char*)arithSeriesPtr->elements);
	    arithSeriesPtr->elements = NULL;
	}
	ckfree((char*)arithSeriesPtr);
    }
}


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

 * 	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;
    Tcl_Obj *arithSeriesObj;
    ArithSeries *arithSeriesRepPtr;

    TclNewObj(arithSeriesPtr);

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

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

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

    if (length > 0)
    	Tcl_InvalidateStringRep(arithSeriesPtr);
    	Tcl_InvalidateStringRep(arithSeriesObj);

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

 * 	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;
    Tcl_Obj *arithSeriesObj;
    ArithSeriesDbl *arithSeriesRepPtr;

    TclNewObj(arithSeriesPtr);

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

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

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

    if (length > 0)
    	Tcl_InvalidateStringRep(arithSeriesPtr);
    	Tcl_InvalidateStringRep(arithSeriesObj);

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

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

 * 	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,
    Tcl_Interp *interp,        /* For error reporting */
    Tcl_Obj **arithSeriesObj,  /* return value */
    int useDoubles,            /* Promote values to double when true,
			      ** 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 */
                                * 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, 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;
            return TCL_OK;
	}
    }
    if (endObj) {
	assignNumber(useDoubles, &end, &dend, endObj);
    }
    if (lenObj) {
	if (TCL_OK != Tcl_GetWideIntFromObj(interp, lenObj, &len)) {

    }
    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_WideInt index,       /* index to element of interest */
    Tcl_Obj **elemObj)       /* Return value */
{
    ArithSeries *arithSeriesRepPtr = (ArithSeries *)Tcl_AbstractListGetConcreteRep(arithSeriesPtr);
    (void)interp; // quiet compiler
    if (0 <= index || index < arithSeriesRepPtr->len) {
	/* List[i] = Start + (Step * index) */
	if (arithSeriesRepPtr->isDouble) {
	    *elemObj = Tcl_NewDoubleObj(ArithSeriesIndexM(arithSeriesRepPtr, index));
	} else {
	    *elemObj = Tcl_NewWideIntObj(ArithSeriesIndexM(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.
 *----------------------------------------------------------------------
 */
/*

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

    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 --
 * Tcl_NewArithSeriesObj --
 *
 *	Returns the element with the specified index in the list
 *	represented by the specified Arithmetic Sequence object.
 *	Creates a new ArithSeries object. The returned object has
 *	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.
 *	refcount = 0.
 *
 * Results:
 *
 * 	TCL_OK on success, TCL_ERROR on index out of range.
 *
 * Side Effects:
 *
 * 	On success, the integer pointed by *element is modified.
 *
 *----------------------------------------------------------------------
 */

 * 	A Tcl_Obj pointer to the created ArithSeries object.
int
TclArithSeriesObjIndex(Tcl_Obj *arithSeriesPtr, Tcl_WideInt index, Tcl_Obj **elementObj)
{
    ArithSeries *arithSeriesRepPtr;

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

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

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

static void
FreeArithSeriesInternalRep(Tcl_Obj *arithSeriesPtr)
{
    ArithSeries *arithSeriesRepPtr =
	    (ArithSeries *) arithSeriesPtr->internalRep.twoPtrValue.ptr1;
    if (arithSeriesRepPtr->elements) {
	Tcl_WideInt i;
	Tcl_Obj**elmts = arithSeriesRepPtr->elements;
	for(i=0; i<arithSeriesRepPtr->len; i++) {
	    if (elmts[i]) {
		Tcl_DecrRefCount(elmts[i]);
	    }
	}
	ckfree((char *) arithSeriesRepPtr->elements);
    }
    ckfree((char *) arithSeriesRepPtr);
    arithSeriesPtr->internalRep.twoPtrValue.ptr1 = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * DupArithSeriesInternalRep --
 *
 *	Initialize the internal representation of a arithseries Tcl_Obj to a
 *	copy of the internal representation of an existing arithseries object.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	We set "copyPtr"s internal rep to a pointer to a
 *	newly allocated ArithSeries structure.
 *----------------------------------------------------------------------
 */

static void
DupArithSeriesInternalRep(
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
{
    ArithSeries *srcArithSeriesRepPtr =
	    (ArithSeries *) srcPtr->internalRep.twoPtrValue.ptr1;
    ArithSeries *copyArithSeriesRepPtr;

    /*
     * Allocate a new ArithSeries structure. */

    copyArithSeriesRepPtr = (ArithSeries*) ckalloc(sizeof(ArithSeries));
    *copyArithSeriesRepPtr = *srcArithSeriesRepPtr;
    copyArithSeriesRepPtr->elements = NULL;
    copyPtr->internalRep.twoPtrValue.ptr1 = copyArithSeriesRepPtr;
    copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
    copyPtr->typePtr = &tclArithSeriesType;
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfArithSeries --
 *
 *	Update the string representation for an arithseries object.
 *	Note: This procedure does not invalidate an existing old string rep
 *	so storage will be lost if this has not already been done.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The object's string is set to a valid string that results from
 *	the list-to-string conversion. This string will be empty if the
 *	list has no elements. The list internal representation
 *	should not be NULL and we assume it is not NULL.
 *
 * Notes:
 * 	At the cost of overallocation it's possible to estimate
 * 	the length of the string representation and make this procedure
 * 	much faster. Because the programmer shouldn't expect the
 * 	string conversion of a big arithmetic sequence to be fast
 * 	this version takes more care of space than time.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateStringOfArithSeries(Tcl_Obj *arithSeriesPtr)
{
    ArithSeries *arithSeriesRepPtr =
	    (ArithSeries*) arithSeriesPtr->internalRep.twoPtrValue.ptr1;
    char *elem, *p;
    Tcl_Obj *elemObj;
    Tcl_WideInt i;
    Tcl_WideInt length = 0;
    int slen;

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

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

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

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

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

Tcl_Obj *
TclArithSeriesObjCopy(
Tcl_NewArithSeriesObj(Tcl_Size objc, Tcl_Obj * const objv[])
    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;
    Tcl_Obj *arithSeriesObj;
    ArithSeries *arithSeriesRepPtr;

    if (objc != 4) return NULL;
    ArithSeriesGetInternalRep(arithSeriesPtr, arithSeriesRepPtr);
    if (NULL == arithSeriesRepPtr) {
	if (SetArithSeriesFromAny(interp, arithSeriesPtr) != TCL_OK) {
    // 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) {
	    /* We know this is going to panic, but it's the message we want */
	    return NULL;
	}
        arithSeriesObj = NULL;
    }
    }

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

 * Side effects:
 *	?The possible conversion of the object referenced by listPtr?
 *	?to a list object.?
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
int
TclArithSeriesObjRange(
    Tcl_Interp *interp,         /* For error message(s) */
    Tcl_Interp *interp,         /* for error messages. */
    Tcl_Obj *arithSeriesPtr,	/* List object to take a range from. */
    int fromIdx,		/* Index of first element to include. */
    int toIdx)			/* Index of last element to include. */
    Tcl_WideInt fromIdx,	/* Index of first element to include. */
    Tcl_WideInt toIdx,		/* Index of last element to include. */
    Tcl_Obj **newObjPtr)        /* return value */
{
    ArithSeries *arithSeriesRepPtr;
    Tcl_Obj *startObj, *endObj, *stepObj;

    (void)interp; /* silence compiler */
    ArithSeriesGetInternalRep(arithSeriesPtr, arithSeriesRepPtr);

    arithSeriesRepPtr = (ArithSeries *)Tcl_AbstractListGetConcreteRep(arithSeriesPtr);

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

    if (TclArithSeriesObjIndex(arithSeriesPtr, fromIdx, &startObj) != TCL_OK) {
    TclArithSeriesObjIndex(NULL, arithSeriesPtr, fromIdx, &startObj);
	if (interp) {
	    Tcl_SetObjResult(
		interp,
		Tcl_ObjPrintf("index %d 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) {
    TclArithSeriesObjIndex(NULL, arithSeriesPtr, toIdx, &endObj);
	if (interp) {
	    Tcl_SetObjResult(
		interp,
		Tcl_ObjPrintf("index %d 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,
        int status = TclNewArithSeriesObj(NULL, newObjPtr,
		         arithSeriesRepPtr->isDouble, startObj, endObj, stepObj, NULL);
		stepObj, NULL) != TCL_OK) {
	    newSlicePtr = NULL;
	}
	Tcl_DecrRefCount(startObj);
	Tcl_DecrRefCount(endObj);
	Tcl_DecrRefCount(stepObj);
	return newSlicePtr;

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

    /*
     * In-place is possible.
     */

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

    TclInvalidateStringRep(arithSeriesPtr);

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

	arithSeriesRepPtr->elements = NULL;
    }

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

    return arithSeriesPtr;
    *newObjPtr = 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 **)ckalloc(sizeof(Tcl_Obj*) * objc);
		if (objv == NULL) {
		    if (interp) {
			Tcl_SetObjResult(
			    interp,
			    Tcl_NewStringObj("max length of a Tcl list exceeded", -1));
			Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		    }
		    return TCL_ERROR;
		}
		arithSeriesRepPtr->elements = objv;
		for (i = 0; i < objc; i++) {
		    if (TclArithSeriesObjIndex(objPtr, i, &objv[i]) != TCL_OK) {
			if (interp) {
			    Tcl_SetObjResult(
				interp,
				Tcl_NewStringObj("indexing error", -1));
			    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
			}
			return TCL_ERROR;
		    }
		    Tcl_IncrRefCount(objv[i]);
		}
	    }
	} else {
	    objv = NULL;
	}
	*objvPtr = objv;
	*objcPtr = objc;
    } else {
	if (interp != NULL) {
	    Tcl_SetObjResult(
		interp,
		Tcl_ObjPrintf("value is not an arithseries"));
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "UNKNOWN", NULL);
	}
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclArithSeriesObjReverse --
 *  Handle ArithSeries special case - don't shimmer a series into a list
 *
 *	Reverse the order of the ArithSeries value.
 *  just to reverse it.
 *      *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.?
 *
 *----------------------------------------------------------------------
 */

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

    (void)interp;
    ArithSeriesGetInternalRep(arithSeriesPtr, arithSeriesRepPtr);

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

    arithSeriesRepPtr = (ArithSeries *)Tcl_AbstractListGetConcreteRep(arithSeriesPtr);

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

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

    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(interp, &resultObj,
		 isDouble, startObj, endObj, stepObj, lenObj) != TCL_OK) {
	    resultObj = NULL;
	}
	Tcl_DecrRefCount(lenObj);
	if (TclNewArithSeriesObj(NULL, &resultObj, isDouble,
                                 startObj, endObj, stepObj, lenObj) != TCL_OK) {
            resultObj = NULL;
        }
        Tcl_DecrRefCount(lenObj);
    } else {

	/*
	 * In-place is possible.
	 */

	TclInvalidateStringRep(arithSeriesPtr);

	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 **)ckalloc(sizeof(Tcl_Obj*) * objc);
	if (objv == NULL) {
	    if (interp) {
		Tcl_SetObjResult(
		    interp,
		    Tcl_NewStringObj("max length of a Tcl list exceeded", -1));
		Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	    }
	    return TCL_ERROR;
	}
	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 resultObj;
}
	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:
 */

/*
 * 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.
 * 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_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,
MODULE_SCOPE int	TclNewArithSeriesObj(Tcl_Interp *interp, Tcl_Obj **arithSeriesPtr,
			    Tcl_Obj **arithSeriesObj, int useDoubles,
			    Tcl_Obj *startObj, Tcl_Obj *endObj,
			    Tcl_Obj *stepObj, Tcl_Obj *lenObj);
                            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:
 */

    {"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},
    {"lseq",		Tcl_LseqObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"lset",		Tcl_LsetObjCmd,		TclCompileLsetCmd,	NULL,	CMD_IS_SAFE},
    {"lsort",		Tcl_LsortObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"ledit",		Tcl_LeditObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"package",		Tcl_PackageObjCmd,	NULL,			TclNRPackageObjCmd,	CMD_IS_SAFE},
    {"proc",		Tcl_ProcObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"regexp",		Tcl_RegexpObjCmd,	TclCompileRegexpCmd,	NULL,	CMD_IS_SAFE},
    {"regsub",		Tcl_RegsubObjCmd,	TclCompileRegsubCmd,	NULL,	CMD_IS_SAFE},

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

		(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 (TclHasInternalRep(objv[2+i*2],&tclAbstractListType)) {
	    /* Special case for Abstract List */
	    statePtr->aCopyList[i] = Tcl_AbstractListObjCopy(interp, objv[2+i*2]);
	    if (statePtr->aCopyList[i] == NULL) {
		result = TCL_ERROR;
		goto done;
	    }
	    /* Don't compute values here, wait until the last momement */
	    statePtr->argcList[i] = TclArithSeriesObjLength(statePtr->aCopyList[i]);
	    statePtr->argcList[i] = Tcl_AbstractListObjLength(statePtr->aCopyList[i]);
	} else {
	    /* List values */
	    statePtr->aCopyList[i] = TclListObjCopy(interp, objv[2+i*2]);
	    if (statePtr->aCopyList[i] == NULL) {
		result = TCL_ERROR;
		goto done;
	    }
	    TclListObjGetElementsM(NULL, statePtr->aCopyList[i],
		&statePtr->argcList[i], &statePtr->argvList[i]);
		    &statePtr->argcList[i], &statePtr->argvList[i]);
	}
	/* account for variable <> value mismatch */
	j = statePtr->argcList[i] / statePtr->varcList[i];
	if ((statePtr->argcList[i] % statePtr->varcList[i]) != 0) {
	    j++;
	}
	if (j > statePtr->maxj) {

    Tcl_Interp *interp,
    struct ForeachState *statePtr)
{
    int i, v, k;
    Tcl_Obj *valuePtr, *varValuePtr;

    for (i=0 ; i<statePtr->numLists ; i++) {
	int isAbstractList =
	int isarithseries = TclHasInternalRep(statePtr->aCopyList[i],&tclArithSeriesType);
	    TclHasInternalRep(statePtr->aCopyList[i],&tclAbstractListType);

	for (v=0 ; v<statePtr->varcList[i] ; v++) {
	    k = statePtr->index[i]++;
	    if (k < statePtr->argcList[i]) {
		if (isarithseries) {
		    if (TclArithSeriesObjIndex(statePtr->aCopyList[i], k, &valuePtr) != TCL_OK) {
		if (isAbstractList) {
		    if (Tcl_AbstractListObjIndex(interp, statePtr->aCopyList[i], k, &valuePtr)
                        != TCL_OK) {
			Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
			"\n    (setting %s loop variable \"%s\")",
			(statePtr->resultList != NULL ? "lmap" : "foreach"),
			TclGetString(statePtr->varvList[i][v])));
			    "\n    (setting %s loop variable \"%s\")",
			    (statePtr->resultList != NULL ? "lmap" : "foreach"),
			    TclGetString(statePtr->varvList[i][v])));
			return TCL_ERROR;
		    }
		} else {
		    valuePtr = statePtr->argvList[i][k];
		}
	    } else {
		TclNewObj(valuePtr);	/* Empty string */

 * 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 "tclArithSeries.h"
#include <math.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.
 */

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

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

int
Tcl_JoinObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    int length, listLen, isArithSeries = 0;
    int 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 (TclHasInternalRep(objv[1],&tclArithSeriesType)) {
    if (TclAbstractListHasProc(objv[1], TCL_ABSL_GETELEMENTS)) {
	isArithSeries = 1;
	listLen = TclArithSeriesObjLength(objv[1]);
    } else {
	if (TclListObjGetElementsM(interp, objv[1], &listLen,
	    &elemPtrs) != TCL_OK) {
	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 (isArithSeries) {
	    Tcl_Obj *valueObj;
	    if (TclArithSeriesObjIndex(objv[1], 0, &valueObj) != TCL_OK) {
		return TCL_ERROR;
	    }
	    Tcl_SetObjResult(interp, valueObj);
	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);
	} else {
	    Tcl_SetObjResult(interp, elemPtrs[0]);
	}
	return TCL_OK;
    }

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

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

	TclNewObj(resObjPtr);
	if (isArithSeries) {
	    Tcl_Obj *valueObj;
	    for (i = 0;  i < listLen;  i++) {
		if (i > 0) {
	for (i = 0;  i < listLen;  i++) {
	    if (i > 0) {

		    /*
		     * NOTE: This code is relying on Tcl_AppendObjToObj() **NOT**
		     * to shimmer joinObjPtr.  If it did, then the case where
		     * objv[1] and objv[2] are the same value would not be safe.
		     * Accessing elemPtrs would crash.
		     */
		/*
		 * NOTE: This code is relying on Tcl_AppendObjToObj() **NOT**
		 * to shimmer joinObjPtr.  If it did, then the case where
		 * objv[1] and objv[2] are the same value would not be safe.
		 * Accessing elemPtrs would crash.
		 */

		    Tcl_AppendObjToObj(resObjPtr, joinObjPtr);
		}
		Tcl_AppendObjToObj(resObjPtr, joinObjPtr);
	    }
		if (TclArithSeriesObjIndex(objv[1], i, &valueObj) != TCL_OK) {
		    return TCL_ERROR;
		}
		Tcl_AppendObjToObj(resObjPtr, valueObj);
		Tcl_DecrRefCount(valueObj);
	    }
	} else {
	    for (i = 0;  i < listLen;  i++) {
		if (i > 0) {

		    /*
		     * NOTE: This code is relying on Tcl_AppendObjToObj() **NOT**
		     * to shimmer joinObjPtr.  If it did, then the case where
		     * objv[1] and objv[2] are the same value would not be safe.
		     * Accessing elemPtrs would crash.
		     */

		    Tcl_AppendObjToObj(resObjPtr, joinObjPtr);
		}
		Tcl_AppendObjToObj(resObjPtr, elemPtrs[i]);
	    Tcl_AppendObjToObj(resObjPtr, elemPtrs[i]);
	    }
	}
    }
    Tcl_DecrRefCount(joinObjPtr);
    if (resObjPtr) {
	Tcl_SetObjResult(interp, resObjPtr);
	return TCL_OK;
    }

    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);
    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);
	} else {
	    return TCL_ERROR;
	}
	return status;
    } else {
	Tcl_SetObjResult(interp, TclListObjRange(objv[1], first, last));
    }
    return TCL_OK;
}

/*

    Tcl_Obj **elemv;
    int 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.
     *  Handle AbstractList special case - do not shimmer into a list, if it
     *  supports a private Reverse function, just to reverse it.
     */
    if (TclHasInternalRep(objv[1],&tclArithSeriesType)) {
	Tcl_Obj *resObj = TclArithSeriesObjReverse(interp, objv[1]);
	if (resObj) {
	    Tcl_SetObjResult(interp, resObj);
    if (TclAbstractListHasProc(objv[1], TCL_ABSL_REVERSE)) {
	Tcl_Obj *resultObj;

	if (Tcl_AbstractListObjReverse(interp, objv[1], &resultObj) == TCL_OK) {
	    Tcl_SetObjResult(interp, resultObj);
	    return TCL_OK;
	} else {
	    return TCL_ERROR;
	}
    } /* end ArithSeries */
    } /* end Abstract List */

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

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

	Tcl_DecrRefCount(startPtr);
    }
    if (allocatedIndexVector) {
	TclStackFree(interp, sortInfo.indexv);
    }
    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(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 {
	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)
 *

     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;
    void *clientData;
    } *nvalue;

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

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

     */
    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 */
/*    lseq n */
    case 1:
	start = zero;
	elementCount = numValues[0];
	end = NULL;
	step = one;
	break;

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

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

/*    range n 'to' n    */
/*    range n 'count' n */
/*    range n 'by' n    */
/*    lseq n 'to' n    */
/*    lseq n 'count' n */
/*    lseq n 'by' n    */
    case 121:
	opmode = (SequenceOperators)values[1];
	switch (opmode) {
	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 */
/*    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 */
	    status = TCL_ERROR;
	    goto done;
	    break;
	default:
	    status = TCL_ERROR;
	    goto done;
	    break;
	}
	break;

/*    range n n 'by' n */
/*    lseq n n 'by' n */
    case 1121:
	start = numValues[0];
	end = numValues[1];
	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 */
/*    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:
	    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,
    status = TclNewArithSeriesObj(interp, &arithSeriesPtr, useDoubles, start, end, step, elementCount);
		  useDoubles, start, end, step, elementCount);

    if (status == TCL_OK) {
	Tcl_SetObjResult(interp, arithSeriesPtr);
        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

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

				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_WideInt index,
				Tcl_Obj **elemObjPtr);
/* 688 */
EXTERN int		Tcl_AbstractListObjRange(Tcl_Interp *interp,
				Tcl_Obj *abstractListPtr,
				Tcl_WideInt fromIdx, Tcl_WideInt 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, int *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;

    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_WideInt index, Tcl_Obj **elemObjPtr); /* 687 */
    int (*tcl_AbstractListObjRange) (Tcl_Interp *interp, Tcl_Obj *abstractListPtr, Tcl_WideInt fromIdx, Tcl_WideInt 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, int *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

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

#undef TclUnusedStubEntry
#if defined(USE_TCL_STUBS)

 * 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 "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

	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);
	/* special case for AbstractList */
	if (TclHasInternalRep(valuePtr,&tclAbstractListType)) {
	    length = Tcl_AbstractListObjLength(valuePtr);
	    if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) {
		CACHE_STACK_INFO();
		TRACE_ERROR(interp);
		goto gotError;
	    }
	    if (TclArithSeriesObjIndex(valuePtr, index, &objResultPtr) != TCL_OK) {
	    if (Tcl_AbstractListObjIndex(interp, valuePtr, index, &objResultPtr)!=TCL_OK) {
		CACHE_STACK_INFO();
		TRACE_ERROR(interp);
		goto gotError;
	    }
	    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();

	 * 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 ArithSeries */
	if (TclHasInternalRep(valuePtr,&tclArithSeriesType)) {
	    length = TclArithSeriesObjLength(valuePtr);
	/* special case for AbstractList */
	if (TclHasInternalRep(valuePtr,&tclAbstractListType)) {
	    length = Tcl_AbstractListObjLength(valuePtr);

	    /* Decode end-offset index values. */

	    index = TclIndexDecode(opnd, length-1);

	    /* Compute value @ index */
	    if (index >= 0 && index < length) {
		if (TclArithSeriesObjIndex(valuePtr, index, &objResultPtr) != 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;
	    }
	    } else {
		TclNewObj(objResultPtr);
	    }

	    pcAdjustment = 5;
	    goto lindexFastPath2;
	}

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

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

	/* Decode end-offset index values. */

	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,
	    objResultPtr = TclLsetFlat(interp, valuePtr, numIndices,
		&OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS);
	}
	if (!objResultPtr) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}

	/*
	 * Set result.

	 */
	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 (TclAbstractListHasProc(valuePtr, TCL_ABSL_SLICE)) {
	    if (Tcl_AbstractListObjRange(interp, valuePtr, fromIdx, toIdx, &objResultPtr) != TCL_OK) {
	    if (objResultPtr == NULL) {
		TRACE_ERROR(interp);
		goto gotError;
	    }
	} else {
	    objResultPtr = TclListObjRange(valuePtr, fromIdx, toIdx);
	}

	    TRACE_ERROR(interp);
	    goto gotError;
	}
	match = 0;
	if (length > 0) {
	    int i = 0;
	    Tcl_Obj *o;
	    int isArithSeries = TclHasInternalRep(value2Ptr,&tclArithSeriesType);
	    int isAbstractList = TclHasInternalRep(value2Ptr,&tclAbstractListType);

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

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

	if (*pc == INST_LIST_NOT_IN) {

    (((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] */

MODULE_SCOPE const Tcl_ObjType tclBignumType;
MODULE_SCOPE const Tcl_ObjType tclBooleanType;
MODULE_SCOPE const Tcl_ObjType tclByteArrayType;
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 tclDictType;
MODULE_SCOPE const Tcl_ObjType tclAbstractListType;
MODULE_SCOPE const Tcl_ObjType tclProcBodyType;
MODULE_SCOPE const Tcl_ObjType tclStringType;
MODULE_SCOPE const Tcl_ObjType tclUniCharStringType;
MODULE_SCOPE const Tcl_ObjType tclEnsembleCmdType;
MODULE_SCOPE const Tcl_ObjType tclRegexpType;
MODULE_SCOPE Tcl_ObjType tclCmdNameType;

#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 increment a namespace's export epoch
 * counter. The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE void	TclInvalidateNsCmdLookup(Namespace *nsPtr);

 */

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

/*
 * 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"
#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?
 */

    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 (TclHasInternalRep(listObj,&tclAbstractListType)) {
	    return Tcl_AbstractListObjCopy(interp, listObj);
	}
	if (SetListFromAny(interp, listObj) != TCL_OK) {
	    return NULL;
	}
    }

    TclNewObj(copyObj);

    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 (TclAbstractListHasProc(objPtr, TCL_ABSL_GETELEMENTS) &&
	Tcl_AbstractListObjGetElements(interp, objPtr, objcPtr, objvPtr) == TCL_OK) {
    }

    if (TclListObjGetRep(interp, objPtr, &listRep) != TCL_OK)
	return TCL_ERROR;
	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;
}

/*
 *----------------------------------------------------------------------
 *

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,&tclArithSeriesType)) {
	*lenPtr = TclArithSeriesObjLength(listObj);
    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

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

    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);
    /* 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) {
		TclArithSeriesObjIndex(listObj, index, &elemObj);
		if (Tcl_AbstractListObjIndex(interp, listObj, index, &elemObj) != TCL_OK) {
		    return NULL;
		}
	    } else if (index > 0) {
		// TODO: support nested lists
		/* ArithSeries cannot be a list of lists */
		// For now, only support 1 index, which is all an ArithSeries has
		Tcl_DecrRefCount(elemObj);
		TclNewObj(elemObj);
		break;
	    }
	}
	Tcl_IncrRefCount(elemObj);
	return elemObj;