Speed up [info <thing> <simplePattern>]

6 files changed, 221 insertions, 51 deletions

diff --git a/ChangeLog b/ChangeLog
index d8922af..c3b855c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2004-10-14  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
+
+	* generic/tclUtil.c (TclMatchIsTrivial): Detect degenerate cases
+	of glob matching that let us avoid scanning through hash tables.
+	* generic/tclCmdIL.c (InfoCommandsCmd, InfoGlobalsCmd, InfoProcsCmd):
+	(InfoVarsCmd): Use this to speed up some [info] subcommands.
+
 2004-10-12  Kevin B. Kenny  <kennykb@acm.org>
 
 	* library/tzdata/America/Campo_Grande:
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 7f58df2..2997509 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -15,7 +15,7 @@
  * 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.64 2004/10/06 09:37:46 dkf Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.65 2004/10/14 15:06:01 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -746,6 +746,14 @@ InfoCommandsCmd(dummy, interp, objc, objv)
     }
 
     /*
+     * Exit as quickly as possible if we couldn't find the namespace.
+     */
+
+    if (nsPtr == NULL) {
+	return TCL_OK;
+    }
+
+    /*
      * Scan through the effective namespace's command table and create a
      * list with all commands that match the pattern. If a specific
      * namespace was requested in the pattern, qualify the command names
@@ -754,7 +762,33 @@ InfoCommandsCmd(dummy, interp, objc, objv)
 
     listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
 
-    if (nsPtr != NULL) {
+    if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) {
+	/*
+	 * Special case for when the pattern doesn't include any of
+	 * glob's special characters. This lets us avoid scans of any
+	 * hash tables.
+	 */
+	entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern);
+	if (entryPtr != NULL) {
+	    if (specificNsInPattern) {
+		cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr);
+		elemObjPtr = Tcl_NewObj();
+		Tcl_GetCommandFullName(interp, cmd, elemObjPtr);
+	    } else {
+		cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
+		elemObjPtr = Tcl_NewStringObj(cmdName, -1);
+	    }
+	    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
+	} else if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
+	    entryPtr = Tcl_FindHashEntry(&globalNsPtr->cmdTable,
+		    simplePattern);
+	    if (entryPtr != NULL) {
+		cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
+		Tcl_ListObjAppendElement(interp, listPtr,
+			Tcl_NewStringObj(cmdName, -1));
+	    }
+	}
+    } else {
 	entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
 	while (entryPtr != NULL) {
 	    cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
@@ -1069,17 +1103,25 @@ InfoGlobalsCmd(dummy, interp, objc, objv)
      */
 
     listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
-    for (entryPtr = Tcl_FirstHashEntry(&globalNsPtr->varTable, &search);
-	    entryPtr != NULL;
-	    entryPtr = Tcl_NextHashEntry(&search)) {
-	varPtr = (Var *) Tcl_GetHashValue(entryPtr);
-	if (TclIsVarUndefined(varPtr)) {
-	    continue;
-	}
-	varName = Tcl_GetHashKey(&globalNsPtr->varTable, entryPtr);
-	if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
+    if (pattern != NULL && TclMatchIsTrivial(pattern)) {
+	entryPtr = Tcl_FindHashEntry(&globalNsPtr->varTable, pattern);
+	if (entryPtr != NULL) {
 	    Tcl_ListObjAppendElement(interp, listPtr,
-		    Tcl_NewStringObj(varName, -1));
+		    Tcl_NewStringObj(pattern, -1));
+	}
+    } else {
+	for (entryPtr = Tcl_FirstHashEntry(&globalNsPtr->varTable, &search);
+		entryPtr != NULL;
+		entryPtr = Tcl_NextHashEntry(&search)) {
+	    varPtr = (Var *) Tcl_GetHashValue(entryPtr);
+	    if (TclIsVarUndefined(varPtr)) {
+		continue;
+	    }
+	    varName = Tcl_GetHashKey(&globalNsPtr->varTable, entryPtr);
+	    if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
+		Tcl_ListObjAppendElement(interp, listPtr,
+			Tcl_NewStringObj(varName, -1));
+	    }
 	}
     }
     Tcl_SetObjResult(interp, listPtr);
@@ -1585,6 +1627,10 @@ InfoProcsCmd(dummy, interp, objc, objv)
 	return TCL_ERROR;
     }
 
+    if (nsPtr == NULL) {
+	return TCL_OK;
+    }
+
     /*
      * Scan through the effective namespace's command table and create a
      * list with all procs that match the pattern. If a specific
@@ -1593,7 +1639,33 @@ InfoProcsCmd(dummy, interp, objc, objv)
      */
 
     listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
-    if (nsPtr != NULL) {
+#ifndef INFO_PROCS_SEARCH_GLOBAL_NS
+    if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) {
+	entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern);
+	if (entryPtr != NULL) {
+	    cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
+
+	    if (!TclIsProc(cmdPtr)) {
+		realCmdPtr = (Command *)
+			TclGetOriginalCommand((Tcl_Command) cmdPtr);
+		if (realCmdPtr != NULL && TclIsProc(realCmdPtr)) {
+		    goto simpleProcOK;
+		}
+	    } else {
+	      simpleProcOK:
+		if (specificNsInPattern) {
+		    elemObjPtr = Tcl_NewObj();
+		    Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,
+			    elemObjPtr);
+		} else {
+		    elemObjPtr = Tcl_NewStringObj(simplePattern, -1);
+		}
+		Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
+	    }
+	}
+    } else
+#endif /* !INFO_PROCS_SEARCH_GLOBAL_NS */
+    {
 	entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
 	while (entryPtr != NULL) {
 	    cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
@@ -1601,11 +1673,14 @@ InfoProcsCmd(dummy, interp, objc, objv)
 		    || Tcl_StringMatch(cmdName, simplePattern)) {
 		cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
 
-		realCmdPtr = (Command *)
-		    TclGetOriginalCommand((Tcl_Command) cmdPtr);
-
-		if (TclIsProc(cmdPtr)
-			|| ((realCmdPtr != NULL) && TclIsProc(realCmdPtr))) {
+		if (!TclIsProc(cmdPtr)) {
+		    realCmdPtr = (Command *)
+			    TclGetOriginalCommand((Tcl_Command) cmdPtr);
+		    if (realCmdPtr != NULL && TclIsProc(realCmdPtr)) {
+			goto procOK;
+		    }
+		} else {
+		  procOK:
 		    if (specificNsInPattern) {
 			elemObjPtr = Tcl_NewObj();
 			Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,
@@ -1613,7 +1688,6 @@ InfoProcsCmd(dummy, interp, objc, objv)
 		    } else {
 			elemObjPtr = Tcl_NewStringObj(cmdName, -1);
 		    }
-
 		    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
 		}
 	    }
@@ -1893,54 +1967,91 @@ InfoVarsCmd(dummy, interp, objc, objv)
 	 * only the variables in the effective namespace's variable table.
 	 */
 
-	entryPtr = Tcl_FirstHashEntry(&nsPtr->varTable, &search);
-	while (entryPtr != NULL) {
-	    varPtr = (Var *) Tcl_GetHashValue(entryPtr);
-	    if (!TclIsVarUndefined(varPtr)
-		    || (varPtr->flags & VAR_NAMESPACE_VAR)) {
-		varName = Tcl_GetHashKey(&nsPtr->varTable, entryPtr);
-		if ((simplePattern == NULL)
-			|| Tcl_StringMatch(varName, simplePattern)) {
+	if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) {
+	    /*
+	     * If we can just do hash lookups, that simplifies things
+	     * a lot.
+	     */
+
+	    entryPtr = Tcl_FindHashEntry(&nsPtr->varTable, simplePattern);
+	    if (entryPtr != NULL) {
+		varPtr = (Var *) Tcl_GetHashValue(entryPtr);
+		if (!TclIsVarUndefined(varPtr)
+			|| (varPtr->flags & VAR_NAMESPACE_VAR)) {
 		    if (specificNsInPattern) {
 			elemObjPtr = Tcl_NewObj();
 			Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,
-				elemObjPtr);
+				    elemObjPtr);
 		    } else {
-			elemObjPtr = Tcl_NewStringObj(varName, -1);
+			elemObjPtr = Tcl_NewStringObj(simplePattern, -1);
 		    }
 		    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
 		}
+	    } else if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
+		entryPtr = Tcl_FindHashEntry(&globalNsPtr->varTable,
+			simplePattern);
+		varPtr = (Var *) Tcl_GetHashValue(entryPtr);
+		if (!TclIsVarUndefined(varPtr)
+			|| (varPtr->flags & VAR_NAMESPACE_VAR)) {
+		    Tcl_ListObjAppendElement(interp, listPtr,
+			    Tcl_NewStringObj(simplePattern, -1));
+		}
 	    }
-	    entryPtr = Tcl_NextHashEntry(&search);
-	}
-
-	/*
-	 * If the effective namespace isn't the global :: namespace, and a
-	 * specific namespace wasn't requested in the pattern (i.e., the
-	 * pattern only specifies variable names), then add in all global ::
-	 * variables that match the simple pattern. Of course, add in only
-	 * those variables that aren't hidden by a variable in the effective
-	 * namespace.
-	 */
+	} else {
+	    /*
+	     * Have to scan the tables of variables.
+	     */
 
-	if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
-	    entryPtr = Tcl_FirstHashEntry(&globalNsPtr->varTable, &search);
+	    entryPtr = Tcl_FirstHashEntry(&nsPtr->varTable, &search);
 	    while (entryPtr != NULL) {
 		varPtr = (Var *) Tcl_GetHashValue(entryPtr);
 		if (!TclIsVarUndefined(varPtr)
 			|| (varPtr->flags & VAR_NAMESPACE_VAR)) {
-		    varName = Tcl_GetHashKey(&globalNsPtr->varTable, entryPtr);
+		    varName = Tcl_GetHashKey(&nsPtr->varTable, entryPtr);
 		    if ((simplePattern == NULL)
 			    || Tcl_StringMatch(varName, simplePattern)) {
-			if (Tcl_FindHashEntry(&nsPtr->varTable,
-				varName) == NULL) {
-			    Tcl_ListObjAppendElement(interp, listPtr,
-				    Tcl_NewStringObj(varName, -1));
+			if (specificNsInPattern) {
+			    elemObjPtr = Tcl_NewObj();
+			    Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,				    elemObjPtr);
+			} else {
+			    elemObjPtr = Tcl_NewStringObj(varName, -1);
 			}
+			Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
 		    }
 		}
 		entryPtr = Tcl_NextHashEntry(&search);
 	    }
+
+	    /*
+	     * If the effective namespace isn't the global ::
+	     * namespace, and a specific namespace wasn't requested in
+	     * the pattern (i.e., the pattern only specifies variable
+	     * names), then add in all global :: variables that match
+	     * the simple pattern. Of course, add in only those
+	     * variables that aren't hidden by a variable in the
+	     * effective namespace.
+	     */
+
+	    if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
+		entryPtr = Tcl_FirstHashEntry(&globalNsPtr->varTable, &search);
+		while (entryPtr != NULL) {
+		    varPtr = (Var *) Tcl_GetHashValue(entryPtr);
+		    if (!TclIsVarUndefined(varPtr)
+			    || (varPtr->flags & VAR_NAMESPACE_VAR)) {
+			varName = Tcl_GetHashKey(&globalNsPtr->varTable,
+				entryPtr);
+			if ((simplePattern == NULL)
+				|| Tcl_StringMatch(varName, simplePattern)) {
+			    if (Tcl_FindHashEntry(&nsPtr->varTable,
+				    varName) == NULL) {
+				Tcl_ListObjAppendElement(interp, listPtr,
+					Tcl_NewStringObj(varName, -1));
+			    }
+			}
+		    }
+		    entryPtr = Tcl_NextHashEntry(&search);
+		}
+	    }
 	}
     } else if (((Interp *)interp)->varFramePtr->procPtr != NULL) {
 	AppendLocals(interp, listPtr, simplePattern, 1);
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index e25d521..36b19a8 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -12,7 +12,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 # 
-# RCS: @(#) $Id: tclInt.decls,v 1.80 2004/10/01 12:45:18 dkf Exp $
+# RCS: @(#) $Id: tclInt.decls,v 1.81 2004/10/14 15:06:02 dkf Exp $
 
 library tcl
 
@@ -806,6 +806,10 @@ declare 198 generic {
 	    CallFrame **framePtrPtr)
 }
 
+declare 199 generic {
+    int TclMatchIsTrivial(CONST char *pattern)
+}
+
 ##############################################################################
 
 # Define the platform specific internal Tcl interface. These functions are
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index e620e94..6f80d37 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIntDecls.h,v 1.70 2004/10/01 12:45:19 dkf Exp $
+ * RCS: @(#) $Id: tclIntDecls.h,v 1.71 2004/10/14 15:06:02 dkf Exp $
  */
 
 #ifndef _TCLINTDECLS
@@ -1019,6 +1019,11 @@ EXTERN int		TclCompEvalObj _ANSI_ARGS_((Tcl_Interp * interp,
 EXTERN int		TclObjGetFrame _ANSI_ARGS_((Tcl_Interp * interp, 
 				Tcl_Obj * objPtr, CallFrame ** framePtrPtr));
 #endif
+#ifndef TclMatchIsTrivial_TCL_DECLARED
+#define TclMatchIsTrivial_TCL_DECLARED
+/* 199 */
+EXTERN int		TclMatchIsTrivial _ANSI_ARGS_((CONST char * pattern));
+#endif
 
 typedef struct TclIntStubs {
     int magic;
@@ -1238,6 +1243,7 @@ typedef struct TclIntStubs {
     void (*tclFinalizeThreadStorageDataKey) _ANSI_ARGS_((Tcl_ThreadDataKey * keyPtr)); /* 196 */
     int (*tclCompEvalObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr)); /* 197 */
     int (*tclObjGetFrame) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, CallFrame ** framePtrPtr)); /* 198 */
+    int (*tclMatchIsTrivial) _ANSI_ARGS_((CONST char * pattern)); /* 199 */
 } TclIntStubs;
 
 #ifdef __cplusplus
@@ -1921,6 +1927,10 @@ extern TclIntStubs *tclIntStubsPtr;
 #define TclObjGetFrame \
 	(tclIntStubsPtr->tclObjGetFrame) /* 198 */
 #endif
+#ifndef TclMatchIsTrivial
+#define TclMatchIsTrivial \
+	(tclIntStubsPtr->tclMatchIsTrivial) /* 199 */
+#endif
 
 #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
 
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index e4a28d0..de789c6 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclStubInit.c,v 1.104 2004/10/01 12:45:20 dkf Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.105 2004/10/14 15:06:03 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -283,6 +283,7 @@ TclIntStubs tclIntStubs = {
     TclFinalizeThreadStorageDataKey, /* 196 */
     TclCompEvalObj, /* 197 */
     TclObjGetFrame, /* 198 */
+    TclMatchIsTrivial, /* 199 */
 };
 
 TclIntPlatStubs tclIntPlatStubs = {
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 1a4b841..068a20b 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- *  RCS: @(#) $Id: tclUtil.c,v 1.47 2004/10/06 15:59:25 dgp Exp $
+ *  RCS: @(#) $Id: tclUtil.c,v 1.48 2004/10/14 15:06:03 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -1416,6 +1416,43 @@ Tcl_StringCaseMatch(string, pattern, nocase)
 /*
  *----------------------------------------------------------------------
  *
+ * TclMatchIsTrivial --
+ *
+ *	Test whether a particular glob pattern is a trivial pattern.
+ *	(i.e. where matching is the same as equality testing).
+ *
+ * Results:
+ *	A boolean indicating whether the pattern is free of all of the
+ *	glob special chars.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclMatchIsTrivial(pattern)
+    CONST char *pattern;
+{
+    CONST char *p = pattern;
+
+    while (1) {
+	switch (*p++) {
+	case '\0':
+	    return 1;
+	case '*':
+	case '?':
+	case '[':
+	case '\\':
+	    return 0;
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_DStringInit --
  *
  *	Initializes a dynamic string, discarding any previous contents