summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclCompExpr.c129
-rw-r--r--generic/tclInt.h2
-rw-r--r--generic/tclParse.c76
3 files changed, 182 insertions, 25 deletions
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index d5cb11a..7074253 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -734,20 +734,58 @@ ParseExpr(
if (start[scanned+TclParseAllWhiteSpace(
start+scanned, numBytes-scanned)] == '(') {
- lexeme = FUNCTION;
- /*
- * When we compile the expression we'll need the function
- * name, and there's no place in the parse tree to store
- * it, so we keep a separate list of all the function
- * names we've parsed in the order we found them.
+ /* Look ahead for assignment operator */
+
+ /*
+ * TODO: this can probably be simplified.
+ * For now, it is working.
*/
- Tcl_ListObjAppendElement(NULL, funcList, literal);
+ Tcl_Parse vparse;
+ const char *varend, *varstart = &start[TclParseAllWhiteSpace(start, numBytes)];
+ int code, len;
+ TclParseInit(interp, varstart, numBytes, &vparse);
+ code = Tcl_ParseVarName(NULL, varstart, numBytes, &vparse, 0);
+ if (code != TCL_OK) {
+ //fprintf(stderr, "Replace me with proper error!\n");
+ }
+ len = vparse.tokenPtr[0].size;
+ varend = varstart+len;
+ Tcl_FreeParse(&vparse);
+
+ /* Look ahead for Assignment operator ':=' */
+ if (code == TCL_OK &&
+ varend[TclParseAllWhiteSpace(varend,numBytes-len)] == ':' &&
+ varend[TclParseAllWhiteSpace(varend,numBytes-len)+1] == '=') {
+
+ lexeme = VARNAME;
+
+ /* Adjust scanned bytes */
+ scanned = varend-start;
+
+ /* The variable name is tokenized below as a quoted string */
+
+ } else {
+
+ lexeme = FUNCTION;
+
+ /*
+ * When we compile the expression we'll need the function
+ * name, and there's no place in the parse tree to store
+ * it, so we keep a separate list of all the function
+ * names we've parsed in the order we found them.
+ */
+
+ Tcl_ListObjAppendElement(NULL, funcList, literal);
+ }
+
} else if (start[scanned+TclParseAllWhiteSpace(
start+scanned, numBytes-scanned)] == ':' &&
start[scanned+TclParseAllWhiteSpace(
start+scanned, numBytes-scanned)+1] == '=') {
+
+ /* Simple bareword */
lexeme = VARNAME;
/* The variable name is stored as an OT_LITERAL below */
@@ -862,7 +900,6 @@ ParseExpr(
switch (lexeme) {
case NUMBER:
case BOOLEAN:
- case VARNAME:
/*
* TODO: Consider using a dict or hash to collapse all
* duplicate literals into a single representative value.
@@ -886,6 +923,21 @@ ParseExpr(
numBytes -= scanned;
continue;
+ case VARNAME: {
+ int length;
+ TclGetStringFromObj(literal, &length);
+ if (length < scanned) {
+ // Go tokenize the literal...
+ break;
+ } else {
+ Tcl_ListObjAppendElement(NULL, litList, literal);
+ complete = lastParsed = OT_LITERAL;
+ start += scanned;
+ numBytes -= scanned;
+ continue;
+ }
+ } /* VARNAME case */
+
default:
break;
}
@@ -932,6 +984,13 @@ ParseExpr(
scanned = tokenPtr->size;
break;
+ case VARNAME:
+ code = TclParseTokens(NULL, start, scanned, TCL_SUBST_ALL, 1,
+ parsePtr);
+
+ // scanned already adjusted...
+ break;
+
case SCRIPT: {
Tcl_Parse *nestedPtr =
TclStackAlloc(interp, sizeof(Tcl_Parse));
@@ -1327,6 +1386,20 @@ ParseExpr(
}
}
+ /* Enfocre LHS is literal, bareword, function
+ * TODO: If function, convert to array reference
+ */
+ if (lexeme == ASSIGN) {
+ if (complete != OT_LITERAL &&
+ complete != OT_TOKENS &&
+ complete != FUNCTION) {
+
+ TclNewLiteralStringObj(msg, "Target of assignment must be string");
+ errCode = "SURPRISE";
+ goto error;
+ }
+ }
+
/* Commas must appear only in function argument lists. */
if (lexeme == COMMA) {
if ((incompletePtr->lexeme != OPEN_PAREN)
@@ -1614,7 +1687,9 @@ DumpExprTreeIndent(
{1,"+"},{2,"-"},{3,"bareword"},{4,"incompatible"},{5,"invalid"},
{0xc1,"number"},{0xc2,"[command]"},{0xc3,"boolean"},{0xc4,"{string}"},{0xc5,"$var"},{0xc6,"\"string\""},{0xc7,"()"},
{0x81,"+"},{0x82,"-"},{0x83,"function"},{0x84,"start"},{0x85,"("},{0x86,"!"},{0x87,"~"},
- {0x41,"+"},{0x42,"-"},{0x43,","},{0x4c,"?"},{0x4d,":"},
+ {0x41,"+"},{0x42,"-"},{0x43,","},{0x44,"*"},{0x45,"/"},{0x46,"%"},{0x47,","},{0x48,">"},
+ {0x49,"&"},{0x4a,"^"},{0x4b,"|"},
+ {0x4c,"?"},{0x4d,":"},
{0x5B,")"},{0x5c,"end"},{0x5d,";"},{0x5e,":="}
};
static int lexdone=0;
@@ -2224,9 +2299,13 @@ ParseLexeme(
return 1;
case ':':
- if ((numBytes > 1) && (start[1] == '=')) {
- *lexemePtr = ASSIGN;
- return 2;
+ if (numBytes > 1) {
+ if (start[1] == '=') {
+ *lexemePtr = ASSIGN;
+ return 2;
+ } else if (start[1] == ':') {
+ break; // bareword
+ }
}
*lexemePtr = COLON;
return 1;
@@ -2387,7 +2466,7 @@ ParseLexeme(
* have no direct relevance here.
*/
- if (!TclIsBareword(*start) || *start == '_') {
+ if ((!TclIsBareword(*start) && strncmp("::",start,2)) || *start == '_') {
if (Tcl_UtfCharComplete(start, numBytes)) {
scanned = Tcl_UtfToUniChar(start, &ch);
} else {
@@ -2402,9 +2481,14 @@ ParseLexeme(
return scanned;
}
end = start;
- while (numBytes && TclIsBareword(*end)) {
- end += 1;
- numBytes -= 1;
+ while (numBytes && (TclIsBareword(*end) || !strncmp("::",end,2))) {
+ if (*end==':') {
+ end += 2;
+ numBytes -= 2;
+ } else {
+ end += 1;
+ numBytes -= 1;
+ }
}
*lexemePtr = BAREWORD;
if (literalPtr) {
@@ -2649,15 +2733,10 @@ CompileExprTree(
}
break;
case ASSIGN:
- if (convert) {
- /*
- * Make sure we assign to a variable only values that
- * have been numerically normalized in the expr way.
- */
- TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
- /* already converted */
- convert = 0;
- }
+ /* No need to convert, value should aready be
+ * numeric result of expression.
+ * A non-numeric result is probably intentional.
+ */
TclEmitOpcode(INST_STORE_STK, envPtr);
break;
case OPEN_PAREN:
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 4b4f1f3..327ad3b 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3054,6 +3054,8 @@ MODULE_SCOPE int TclParseNumber(Tcl_Interp *interp, Tcl_Obj *objPtr,
MODULE_SCOPE void TclParseInit(Tcl_Interp *interp, const char *string,
int numBytes, Tcl_Parse *parsePtr);
MODULE_SCOPE int TclParseAllWhiteSpace(const char *src, int numBytes);
+MODULE_SCOPE int TclParseTokens(Tcl_Interp *interp, const char *bytes,
+ int numBytes, int flags, int append, Tcl_Parse *parsePtr);
MODULE_SCOPE int TclProcessReturn(Tcl_Interp *interp,
int code, int level, Tcl_Obj *returnOpts);
MODULE_SCOPE int TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
diff --git a/generic/tclParse.c b/generic/tclParse.c
index 3a04df4..71f51b6 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -2502,6 +2502,82 @@ TclObjCommandComplete(
}
/*
+ *----------------------------------------------------------------------
+ *
+ * TclParseTokens --
+ *
+ * Token parser used by ParseExpr. Parses the string made up of
+ * 'numBytes' bytes starting at 'bytes'. Parsing is controlled by the
+ * flags argument to limit which substitutions to apply, as
+ * represented by the flag values TCL_SUBST_BACKSLASHES,
+ * TCL_SUBST_COMMANDS, TCL_SUBST_VARIABLES.
+ *
+ * Results:
+ * Tokens are added to parsePtr and parsePtr->term is filled in with the
+ * address of the character that terminated the parse (the character at
+ * parsePtr->end). The return value is TCL_OK if the parse completed
+ * successfully and TCL_ERROR otherwise. If a parse error occurs and
+ * parsePtr->interp is not NULL, then an error message is left in the
+ * interpreter's result.
+ *
+ * Side effects:
+ * The Tcl_Parse struct '*parsePtr' is filled with parse results.
+ * The caller is expected to eventually call Tcl_FreeParse() to properly
+ * cleanup the value written there.
+ *
+ * If a parse error occurs, the Tcl_InterpState value '*statePtr' is
+ * filled with the state created by that error. When *statePtr is written
+ * to, the caller is expected to make the required calls to either
+ * Tcl_RestoreInterpState() or Tcl_DiscardInterpState() to dispose of the
+ * value written there.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclParseTokens(
+ Tcl_Interp *interp,
+ const char *bytes,
+ int numBytes,
+ int flags,
+ int append,
+ Tcl_Parse *parsePtr)
+{
+ int length = numBytes;
+ const char *p = bytes;
+ int code, offset, i;
+ int startToken;
+
+ if (!append) {
+ TclParseInit(interp, p, length, parsePtr);
+ }
+
+ startToken = parsePtr->numTokens;
+
+ /*
+ * First parse the string rep of objPtr, as if it were enclosed as a
+ * "-quoted word in a normal Tcl command. Honor flags that selectively
+ * inhibit types of substitution.
+ */
+
+ code = ParseTokens(p, length, /* mask */ 0, flags, parsePtr);
+ /* Truncate last token to length */
+ /* Hack? Why does ParseTokens not stop at numBytes? */
+ for (i=startToken; i<parsePtr->numTokens; i++) {
+ offset = parsePtr->tokenPtr[i].start - p + parsePtr->tokenPtr[i].size;
+ if (offset >= length) break;
+ }
+ if (offset > length) {
+ parsePtr->tokenPtr[i].size = length - (parsePtr->tokenPtr[i].start - p);
+ /* Truncate tokens */
+ if (i < parsePtr->numTokens)
+ parsePtr->numTokens = i + 1;
+ }
+ return code;
+}
+
+
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4
generated by cgit v0.12 at 2024-07-15 13:45:43 (GMT)