Reference implementation of TIP's #22, #33 and #45. Adds the

	ability of the [lindex] command to have multiple index arguments,
	and adds the [lset] command.  Both commands are byte-code compiled.
	[Patch #471874] (work by Kenny, commited by Hobbs)

1 files changed, 384 insertions, 30 deletions

diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index b3461f9..cf8681d 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -10,11 +10,12 @@
  * Copyright (c) 1993-1997 Lucent Technologies.
  * Copyright (c) 1994-1997 Sun Microsystems, Inc.
  * Copyright (c) 1998-1999 by Scriptics Corporation.
+ * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdIL.c,v 1.35 2001/10/01 15:31:51 msofer Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.36 2001/11/14 23:17:03 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -2003,61 +2004,334 @@ Tcl_LindexObjCmd(dummy, interp, objc, objv)
     int objc;			/* Number of arguments. */
     Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
-    Tcl_Obj *listPtr;
-    Tcl_Obj **elemPtrs;
-    int listLen, index, result;
 
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "list index");
+    Tcl_Obj *elemPtr;		/* Pointer to the element being extracted */
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "list ?index...?");
 	return TCL_ERROR;
     }
 
     /*
-     * Convert the first argument to a list if necessary.
+     * If objc == 3, then objv[ 2 ] may be either a single index or
+     * a list of indices: go to TclLindexList to determine which.
+     * If objc >= 4, or objc == 2, then objv[ 2 .. objc-2 ] are all
+     * single indices and processed as such in TclLindexFlat.
      */
 
-    listPtr = objv[1];
-    result = Tcl_ListObjGetElements(interp, listPtr, &listLen, &elemPtrs);
-    if (result != TCL_OK) {
-	return result;
-    }
+    if ( objc == 3 ) {
+
+	elemPtr = TclLindexList( interp, objv[ 1 ], objv[ 2 ] );
+
+    } else {
 
+	elemPtr = TclLindexFlat( interp, objv[ 1 ], objc-2, objv+2 );
+
+    }
+	
     /*
-     * Get the index from objv[2].
+     * Set the interpreter's object result to the last element extracted
      */
 
-    result = TclGetIntForIndex(interp, objv[2], /*endValue*/ (listLen - 1),
-	    &index);
-    if (result != TCL_OK) {
-	return result;
+    if ( elemPtr == NULL ) {
+	return TCL_ERROR;
+    } else {
+	Tcl_SetObjResult(interp, elemPtr);
+	Tcl_DecrRefCount( elemPtr );
+	return TCL_OK;
     }
-    if ((index < 0) || (index >= listLen)) {
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLindexList --
+ *
+ *	This procedure handles the 'lindex' command when objc==3.
+ *
+ * Results:
+ *	Returns a pointer to the object extracted, or NULL if an
+ *	error occurred.
+ *
+ * Side effects:
+ *	None.
+ *
+ * If objv[1] can be parsed as a list, TclLindexList handles extraction
+ * of the desired element locally.  Otherwise, it invokes
+ * TclLindexFlat to treat objv[1] as a scalar.
+ *
+ * The reference count of the returned object includes one reference
+ * corresponding to the pointer returned.  Thus, the calling code will
+ * usually do something like:
+ *	Tcl_SetObjResult( interp, result );
+ *	Tcl_DecrRefCount( result );
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclLindexList( interp, listPtr, argPtr )
+    Tcl_Interp* interp;		/* Tcl interpreter */
+    Tcl_Obj* listPtr;		/* List being unpacked */
+    Tcl_Obj* argPtr;		/* Index or index list */
+{
+
+    Tcl_Obj **elemPtrs;		/* Elements of the list being manipulated. */
+    int listLen;		/* Length of the list being manipulated. */
+    int index;			/* Index into the list */
+    int result;			/* Result returned from a Tcl library call */
+    int i;			/* Current index number */
+    Tcl_Obj** indices;		/* Array of list indices */
+    int indexCount;		/* Size of the array of list indices */
+    Tcl_Obj* oldListPtr;	/* Temp location to preserve the list
+				 * pointer when replacing it with a sublist */
+
+    /*
+     * Determine whether argPtr designates a list or a single index.
+     * We have to be careful about the order of the checks to avoid
+     * repeated shimmering; see TIP#22 and TIP#33 for the details.
+     */
+
+    if ( argPtr->typePtr != &tclListType 
+	 && TclGetIntForIndex( NULL , argPtr, 0, &index ) == TCL_OK ) {
+
 	/*
-	 * The index is out of range: the result is an empty string object.
+	 * argPtr designates a single index.
+	 */
+
+	return TclLindexFlat( interp, listPtr, 1, &argPtr );
+
+    } else if ( Tcl_ListObjGetElements( NULL, argPtr, &indexCount, &indices )
+		!= TCL_OK ) {
+
+	/*
+	 * argPtr designates something that is neither an index nor a
+	 * well-formed list.  Report the error via TclLindexFlat.
 	 */
 	
-	return TCL_OK;
+	return TclLindexFlat( interp, listPtr, 1, &argPtr );
     }
 
     /*
-     * Make sure listPtr still refers to a list object. It might have been
-     * converted to an int above if the argument objects were shared.
+     * Record the reference to the list that we are maintaining in
+     * the activation record.
      */
 
-    if (listPtr->typePtr != &tclListType) {
-	result = Tcl_ListObjGetElements(interp, listPtr, &listLen,
-	        &elemPtrs);
+    Tcl_IncrRefCount( listPtr );
+
+    /*
+     * argPtr designates a list, and the 'else if' above has parsed it
+     * into indexCount and indices.
+     */
+
+    for ( i = 0; i < indexCount; ++i ) {
+
+	/*
+	 * Convert the current listPtr to a list if necessary.
+	 */
+	    
+	result = Tcl_ListObjGetElements( interp, listPtr,
+					 &listLen, &elemPtrs);
 	if (result != TCL_OK) {
-	    return result;
+	    Tcl_DecrRefCount( listPtr );
+	    return NULL;
 	}
-    }
+	    
+	/*
+	 * Get the index from indices[ i ]
+	 */
+	
+	result = TclGetIntForIndex( interp, indices[ i ],
+				    /*endValue*/ (listLen - 1),
+				    &index );
+	if ( result != TCL_OK ) {
+	    /*
+	     * Index could not be parsed
+	     */
+
+	    Tcl_DecrRefCount( listPtr );
+	    return NULL;
+
+	} else if ( index < 0
+		    || index >= listLen ) {
+	    /*
+	     * Index is out of range
+	     */
+	    Tcl_DecrRefCount( listPtr );
+	    listPtr = Tcl_NewObj();
+	    Tcl_IncrRefCount( listPtr );
+	    return listPtr;
+	}
+	
+	/*
+	 * Make sure listPtr still refers to a list object.
+	 * If it shared a Tcl_Obj structure with the arguments, then
+	 * it might have just been converted to something else.
+	 */
+	
+	if (listPtr->typePtr != &tclListType) {
+	    result = Tcl_ListObjGetElements(interp, listPtr, &listLen,
+					    &elemPtrs);
+	    if (result != TCL_OK) {
+		Tcl_DecrRefCount( listPtr );
+		return NULL;
+	    }
+	}
+	
+	/*
+	 * Extract the pointer to the appropriate element
+	 */
+	
+	oldListPtr = listPtr;
+	listPtr = elemPtrs[ index ];
+	Tcl_IncrRefCount( listPtr );
+	Tcl_DecrRefCount( oldListPtr );
+	
+	/*
+	 * The work we did above may have caused the internal rep
+	 * of *argPtr to change to something else.  Get it back.
+	 */
+	
+	result = Tcl_ListObjGetElements( interp, argPtr,
+					 &indexCount, &indices );
+	if ( result != TCL_OK ) {
+	    /* 
+	     * This can't happen unless some extension corrupted a Tcl_Obj.
+	     */
+	    Tcl_DecrRefCount( listPtr );
+	    return NULL;
+	}
+	
+    } /* end for */
 
     /*
-     * Set the interpreter's object result to the index-th list element.
+     * Return the last object extracted.  Its reference count will include
+     * the reference being returned.
      */
 
-    Tcl_SetObjResult(interp, elemPtrs[index]);
-    return TCL_OK;
+    return listPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLindexFlat --
+ *
+ *	This procedure handles the 'lindex' command, given that the
+ *	arguments to the command are known to be a flat list.
+ *
+ * Results:
+ *	Returns a standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ * This procedure is called from either tclExecute.c or
+ * Tcl_LindexObjCmd whenever either is presented with
+ * objc == 2 or objc >= 4.  It is also called from TclLindexList
+ * for the objc==3 case once it is determined that objv[2] cannot
+ * be parsed as a list.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclLindexFlat( interp, listPtr, indexCount, indexArray )
+    Tcl_Interp* interp;		/* Tcl interpreter */
+    Tcl_Obj* listPtr;		/* Tcl object representing the list */
+    int indexCount;		/* Count of indices */
+    Tcl_Obj* CONST indexArray[];
+				/* Array of pointers to Tcl objects
+				 * representing the indices in the
+				 * list */
+{
+
+    int i;			/* Current list index */
+    int result;			/* Result of Tcl library calls */
+    int listLen;		/* Length of the current list being 
+				 * processed */
+    Tcl_Obj** elemPtrs;		/* Array of pointers to the elements
+				 * of the current list */
+    int index;			/* Parsed version of the current element
+				 * of indexArray  */
+    Tcl_Obj* oldListPtr;	/* Temporary to hold listPtr so that
+				 * its ref count can be decremented. */
+
+    /*
+     * Record the reference to the 'listPtr' object that we are
+     * maintaining in the C activation record.
+     */
+
+    Tcl_IncrRefCount( listPtr );
+
+    for ( i = 0; i < indexCount; ++i ) {
+
+	/*
+	 * Convert the current listPtr to a list if necessary.
+	 */
+	
+	result = Tcl_ListObjGetElements(interp, listPtr,
+					&listLen, &elemPtrs);
+	if (result != TCL_OK) {
+	    Tcl_DecrRefCount( listPtr );
+	    return NULL;
+	}
+	
+	/*
+	 * Get the index from objv[i]
+	 */
+	
+	result = TclGetIntForIndex( interp, indexArray[ i ],
+				    /*endValue*/ (listLen - 1),
+				    &index );
+	if ( result != TCL_OK ) {
+
+	    /* Index could not be parsed */
+
+	    Tcl_DecrRefCount( listPtr );
+	    return NULL;
+
+	} else if ( index < 0
+		    || index >= listLen ) {
+	    
+	    /*
+	     * Index is out of range
+	     */
+		
+	    Tcl_DecrRefCount( listPtr );
+	    listPtr = Tcl_NewObj();
+	    Tcl_IncrRefCount( listPtr );
+	    return listPtr;
+	}
+	    
+	/*
+	 * Make sure listPtr still refers to a list object.
+	 * It might have been converted to something else above
+	 * if objv[1] overlaps with one of the other parameters.
+	 */
+	
+	if (listPtr->typePtr != &tclListType) {
+	    result = Tcl_ListObjGetElements(interp, listPtr, &listLen,
+					    &elemPtrs);
+	    if (result != TCL_OK) {
+		Tcl_DecrRefCount( listPtr );
+		return NULL;
+	    }
+	}
+	
+	/*
+	 * Extract the pointer to the appropriate element
+	 */
+	
+	oldListPtr = listPtr;
+	listPtr = elemPtrs[ index ];
+	Tcl_IncrRefCount( listPtr );
+	Tcl_DecrRefCount( oldListPtr );
+	
+    }
+
+    return listPtr;
+
 }
 
 /*
@@ -2721,6 +2995,86 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
 /*
  *----------------------------------------------------------------------
  *
+ * 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( clientData, interp, objc, objv )
+    ClientData clientData;	/* Not used. */
+    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 ], (Tcl_Obj*) 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;
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_LsortObjCmd --
  *
  *	This procedure is invoked to process the "lsort" Tcl command.