summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tcl.h8
-rw-r--r--generic/tclAbstractList.c73
-rw-r--r--generic/tclAbstractList.h7
-rwxr-xr-xgeneric/tclArithSeries.c3
-rw-r--r--generic/tclInt.h65
-rw-r--r--generic/tclListObj.c5
6 files changed, 130 insertions, 31 deletions
diff --git a/generic/tcl.h b/generic/tcl.h
index 203cfa6..0aaafb5 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -746,11 +746,15 @@ typedef void (Tcl_ALToStringRep) (struct Tcl_Obj *listPtr);
typedef struct Tcl_Obj* (Tcl_ALSetElement) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
struct Tcl_Obj *indicies,
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_TOSTRING, TCL_ABSL_SETELEMENT, TCL_ABSL_REPLACE
} Tcl_AbstractListProcType;
typedef struct Tcl_AbstractListVersion_ *Tcl_AbstractListVersion;
@@ -873,6 +877,8 @@ typedef struct Tcl_AbstractListType {
** 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;
/*
diff --git a/generic/tclAbstractList.c b/generic/tclAbstractList.c
index 209e9ac..12dfe1f 100644
--- a/generic/tclAbstractList.c
+++ b/generic/tclAbstractList.c
@@ -663,6 +663,79 @@ Tcl_AbstractListSetElement(
}
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. */
+ ListSizeT first, /* Index of first element to replace. */
+ ListSizeT numToDelete, /* Number of elements to replace. */
+ ListSizeT 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:
diff --git a/generic/tclAbstractList.h b/generic/tclAbstractList.h
index 1c92b42..824a53d 100644
--- a/generic/tclAbstractList.h
+++ b/generic/tclAbstractList.h
@@ -43,6 +43,13 @@ 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_Obj *indicies, Tcl_Obj *valueObj);
+int Tcl_AbstractListObjReplace(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ Tcl_Obj *listObj, /* List object whose elements to replace. */
+ ListSizeT first, /* Index of first element to replace. */
+ ListSizeT numToDelete, /* Number of elements to replace. */
+ ListSizeT numToInsert, /* Number of objects to insert. */
+ Tcl_Obj *const insertObjs[]); /* Tcl objects to insert */
#endif
diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c
index 445088b..255b0de 100755
--- a/generic/tclArithSeries.c
+++ b/generic/tclArithSeries.c
@@ -80,7 +80,8 @@ static Tcl_AbstractListType arithSeriesType = {
TclArithSeriesGetElements,
FreeArithSeriesRep,
UpdateStringOfArithSeries,
- NULL
+ NULL, // SetElement
+ NULL // Replace
};
/*
diff --git a/generic/tclInt.h b/generic/tclInt.h
index d2ad1af..99ba3cf 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2655,35 +2655,6 @@ AbstractListObjLength(Tcl_Obj* abstractListObjPtr)
return typePtr->lengthProc(abstractListObjPtr);
}
-static inline int
-TclAbstractListHasProc(Tcl_Obj* abstractListObjPtr, Tcl_AbstractListProcType ptype)
-{
- Tcl_AbstractListType *typePtr = 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);
- }
- return 0;
-}
-
/*
* Modes for collecting (or not) in the implementations of TclNRForeachCmd,
* TclNRLmapCmd and their compilations.
@@ -4789,6 +4760,42 @@ MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr);
#define TclFetchInternalRep(objPtr, type) \
(TclHasInternalRep((objPtr), (type)) ? &((objPtr)->internalRep) : NULL)
+static inline int
+TclAbstractListHasProc(Tcl_Obj* abstractListObjPtr, Tcl_AbstractListProcType ptype)
+{
+ Tcl_AbstractListType *typePtr;
+ if ( ! TclHasInternalRep(abstractListObjPtr,&tclAbstractListType)) {
+ return 0;
+ }
+ typePtr = 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;
+}
+
+
/*
*----------------------------------------------------------------
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 5fe3819..f29b120 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -2087,6 +2087,11 @@ Tcl_ListObjReplace(
Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace");
}
+ if (TclAbstractListHasProc(listObj, TCL_ABSL_REPLACE)) {
+ return Tcl_AbstractListObjReplace(interp, listObj, first,
+ numToDelete, numToInsert, insertObjs);
+ }
+
if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK)
return TCL_ERROR; /* Cannot be converted to a list */
generated by cgit v0.12 at 2024-11-17 05:15:11 (GMT)