diff options
Diffstat (limited to 'generic/tclCompExpr.c')
-rw-r--r-- | generic/tclCompExpr.c | 129 |
1 files changed, 104 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: |