summaryrefslogtreecommitdiffstats
path: root/generic/tclCompCmds.c
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2014-01-07 14:19:04 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2014-01-07 14:19:04 (GMT)
commita952237bcf20a7d4140f857c095b3bf0417ca40a (patch)
tree7d9ce87fc3e6d661dd7d680b10ab279348c76da9 /generic/tclCompCmds.c
parent92f27b7095220ef6e508c9a0216e0fce97b3d2ae (diff)
parent8bb7405765b9aed27270dfd145037e3c5884a34a (diff)
downloadtcl-a952237bcf20a7d4140f857c095b3bf0417ca40a.zip
tcl-a952237bcf20a7d4140f857c095b3bf0417ca40a.tar.gz
tcl-a952237bcf20a7d4140f857c095b3bf0417ca40a.tar.bz2
Add compilations for the following commands:
* concat * linsert * namespace origin * next * string replace * string tolower * string totitle * string toupper * string trim * string trimleft * string trimright
Diffstat (limited to 'generic/tclCompCmds.c')
-rw-r--r--generic/tclCompCmds.c91
1 files changed, 89 insertions, 2 deletions
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 3d5bfe0..d1d7a80 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -690,6 +690,93 @@ TclCompileCatchCmd(
/*
*----------------------------------------------------------------------
*
+ * TclCompileConcatCmd --
+ *
+ * Procedure called to compile the "concat" 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 "concat" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileConcatCmd(
+ 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. */
+{
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Obj *objPtr, *listObj;
+ Tcl_Token *tokenPtr;
+ int i;
+
+ /* TODO: Consider compiling expansion case. */
+ if (parsePtr->numWords == 1) {
+ /*
+ * [concat] without arguments just pushes an empty object.
+ */
+
+ PushStringLiteral(envPtr, "");
+ return TCL_OK;
+ }
+
+ /*
+ * Test if all arguments are compile-time known. If they are, we can
+ * implement with a simple push.
+ */
+
+ listObj = Tcl_NewObj();
+ for (i = 1, tokenPtr = parsePtr->tokenPtr; i < parsePtr->numWords; i++) {
+ tokenPtr = TokenAfter(tokenPtr);
+ objPtr = Tcl_NewObj();
+ if (!TclWordKnownAtCompileTime(tokenPtr, objPtr)) {
+ Tcl_DecrRefCount(objPtr);
+ Tcl_DecrRefCount(listObj);
+ listObj = NULL;
+ break;
+ }
+ (void) Tcl_ListObjAppendElement(NULL, listObj, objPtr);
+ }
+ if (listObj != NULL) {
+ Tcl_Obj **objs;
+ const char *bytes;
+ int len;
+
+ Tcl_ListObjGetElements(NULL, listObj, &len, &objs);
+ objPtr = Tcl_ConcatObj(len, objs);
+ Tcl_DecrRefCount(listObj);
+ bytes = Tcl_GetStringFromObj(objPtr, &len);
+ PushLiteral(envPtr, bytes, len);
+ Tcl_DecrRefCount(objPtr);
+ return TCL_OK;
+ }
+
+ /*
+ * General case: runtime concat.
+ */
+
+ for (i = 1, tokenPtr = parsePtr->tokenPtr; i < parsePtr->numWords; i++) {
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, i);
+ }
+
+ TclEmitInstInt4( INST_CONCAT_STK, i-1, envPtr);
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclCompileContinueCmd --
*
* Procedure called to compile the "continue" command.
@@ -1678,7 +1765,7 @@ TclCompileDictAppendCmd(
tokenPtr = TokenAfter(tokenPtr);
}
if (parsePtr->numWords > 4) {
- TclEmitInstInt1(INST_CONCAT1, parsePtr->numWords-3, envPtr);
+ TclEmitInstInt1(INST_STR_CONCAT1, parsePtr->numWords-3, envPtr);
}
/*
@@ -3011,7 +3098,7 @@ TclCompileFormatCmd(
* Do the concatenation, which produces the result.
*/
- TclEmitInstInt1(INST_CONCAT1, i, envPtr);
+ TclEmitInstInt1(INST_STR_CONCAT1, i, envPtr);
} else {
/*
* EVIL HACK! Force there to be a string representation in the case