Tentative implementation of the "pure" part of TIP 429: the [id] function (bytecoded). To be discussed.

4 files changed, 93 insertions, 0 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 2a334c4..edf127d 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -221,6 +221,7 @@ static const CmdInfo builtInCmds[] = {
     {"foreach",		Tcl_ForeachObjCmd,	TclCompileForeachCmd,	TclNRForeachCmd,	CMD_IS_SAFE},
     {"format",		Tcl_FormatObjCmd,	TclCompileFormatCmd,	NULL,	CMD_IS_SAFE},
     {"global",		Tcl_GlobalObjCmd,	TclCompileGlobalCmd,	NULL,	CMD_IS_SAFE},
+    {"id",		Tcl_IdObjCmd,		TclCompileIdCmd,	NULL,	CMD_IS_SAFE},
     {"if",		Tcl_IfObjCmd,		TclCompileIfCmd,	TclNRIfObjCmd,	CMD_IS_SAFE},
     {"incr",		Tcl_IncrObjCmd,		TclCompileIncrCmd,	NULL,	CMD_IS_SAFE},
     {"join",		Tcl_JoinObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index d723e4b..ec6ad14 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -191,6 +191,42 @@ static const EnsembleImplMap defaultInfoMap[] = {
 /*
  *----------------------------------------------------------------------
  *
+ * Tcl_IdObjCmd --
+ *
+ *	This procedure is invoked to process the "id" Tcl command. See the
+ *	user documentation for details on what it does.
+ *
+ *	With the bytecode compiler, this procedure is only called in case of
+ *	wrong #args, or if the #args is not known at compile time (expand
+ *	operator).
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_IdObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    if (objc !=2) {
+	Tcl_WrongNumArgs(interp, 0, objv, "id value");
+	return TCL_ERROR;
+    }
+    Tcl_SetObjResult(interp, objv[1]);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_IfObjCmd --
  *
  *	This procedure is invoked to process the "if" Tcl command. See the
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index 166fea0..620c2ff 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -163,6 +163,56 @@ TclCompileGlobalCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * TclCompileIdCmd --
+ *
+ *	Procedure called to compile the "id" command.
+ *
+ * Results:
+ *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ *	evaluation to runtime.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the "id" command at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileIdCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    /*
+     * General syntax: [id value]
+     */
+    int numWords = parsePtr->numWords;
+    Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    DefineLineInformation;	/* TIP #280 */
+
+    if (numWords!=2) {
+	/*
+	 * Wrong #args. Clear the error message,
+	 * and report back to the compiler that this must be interpreted at
+	 * runtime.
+	 */
+
+	Tcl_ResetResult(interp);
+	return TCL_ERROR;
+    }
+    
+    CompileWord(envPtr, wordTokenPtr, interp, numWords-1);
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclCompileIfCmd --
  *
  *	Procedure called to compile the "if" command.
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 1bb2103..119b22e 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3294,6 +3294,9 @@ MODULE_SCOPE int	Tcl_GlobalObjCmd(ClientData clientData,
 MODULE_SCOPE int	Tcl_GlobObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_IdObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
 MODULE_SCOPE int	Tcl_IfObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
@@ -3544,6 +3547,9 @@ MODULE_SCOPE int	TclCompileFormatCmd(Tcl_Interp *interp,
 MODULE_SCOPE int	TclCompileGlobalCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileIdCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileIfCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);