diff options
| author | donal.k.fellows@manchester.ac.uk <dkf> | 2014-01-07 14:19:04 (GMT) |
|---|---|---|
| committer | donal.k.fellows@manchester.ac.uk <dkf> | 2014-01-07 14:19:04 (GMT) |
| commit | 1dd57e7f83b454f114c495ecec9d81fcfa8c13f6 (patch) | |
| tree | 7d9ce87fc3e6d661dd7d680b10ab279348c76da9 /generic/tclCompCmds.c | |
| parent | 97e65e9d96d60d24def60a4484c6baec6303fdf7 (diff) | |
| parent | e6361e562f8e0523dcba08b338dea7f925897d82 (diff) | |
| download | tcl-1dd57e7f83b454f114c495ecec9d81fcfa8c13f6.zip tcl-1dd57e7f83b454f114c495ecec9d81fcfa8c13f6.tar.gz tcl-1dd57e7f83b454f114c495ecec9d81fcfa8c13f6.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.c | 91 |
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 |
