* generic/tclBasic.c: Another step down the path of re-using

        * generic/tclCompExpr.c: TclExecuteByteCode to implement the TIP 174
        * generic/tclCompile.h: commands instead of using a mass of code
        * generic/tclMathOp.c:  duplication.  Now all operator commands that
        * tests/mathop.test:    demand exactly one operation are implemented
        via TclSingleOpCmd and a call to TEBC.

6 files changed, 122 insertions, 64 deletions

diff --git a/ChangeLog b/ChangeLog
index 77b92d6..a48d227 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,12 @@
 2006-12-08  Don Porter  <dgp@users.sourceforge.net>
 
+	* generic/tclBasic.c:	 Another step down the path of re-using
+	* generic/tclCompExpr.c: TclExecuteByteCode to implement the TIP 174
+	* generic/tclCompile.h:	commands instead of using a mass of code
+	* generic/tclMathOp.c:	duplication.  Now all operator commands that
+	* tests/mathop.test:	demand exactly one operation are implemented
+	via TclSingleOpCmd and a call to TEBC.
+
 	* generic/tclCompExpr.c: Revised implementation of TclInvertOpCmd
 	* generic/tclMathOp.c:	to perform a bytecode compile / execute
 	sequence.  This demonstrates a path toward avoiding mountains of
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index bef8f10..8c43737 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.227 2006/12/07 16:29:31 dkf Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.228 2006/12/08 20:48:08 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -53,6 +53,7 @@ static char *	CallCommandTraces (Interp *iPtr, Command *cmdPtr,
 		    CONST char *oldName, CONST char* newName, int flags);
 static int	CheckDoubleResult (Tcl_Interp *interp, double dResult);
 static void	DeleteInterpProc (Tcl_Interp *interp);
+static void	DeleteOpCmdClientData(ClientData clientData);
 static void	ProcessUnexpectedResult (Tcl_Interp *interp, int returnCode);
 
 static int	OldMathFuncProc (ClientData clientData, Tcl_Interp *interp,
@@ -270,31 +271,40 @@ static const BuiltinFuncDef BuiltinFuncTable[] = {
  * TIP#174's math operators.
  */
 
-static const CmdInfo mathOpCmds[] = {
-    { "~",  TclInvertOpCmd,  TclCompileInvertOpCmd,   1 },
-    { "!",  TclNotOpCmd,     TclCompileNotOpCmd,      1 },
-    { "+",  TclAddOpCmd,     TclCompileAddOpCmd,      1 },
-    { "*",  TclMulOpCmd,     TclCompileMulOpCmd,      1 },
-    { "&",  TclAndOpCmd,     TclCompileAndOpCmd,      1 },
-    { "|",  TclOrOpCmd,	     TclCompileOrOpCmd,	      1 },
-    { "^",  TclXorOpCmd,     TclCompileXorOpCmd,      1 },
-    { "**", TclPowOpCmd,     TclCompilePowOpCmd,      1 },
-    { "<<", TclLshiftOpCmd,  TclCompileLshiftOpCmd,   1 },
-    { ">>", TclRshiftOpCmd,  TclCompileRshiftOpCmd,   1 },
-    { "%",  TclModOpCmd,     TclCompileModOpCmd,      1 },
-    { "!=", TclNeqOpCmd,     TclCompileNeqOpCmd,      1 },
-    { "ne", TclStrneqOpCmd,  TclCompileStrneqOpCmd,   1 },
-    { "in", TclInOpCmd,	     TclCompileInOpCmd,	      1 },
-    { "ni", TclNiOpCmd,	     TclCompileNiOpCmd,	      1 },
-    { "-",  TclMinusOpCmd,   TclCompileMinusOpCmd,    1 },
-    { "/",  TclDivOpCmd,     TclCompileDivOpCmd,      1 },
-    { "<",  TclLessOpCmd,    TclCompileLessOpCmd,     1 },
-    { "<=", TclLeqOpCmd,     TclCompileLeqOpCmd,      1 },
-    { ">",  TclGreaterOpCmd, TclCompileGreaterOpCmd,  1 },
-    { ">=", TclGeqOpCmd,     TclCompileGeqOpCmd,      1 },
-    { "==", TclEqOpCmd,	     TclCompileEqOpCmd,	      1 },
-    { "eq", TclStreqOpCmd,   TclCompileStreqOpCmd,    1 },
-    { NULL, NULL,	     NULL,		      0 }
+typedef struct {
+    const char *name;		/* Name of object-based command. */
+    Tcl_ObjCmdProc *objProc;	/* Object-based function for command. */
+    CompileProc *compileProc;	/* Function called to compile command. */
+    int numArgs;
+    const char *expected;	/* For error message, what argument(s)
+				 * were expected. */
+} OpCmdInfo;
+
+static const OpCmdInfo mathOpCmds[] = {
+    { "~",  TclSingleOpCmd,  TclCompileInvertOpCmd,   1, "integer" },
+    { "!",  TclSingleOpCmd,  TclCompileNotOpCmd,      1, "boolean" },
+    { "+",  TclAddOpCmd,     TclCompileAddOpCmd,      0, NULL },
+    { "*",  TclMulOpCmd,     TclCompileMulOpCmd,      0, NULL },
+    { "&",  TclAndOpCmd,     TclCompileAndOpCmd,      0, NULL },
+    { "|",  TclOrOpCmd,	     TclCompileOrOpCmd,	      0, NULL },
+    { "^",  TclXorOpCmd,     TclCompileXorOpCmd,      0, NULL },
+    { "**", TclPowOpCmd,     TclCompilePowOpCmd,      0, NULL },
+    { "<<", TclSingleOpCmd,  TclCompileLshiftOpCmd,   2, "integer shift" },
+    { ">>", TclSingleOpCmd,  TclCompileRshiftOpCmd,   2, "integer shift" },
+    { "%",  TclSingleOpCmd,  TclCompileModOpCmd,      2, "integer integer" },
+    { "!=", TclSingleOpCmd,  TclCompileNeqOpCmd,      2, "value value"},
+    { "ne", TclSingleOpCmd,  TclCompileStrneqOpCmd,   2, "value value" },
+    { "in", TclSingleOpCmd,  TclCompileInOpCmd,	      2, "value list"},
+    { "ni", TclSingleOpCmd,  TclCompileNiOpCmd,	      2, "value list"},
+    { "-",  TclMinusOpCmd,   TclCompileMinusOpCmd,    0, NULL },
+    { "/",  TclDivOpCmd,     TclCompileDivOpCmd,      0, NULL },
+    { "<",  TclLessOpCmd,    TclCompileLessOpCmd,     0, NULL },
+    { "<=", TclLeqOpCmd,     TclCompileLeqOpCmd,      0, NULL },
+    { ">",  TclGreaterOpCmd, TclCompileGreaterOpCmd,  0, NULL },
+    { ">=", TclGeqOpCmd,     TclCompileGeqOpCmd,      0, NULL },
+    { "==", TclEqOpCmd,	     TclCompileEqOpCmd,	      0, NULL },
+    { "eq", TclStreqOpCmd,   TclCompileStreqOpCmd,    0, NULL },
+    { NULL, NULL,	     NULL,		      0, NULL }
 };
 
 /*
@@ -322,6 +332,7 @@ Tcl_CreateInterp(void)
     Tcl_Interp *interp;
     Command *cmdPtr;
     const BuiltinFuncDef *builtinFuncPtr;
+    const OpCmdInfo *opcmdInfoPtr;
     const CmdInfo *cmdInfoPtr;
     const CmdInfo2 *cmdInfo2Ptr;
     Tcl_Namespace *mathfuncNSPtr, *mathopNSPtr;
@@ -633,14 +644,20 @@ Tcl_CreateInterp(void)
     }
     (void) Tcl_Export(interp, mathopNSPtr, "*", 1);
     strcpy(mathFuncName, "::tcl::mathop::");
-    for (cmdInfoPtr=mathOpCmds ; cmdInfoPtr->name!=NULL ; cmdInfoPtr++) {
-	strcpy(mathFuncName + MATH_OP_PREFIX_LEN, cmdInfoPtr->name);
+    for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++) {
+	TclOpCmdClientData *occdPtr
+		= (TclOpCmdClientData *) ckalloc(sizeof(TclOpCmdClientData));
+	occdPtr->operator = opcmdInfoPtr->name;
+	occdPtr->numArgs = opcmdInfoPtr->numArgs;
+	occdPtr->expected = opcmdInfoPtr->expected;
+	strcpy(mathFuncName + MATH_OP_PREFIX_LEN, opcmdInfoPtr->name);
 	cmdPtr = (Command *) Tcl_CreateObjCommand(interp, mathFuncName,
-		cmdInfoPtr->objProc, NULL, NULL);
+		opcmdInfoPtr->objProc, (ClientData) occdPtr,
+		DeleteOpCmdClientData);
 	if (cmdPtr == NULL) {
-	    Tcl_Panic("failed to create math operator %s", cmdInfoPtr->name);
-	} else if (cmdInfoPtr->compileProc != NULL) {
-	    cmdPtr->compileProc = cmdInfoPtr->compileProc;
+	    Tcl_Panic("failed to create math operator %s", opcmdInfoPtr->name);
+	} else if (opcmdInfoPtr->compileProc != NULL) {
+	    cmdPtr->compileProc = opcmdInfoPtr->compileProc;
 	}
     }
 
@@ -717,6 +734,14 @@ Tcl_CreateInterp(void)
 
     return interp;
 }
+
+static void
+DeleteOpCmdClientData(
+    ClientData clientData)
+{
+    TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
+    ckfree((char *)occdPtr);
+}
 
 /*
  *----------------------------------------------------------------------
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 146c3c4..195f67e 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompExpr.c,v 1.41 2006/12/08 18:08:33 dgp Exp $
+ * RCS: @(#) $Id: tclCompExpr.c,v 1.42 2006/12/08 20:48:09 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -2584,38 +2584,23 @@ CompileExprTree(
     }
 }
 
-int
-TclInvertOpCmd(
-    ClientData clientData,
+static int
+OpCmd(
     Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
+    OpNode *nodes,
+    Tcl_Obj * const litObjv[])
 {
     CompileEnv compEnv;
     ByteCode *byteCodePtr;
-    OpNode nodes[2];
-    int code, tmp = 1;
-    Tcl_Obj *byteCodeObj;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "number");
-	return TCL_ERROR;
-    }
+    int code, tmp=1;
+    Tcl_Obj *byteCodeObj = Tcl_NewObj();
 
     /* Note we are compiling an expression with literal arguments.
      * This means there can be no [info frame] calls when we execute
      * the resulting bytecode, so there's no need to tend to TIP 280 issues */
     TclInitCompileEnv(interp, &compEnv, NULL, 0, NULL, 0);
-
-    nodes[0].lexeme = START;
-    nodes[0].right = 1;
-    nodes[1].lexeme = BIT_NOT;
-    nodes[1].right = OT_LITERAL;
-    nodes[1].parent = 0;
-
-    CompileExprTree(interp, nodes, objv+1, NULL, NULL, &tmp, &compEnv);
+    CompileExprTree(interp, nodes, litObjv, NULL, NULL, &tmp, &compEnv);
     TclEmitOpcode(INST_DONE, &compEnv);
-    byteCodeObj = Tcl_NewObj();
     Tcl_IncrRefCount(byteCodeObj);
     TclInitByteCodeObj(byteCodeObj, &compEnv);
     TclFreeCompileEnv(&compEnv);
@@ -2624,6 +2609,35 @@ TclInvertOpCmd(
     Tcl_DecrRefCount(byteCodeObj);
     return code;
 }
+
+int
+TclSingleOpCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
+    unsigned char lexeme;
+    OpNode nodes[2];
+
+    if (objc != 1+occdPtr->numArgs) {
+	Tcl_WrongNumArgs(interp, 1, objv, occdPtr->expected);
+	return TCL_ERROR;
+    }
+
+    ParseLexeme(occdPtr->operator, strlen(occdPtr->operator), &lexeme, NULL);
+    nodes[0].lexeme = START;
+    nodes[0].right = 1;
+    nodes[1].lexeme = lexeme;
+    nodes[1].left = OT_LITERAL;
+    nodes[1].right = OT_LITERAL;
+    nodes[1].parent = 0;
+
+    return OpCmd(interp, nodes, objv+1);
+}
+
+
 
 /*
  *----------------------------------------------------------------------
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 5dc9cd7..c864c3c 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -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: tclCompile.h,v 1.63 2006/12/08 18:08:35 dgp Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.64 2006/12/08 20:48:09 dgp Exp $
  */
 
 #ifndef _TCLCOMPILATION
@@ -746,6 +746,16 @@ typedef struct JumptableInfo {
 } JumptableInfo;
 
 MODULE_SCOPE AuxDataType	tclJumptableInfoType;
+
+/*
+ * ClientData type used by the math operator commands.
+ */
+typedef struct {
+    const char *operator;
+    const char *expected;
+    int numArgs;
+} TclOpCmdClientData;
+
 
 /*
  *----------------------------------------------------------------
@@ -845,6 +855,9 @@ MODULE_SCOPE int	TclRegisterLiteral(CompileEnv *envPtr,
 MODULE_SCOPE void	TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
 MODULE_SCOPE void	TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
 			    Command *cmdPtr);
+MODULE_SCOPE int	TclSingleOpCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]);
 #ifdef TCL_COMPILE_DEBUG
 MODULE_SCOPE void	TclVerifyGlobalLiteralTable(Interp *iPtr);
 MODULE_SCOPE void	TclVerifyLocalLiteralTable(CompileEnv *envPtr);
diff --git a/generic/tclMathOp.c b/generic/tclMathOp.c
index f146a39..0ef70a1 100644
--- a/generic/tclMathOp.c
+++ b/generic/tclMathOp.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclMathOp.c,v 1.6 2006/12/08 18:08:37 dgp Exp $
+ * RCS: @(#) $Id: tclMathOp.c,v 1.7 2006/12/08 20:48:09 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -1047,7 +1047,7 @@ CompareNumbers(
  *
  *----------------------------------------------------------------------
  */
-#if 0
+
 int
 TclInvertOpCmd(
     ClientData clientData,
@@ -1108,7 +1108,6 @@ TclInvertOpCmd(
     }
     }
 }
-#endif
 
 /*
  *----------------------------------------------------------------------
diff --git a/tests/mathop.test b/tests/mathop.test
index 477120d..b7e886b 100644
--- a/tests/mathop.test
+++ b/tests/mathop.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution of
 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: mathop.test,v 1.6 2006/12/08 16:14:18 dgp Exp $
+# RCS: @(#) $Id: mathop.test,v 1.7 2006/12/08 20:48:09 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2.1
@@ -306,10 +306,10 @@ namespace eval ::testmathop {
     } -returnCodes error -result {can't use non-numeric string as operand of "~"}
     test mathop-4.9 {compiled ~: errors} -body {
 	~ 0 0
-    } -returnCodes error -result "wrong # args: should be \"~ number\""
+    } -returnCodes error -result "wrong # args: should be \"~ integer\""
     test mathop-4.10 {compiled ~: errors} -body {
 	~
-    } -returnCodes error -result "wrong # args: should be \"~ number\""
+    } -returnCodes error -result "wrong # args: should be \"~ integer\""
     test mathop-4.11 {compiled ~: errors} -returnCodes error -body {
 	~ 0.0
     } -result {can't use floating-point value as operand of "~"}
@@ -329,10 +329,10 @@ namespace eval ::testmathop {
     } -returnCodes error -result {can't use non-numeric string as operand of "~"}
     test mathop-4.21 {interpreted ~: errors} -body {
 	$op 0 0
-    } -returnCodes error -result "wrong # args: should be \"~ number\""
+    } -returnCodes error -result "wrong # args: should be \"~ integer\""
     test mathop-4.22 {interpreted ~: errors} -body {
 	$op
-    } -returnCodes error -result "wrong # args: should be \"~ number\""
+    } -returnCodes error -result "wrong # args: should be \"~ integer\""
     test mathop-4.23 {interpreted ~: errors} -returnCodes error -body {
 	$op 0.0
     } -result {can't use floating-point value as operand of "~"}