summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclAssembly.c10
-rw-r--r--generic/tclCmdMZ.c2
-rw-r--r--generic/tclCompCmdsSZ.c82
-rw-r--r--generic/tclCompile.c5
-rw-r--r--generic/tclCompile.h19
-rw-r--r--generic/tclExecute.c52
-rw-r--r--generic/tclInt.h3
7 files changed, 160 insertions, 13 deletions
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 5ff96fd..10df71a 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -474,6 +474,7 @@ static const TalInstDesc TalInstructionTable[] = {
{"streq", ASSEM_1BYTE, INST_STR_EQ, 2, 1},
{"strindex", ASSEM_1BYTE, INST_STR_INDEX, 2, 1},
{"strlen", ASSEM_1BYTE, INST_STR_LEN, 1, 1},
+ {"strmap", ASSEM_1BYTE, INST_STR_MAP, 3, 1},
{"strmatch", ASSEM_BOOL, INST_STR_MATCH, 2, 1},
{"strneq", ASSEM_1BYTE, INST_STR_NEQ, 2, 1},
{"sub", ASSEM_1BYTE, INST_SUB, 2, 1},
@@ -507,10 +508,11 @@ static const unsigned char NonThrowingByteCodes[] = {
INST_PUSH_RETURN_OPTIONS, /* 108 */
INST_REVERSE, /* 126 */
INST_NOP, /* 132 */
- INST_COROUTINE_NAME, /* 142 */
- INST_NS_CURRENT, /* 143 */
- INST_INFO_LEVEL_NUM, /* 144 */
- INST_RESOLVE_COMMAND /* 146 */
+ INST_STR_MAP, /* 141 */
+ INST_COROUTINE_NAME, /* 143 */
+ INST_NS_CURRENT, /* 144 */
+ INST_INFO_LEVEL_NUM, /* 145 */
+ INST_RESOLVE_COMMAND /* 147 */
};
/*
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 9e720ea..1f210dd 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -3309,7 +3309,7 @@ TclInitStringCmd(
{"is", StringIsCmd, NULL, NULL, NULL, 0},
{"last", StringLastCmd, NULL, NULL, NULL, 0},
{"length", StringLenCmd, TclCompileStringLenCmd, NULL, NULL, 0},
- {"map", StringMapCmd, NULL, NULL, NULL, 0},
+ {"map", StringMapCmd, TclCompileStringMapCmd, NULL, NULL, 0},
{"match", StringMatchCmd, TclCompileStringMatchCmd, NULL, NULL, 0},
{"range", StringRangeCmd, NULL, NULL, NULL, 0},
{"repeat", StringReptCmd, NULL, NULL, NULL, 0},
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index d7dd58e..b8dada5 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -557,6 +557,88 @@ TclCompileStringLenCmd(
/*
*----------------------------------------------------------------------
*
+ * TclCompileStringMapCmd --
+ *
+ * Procedure called to compile the simplest and most common form of the
+ * "string map" 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 "string map" command
+ * at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileStringMapCmd(
+ 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_Token *mapTokenPtr, *stringTokenPtr;
+ Tcl_Obj *mapObj, **objv;
+ char *bytes;
+ int len;
+
+ /*
+ * We only handle the case:
+ *
+ * string map {foo bar} $thing
+ *
+ * That is, a literal two-element list (doesn't need to be brace-quoted,
+ * but does need to be compile-time knowable) and any old argument (the
+ * thing to map).
+ */
+
+ if (parsePtr->numWords != 3) {
+ return TCL_ERROR;
+ }
+ mapTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ stringTokenPtr = TokenAfter(mapTokenPtr);
+ mapObj = Tcl_NewObj();
+ Tcl_IncrRefCount(mapObj);
+ if (!TclWordKnownAtCompileTime(mapTokenPtr, mapObj)) {
+ Tcl_DecrRefCount(mapObj);
+ return TCL_ERROR;
+ } else if (Tcl_ListObjGetElements(NULL, mapObj, &len, &objv) != TCL_OK) {
+ Tcl_DecrRefCount(mapObj);
+ return TCL_ERROR;
+ } else if (len != 2) {
+ Tcl_DecrRefCount(mapObj);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Now issue the opcodes. Note that in the case that we know that the
+ * first word is an empty word, we don't issue the map at all. That is the
+ * correct semantics for mapping.
+ */
+
+ bytes = Tcl_GetStringFromObj(objv[0], &len);
+ if (len == 0) {
+ CompileWord(envPtr, stringTokenPtr, interp, 2);
+ } else {
+ PushLiteral(envPtr, bytes, len);
+ bytes = Tcl_GetStringFromObj(objv[1], &len);
+ PushLiteral(envPtr, bytes, len);
+ CompileWord(envPtr, stringTokenPtr, interp, 2);
+ TclEmitOpcode(INST_STR_MAP, envPtr);
+ }
+ Tcl_DecrRefCount(mapObj);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclCompileSubstCmd --
*
* Procedure called to compile the "subst" command.
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 1924334..8b98746 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -435,6 +435,11 @@ InstructionDesc const tclInstructionTable[] = {
* indicated by the LVT index. Part of [dict with].
* Stack: ... path keyList => ... */
+ {"strmap", 1, -2, 0, {OPERAND_NONE}},
+ /* Simplified version of [string map] that only applies one change
+ * string, and only case-sensitively.
+ * Stack: ... from to string => changedString */
+
{"yield", 1, 0, 0, {OPERAND_NONE}},
/* Makes the current coroutine yield the value at the top of the
* stack, and places the response back on top of the stack when it
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index fcff46c..ff2f0e3 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -681,19 +681,22 @@ typedef struct ByteCode {
#define INST_DICT_RECOMBINE_STK 139
#define INST_DICT_RECOMBINE_IMM 140
+/* For [string map] and [regsub] compilation */
+#define INST_STR_MAP 141
+
/* For operations to do with coroutines */
-#define INST_YIELD 141
-#define INST_COROUTINE_NAME 142
+#define INST_YIELD 142
+#define INST_COROUTINE_NAME 143
/* For compilation of basic information operations */
-#define INST_NS_CURRENT 143
-#define INST_INFO_LEVEL_NUM 144
-#define INST_INFO_LEVEL_ARGS 145
-#define INST_RESOLVE_COMMAND 146
-#define INST_TCLOO_SELF 147
+#define INST_NS_CURRENT 144
+#define INST_INFO_LEVEL_NUM 145
+#define INST_INFO_LEVEL_ARGS 146
+#define INST_RESOLVE_COMMAND 147
+#define INST_TCLOO_SELF 148
/* The last opcode */
-#define LAST_INST_OPCODE 147
+#define LAST_INST_OPCODE 148
/*
* Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index b42e4ab..10cbf46 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -4732,6 +4732,58 @@ TEBCresume(
O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
+ case INST_STR_MAP: {
+ Tcl_UniChar *ustring1, *ustring2, *ustring3, *end, *p;
+ int length3;
+ Tcl_Obj *value3Ptr;
+
+ valuePtr = OBJ_AT_TOS; /* "Main" string. */
+ value3Ptr = OBJ_UNDER_TOS; /* "Target" string. */
+ value2Ptr = OBJ_AT_DEPTH(2); /* "Source" string. */
+ if (value3Ptr == value2Ptr || valuePtr == value2Ptr) {
+ objResultPtr = valuePtr;
+ NEXT_INST_V(1, 3, 1);
+ }
+ ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
+ if (length == 0) {
+ objResultPtr = valuePtr;
+ NEXT_INST_V(1, 3, 1);
+ }
+ ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
+ if (length2 > length || length2 == 0) {
+ objResultPtr = valuePtr;
+ NEXT_INST_V(1, 3, 1);
+ }
+ ustring3 = Tcl_GetUnicodeFromObj(value3Ptr, &length3);
+
+ objResultPtr = Tcl_NewUnicodeObj(ustring1, 0);
+ p = ustring1;
+ end = ustring1 + length;
+ for (; ustring1 < end; ustring1++) {
+ if ((*ustring1 == *ustring2) &&
+ (length2==1 || Tcl_UniCharNcmp(ustring1, ustring2,
+ (unsigned long) length2) == 0)) {
+ if (p != ustring1) {
+ Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1-p);
+ p = ustring1 + length2;
+ } else {
+ p += length2;
+ }
+ ustring1 = p - 1;
+
+ Tcl_AppendUnicodeToObj(objResultPtr, ustring3, length3);
+ }
+ }
+ if (p != ustring1) {
+ /*
+ * Put the rest of the unmapped chars onto result.
+ */
+
+ Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1 - p);
+ }
+ NEXT_INST_V(1, 3, 1);
+ }
+
case INST_STR_MATCH:
nocase = TclGetInt1AtPtr(pc+1);
valuePtr = OBJ_AT_TOS; /* String */
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 46c7a13..3aaed4c 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3634,6 +3634,9 @@ MODULE_SCOPE int TclCompileStringIndexCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileStringLenCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileStringMapCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileStringMatchCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
generated by cgit v0.12 at 2024-11-10 22:15:44 (GMT)